aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/emacs-lisp/bindat.el108
1 files changed, 54 insertions, 54 deletions
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 65a9ab46c79..d05eed2c4a2 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -188,21 +188,20 @@
188;; ([FIELD] eval FORM) 188;; ([FIELD] eval FORM)
189;; is interpreted by evalling FORM for its side effects only. 189;; is interpreted by evalling FORM for its side effects only.
190;; If FIELD is specified, the value is bound to that field. 190;; If FIELD is specified, the value is bound to that field.
191;; The FORM may access and update `raw-data' and `pos' (see `bindat-unpack'), 191;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack').
192;; as well as the lisp data structure in `struct'.
193 192
194;;; Code: 193;;; Code:
195 194
196;; Helper functions for structure unpacking. 195;; Helper functions for structure unpacking.
197;; Relies on dynamic binding of RAW-DATA and POS 196;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
198 197
199(defvar raw-data) 198(defvar bindat-raw)
200(defvar pos) 199(defvar bindat-idx)
201 200
202(defun bindat--unpack-u8 () 201(defun bindat--unpack-u8 ()
203 (prog1 202 (prog1
204 (aref raw-data pos) 203 (aref bindat-raw bindat-idx)
205 (setq pos (1+ pos)))) 204 (setq bindat-idx (1+ bindat-idx))))
206 205
207(defun bindat--unpack-u16 () 206(defun bindat--unpack-u16 ()
208 (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8))) 207 (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
@@ -259,16 +258,16 @@
259 j (lsh j -1))))) 258 j (lsh j -1)))))
260 bits)) 259 bits))
261 ((eq type 'str) 260 ((eq type 'str)
262 (let ((s (substring raw-data pos (+ pos len)))) 261 (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
263 (setq pos (+ pos len)) 262 (setq bindat-idx (+ bindat-idx len))
264 (if (stringp s) s 263 (if (stringp s) s
265 (string-make-unibyte (concat s))))) 264 (string-make-unibyte (concat s)))))
266 ((eq type 'strz) 265 ((eq type 'strz)
267 (let ((i 0) s) 266 (let ((i 0) s)
268 (while (and (< i len) (/= (aref raw-data (+ pos i)) 0)) 267 (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
269 (setq i (1+ i))) 268 (setq i (1+ i)))
270 (setq s (substring raw-data pos (+ pos i))) 269 (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
271 (setq pos (+ pos len)) 270 (setq bindat-idx (+ bindat-idx len))
272 (if (stringp s) s 271 (if (stringp s) s
273 (string-make-unibyte (concat s))))) 272 (string-make-unibyte (concat s)))))
274 ((eq type 'vec) 273 ((eq type 'vec)
@@ -310,10 +309,10 @@
310 (setq data (eval len)) 309 (setq data (eval len))
311 (eval len))) 310 (eval len)))
312 ((eq type 'fill) 311 ((eq type 'fill)
313 (setq pos (+ pos len))) 312 (setq bindat-idx (+ bindat-idx len)))
314 ((eq type 'align) 313 ((eq type 'align)
315 (while (/= (% pos len) 0) 314 (while (/= (% bindat-idx len) 0)
316 (setq pos (1+ pos)))) 315 (setq bindat-idx (1+ bindat-idx))))
317 ((eq type 'struct) 316 ((eq type 'struct)
318 (setq data (bindat--unpack-group (eval len)))) 317 (setq data (bindat--unpack-group (eval len))))
319 ((eq type 'repeat) 318 ((eq type 'repeat)
@@ -341,13 +340,13 @@
341 (setq struct (append data struct)))))) 340 (setq struct (append data struct))))))
342 struct)) 341 struct))
343 342
344(defun bindat-unpack (spec raw-data &optional pos) 343(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
345 "Return structured data according to SPEC for binary data in RAW-DATA. 344 "Return structured data according to SPEC for binary data in BINDAT-RAW.
346RAW-DATA is a unibyte string or vector. Optional third arg POS specifies 345BINDAT-RAW is a unibyte string or vector. Optional third arg BINDAT-IDX specifies
347the starting offset in RAW-DATA." 346the starting offset in BINDAT-RAW."
348 (when (multibyte-string-p raw-data) 347 (when (multibyte-string-p bindat-raw)
349 (error "String is multibyte")) 348 (error "String is multibyte"))
350 (unless pos (setq pos 0)) 349 (unless bindat-idx (setq bindat-idx 0))
351 (bindat--unpack-group spec)) 350 (bindat--unpack-group spec))
352 351
353(defun bindat-get-field (struct &rest field) 352(defun bindat-get-field (struct &rest field)
@@ -366,7 +365,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
366 struct) 365 struct)
367 366
368 367
369;; Calculate raw-data length of structured data 368;; Calculate bindat-raw length of structured data
370 369
371(defvar bindat--fixed-length-alist 370(defvar bindat--fixed-length-alist
372 '((u8 . 1) (byte . 1) 371 '((u8 . 1) (byte . 1)
@@ -405,10 +404,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
405 (setq struct (cons (cons field (eval len)) struct)) 404 (setq struct (cons (cons field (eval len)) struct))
406 (eval len))) 405 (eval len)))
407 ((eq type 'fill) 406 ((eq type 'fill)
408 (setq pos (+ pos len))) 407 (setq bindat-idx (+ bindat-idx len)))
409 ((eq type 'align) 408 ((eq type 'align)
410 (while (/= (% pos len) 0) 409 (while (/= (% bindat-idx len) 0)
411 (setq pos (1+ pos)))) 410 (setq bindat-idx (1+ bindat-idx))))
412 ((eq type 'struct) 411 ((eq type 'struct)
413 (bindat--length-group 412 (bindat--length-group
414 (if field (bindat-get-field struct field) struct) (eval len))) 413 (if field (bindat-get-field struct field) struct) (eval len)))
@@ -435,25 +434,25 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
435 (setq len (cdr type))) 434 (setq len (cdr type)))
436 (if field 435 (if field
437 (setq last (bindat-get-field struct field))) 436 (setq last (bindat-get-field struct field)))
438 (setq pos (+ pos len)))))))) 437 (setq bindat-idx (+ bindat-idx len))))))))
439 438
440(defun bindat-length (spec struct) 439(defun bindat-length (spec struct)
441 "Calculate raw-data length for STRUCT according to bindat SPEC." 440 "Calculate bindat-raw length for STRUCT according to bindat SPEC."
442 (let ((pos 0)) 441 (let ((bindat-idx 0))
443 (bindat--length-group struct spec) 442 (bindat--length-group struct spec)
444 pos)) 443 bindat-idx))
445 444
446 445
447;; Pack structured data into raw-data 446;; Pack structured data into bindat-raw
448 447
449(defun bindat--pack-u8 (v) 448(defun bindat--pack-u8 (v)
450 (aset raw-data pos (logand v 255)) 449 (aset bindat-raw bindat-idx (logand v 255))
451 (setq pos (1+ pos))) 450 (setq bindat-idx (1+ bindat-idx)))
452 451
453(defun bindat--pack-u16 (v) 452(defun bindat--pack-u16 (v)
454 (aset raw-data pos (logand (lsh v -8) 255)) 453 (aset bindat-raw bindat-idx (logand (lsh v -8) 255))
455 (aset raw-data (1+ pos) (logand v 255)) 454 (aset bindat-raw (1+ bindat-idx) (logand v 255))
456 (setq pos (+ pos 2))) 455 (setq bindat-idx (+ bindat-idx 2)))
457 456
458(defun bindat--pack-u24 (v) 457(defun bindat--pack-u24 (v)
459 (bindat--pack-u8 (lsh v -16)) 458 (bindat--pack-u8 (lsh v -16))
@@ -464,9 +463,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
464 (bindat--pack-u16 v)) 463 (bindat--pack-u16 v))
465 464
466(defun bindat--pack-u16r (v) 465(defun bindat--pack-u16r (v)
467 (aset raw-data (1+ pos) (logand (lsh v -8) 255)) 466 (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255))
468 (aset raw-data pos (logand v 255)) 467 (aset bindat-raw bindat-idx (logand v 255))
469 (setq pos (+ pos 2))) 468 (setq bindat-idx (+ bindat-idx 2)))
470 469
471(defun bindat--pack-u24r (v) 470(defun bindat--pack-u24r (v)
472 (bindat--pack-u16r v) 471 (bindat--pack-u16r v)
@@ -481,7 +480,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
481 (setq type 'vec len 4)) 480 (setq type 'vec len 4))
482 (cond 481 (cond
483 ((null v) 482 ((null v)
484 (setq pos (+ pos len))) 483 (setq bindat-idx (+ bindat-idx len)))
485 ((memq type '(u8 byte)) 484 ((memq type '(u8 byte))
486 (bindat--pack-u8 v)) 485 (bindat--pack-u8 v))
487 ((memq type '(u16 word short)) 486 ((memq type '(u16 word short))
@@ -513,11 +512,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
513 (let ((l (length v)) (i 0)) 512 (let ((l (length v)) (i 0))
514 (if (> l len) (setq l len)) 513 (if (> l len) (setq l len))
515 (while (< i l) 514 (while (< i l)
516 (aset raw-data (+ pos i) (aref v i)) 515 (aset bindat-raw (+ bindat-idx i) (aref v i))
517 (setq i (1+ i))) 516 (setq i (1+ i)))
518 (setq pos (+ pos len)))) 517 (setq bindat-idx (+ bindat-idx len))))
519 (t 518 (t
520 (setq pos (+ pos len))))) 519 (setq bindat-idx (+ bindat-idx len)))))
521 520
522(defun bindat--pack-group (struct spec) 521(defun bindat--pack-group (struct spec)
523 (let (last) 522 (let (last)
@@ -549,10 +548,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
549 (setq struct (cons (cons field (eval len)) struct)) 548 (setq struct (cons (cons field (eval len)) struct))
550 (eval len))) 549 (eval len)))
551 ((eq type 'fill) 550 ((eq type 'fill)
552 (setq pos (+ pos len))) 551 (setq bindat-idx (+ bindat-idx len)))
553 ((eq type 'align) 552 ((eq type 'align)
554 (while (/= (% pos len) 0) 553 (while (/= (% bindat-idx len) 0)
555 (setq pos (1+ pos)))) 554 (setq bindat-idx (1+ bindat-idx))))
556 ((eq type 'struct) 555 ((eq type 'struct)
557 (bindat--pack-group 556 (bindat--pack-group
558 (if field (bindat-get-field struct field) struct) (eval len))) 557 (if field (bindat-get-field struct field) struct) (eval len)))
@@ -579,18 +578,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
579 (bindat--pack-item last type len) 578 (bindat--pack-item last type len)
580 )))))) 579 ))))))
581 580
582(defun bindat-pack (spec struct &optional raw-data pos) 581(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
583 "Return binary data packed according to SPEC for structured data STRUCT. 582 "Return binary data packed according to SPEC for structured data STRUCT.
584Optional third arg RAW-DATA is a pre-allocated unibyte string or vector to 583Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
585pack into. Optional fourth arg POS is the starting offset into RAW-DATA." 584pack into.
586 (when (multibyte-string-p raw-data) 585Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
586 (when (multibyte-string-p bindat-raw)
587 (error "Pre-allocated string is multibyte")) 587 (error "Pre-allocated string is multibyte"))
588 (let ((no-return raw-data)) 588 (let ((no-return bindat-raw))
589 (unless pos (setq pos 0)) 589 (unless bindat-idx (setq bindat-idx 0))
590 (unless raw-data 590 (unless bindat-raw
591 (setq raw-data (make-vector (+ pos (bindat-length spec struct)) 0))) 591 (setq bindat-raw (make-vector (+ bindat-idx (bindat-length spec struct)) 0)))
592 (bindat--pack-group struct spec) 592 (bindat--pack-group struct spec)
593 (if no-return nil (concat raw-data)))) 593 (if no-return nil (concat bindat-raw))))
594 594
595 595
596;; Misc. format conversions 596;; Misc. format conversions