mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
* lisp/emacs-lisp/bindat.el: Minor refactoring
(bindat--unpack-str, bindat--unpack-strz, bindat--unpack-bits): New functions, extracted from `bindat--unpack-item`. (bindat--unpack-item): Use them. (bindat--align): New function. (bindat--unpack-group, bindat--length-group, bindat--pack-group): Use it. (bindat-get-field): Allow integers to index both lists (as returned by `repeat`) and vectors (as returned by `vec`). (bindat--pack-str, bindat--pack-bits): New functions, extracted from `bindat--pack-item`. (bindat--pack-item): Use them. * test/lisp/emacs-lisp/bindat-tests.el (struct-bindat): Place the fields in the order in which they appear in the structs.
This commit is contained in:
Stefan Monnier
parent
d582356a7f
commit
03ada27cb8
2 changed files with 83 additions and 82 deletions
|
|
@ -201,7 +201,7 @@
|
|||
(defvar bindat-raw)
|
||||
(defvar bindat-idx)
|
||||
|
||||
(defun bindat--unpack-u8 ()
|
||||
(defsubst bindat--unpack-u8 ()
|
||||
(prog1
|
||||
(aref bindat-raw bindat-idx)
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
|
|
@ -230,47 +230,50 @@
|
|||
(defun bindat--unpack-u64r ()
|
||||
(logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32)))
|
||||
|
||||
(defun bindat--unpack-str (len)
|
||||
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
|
||||
(setq bindat-idx (+ bindat-idx len))
|
||||
(if (stringp s) s
|
||||
(apply #'unibyte-string s))))
|
||||
|
||||
(defun bindat--unpack-strz (len)
|
||||
(let ((i 0) s)
|
||||
(while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
|
||||
(setq i (1+ i)))
|
||||
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
|
||||
(setq bindat-idx (+ bindat-idx len))
|
||||
(if (stringp s) s
|
||||
(apply #'unibyte-string s))))
|
||||
|
||||
(defun bindat--unpack-bits (len)
|
||||
(let ((bits nil) (bnum (1- (* 8 len))) j m)
|
||||
(while (>= bnum 0)
|
||||
(if (= (setq m (bindat--unpack-u8)) 0)
|
||||
(setq bnum (- bnum 8))
|
||||
(setq j 128)
|
||||
(while (> j 0)
|
||||
(if (/= 0 (logand m j))
|
||||
(setq bits (cons bnum bits)))
|
||||
(setq bnum (1- bnum)
|
||||
j (ash j -1)))))
|
||||
bits))
|
||||
|
||||
(defun bindat--unpack-item (type len &optional vectype)
|
||||
(if (eq type 'ip)
|
||||
(setq type 'vec len 4))
|
||||
(pcase type
|
||||
((or 'u8 'byte)
|
||||
(bindat--unpack-u8))
|
||||
((or 'u16 'word 'short)
|
||||
(bindat--unpack-u16))
|
||||
((or 'u8 'byte) (bindat--unpack-u8))
|
||||
((or 'u16 'word 'short) (bindat--unpack-u16))
|
||||
('u24 (bindat--unpack-u24))
|
||||
((or 'u32 'dword 'long)
|
||||
(bindat--unpack-u32))
|
||||
((or 'u32 'dword 'long) (bindat--unpack-u32))
|
||||
('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)
|
||||
(if (= (setq m (bindat--unpack-u8)) 0)
|
||||
(setq bnum (- bnum 8))
|
||||
(setq j 128)
|
||||
(while (> j 0)
|
||||
(if (/= 0 (logand m j))
|
||||
(setq bits (cons bnum bits)))
|
||||
(setq bnum (1- bnum)
|
||||
j (ash j -1)))))
|
||||
bits))
|
||||
('str
|
||||
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
|
||||
(setq bindat-idx (+ bindat-idx len))
|
||||
(if (stringp s) s
|
||||
(apply #'unibyte-string s))))
|
||||
('strz
|
||||
(let ((i 0) s)
|
||||
(while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
|
||||
(setq i (1+ i)))
|
||||
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
|
||||
(setq bindat-idx (+ bindat-idx len))
|
||||
(if (stringp s) s
|
||||
(apply #'unibyte-string s))))
|
||||
('bits (bindat--unpack-bits len))
|
||||
('str (bindat--unpack-str len))
|
||||
('strz (bindat--unpack-strz len))
|
||||
('vec
|
||||
(let ((v (make-vector len 0)) (vlen 1))
|
||||
(if (consp vectype)
|
||||
|
|
@ -283,6 +286,9 @@
|
|||
v))
|
||||
(_ nil)))
|
||||
|
||||
(defsubst bindat--align (n len)
|
||||
(* len (/ (+ n (1- len)) len))) ;Isn't there a simpler way?
|
||||
|
||||
(defun bindat--unpack-group (spec)
|
||||
(with-suppressed-warnings ((lexical struct last))
|
||||
(defvar struct) (defvar last))
|
||||
|
|
@ -317,8 +323,7 @@
|
|||
('fill
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
('align
|
||||
(while (/= (% bindat-idx len) 0)
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
(setq bindat-idx (bindat--align bindat-idx len)))
|
||||
('struct
|
||||
(setq data (bindat--unpack-group (eval len t))))
|
||||
('repeat
|
||||
|
|
@ -366,9 +371,8 @@ An integer value in the field list is taken as an array index,
|
|||
e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(while (and struct field)
|
||||
(setq struct (if (integerp (car field))
|
||||
(nth (car field) struct)
|
||||
(let ((val (assq (car field) struct)))
|
||||
(if (consp val) (cdr val)))))
|
||||
(elt struct (car field))
|
||||
(cdr (assq (car field) struct))))
|
||||
(setq field (cdr field)))
|
||||
struct)
|
||||
|
||||
|
|
@ -421,8 +425,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
|||
('fill
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
('align
|
||||
(while (/= (% bindat-idx len) 0)
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
(setq bindat-idx (bindat--align bindat-idx len)))
|
||||
('struct
|
||||
(bindat--length-group
|
||||
(if field (bindat-get-field struct field) struct) (eval len t)))
|
||||
|
|
@ -460,7 +463,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
|||
|
||||
;;;; Pack structured data into bindat-raw
|
||||
|
||||
(defun bindat--pack-u8 (v)
|
||||
(defsubst bindat--pack-u8 (v)
|
||||
(aset bindat-raw bindat-idx (logand v 255))
|
||||
(setq bindat-idx (1+ bindat-idx)))
|
||||
|
||||
|
|
@ -498,42 +501,41 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
|||
(bindat--pack-u32r v)
|
||||
(bindat--pack-u32r (ash v -32)))
|
||||
|
||||
(defun bindat--pack-str (len v)
|
||||
(dotimes (i (min len (length v)))
|
||||
(aset bindat-raw (+ bindat-idx i) (aref v i)))
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
|
||||
(defun bindat--pack-bits (len v)
|
||||
(let ((bnum (1- (* 8 len))) j m)
|
||||
(while (>= bnum 0)
|
||||
(setq m 0)
|
||||
(if (null v)
|
||||
(setq bnum (- bnum 8))
|
||||
(setq j 128)
|
||||
(while (> j 0)
|
||||
(if (memq bnum v)
|
||||
(setq m (logior m j)))
|
||||
(setq bnum (1- bnum)
|
||||
j (ash j -1))))
|
||||
(bindat--pack-u8 m))))
|
||||
|
||||
(defun bindat--pack-item (v type len &optional vectype)
|
||||
(if (eq type 'ip)
|
||||
(setq type 'vec len 4))
|
||||
(pcase type
|
||||
((guard (null v))
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
((or 'u8 'byte)
|
||||
(bindat--pack-u8 v))
|
||||
((or 'u16 'word 'short)
|
||||
(bindat--pack-u16 v))
|
||||
('u24
|
||||
(bindat--pack-u24 v))
|
||||
((or 'u32 'dword 'long)
|
||||
(bindat--pack-u32 v))
|
||||
((guard (null v)) (setq bindat-idx (+ bindat-idx len)))
|
||||
((or 'u8 'byte) (bindat--pack-u8 v))
|
||||
((or 'u16 'word 'short) (bindat--pack-u16 v))
|
||||
('u24 (bindat--pack-u24 v))
|
||||
((or 'u32 'dword 'long) (bindat--pack-u32 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)
|
||||
(setq m 0)
|
||||
(if (null v)
|
||||
(setq bnum (- bnum 8))
|
||||
(setq j 128)
|
||||
(while (> j 0)
|
||||
(if (memq bnum v)
|
||||
(setq m (logior m j)))
|
||||
(setq bnum (1- bnum)
|
||||
j (ash j -1))))
|
||||
(bindat--pack-u8 m))))
|
||||
((or 'str 'strz)
|
||||
(dotimes (i (min len (length v)))
|
||||
(aset bindat-raw (+ bindat-idx i) (aref v i)))
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
('bits (bindat--pack-bits len v))
|
||||
((or 'str 'strz) (bindat--pack-str len v))
|
||||
('vec
|
||||
(let ((l (length v)) (vlen 1))
|
||||
(if (consp vectype)
|
||||
|
|
@ -580,8 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
|||
('fill
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
('align
|
||||
(while (/= (% bindat-idx len) 0)
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
(setq bindat-idx (bindat--align bindat-idx len)))
|
||||
('struct
|
||||
(bindat--pack-group
|
||||
(if field (bindat-get-field struct field) struct) (eval len t)))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*-
|
||||
;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -23,14 +23,14 @@
|
|||
(require 'bindat)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar header-bindat-spec
|
||||
(defconst header-bindat-spec
|
||||
(bindat-spec
|
||||
(dest-ip ip)
|
||||
(src-ip ip)
|
||||
(dest-port u16)
|
||||
(src-port u16)))
|
||||
|
||||
(defvar data-bindat-spec
|
||||
(defconst data-bindat-spec
|
||||
(bindat-spec
|
||||
(type u8)
|
||||
(opcode u8)
|
||||
|
|
@ -39,7 +39,7 @@
|
|||
(data vec (length))
|
||||
(align 4)))
|
||||
|
||||
(defvar packet-bindat-spec
|
||||
(defconst packet-bindat-spec
|
||||
(bindat-spec
|
||||
(header struct header-bindat-spec)
|
||||
(items u8)
|
||||
|
|
@ -47,23 +47,23 @@
|
|||
(item repeat (items)
|
||||
(struct data-bindat-spec))))
|
||||
|
||||
(defvar struct-bindat
|
||||
(defconst struct-bindat
|
||||
'((header
|
||||
(dest-ip . [192 168 1 100])
|
||||
(src-ip . [192 168 1 101])
|
||||
(dest-port . 284)
|
||||
(src-port . 5408))
|
||||
(items . 2)
|
||||
(item ((data . [1 2 3 4 5])
|
||||
(id . "ABCDEF")
|
||||
(length . 5)
|
||||
(item ((type . 2)
|
||||
(opcode . 3)
|
||||
(type . 2))
|
||||
((data . [6 7 8 9 10 11 12])
|
||||
(id . "BCDEFG")
|
||||
(length . 7)
|
||||
(length . 5)
|
||||
(id . "ABCDEF")
|
||||
(data . [1 2 3 4 5]))
|
||||
((type . 1)
|
||||
(opcode . 4)
|
||||
(type . 1)))))
|
||||
(length . 7)
|
||||
(id . "BCDEFG")
|
||||
(data . [6 7 8 9 10 11 12])))))
|
||||
|
||||
(ert-deftest bindat-test-pack ()
|
||||
(should (equal
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue