blob: 51b9b550c42eef48f4cc3223ee3c785702f8f89a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
#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-header
(source destination primaryCommand secondaryCommand payloadLength)
#:transparent)
(struct ebus-body-broadcast (crc) #:transparent)
(struct ebus-body-mastermaster (crc) #:transparent)
(struct ebus-body-masterslave
(crc payloadSlaveLength payloadSlave crcSlave)
#:transparent)
(struct ebus-paket (header payload body) #:transparent)
(define parse-ebus-header (token (seq source <- any-byte
destination <- any-byte
primaryCommand <- any-byte
secondaryCommand <- any-byte
payloadLength <- any-byte
(return (ebus-header source
destination
primaryCommand
secondaryCommand
payloadLength)) )))
;; 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 header <- parse-ebus-header
payload <- (repeat ebus-payload (ebus-header-payloadLength header) (ebus-header-payloadLength header))
body <- (cond ((= (ebus-header-destination header) ebus-const-broadcastaddr) parse-ebus-broadcast)
(else parse-ebus-master-or-slave))
(return (ebus-paket header 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 read-ebus
read-ebus-loop
(struct-out ebus-paket)
(struct-out ebus-header)
(struct-out ebus-body-broadcast)
(struct-out ebus-body-mastermaster)
(struct-out ebus-body-masterslave))
|
