From 946eb7d95fc04d465802c8fc00e5d4130a52c8f2 Mon Sep 17 00:00:00 2001
From: Random Hacker <random_hacker@xapek.org>
Date: Sat, 23 Feb 2013 01:32:51 +0100
Subject: racket: aufgraeumt, data2c gefixt

---
 ebus-racket/ebus/layer2.rkt | 104 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)
 create mode 100644 ebus-racket/ebus/layer2.rkt

(limited to 'ebus-racket/ebus/layer2.rkt')

diff --git a/ebus-racket/ebus/layer2.rkt b/ebus-racket/ebus/layer2.rkt
new file mode 100644
index 0000000..3dd881c
--- /dev/null
+++ b/ebus-racket/ebus/layer2.rkt
@@ -0,0 +1,104 @@
+#lang racket/base
+(require racket/bool
+         (planet bzlib/parseq:1:3))
+
+(define logger (make-logger 'ebus-layer2 (current-logger)))
+;; Ebus SYN
+(define ebus-const-syn #xaa)
+;; Ebus Escape-Sequence Start
+(define ebus-const-escape #xa9)
+;; Ebus ACK
+(define ebus-const-ackok #x00)
+;; Ebus Broadcast Address
+(define ebus-const-broadcastaddr 254)
+
+(struct ebus-body-broadcast (crc) #:transparent)
+
+(struct ebus-body-mastermaster (crc) #:transparent)
+
+(struct ebus-body-masterslave
+	(crc payloadSlaveLength payloadSlave crcSlave)
+	#:transparent)
+
+(struct ebus-paket
+	(source destination primaryCommand secondaryCommand payloadLength payload body)
+	#:transparent)
+
+;; single, maybe escaped, payload data byte 
+(define ebus-payload
+  (choice (seq escape-seq <- ebus-const-escape
+	       escape-code <- (byte-in (list 0 1))
+	       (return (cond
+			((= escape-code 0) ebus-const-escape)
+			((= escape-code 1) bytes ebus-const-syn))))
+	  any-byte
+	  ))
+
+(define parse-ebus-broadcast
+  (token (seq crc <- any-byte
+	      syn <- ebus-const-syn
+	      (return (ebus-body-broadcast crc)))))
+
+(define parse-ebus-mastermaster
+  (token (seq  crc <- any-byte
+	       ack <- ebus-const-ackok ;; ACK des Empfängers
+	       syn <- ebus-const-syn   ;; SYN des Senders
+	       (return (ebus-body-mastermaster crc)))))
+
+(define parse-ebus-masterslave 
+  (token (seq crc <- any-byte
+	      ack <- ebus-const-ackok ;; ACK des Empfängers
+	      payloadSlaveLength <- any-byte
+	      payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength)
+	      crcSlave <- any-byte
+	      ackSlave <- ebus-const-ackok ;; ACK des Senders
+	      synSlave <- ebus-const-syn   ;; SYN des Senders
+	      (return (ebus-body-masterslave crc payloadSlaveLength payloadSlave crcSlave)))))
+
+(define parse-ebus-paket
+  (token (seq source <- any-byte
+	      destination <- any-byte
+	      primaryCommand <- any-byte
+	      secondaryCommand <- any-byte
+	      payloadLength <- any-byte
+	      payload <- (repeat ebus-payload payloadLength payloadLength)
+	      body <- (cond ((= destination ebus-const-broadcastaddr) parse-ebus-broadcast)
+			    (else (choice parse-ebus-mastermaster 
+					  parse-ebus-masterslave)))
+	      (return (ebus-paket source 
+				  destination
+				  primaryCommand
+				  secondaryCommand
+				  payloadLength
+				  payload 
+				  body)))))
+
+(define ebus-sync (tokens syncs <- (seq (repeat (string->bytes/latin-1 "\xaa")))
+                          (return (length syncs))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (read-ebus input-port)
+  (define syn   ((make-reader ebus-sync #:sof? #f #:eof? #f)  input-port))
+  (define paket   ((make-reader parse-ebus-paket #:sof? #f #:eof? #f) input-port))
+  (cond ((not (false? syn))
+	 (log-message logger 'debug (format "drop ~s x SYN (~s)" syn ebus-const-syn) #t)))
+  (cond ((not (false? paket))
+	 paket)
+	((eof-object? (peek-byte input-port))
+	 eof)
+	(else
+	 ;; skip one byte
+	 (let ([byte (read-byte input-port)])
+	   (log-message logger 'debug (format "drop ~s 0x~x ~n" byte byte) #t))
+	 (read-ebus input-port))))
+
+(provide 
+ ;; Read Layer Ebus-Paket `ebus-paket`
+ (prefix-out layer2- read-ebus)
+ (prefix-out layer2- (struct-out ebus-paket))
+ (prefix-out layer2- (struct-out ebus-body-broadcast))
+ (prefix-out layer2- (struct-out ebus-body-mastermaster))
+ (prefix-out layer2- (struct-out ebus-body-masterslave))
+ (prefix-out layer2- logger))
\ No newline at end of file
-- 
cgit v1.2.1