From 83d9fbe3bb8ffdf9e4719842e2510a8dbde86f78 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Feb 2021 21:25:15 -0500 Subject: [PATCH] * lisp/emacs-lisp/bindat.el (bindat-spec): New macro. It's basically an alias for `quote`, but it offers the advantage of providing Edebug support and opens the possibility of compiling the bindat spec to ELisp code. * doc/lispref/processes.texi (Bindat Spec): Document `bindat-spec`. (Bindat Functions): Tweak a few things to adjust to the state of the code. * test/lisp/emacs-lisp/bindat-tests.el: Use it. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests--read): New function. (edebug-tests--&rest-behavior): New test. --- doc/lispref/processes.texi | 28 +++++++------ etc/NEWS | 2 + lisp/emacs-lisp/bindat.el | 59 +++++++++++++++++++++++----- test/lisp/emacs-lisp/bindat-tests.el | 9 +++-- test/lisp/emacs-lisp/edebug-tests.el | 17 ++++++++ 5 files changed, 91 insertions(+), 24 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 83461656063..661e56d2762 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -3368,6 +3368,11 @@ processed, and how to pack or unpack it. We normally keep bindat specs in variables whose names end in @samp{-bindat-spec}; that kind of name is automatically recognized as risky. +@defmac bindat-spec &rest specs +Creates a Bindat spec object according to the data layout +specification @var{specs}. +@end defmac + @cindex endianness @cindex big endian @cindex little endian @@ -3398,7 +3403,6 @@ Unsigned integer in network byte order, with length 3. @itemx dword @itemx long Unsigned integer in network byte order, with length 4. -Note: These values may be limited by Emacs's integer implementation limits. @item u16r @itemx u24r @@ -3534,16 +3538,16 @@ repetition has completed. @node Bindat Functions @subsection Functions to Unpack and Pack Bytes - In the following documentation, @var{spec} refers to a data layout -specification, @code{bindat-raw} to a byte array, and @var{struct} to an -alist representing unpacked field data. + In the following documentation, @var{spec} refers to a Bindat spec +object as returned from @code{bindat-spec}, @code{raw} to a byte +array, and @var{struct} to an alist representing unpacked field data. -@defun bindat-unpack spec bindat-raw &optional bindat-idx +@defun bindat-unpack spec raw &optional idx @c FIXME? Again, no multibyte? This function unpacks data from the unibyte string or byte -array @code{bindat-raw} +array var{raw} according to @var{spec}. Normally, this starts unpacking at the -beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it +beginning of the byte array, but if @var{idx} is non-@code{nil}, it specifies a zero-based starting position to use instead. The value is an alist or nested alist in which each element describes @@ -3576,15 +3580,15 @@ This function returns the total length of the data in @var{struct}, according to @var{spec}. @end defun -@defun bindat-pack spec struct &optional bindat-raw bindat-idx +@defun bindat-pack spec struct &optional raw idx This function returns a byte array packed according to @var{spec} from the data in the alist @var{struct}. It normally creates and fills a -new byte array starting at the beginning. However, if @var{bindat-raw} +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{bindat-idx} is non-@code{nil}, it specifies the starting -offset for packing into @code{bindat-raw}. +pack into. If @var{idx} is non-@code{nil}, it specifies the starting +offset for packing into var{raw}. -When pre-allocating, you should make sure @code{(length @var{bindat-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. @end defun diff --git a/etc/NEWS b/etc/NEWS index 7f32f7bf6a9..3ac9bb21bd8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -357,6 +357,8 @@ 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 has a new 'bindat-spec' macro to define specs, with Edebug support ** pcase +++ diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index bf01347ae0e..0bb4b870704 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -65,13 +65,15 @@ ;; The corresponding Lisp bindat specification looks like this: ;; ;; (setq header-bindat-spec -;; '((dest-ip ip) +;; (bindat-spec +;; (dest-ip ip) ;; (src-ip ip) ;; (dest-port u16) ;; (src-port u16))) ;; ;; (setq data-bindat-spec -;; '((type u8) +;; (bindat-spec +;; (type u8) ;; (opcode u8) ;; (length u16r) ;; little endian order ;; (id strz 8) @@ -79,7 +81,8 @@ ;; (align 4))) ;; ;; (setq packet-bindat-spec -;; '((header struct header-bindat-spec) +;; (bindat-spec +;; (header struct header-bindat-spec) ;; (items u8) ;; (fill 3) ;; (item repeat (items) @@ -179,7 +182,7 @@ ;; is interpreted by evalling TAG_VAL and then comparing that to ;; each TAG using equal; if a match is found, the corresponding SPEC ;; is used. -;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the +;; If TAG is a form (eval EXPR), EXPR is eval'ed with `tag' bound to the ;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil. ;; Finally, if TAG is t, the corresponding SPEC is used unconditionally. ;; @@ -368,8 +371,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq field (cdr field))) struct) - -;; Calculate bindat-raw length of structured data +;;;; Calculate bindat-raw length of structured data (defvar bindat--fixed-length-alist '((u8 . 1) (byte . 1) @@ -452,13 +454,13 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bindat-idx (+ bindat-idx len)))))))) (defun bindat-length (spec struct) - "Calculate bindat-raw length for STRUCT according to bindat SPEC." + "Calculate `bindat-raw' length for STRUCT according to bindat SPEC." (let ((bindat-idx 0)) (bindat--length-group struct spec) bindat-idx)) -;; Pack structured data into bindat-raw +;;;; Pack structured data into bindat-raw (defun bindat--pack-u8 (v) (aset bindat-raw bindat-idx (logand v 255)) @@ -623,8 +625,47 @@ Optional fourth arg IDX is the starting offset into RAW." (bindat--pack-group struct spec) (if raw nil bindat-raw))) +;;;; Debugging support + +(def-edebug-elem-spec 'bindat-spec '(&rest bindat-item)) + +(def-edebug-elem-spec 'bindat-item + '(([&optional bindat-field] + &or ["eval" form] + ["fill" bindat-len] + ["align" bindat-len] + ["struct" form] ;A reference to another bindat-spec. + ["union" bindat-tag-val &rest (bindat-tag bindat-spec)] + ["repeat" integerp bindat-spec] + bindat-type))) + +(def-edebug-elem-spec 'bindat-type + '(&or ("eval" form) + ["str" bindat-len] + ["strz" bindat-len] + ["vec" bindat-len &optional bindat-type] + ["bits" bindat-len] + symbolp)) + +(def-edebug-elem-spec 'bindat-field + '(&or ("eval" form) symbolp)) + +(def-edebug-elem-spec 'bindat-len '(&or [] "nil" bindat-arg)) + +(def-edebug-elem-spec 'bindat-tag-val '(bindat-arg)) + +(def-edebug-elem-spec 'bindat-tag '(&or ("eval" form) atom)) + +(def-edebug-elem-spec 'bindat-arg + '(&or ("eval" form) integerp (&rest symbolp integerp))) + +(defmacro bindat-spec (&rest fields) + "Build the bindat spec described by FIELDS." + (declare (indent 0) (debug (bindat-spec))) + ;; FIXME: We should really "compile" this to a triplet of functions! + `',fields) -;; Misc. format conversions +;;;; Misc. format conversions (defun bindat-format-vector (vect fmt sep &optional len) "Format vector VECT using element format FMT and separator SEP. diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index a9a881987c0..72883fc2ec7 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -24,13 +24,15 @@ (require 'cl-lib) (defvar header-bindat-spec - '((dest-ip ip) + (bindat-spec + (dest-ip ip) (src-ip ip) (dest-port u16) (src-port u16))) (defvar data-bindat-spec - '((type u8) + (bindat-spec + (type u8) (opcode u8) (length u16r) ;; little endian order (id strz 8) @@ -38,7 +40,8 @@ (align 4))) (defvar packet-bindat-spec - '((header struct header-bindat-spec) + (bindat-spec + (header struct header-bindat-spec) (items u8) (fill 3) (item repeat (items) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index d81376e45ec..daac43372ac 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -970,6 +970,23 @@ primary ones (Bug#42671)." (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) t)) "(func")))) +(defun edebug-tests--read (form spec) + (with-temp-buffer + (print form (current-buffer)) + (goto-char (point-min)) + (cl-letf ((edebug-all-forms t) + ((get (car form) 'edebug-form-spec) spec)) + (edebug--read nil (current-buffer))))) + +(ert-deftest edebug-tests--&rest-behavior () + ;; `&rest' is documented to allow the last "repetition" to be aborted early. + (should (edebug-tests--read '(dummy x 1 y 2 z) + '(&rest symbolp integerp))) + ;; `&rest' should notice here that the "symbolp integerp" sequence + ;; is not respected. + (should-error (edebug-tests--read '(dummy x 1 2 y) + '(&rest symbolp integerp)))) + (ert-deftest edebug-tests-cl-flet () "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." -- 2.39.2