From: Stefan Monnier Date: Tue, 16 Feb 2021 04:54:45 +0000 (-0500) Subject: * lisp/emacs-lisp/bindat.el: Add 64bit int support X-Git-Tag: emacs-28.0.90~3708 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=62cda6acd61f6de2698674391a26ce0a8672fc93;p=emacs.git * lisp/emacs-lisp/bindat.el: Add 64bit int support (bindat--unpack-u64, bindat--unpack-u64r, bindat--pack-u64) (bindat--pack-u64r): New functions. (bindat--unpack-item, bindat--pack-item): Use them. (bindat--fixed-length-alist): Add new types. --- diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 661e56d2762..bb4c57a6196 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -3404,10 +3404,15 @@ Unsigned integer in network byte order, with length 3. @itemx long Unsigned integer in network byte order, with length 4. +@item u64 +Unsigned integer in network byte order, with length 8. + @item u16r @itemx u24r @itemx u32r -Unsigned integer in little endian order, with length 2, 3 and 4, respectively. +@itemx u64r +Unsigned integer in little endian order, with length 2, 3, 4, and +8, respectively. @item str @var{len} String of length @var{len}. @@ -3545,7 +3550,7 @@ array, and @var{struct} to an alist representing unpacked field data. @defun bindat-unpack spec raw &optional idx @c FIXME? Again, no multibyte? This function unpacks data from the unibyte string or byte -array var{raw} +array @var{raw} according to @var{spec}. Normally, this starts unpacking at the beginning of the byte array, but if @var{idx} is non-@code{nil}, it specifies a zero-based starting position to use instead. @@ -3586,7 +3591,7 @@ the data in the alist @var{struct}. It normally creates and fills a new byte array starting at the beginning. However, if @var{raw} is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to pack into. If @var{idx} is non-@code{nil}, it specifies the starting -offset for packing into var{raw}. +offset for packing into @var{raw}. When pre-allocating, you should make sure @code{(length @var{raw})} meets or exceeds the total length to avoid an out-of-range error. diff --git a/etc/NEWS b/etc/NEWS index 3ac9bb21bd8..943ad6ac591 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -357,8 +357,11 @@ the buffer cycles the whole buffer between "only top-level headings", It used to be enabled when Emacs is started in GUI mode but not when started in text mode. The cursor still only actually blinks in GUI frames. +** Bindat +++ -** Bindat has a new 'bindat-spec' macro to define specs, with Edebug support +*** New types 'u64' and 'u64r' ++++ +*** New macro 'bindat-spec' to define specs, with Edebug support ** pcase +++ diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index eafcdc77606..1f5022c2743 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -146,7 +146,8 @@ ;; | u16 | word | short -- length 2, network byte order ;; | u24 -- 3-byte value ;; | u32 | dword | long -- length 4, network byte order -;; | u16r | u24r | u32r -- little endian byte order. +;; | u64 -- length 8, network byte order +;; | u16r | u24r | u32r | u64r - little endian byte order. ;; | str LEN -- LEN byte string ;; | strz LEN -- LEN byte (zero-terminated) string ;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8) @@ -214,6 +215,9 @@ (defun bindat--unpack-u32 () (logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16))) +(defun bindat--unpack-u64 () + (logior (ash (bindat--unpack-u32) 32) (bindat--unpack-u32))) + (defun bindat--unpack-u16r () (logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8))) @@ -223,6 +227,9 @@ (defun bindat--unpack-u32r () (logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16))) +(defun bindat--unpack-u64r () + (logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32))) + (defun bindat--unpack-item (type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) @@ -231,16 +238,14 @@ (bindat--unpack-u8)) ((or 'u16 'word 'short) (bindat--unpack-u16)) - ('u24 - (bindat--unpack-u24)) + ('u24 (bindat--unpack-u24)) ((or 'u32 'dword 'long) (bindat--unpack-u32)) - ('u16r - (bindat--unpack-u16r)) - ('u24r - (bindat--unpack-u24r)) - ('u32r - (bindat--unpack-u32r)) + ('u64 (bindat--unpack-u64)) + ('u16r (bindat--unpack-u16r)) + ('u24r (bindat--unpack-u24r)) + ('u32r (bindat--unpack-u32r)) + ('u64r (bindat--unpack-u64r)) ('bits (let ((bits nil) (bnum (1- (* 8 len))) j m) (while (>= bnum 0) @@ -374,6 +379,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (u16 . 2) (u16r . 2) (word . 2) (short . 2) (u24 . 3) (u24r . 3) (u32 . 4) (u32r . 4) (dword . 4) (long . 4) + (u64 . 8) (u64r . 8) (ip . 4))) (defun bindat--length-group (struct spec) @@ -471,6 +477,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u16 (ash v -16)) (bindat--pack-u16 v)) +(defun bindat--pack-u64 (v) + (bindat--pack-u32 (ash v -32)) + (bindat--pack-u32 v)) + (defun bindat--pack-u16r (v) (aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255)) (aset bindat-raw bindat-idx (logand v 255)) @@ -484,6 +494,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u16r v) (bindat--pack-u16r (ash v -16))) +(defun bindat--pack-u64r (v) + (bindat--pack-u32r v) + (bindat--pack-u32r (ash v -32))) + (defun bindat--pack-item (v type len &optional vectype) (if (eq type 'ip) (setq type 'vec len 4)) @@ -498,12 +512,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u24 v)) ((or 'u32 'dword 'long) (bindat--pack-u32 v)) - ('u16r - (bindat--pack-u16r v)) - ('u24r - (bindat--pack-u24r v)) - ('u32r - (bindat--pack-u32r v)) + ('u64 (bindat--pack-u64 v)) + ('u16r (bindat--pack-u16r v)) + ('u24r (bindat--pack-u24r v)) + ('u32r (bindat--pack-u32r v)) + ('u64r (bindat--pack-u64r v)) ('bits (let ((bnum (1- (* 8 len))) j m) (while (>= bnum 0) @@ -518,11 +531,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." j (ash j -1)))) (bindat--pack-u8 m)))) ((or 'str 'strz) - (let ((l (length v))) - (if (> l len) (setq l len)) - (dotimes (i l) - (aset bindat-raw (+ bindat-idx i) (aref v i))) - (setq bindat-idx (+ bindat-idx len)))) + (dotimes (i (min len (length v))) + (aset bindat-raw (+ bindat-idx i) (aref v i))) + (setq bindat-idx (+ bindat-idx len))) ('vec (let ((l (length v)) (vlen 1)) (if (consp vectype)