blob: 8f8f39e2b0f6530375e2fbe172aaabdcd516ac29 (
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
|
#lang racket
(require (planet lizorkin/sxml:2:1/sxml)
(planet lizorkin/ssax:2:0/ssax)
"layer2.rkt")
(define definition
(ssax:xml->sxml (open-input-file "../ebus-xml/ebus.xml")
'[(#f . "http://xapek.org/ebus/0.1")]))
(define (paket ebus-paket)
(let ([primaryCommand (layer2-ebus-paket-primaryCommand ebus-paket)]
[secondaryCommand (layer2-ebus-paket-secondaryCommand ebus-paket)])
((sxpath (string-append "//packet[@primary=" (number->string primaryCommand)
" and @secondary=" (number->string secondaryCommand) "]"))
definition)))
;; returns the full device-definition
(define (device address)
((sxpath (string-append "//devices/device[@address=" (number->string address) "]"))
definition))
;; returns device-name in a list or empty-list
(define (device-name address)
((sxpath "@name/text()") (device address)))
(define (paket-fields ebus-paket)
(let* ([paket-definition (paket ebus-paket)]
[paket-name (first ((sxpath "@name/text()") paket-definition))]
[fields ((sxpath "fields/*") paket-definition)]
[values (for/list ([field fields])
(let ([datatype ((sxpath "name()") field)]
[name (string-append paket-name "." (first ((sxpath "@name/text()") field)))]
[offset (string->number (first ((sxpath "@offset/text()") field)))])
(cond ((string=? "bit" datatype)
(list name datatype offset
(field-decoder-bit (list-ref (layer2-ebus-paket-payload ebus-paket) offset))))
((string=? "data1b" datatype)
(list name datatype offset
(field-decoder-data1b (list-ref (layer2-ebus-paket-payload ebus-paket) offset))))
((string=? "data2b" datatype)
(list name datatype offset
(field-decoder-data2b (list-ref (layer2-ebus-paket-payload ebus-paket) offset)
(list-ref (layer2-ebus-paket-payload ebus-paket) (+ offset 1)))))
(else (display (string-append "unknown datatype: " datatype))
(void)))
))])
; filter invalid values
(for/list ([value values] #:when (not (void? value)))
value)))
;; type bit
(define (field-decoder-bit value)
(cond ((= value 1) 1)
(else 0)))
;; type data1b
(define (field-decoder-data1b value)
value)
;; type data2b
(define (field-decoder-data2b lowByte highByte)
(cond ((= (bitwise-and highByte 128) 128)
(* -1 (+ (+ 256 (bitwise-not highByte))
(/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0))))
(else (+ highByte (/ lowByte 256.0)))))
(provide (prefix-out layer7- paket)
(prefix-out layer7- paket-fields)
(prefix-out layer7- device)
(prefix-out layer7- device-name))
|
