From: Ralph Ronnquist Date: Sun, 16 Apr 2023 01:38:40 +0000 (+1000) Subject: Fixes to handle BOOLEAN as UINT32, replace braces with parentheses in X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=0359cc142e9003e886bae84b55a212bf69e24970;p=rrq%2Flsp-utils.git Fixes to handle BOOLEAN as UINT32, replace braces with parentheses in signature, ensure empty array of struct includes struct alignment and use the header signature for the body correctly. --- diff --git a/lsp-dbus/lsp-dbus-marshal.lsp b/lsp-dbus/lsp-dbus-marshal.lsp index 02859d6..90db86e 100644 --- a/lsp-dbus/lsp-dbus-marshal.lsp +++ b/lsp-dbus/lsp-dbus-marshal.lsp @@ -15,6 +15,7 @@ ; Ex: "a(yi)" = (("a" ("y" "i"))) ; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v"))) (define (expand-signature S) + (setf S (replace "{" (replace "}" (copy S) ")") "(")) (let ((STACK '()) (CUR '()) (A 0)) (dolist (X (explode S)) (case X @@ -49,7 +50,7 @@ (constant 'FMTMAP ; mapping dbus type code to byte size and newlisp code '( ("y" 1 "b") ; BYTE (unsigned 8-bit integer) - ("b" 1 "b") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid) + ("b" 4 "lu") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid) ("n" 2 "d") ; INT16 (signed 16-bit integer) ("q" 2 "u") ; UINT16 (unsigned 16-bit integer) ("i" 4 "ld") ; INT32 (signed 32-bit integer) @@ -144,9 +145,7 @@ ;; and followed by a NUL byte. The subsequent data is unpacked ;; according to that type character. (define (unpack-data-variant) - (let ((ES ((unpack "bs1b" (AT DATA)) 1))) - (inc AT 3) - (unpack-data-item ES))) + (unpack-data-item ((expand-signature (unpack-data-signature "g")) 0))) ;; Unpack the ES type item from (AT DATA), optionally with ;; pre-alignment, and increment AT past the padding and item. @@ -163,6 +162,7 @@ ;; elements. (define (unpack-data-array ES) (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '())) + (when (and (list? ES) (!= "a" (ES 0))) (align-AT 8)) (while (< AT N) (push (unpack-data-item ES) OUT -1)) OUT)) @@ -195,7 +195,7 @@ (dotimes (i (length M 0)) (setf (M i 0) (MESSAGE-HEADERS (M i 0) 0))) ;; Add the body, if any, keyed by "". - (setf S (if (lookup 'SIGNATURE M) ($it 0) "")) + (setf S (if (lookup 'SIGNATURE M) $it "")) (when (and (!= S "") (setf D (unpack-data S DATA AT))) (setf AT (D 1)) (extend M (list (list "" (D 0)))))