diff options
Diffstat (limited to 'ebus-racket/layer2.rkt')
-rw-r--r-- | ebus-racket/layer2.rkt | 100 |
1 files changed, 100 insertions, 0 deletions
diff --git a/ebus-racket/layer2.rkt b/ebus-racket/layer2.rkt new file mode 100644 index 0000000..dbdd411 --- /dev/null +++ b/ebus-racket/layer2.rkt @@ -0,0 +1,100 @@ +#lang racket +(require (planet bzlib/parseq:1:3)) + +; Ebus SYN Byte-String +(define ebus-const-syn (string->bytes/latin-1 "\xaa")) +(define ebus-const-escape (string->bytes/latin-1 "\xa9")) +(define ebus-const-ackok (string->bytes/latin-1 "\x00")) +(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 <- (bytes= ebus-const-escape) + escape-code <- (byte-in (list 0 1)) + (return (cond + ((= escape-code 0) ebus-const-escape) + ((= escape-code 1) ebus-const-syn)))) + any-byte + )) + +(define parse-ebus-broadcast (token (seq crc <- any-byte + syn <- (bytes= ebus-const-syn) + (return (ebus-body-broadcast crc))))) + +(define parse-ebus-mastermaster (token (seq crc <- any-byte + ack <- (bytes= ebus-const-ackok) ; ACK des Empfängers + syn <- (bytes= ebus-const-syn) ; SYN des Senders + (return (ebus-body-mastermaster crc))))) + +(define parse-ebus-masterslave (token (seq crc <- any-byte + ack <- (bytes= ebus-const-ackok) ;ACK des Empfängers + payloadSlaveLength <- any-byte + payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength) + crcSlave <- any-byte + ackSlave <- (bytes= ebus-const-ackok) ;ACK des Senders + synSlave <- (bytes= ebus-const-syn) ;SYN des Senders + (return (ebus-body-masterslave crc payloadSlaveLength payloadSlave crcSlave))))) + +(define parse-ebus-master-or-slave (token (choice parse-ebus-mastermaster parse-ebus-masterslave))) + +(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 parse-ebus-master-or-slave)) + (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) + (let ([syn ((make-reader ebus-sync #:sof? #f #:eof? #f) input-port)] + [paket ((make-reader parse-ebus-paket #:sof? #f #:eof? #f) input-port)]) + (cond ((not (false? syn)) + (display (format "drop ~s x SYN (~s) ~n" syn ebus-const-syn)))) + (cond ((not (false? paket)) + paket) + ((eof-object? (peek-byte input-port)) + eof) + (else + (display (format "drop ~s ~n" (peek-byte input-port))) + ; skip one byte + (read-byte input-port) + ;(file-position input-port (+ 1 (file-position input-port))) + (read-ebus input-port))))) + +(define (read-ebus-loop input-port) + (let ([paket (read-ebus (current-input-port))]) + (display (format "Paket ~s~n" paket)) + (cond ((not (eof-object? paket)) (read-ebus-loop input-port))))) + +(provide (prefix-out layer2- read-ebus) + (prefix-out layer2- read-ebus-loop) + (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 layre2- (struct-out ebus-body-masterslave))) |