diff options
Diffstat (limited to 'ebus-racket/layer7.rkt')
| -rw-r--r-- | ebus-racket/layer7.rkt | 142 |
1 files changed, 111 insertions, 31 deletions
diff --git a/ebus-racket/layer7.rkt b/ebus-racket/layer7.rkt index 8f8f39e..5cb4477 100644 --- a/ebus-racket/layer7.rkt +++ b/ebus-racket/layer7.rkt @@ -1,5 +1,6 @@ -#lang racket -(require (planet lizorkin/sxml:2:1/sxml) +#lang racket/base +(require racket/list + (planet lizorkin/sxml:2:1/sxml) (planet lizorkin/ssax:2:0/ssax) "layer2.rkt") @@ -26,30 +27,56 @@ (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))) - + (let ([paket-definition (paket ebus-paket)]) + (cond ((> (length paket-definition) 0) + (let* + ([paket-name (first ((sxpath "@name/text()") paket-definition))] + [fields ((sxpath "fields/*") paket-definition)] + [values + (for/list ([field fields]) (paket-fields-dispatch-decoder ebus-paket field paket-name))]) + ;; filter invalid values + (for/list ([value values] #:when (not (void? value))) + value))) + (else (display (format "Unknown Paket: ~s~n" ebus-paket)) + (void))))) + +(define (paket-fields-dispatch-decoder ebus-paket field paket-name) + (let ([datatype ((sxpath "name()") field)] + [name (string-append paket-name "." (first ((sxpath "@name/text()") field)))] + [offset (string->number (first ((sxpath "@offset/text()") field)))] + [payload (layer2-ebus-paket-payload ebus-paket)]) + (cond ((string=? "bit" datatype) + (list name datatype offset + (field-decoder-bit (list-ref payload offset)))) + ((string=? "bcd" datatype) + (list name datatype offset + (field-decoder-bcd (list-ref payload offset)))) + ((string=? "data1b" datatype) + (list name datatype offset + (field-decoder-data1b (list-ref payload offset)))) + ((string=? "data1c" datatype) + (list name datatype offset + (field-decoder-data1c (list-ref (layer2-ebus-paket-payload ebus-paket) offset)))) + ((string=? "byte" datatype) + (list name datatype offset (list-ref payload offset))) + ((string=? "data2b" datatype) + (list name datatype offset + (field-decoder-data2b (list-ref payload offset) + (list-ref payload (+ offset 1))))) + ((string=? "data2c" datatype) + (list name datatype offset + (field-decoder-data2c (list-ref payload offset) + (list-ref payload (+ offset 1))))) + ((string=? "word" datatype) + (list name datatype offset + (field-decoder-word (list-ref payload offset) + (list-ref payload (+ offset 1))))) + ((string=? "byteEnum" datatype) + (list name datatype offset + (field-decoder-byteEnum (list-ref payload offset) field))) + (else (display (string-append "unknown datatype: " datatype "\n")) + (void))))) + ;; type bit (define (field-decoder-bit value) (cond ((= value 1) 1) @@ -59,14 +86,67 @@ (define (field-decoder-data1b value) value) +;; type data1c +(define (field-decoder-data1c value) + (/ value 2.0)) + ;; 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))))) + (if (= (bitwise-and highByte 128) 128) + (* -1 + (+ (+ 256 (bitwise-not highByte)) + (/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0))) + (+ highByte (/ lowByte 256.0)))) + +;; type data2c +(define (field-decoder-data2c lowByte highByte) + (define (lowNibble v) + (bitwise-and v #x0f)) + (define (highNibble v) + (arithmetic-shift v -4)) + (define (u-not v) + (+ 256 (bitwise-not v))) + (if (= (bitwise-and highByte 128) 128) + (* -1 + (+ (* 16 (u-not highByte)) + (highNibble (u-not lowByte)) + (/ (lowNibble (u-not lowByte) 16)))) + (+ (* 16 (u-not highByte)) + (highNibble lowByte) + (/ (lowNibble lowByte) 16)))) + +;; type byteEnum +(define (field-decoder-byteEnum value field-definition) + (define (pred l) + (= value (list-ref l 0))) + (let* ([all-options (for/list ([option ((sxpath "option") field-definition)]) + (list (string->number (first ((sxpath "@value/text()") option))) ;; value, name + (first ((sxpath "@name/text()") option))))] + [options (filter pred all-options)]) + (cond ((= (length options) 1) + (list-ref (first options) 1)) + (else "<undefined>")))) + +;; type word +(define (field-decoder-word lowByte highByte) + (+ lowByte + (arithmetic-shift highByte 8))) + +;; type bcd +(define (field-decoder-bcd value) + (+ (bitwise-and value #x0f) + (arithmetic-shift value -4))) + +;; read one ebus-paket or eof from input-port +;; or return #<eof> +(define (read-ebus input-port) + (let* ([paket (layer2-read-ebus input-port)]) + (cond ((layer2-ebus-paket? paket) + (paket-fields paket)) + (else paket)))) (provide (prefix-out layer7- paket) (prefix-out layer7- paket-fields) (prefix-out layer7- device) - (prefix-out layer7- device-name))
\ No newline at end of file + (prefix-out layer7- device-name) + (prefix-out layer7- read-ebus))
\ No newline at end of file |