diff options
| -rw-r--r-- | lisp/emacs-lisp/bindat.el | 108 |
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. |
| 346 | RAW-DATA is a unibyte string or vector. Optional third arg POS specifies | 345 | BINDAT-RAW is a unibyte string or vector. Optional third arg BINDAT-IDX specifies |
| 347 | the starting offset in RAW-DATA." | 346 | the 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. |
| 584 | Optional third arg RAW-DATA is a pre-allocated unibyte string or vector to | 583 | Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to |
| 585 | pack into. Optional fourth arg POS is the starting offset into RAW-DATA." | 584 | pack into. |
| 586 | (when (multibyte-string-p raw-data) | 585 | Optional 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 |