From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
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)))))