Re: Byte swapping and bindat

[Stefan Monnier]

Eli Zaretskii [2022-06-10 18:53:32] wrote:

>> Date: Fri, 10 Jun 2022 09:32:31 -0400
>> From:  Stefan Monnier via Users list for the GNU Emacs text editor 
>> <help-gnu-emacs@gnu.org>
>> 
>>     (let* ((threshold 32)
>>            (type (bindat-type (kind   uint 8)
>>                               (length sint 32 (> kind threshold)))))
>>       (list (bindat-unpack type "\x10\x00\x00\x01\x01")
>>             (bindat-unpack type "\x80\x00\x00\x01\x01")))
>>     =>
>>     (((kind . 16)  (length . 257))
>>      ((kind . 128) (length . 16842752)))
>
> It would be nice to have sint documented in the ELisp manual...

Good point.  I think it would also be nice to unify `uint` and `uintr`.

What about the patch below?


        Stefan


diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 55fb93ec5a8..63570d2117f 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3470,13 +3470,15 @@ Bindat Types
 @itemx byte
 Unsigned byte, with length 1.
 
-@item uint @var{bitlen}
-Unsigned integer in network byte order, with @var{bitlen} bits.
+@item uint @var{bitlen} &optional @var{le}
+Unsigned integer in network byte order (big-endian), with @var{bitlen} bits.
 @var{bitlen} has to be a multiple of 8.
+If @var{le} is non-@code{nil}, then use little-endian.
 
-@item uintr @var{bitlen}
-Unsigned integer in little endian order, with @var{bitlen} bits.
+@item sint @var{bitlen} @var{le}
+Signed integer in network byte order (big-endian), with @var{bitlen} bits.
 @var{bitlen} has to be a multiple of 8.
+If @var{le} is non-@code{nil}, then use little-endian.
 
 @item str @var{len}
 Unibyte string (@pxref{Text Representations}) of length @var{len} bytes.
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 5f3c772983a..48ae7c8545b 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -77,7 +77,7 @@
 ;;    (bindat-type
 ;;      (type      u8)
 ;;     (opcode    u8)
-;;     (length    uintr 32)  ;; little endian order
+;;     (length    uint 32 t)  ;; little endian order
 ;;     (id        strz 8)
 ;;     (data      vec length)
 ;;     (_         align 4)))
@@ -663,14 +663,17 @@ bindat--type
     (`(length . ,_) `(cl-incf bindat-idx 1))
     (`(pack . ,args) `(bindat--pack-u8 . ,args))))
 
-(cl-defmethod bindat--type (op (_ (eql 'uint))  n)
+(cl-defmethod bindat--type (op (_ (eql 'uint))  n &optional le)
   (if (eq n 8) (bindat--type op 'byte)
     (bindat--pcase op
-      ('unpack `(bindat--unpack-uint ,n))
+      ('unpack
+       `(if ,le (bindat--unpack-uintr ,n) (bindat--unpack-uint ,n)))
       (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
-      (`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
+      (`(pack . ,args)
+       `(if ,le (bindat--pack-uintr ,n . ,args)
+          (bindat--pack-uint ,n . ,args))))))
 
-(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n) ;Obsolete since Emacs-29.
   (if (eq n 8) (bindat--type op 'byte)
     (bindat--pcase op
       ('unpack `(bindat--unpack-uintr ,n))
@@ -849,8 +852,7 @@ bindat-type
   "Return the Bindat type value to pack&unpack TYPE.
 TYPE is a Bindat type expression.  It can take the following forms:
 
-  uint BITLEN          - Big-endian unsigned integer
-  uintr BITLEN         - Little-endian unsigned integer
+  uint BITLEN [LE]     - unsigned integer (big-endian if LE is nil)
   str LEN              - Byte string
   strz [LEN]           - Zero-terminated byte-string
   bits LEN             - Bit vector (LEN is counted in bytes)
@@ -935,9 +937,9 @@ bindat--make-docstring
         (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
 
 (bindat-defmacro u8 () "Unsigned 8bit integer." '(byte))
-(bindat-defmacro sint (bitlen r)
+(bindat-defmacro sint (bitlen le)
   "Signed integer of size BITLEN.
-Bigendian if R is nil and little endian if not."
+Big-endian if LE is nil and little-endian if not."
   (let ((bl (make-symbol "bitlen"))
         (max (make-symbol "max"))
         (wrap (make-symbol "wrap")))
@@ -945,7 +947,7 @@ sint
             (,max (ash 1 (1- ,bl)))
             (,wrap (+ ,max ,max)))
        (struct :pack-var v
-               (n if ,r (uintr ,bl) (uint ,bl)
+               (n uint ,bl ,le
                   :pack-val (if (< v 0) (+ v ,wrap) v))
                :unpack-val (if (>= n ,max) (- n ,wrap) n)))))
 
diff --git a/test/lisp/emacs-lisp/bindat-tests.el 
b/test/lisp/emacs-lisp/bindat-tests.el
index 48170727525..1ce402977f5 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -36,7 +36,7 @@ data-bindat-spec
   (bindat-type
     (type u8)
     (opcode u8)
-    (length uintr 16) ;; little endian order
+    (length uint 16 'le) ;; little endian order
     (id strz 8)
     (data vec length)
     (_ align 4)))
@@ -128,18 +128,17 @@ bindat-test--sint
           (r (zerop (% kind 2))))
       (dotimes (_ 100)
         (let* ((n (random (ash 1 bitlen)))
-               (i (- n (ash 1 (1- bitlen)))))
+               (i (- n (ash 1 (1- bitlen))))
+               (stype (bindat-type sint bitlen r))
+               (utype (bindat-type if r (uintr bitlen) (uint bitlen))))
           (should (equal (bindat-unpack
-                          (bindat-type sint bitlen r)
-                          (bindat-pack (bindat-type sint bitlen r) i))
+                          stype
+                          (bindat-pack stype i))
                          i))
           (when (>= i 0)
-            (should (equal (bindat-pack
-                            (bindat-type if r (uintr bitlen) (uint bitlen)) i)
-                           (bindat-pack (bindat-type sint bitlen r) i)))
-            (should (equal (bindat-unpack
-                            (bindat-type if r (uintr bitlen) (uint bitlen))
-                            (bindat-pack (bindat-type sint bitlen r) i))
+            (should (equal (bindat-pack utype i)
+                           (bindat-pack stype i)))
+            (should (equal (bindat-unpack utype (bindat-pack stype i))
                            i))))))))
 
 (defconst bindat-test--LEB128