From 488d34657ac1159adace7094f7f78ef10c7452e5 Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Tue, 2 Apr 2013 20:16:20 +0200 Subject: [PATCH 01/13] Remove conflicting nickname. Because BT is already taken by BORDEAUX-THREADS. --- binary-types.lisp | 1 - 1 file changed, 1 deletion(-) diff --git a/binary-types.lisp b/binary-types.lisp index b5bf6f4..d990d11 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -14,7 +14,6 @@ ;;;;------------------------------------------------------------------ (defpackage #:binary-types - (:nicknames #:bt) (:use #:common-lisp) (:export #:*endian* ; [dynamic-var] must be bound when reading integers #:endianess ; [deftype] The set of endian names From 007ec8f9db3cebde863dbde267611be5f1f5df5b Mon Sep 17 00:00:00 2001 From: Rob Blackwell Date: Fri, 26 Apr 2013 11:41:03 +0100 Subject: [PATCH 02/13] Graph can now be built using libraries from Quicklisp --- README | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/README b/README index a9dd259..b784c4b 100644 --- a/README +++ b/README @@ -159,16 +159,18 @@ For a second example, here's an approach to supporting floats: The postscript file "type-hierarchy.ps" shows the binary types -hierarchy. It is generated using psgraph from the CMU lisp +hierarchy. It is generated using psgraph from Quicklisp repository: - (with-open-file (*standard-output* "type-hierarchy.ps" - :direction :output - :if-exists :supersede) - (psgraph:psgraph 'binary-type - #'(lambda (p) - (mapcar #'class-name - (aclmop:class-direct-subclasses - (find-class p)))) - #'(lambda (s) (list (symbol-name s))) - t)) + (ql:quickload "psgraph") + (ql:quickload "closer-mop") + (with-open-file (*standard-output* "type-hierarchy.ps" + :direction :output + :if-exists :supersede) + (psgraph:psgraph *standard-output* 'binary-types::binary-type + #'(lambda (p) + (mapcar #'class-name + (closer-mop:class-direct-subclasses + (find-class p)))) + #'(lambda (s) (list (symbol-name s))) + t)) \ No newline at end of file From b5c43084896e86257f30435170b7f55cb7323f12 Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Thu, 6 Jun 2013 22:55:11 +0200 Subject: [PATCH 03/13] Add primitives integers up to 256 bit width. --- binary-types.lisp | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/binary-types.lisp b/binary-types.lisp index d990d11..72300c3 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -22,9 +22,15 @@ #:u8 ; [type-name] 8-bit unsigned integer #:u16 ; [type-name] 16-bit unsigned integer #:u32 ; [type-name] 32-bit unsigned integer + #:u64 ; [type-name] 64-bit unsigned integer + #:u128 ; [type-name] 128-bit unsigned integer + #:u256 ; [type-name] 256-bit unsigned integer #:s8 ; [type-name] 8-bit signed integer #:s16 ; [type-name] 16-bit signed integer #:s32 ; [type-name] 32-bit signed integer + #:s64 ; [type-name] 64-bit signed integer + #:s128 ; [type-name] 128-bit signed integer + #:s256 ; [type-name] 256-bit signed integer ; (you may define additional integer types ; of any size yourself.) ;; type defining macros @@ -223,6 +229,9 @@ or nil if TYPE is not constant-sized.")) (define-unsigned u8 1) (define-unsigned u16 2) (define-unsigned u32 4) +(define-unsigned u64 8) +(define-unsigned u128 16) +(define-unsigned u256 32) (defmethod read-binary ((type binary-unsigned) stream &key &allow-other-keys) (if (= 1 (sizeof type)) @@ -265,6 +274,9 @@ or nil if TYPE is not constant-sized.")) (define-signed s8 1) (define-signed s16 2) (define-signed s32 4) +(define-signed s64 8) +(define-signed s128 16) +(define-signed s256 32) (defmethod read-binary ((type binary-signed) stream &key &allow-other-keys) (let ((unsigned-value 0)) From 7587ff45b8a04a8f9adf55c3977681dc3897d9bb Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Thu, 6 Jun 2013 22:57:14 +0200 Subject: [PATCH 04/13] Don't throw an error on variable sized members. This just means that the whole struct doesn't have a fixed size. --- binary-types.lisp | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/binary-types.lisp b/binary-types.lisp index 72300c3..b540d74 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -672,6 +672,14 @@ read are returned." ',type-name))))))) +(defun calculate-sizeof (slot-types) + (loop + for slot-type in slot-types + for sizeof = (sizeof slot-type) + when (null sizeof) + do (return) + sum sizeof)) + (defmacro define-binary-struct (name-and-options dummy-options &rest doc-slot-descriptions) (declare (ignore dummy-options)) ; clisp seems to require this.. (let (embedded-declarations) @@ -732,7 +740,7 @@ read are returned." (setf (find-binary-type ',type-name) (make-instance 'binary-struct 'name ',type-name - 'sizeof (loop for s in ',slot-types sum (sizeof s)) + 'sizeof (calculate-sizeof ',slot-types) 'slots ',binslots 'offset 0 'constructor (find-symbol (format nil "~A-~A" '#:make ',type-name)))) From a17caf8890f11fdc56f6ea3a21260bf0fb9c589c Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Thu, 6 Jun 2013 23:27:08 +0200 Subject: [PATCH 05/13] UTF-8, untabify, whitespaces. --- README | 105 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 54 insertions(+), 51 deletions(-) diff --git a/README b/README index b784c4b..4b7fac2 100644 --- a/README +++ b/README @@ -1,15 +1,17 @@ +-*- mode: text; coding: utf-8-unix; -*- + ###################################################################### -## +## ## Copyright (C) 2001,2000, 2003 -## Department of Computer Science, University of Tromsø, Norway -## +## Department of Computer Science, University of Tromsø, Norway +## ## Filename: README ## Author: Frode Vatvedt Fjeld ## Created at: Wed Dec 8 15:35:53 1999 ## Distribution: See the accompanying file COPYING. -## +## ## $Id: README,v 1.1.1.1 2004/01/13 11:13:13 ffjeld Exp $ -## +## ###################################################################### Binary-types is a Common Lisp package for reading and writing binary @@ -94,45 +96,45 @@ with the form (define-binary-class elf-header () ((e-ident :binary-type (define-binary-struct e-ident () - (ei-magic nil :binary-type - (define-binary-struct ei-magic () - (ei-mag0 0 :binary-type u8) - (ei-mag1 #\null :binary-type char8) - (ei-mag2 #\null :binary-type char8) - (ei-mag3 #\null :binary-type char8))) - (ei-class nil :binary-type - (define-enum ei-class (u8) - elf-class-none 0 - elf-class-32 1 - elf-class-64 2)) - (ei-data nil :binary-type - (define-enum ei-data (u8) - elf-data-none 0 - elf-data-2lsb 1 - elf-data-2msb 2)) - (ei-version 0 :binary-type u8) - (padding nil :binary-type 1) - (ei-name "" :binary-type - (define-null-terminated-string ei-name 8)))) + (ei-magic nil :binary-type + (define-binary-struct ei-magic () + (ei-mag0 0 :binary-type u8) + (ei-mag1 #\null :binary-type char8) + (ei-mag2 #\null :binary-type char8) + (ei-mag3 #\null :binary-type char8))) + (ei-class nil :binary-type + (define-enum ei-class (u8) + elf-class-none 0 + elf-class-32 1 + elf-class-64 2)) + (ei-data nil :binary-type + (define-enum ei-data (u8) + elf-data-none 0 + elf-data-2lsb 1 + elf-data-2msb 2)) + (ei-version 0 :binary-type u8) + (padding nil :binary-type 1) + (ei-name "" :binary-type + (define-null-terminated-string ei-name 8)))) (e-type :binary-type (define-enum e-type (half) - et-none 0 - et-rel 1 - et-exec 2 - et-dyn 3 - et-core 4 - et-loproc #xff00 - et-hiproc #xffff)) + et-none 0 + et-rel 1 + et-exec 2 + et-dyn 3 + et-core 4 + et-loproc #xff00 + et-hiproc #xffff)) (e-machine :binary-type (define-enum e-machine (half) - em-none 0 - em-m32 1 - em-sparc 2 - em-386 3 - em-68k 4 - em-88k 5 - em-860 7 - em-mips 8)) + em-none 0 + em-m32 1 + em-sparc 2 + em-386 3 + em-68k 4 + em-88k 5 + em-860 7 + em-mips 8)) (e-version :binary-type word) (e-entry :binary-type addr) (e-phoff :binary-type off) @@ -159,18 +161,19 @@ For a second example, here's an approach to supporting floats: The postscript file "type-hierarchy.ps" shows the binary types -hierarchy. It is generated using psgraph from Quicklisp -repository: +hierarchy. It is generated using psgraph and closer-mop, which may be +loaded via Quicklisp as shown below: (ql:quickload "psgraph") (ql:quickload "closer-mop") + (with-open-file (*standard-output* "type-hierarchy.ps" - :direction :output - :if-exists :supersede) - (psgraph:psgraph *standard-output* 'binary-types::binary-type - #'(lambda (p) - (mapcar #'class-name - (closer-mop:class-direct-subclasses - (find-class p)))) - #'(lambda (s) (list (symbol-name s))) - t)) \ No newline at end of file + :direction :output + :if-exists :supersede) + (psgraph:psgraph *standard-output* 'binary-types::binary-type + (lambda (p) + (mapcar #'class-name + (closer-mop:class-direct-subclasses + (find-class p)))) + (lambda (s) (list (symbol-name s))) + t)) From 259b9cbd00f4a1d91488cddcd50f872cd0d5a000 Mon Sep 17 00:00:00 2001 From: Symbolics Date: Tue, 30 Apr 2024 16:03:16 +0800 Subject: [PATCH 06/13] Refactor repo; update README --- .gitignore | 15 ++ CONTRIBUTING.md | 45 ++++++ ChangeLog | 15 ++ COPYING => LICENSE | 16 +-- README | 179 ------------------------ README-bitfield | 52 ------- README.md | 342 +++++++++++++++++++++++++++++++++++++++++++++ binary-types.asd | 37 ++--- binary-types.lisp | 102 +++----------- pkgdcl.lisp | 62 ++++++++ 10 files changed, 511 insertions(+), 354 deletions(-) create mode 100644 .gitignore create mode 100644 CONTRIBUTING.md rename COPYING => LICENSE (53%) delete mode 100644 README delete mode 100644 README-bitfield create mode 100644 README.md create mode 100644 pkgdcl.lisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f65076d --- /dev/null +++ b/.gitignore @@ -0,0 +1,15 @@ +\#*# +/TAGS +/WIP + + +# Generated build files +*.fasl +*.texi + +# Files local to a developer +TODO.org +NOTES.org +*.text + +public diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..e5db45d --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,45 @@ +# How to Contribute + +We'd love to accept your patches and contributions to this project. There are +just a few small guidelines you need to follow. + +## Contributor License Agreement + +Contributions to this project must be accompanied by a Contributor License +Agreement. You (or your employer) retain the copyright to your contribution; +this simply gives us permission to use and redistribute your contributions as +part of the project. + +You generally only need to submit a CLA once, so if you've already submitted one +(even if it was for a different project), you probably don't need to do it +again. + +## The Contribution Process + +The basic workflow is: + +1. Fork the Project +2. Create your Feature Branch (`git checkout -b feature/AmazingFeature`) +3. Commit your Changes (`git commit -m 'Add some AmazingFeature'`) +4. Push to the Branch (`git push origin feature/AmazingFeature`) +5. Open a Pull Request + +With multiple contributors and the desire to maintain high quality +code, we need a small bit of process. For example all submissions, +including submissions by project members, require review. We use +GitHub pull requests for this purpose. Consult [GitHub +Help](https://help.github.com/articles/about-pull-requests/) for more +information on using pull requests, and the [contributing +code](https://lisp-stat.dev/docs/contributing/code/) page for more +details. + +## Community Guidelines + +This project follows a code of conduct that can be found on the +[contributing](https://lisp-stat.dev/docs/contributing/) page. + +## How to contribute + +See the [contribution +guidelines](https://lisp-stat.dev/docs/contributing/) +in the Lisp-Stat user guide. diff --git a/ChangeLog b/ChangeLog index 87df894..f9b4f90 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2024-04-30 Steve Nunez + + * RELEASE: 1.0.0 + + * Refactor the directory structure and remove file boiler plate + + * Clean up ASDF + + * Add array and vector types + + * Add IEEE-754 floating point types + + * Improve README and documentation + + 2003-12-11 Frode Vatvedt Fjeld * RELEASE: 0.90 diff --git a/COPYING b/LICENSE similarity index 53% rename from COPYING rename to LICENSE index 497dbe4..8d16d2c 100644 --- a/COPYING +++ b/LICENSE @@ -1,17 +1,5 @@ -###################################################################### -## -## Copyright (C) 1999, -## Department of Computer Science, University of Tromsø, Norway -## -## Filename: COPYING -## Description: Defines the terms under which this software may be copied. -## Author: Frode Vatvedt Fjeld -## Created at: Mon Nov 8 20:32:12 1999 -## Distribution: See the accompanying file COPYING. -## -## $Id: COPYING,v 1.1.1.1 2004/01/13 11:13:13 ffjeld Exp $ -## -###################################################################### +Copyright (C) 1999, Department of Computer Science, University of Tromsø, Norway +Copyright (C) 2024, Steven Nunez Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions diff --git a/README b/README deleted file mode 100644 index 4b7fac2..0000000 --- a/README +++ /dev/null @@ -1,179 +0,0 @@ --*- mode: text; coding: utf-8-unix; -*- - -###################################################################### -## -## Copyright (C) 2001,2000, 2003 -## Department of Computer Science, University of Tromsø, Norway -## -## Filename: README -## Author: Frode Vatvedt Fjeld -## Created at: Wed Dec 8 15:35:53 1999 -## Distribution: See the accompanying file COPYING. -## -## $Id: README,v 1.1.1.1 2004/01/13 11:13:13 ffjeld Exp $ -## -###################################################################### - -Binary-types is a Common Lisp package for reading and writing binary -files. Binary-types provides macros that are used to declare the -mapping between lisp objects and some binary (i.e. octet-based) -representation. - -Supported kinds of binary types include: - - * Signed and unsigned integers of any octet-size, big-endian or - little-endian. Maps to lisp integers. - - * Enumerated types based on any integer type. Maps to lisp symbols. - - * Complex bit-field types based on any integer type. Sub-fields can - be numeric, enumerated, or bit-flags. Maps to lisp lists of symbols - and integers. - - * Fixed-length and null-terminated strings. Maps to lisp strings. - - * Compound records of other binary types. Maps to lisp DEFCLASS - classes or, when you prefer, DEFSTRUCT structs. - -Typically, a complete binary record format/type can be specified in a -single (nested) declaration statement. Such compound records may then -be read and written with READ-BINARY and WRITE-BINARY. - -Binary-types is *not* helpful in reading files with variable -bit-length code-words, such as most compressed file formats. It will -basically only work with file-formats based on 8-bit bytes -(octets). Also, at this time no floating-point types are supported out -of the box. - -Binary types may now be declared with the DEFINE-BINARY-CLASS macro, -which has the same syntax (and semantics) as DEFCLASS, only there is -an additional slot-option (named :BINARY-TYPE) that declares that -slot's binary type. Note that the binary aspects of slots are *not* -inherited (the semantics of inheriting binary slots is unclear to me). - -Another slot-option added by binary-types is :MAP-BINARY-WRITE, which -names a function (of two arguments) that is applied to the slot's -value and the name of the slot's binary-type in order to obtain the -value that is actually passed to WRITE-BINARY. Similarly, -:MAP-BINARY-READ takes a function that is to be applied to the binary -data and type-name when a record of that type is being read. A -slightly modified version of :map-binary-read is -:MAP-BINARY-READ-DELAYED, which will do essentially the same thing as -:map-binary-read, only the mapping will be "on-demand": A slot-unbound -method will be created for this purpose. - -A variation of the :BINARY-TYPE slot-option is :BINARY-LISP-TYPE, -which does everything :BINARY-TYPE does, but also passes on a :TYPE -slot-option to DEFCLASS (or DEFSTRUCT). The type-spec is inferred -from the binary-type declaration. When using this mechanism, you -should be careful to always provide a legal value in the slot (as you -must always do when declaring slots' types). If you find this -confusing, just use :BINARY-TYPE. - -Performance has not really been a concern for me while designing this -package. There's no obvious performance bottlenecks that I know of, -but keep in mind that all "binary" reads and writes are reduced to -individual 8-bit READ-BYTEs and WRITE-BYTEs. If you do identify -particular performance bottlenecks, let me know. - -The included file "example.lisp" demonstrates how to use this -package. To give you a taste of what it looks like, the following -declarations are enough to read the header of an ELF executable file -with the form - - (let ((*endian* :big-endian)) - (read-binary 'elf-header stream) - - -;;; ELF basic type declarations -(define-unsigned word 4) -(define-signed sword 4) -(define-unsigned addr 4) -(define-unsigned off 4) -(define-unsigned half 2) - -;;; ELF file header structure -(define-binary-class elf-header () - ((e-ident - :binary-type (define-binary-struct e-ident () - (ei-magic nil :binary-type - (define-binary-struct ei-magic () - (ei-mag0 0 :binary-type u8) - (ei-mag1 #\null :binary-type char8) - (ei-mag2 #\null :binary-type char8) - (ei-mag3 #\null :binary-type char8))) - (ei-class nil :binary-type - (define-enum ei-class (u8) - elf-class-none 0 - elf-class-32 1 - elf-class-64 2)) - (ei-data nil :binary-type - (define-enum ei-data (u8) - elf-data-none 0 - elf-data-2lsb 1 - elf-data-2msb 2)) - (ei-version 0 :binary-type u8) - (padding nil :binary-type 1) - (ei-name "" :binary-type - (define-null-terminated-string ei-name 8)))) - (e-type - :binary-type (define-enum e-type (half) - et-none 0 - et-rel 1 - et-exec 2 - et-dyn 3 - et-core 4 - et-loproc #xff00 - et-hiproc #xffff)) - (e-machine - :binary-type (define-enum e-machine (half) - em-none 0 - em-m32 1 - em-sparc 2 - em-386 3 - em-68k 4 - em-88k 5 - em-860 7 - em-mips 8)) - (e-version :binary-type word) - (e-entry :binary-type addr) - (e-phoff :binary-type off) - (e-shoff :binary-type off) - (e-flags :binary-type word) - (e-ehsize :binary-type half) - (e-phentsize :binary-type half) - (e-phnum :binary-type half) - (e-shentsize :binary-type half) - (e-shnum :binary-type half) - (e-shstrndx :binary-type half))) - - -For a second example, here's an approach to supporting floats: - - (define-bitfield ieee754-single-float (u32) - (((:enum :byte (1 31)) - positive 0 - negative 1) - ((:numeric exponent 8 23)) - ((:numeric significand 23 0)))) - - - - -The postscript file "type-hierarchy.ps" shows the binary types -hierarchy. It is generated using psgraph and closer-mop, which may be -loaded via Quicklisp as shown below: - - (ql:quickload "psgraph") - (ql:quickload "closer-mop") - - (with-open-file (*standard-output* "type-hierarchy.ps" - :direction :output - :if-exists :supersede) - (psgraph:psgraph *standard-output* 'binary-types::binary-type - (lambda (p) - (mapcar #'class-name - (closer-mop:class-direct-subclasses - (find-class p)))) - (lambda (s) (list (symbol-name s))) - t)) diff --git a/README-bitfield b/README-bitfield deleted file mode 100644 index 420cb86..0000000 --- a/README-bitfield +++ /dev/null @@ -1,52 +0,0 @@ - -> My only problem is with DEF-BITFIELD. All other BINARY-TYPES -> features are intuitive and easy to use. - -Hi, you are right that DEF-BITFIELD is poorly documented. I think -that's because it's a bit complex and I'm not quite confident it is -the way it should be. Anyways, here are a couple of examples: - -(define-bitfield r-info (u32) - (((:enum :byte (8 0)) - r-386-none 0 - r-386-32 1 - r-386-pc32 2 - r-386-got32 3 - r-386-plt32 4 - r-386-copy 5 - r-386-glob-dat 6 - r-386-jmp-slot 7 - r-386-relative 8 - r-386-gotoff 9 - r-386-gotpc 10) - ((:numeric r-sym 24 8)))) - -This declares R-INFO to be an unsigned 32-bit number, divided into two -fields. The first field resides in bits 0-7, and is one of the values -r-386-xx. The second field is a numeric value that resides in bits -8-23. So this type R-INFO may for example have symbolic value -(r-386-pc32 (r-sym . 1)), which translates to a numeric value of - (logior 2 1<<8)) = 258. - -Another example: - -(define-bitfield p-flags (u8) - (((:bits) - pf-x 0 - pf-w 1 - pf-r 2))) - -Here P-FLAGS has just one bit-field, where bit 0 is named PF-X, bit 1 -is named PF-W etc. So the value (PF-X PF-R) maps to 5. - -As you may see by now, DEF-BITFIELD divides a numeric base-type -(typically an unsigned integer) into a number of fields, where each -field is one of :BITS for bitmaps, :ENUM for an enumerated field -(takes an optional :BYTE ), and finally :NUMERIC - for a subfield that is a number. - -Hope this helps. - --- -Frode Vatvedt Fjeld - diff --git a/README.md b/README.md new file mode 100644 index 0000000..ebd0228 --- /dev/null +++ b/README.md @@ -0,0 +1,342 @@ + + +
+

+

BINARY-TYPES

+ +

+ +
+
+ Report Bugs + · + Request Feature + · + Reference Manual +

+

+ + + + +
+

Table of Contents

 +
    +
  1. + About the Project + +
    2. +
  2. Installation
    3. +
  3. + Using + +
    4. +
  4. Performance
    5. +
  5. Roadmap
    6. +
  6. Contributing
    7. +
  7. License
    8. +
  8. Contact
    9. +
+
+ + + + +## About the Project + +BINARY-TYPES is a Common Lisp system for reading and writing binary files. Binary-types provides macros that are used to declare the mapping between lisp objects and most binary (i.e. octet-based) representations. Binary-types is *not* helpful in reading files with variable bit-length code-words, such as most compressed file formats. It will basically only work with file-formats based on 8-bit bytes (octets). + +### Objectives + +Support most kinds of binary types including: + + * Signed and unsigned integers of any octet-size, big-endian or + little-endian. Maps to lisp integers. + + * Enumerated types based on any integer type. Maps to lisp symbols. + + * Complex bit-field types based on any integer type. Sub-fields can + be numeric, enumerated, or bit-flags. Maps to lisp lists of symbols + and integers. + + * Fixed-length and null-terminated strings. Maps to lisp strings. + + * Compound records of other binary types. Maps to lisp `DEFCLASS` + classes or, when you prefer, `DEFSTRUCT` structs. + + * Vectors and arrays + + * 32 and 64 bit IEEE-754 floats map to lisp `single-float` and `double-float` + + +### History + +BINARY-TYPES was developed over the years 1999-2003 by Frode Vatvedt Fjeld whilst working at the Department of Computer Science, University of Tromsø, Norway. It later served as the basis for [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) of the book [Practical Common Lisp](https://gigamonkeys.com/book/) by Peter Seibel. That chapter makes a good technical reference for the system, and you should read it if you want to extend BINARY-TYPES. + +Frode's version was sufficiently well done that the system went largely unchanged since, except for some local additions for [slitch](https://github.com/sharplispers/slitch/tree/master) a low-level networking library in 2003 and then again in a [fork by Olof-Joachim Frahm](https://github.com/Ferada/binary-types/commits/master/) in 2013 that added 256 bit integers. + +This repository began in 2024 and adds support for 32/64 bit IEEE-754 floats, binary arrays, improved documentation and refactored the repository/ASDF system. + + + +## Installation + +This version of BINARY-TYPES is not the official QuickLisp version, so to install it you'll need to clone the source code. + +To make the system accessible to [ASDF](https://common-lisp.net/project/asdf/) (a build facility, similar to `make` in the C world), clone the repository in a directory ASDF knows about. By default the `common-lisp` directory in your home directory is known. Create this if it doesn't already exist and then: + +1. Clone the repositories +```sh +cd ~/common-lisp && \ +git clone https://github.com/snunez1/binary-types.git +``` +2. Reset the ASDF source-registry to find the new system (from the REPL) + ```lisp + (asdf:clear-source-registry) + ``` +3. Load the system + ```lisp + (asdf:load-system :binary-types) + ``` + +If you have installed the slime ASDF extensions, you can invoke this with a comma (',') from the slime REPL. + + + +## Using +Typically, a complete binary record format/type can be specified in a single (nested) declaration statement. Such compound records may then be read and written with `READ-BINARY` and `WRITE-BINARY`. So start with the specification for the binary file or stream and map each element. Here's a simple example to take the first two bytes of a file: +```lisp +(define-binary-struct llama-config () + (dim nil :binary-type u32) + (hidden-dim nil :binary-type u32)) +``` +and, with that, we can read and print from the binary file with: +```lisp +(let ((binary-types:*endian* :little-endian)) + (with-binary-file (stream #P"stories15M.bin" :direction :input) + (let ((config (read-binary 'llama-config stream))) + (format t "~A~%~A" + (slot-value config 'dim) + (slot-value config 'hidden-dim))))) +``` + +(Note: this isn't really the on-disk format for a llama LLM checkpoint, it's just an example that will be expanded on later) + +Also see [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) for an extended example. + + +### Declaring classes and structures +Binary types may be declared with the `DEFINE-BINARY-CLASS` macro, which has the same syntax and semantics as `DEFCLASS`, only there is an additional slot-option (named `:BINARY-TYPE`) that declares that slot's binary type. Note that the binary aspects of slots are *not* inherited (the semantics of inheriting binary slots is unspecified). + +Another slot-option added by BINARY-TYPES is `:MAP-BINARY-WRITE`, which +names a function (of two arguments) that is applied to the slot's +value and the name of the slot's binary-type in order to obtain the +value that is actually passed to `WRITE-BINARY`. Similarly, +`:MAP-BINARY-READ` takes a function that is to be applied to the binary +data and type-name when a record of that type is being read. A +slightly modified version of `:map-binary-read` is +`:MAP-BINARY-READ-DELAYED`, which will do essentially the same thing as +`:MAP-BINARY-READ`, only the mapping will be "on-demand": A slot-unbound +method will be created for this purpose. + +A variation of the `:BINARY-TYPE` slot-option is `:BINARY-LISP-TYPE`, +which does everything `:BINARY-TYPE` does, but also passes on a `:TYPE` +slot-option to `DEFCLASS` (or `DEFSTRUCT`). The type-spec is inferred +from the binary-type declaration. When using this mechanism, you +should be careful to always provide a legal value in the slot (as you +must always do when declaring slots' types). If you find this +confusing, just use `:BINARY-TYPE`. + + +### Bitfields + +> My only problem is with DEF-BITFIELD. All other BINARY-TYPES +> features are intuitive and easy to use. + +`DEF-BITFIELD`, because it isn't an oft-seen paradigm, can be confusing. I think that's because it's a bit complex and it's going to take some more using it to make certain it is the way it should be. + +Basically `DEF-BITFIELD` divides a numeric base-type (typically an unsigned integer) into a number of fields, where each field is one of `:BITS` for bitmaps, `:ENUM` for an enumerated field (takes an optional `:BYTE `), and finally `:NUMERIC ` for a subfield that is a number. + +Here are a couple of examples: + +```lisp +(define-bitfield r-info (u32) + (((:enum :byte (8 0)) + r-386-none 0 + r-386-32 1 + r-386-pc32 2 + r-386-got32 3 + r-386-plt32 4 + r-386-copy 5 + r-386-glob-dat 6 + r-386-jmp-slot 7 + r-386-relative 8 + r-386-gotoff 9 + r-386-gotpc 10) + ((:numeric r-sym 24 8)))) +``` +This declares `R-INFO` to be an unsigned 32-bit number, divided into two +fields. The first field resides in bits 0-7, and is one of the values +r-386-xx. The second field is a numeric value that resides in bits +8-23. So this type `R-INFO` may for example have symbolic value +(r-386-pc32 (r-sym . 1)), which translates to a numeric value of + (logior 2 1<<8)) = 258. + +Another example: +```lisp +(define-bitfield p-flags (u8) + (((:bits) + pf-x 0 + pf-w 1 + pf-r 2))) +``` +Here `P-FLAGS` has just one bit-field, where bit 0 is named PF-X, bit 1 +is named PF-W etc. So the value `(PF-X PF-R)` maps to 5. + + + + +### Examples +The included file "example.lisp" demonstrates how to use this +package. To give you a taste of what it looks like, the following +declarations are enough to read the header of an ELF executable file +with the form + +```lisp + (let ((*endian* :big-endian)) + (read-binary 'elf-header stream) + +;;; ELF basic type declarations +(define-unsigned word 4) +(define-signed sword 4) +(define-unsigned addr 4) +(define-unsigned off 4) +(define-unsigned half 2) + +;;; ELF file header structure +(define-binary-class elf-header () + ((e-ident + :binary-type (define-binary-struct e-ident () + (ei-magic nil :binary-type + (define-binary-struct ei-magic () + (ei-mag0 0 :binary-type u8) + (ei-mag1 #\null :binary-type char8) + (ei-mag2 #\null :binary-type char8) + (ei-mag3 #\null :binary-type char8))) + (ei-class nil :binary-type + (define-enum ei-class (u8) + elf-class-none 0 + elf-class-32 1 + elf-class-64 2)) + (ei-data nil :binary-type + (define-enum ei-data (u8) + elf-data-none 0 + elf-data-2lsb 1 + elf-data-2msb 2)) + (ei-version 0 :binary-type u8) + (padding nil :binary-type 1) + (ei-name "" :binary-type + (define-null-terminated-string ei-name 8)))) + (e-type + :binary-type (define-enum e-type (half) + et-none 0 + et-rel 1 + et-exec 2 + et-dyn 3 + et-core 4 + et-loproc #xff00 + et-hiproc #xffff)) + (e-machine + :binary-type (define-enum e-machine (half) + em-none 0 + em-m32 1 + em-sparc 2 + em-386 3 + em-68k 4 + em-88k 5 + em-860 7 + em-mips 8)) + (e-version :binary-type word) + (e-entry :binary-type addr) + (e-phoff :binary-type off) + (e-shoff :binary-type off) + (e-flags :binary-type word) + (e-ehsize :binary-type half) + (e-phentsize :binary-type half) + (e-phnum :binary-type half) + (e-shentsize :binary-type half) + (e-shnum :binary-type half) + (e-shstrndx :binary-type half))) +``` + +For a second example, here's an approach to supporting floats: +```lisp + (define-bitfield ieee754-single-float (u32) + (((:enum :byte (1 31)) + positive 0 + negative 1) + ((:numeric exponent 8 23)) + ((:numeric significand 23 0)))) +``` + + + +In version 1.0 or later BINARY-TYPES uses Marijn Haverbeke's [ieee-floats](https://github.com/marijnh/ieee-floats) system to convert floats. + +The postscript file "type-hierarchy.ps" shows the binary types +hierarchy. It is generated using psgraph and closer-mop, which may be +loaded via Quicklisp as shown below: +```lisp +(ql:quickload "psgraph") +(ql:quickload "closer-mop") + +(with-open-file (*standard-output* "type-hierarchy.ps" + :direction :output + :if-exists :supersede) + (psgraph:psgraph *standard-output* 'binary-types::binary-type + (lambda (p) + (mapcar #'class-name + (closer-mop:class-direct-subclasses + (find-class p)))) + (lambda (s) (list (symbol-name s))) + t)) +``` + +## Performance +Performance has not really been a concern while designing this +system. There's no obvious performance bottlenecks that we are aware of, +but keep in mind that all "binary" reads and writes are reduced to +individual 8-bit `READ-BYTE`s and `WRITE-BYTE`s. If you do identify +particular performance bottlenecks, please raise an issue. + + + +## Roadmap +BINARY-TYPES is more or less feature complete. The only feature I have encountered, once, that wasn't handled is serialized hash-maps. + +See the [open issues](https://github.com/snunez1/binary-types/issues) for a list of proposed features (and known issues). + + + +## Contributing + +Contributions are what make the open source community such an amazing place to be learn, inspire, and create. Any contributions you make are **greatly appreciated**. Please see [CONTRIBUTING](CONTRIBUTING.md) for details on the code of conduct, and the process for submitting pull requests. + + +## License + +Distributed under the BSD-3-Clause License. See [LICENSE](LICENSE) for more information. + + + +## Contact + +Project Link: [https://github.com/snunez1/binary-types](https://github.com/snunez1/binary-types) + diff --git a/binary-types.asd b/binary-types.asd index 53b12a0..7b672ec 100644 --- a/binary-types.asd +++ b/binary-types.asd @@ -1,30 +1,19 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;;------------------------------------------------------------------ -;;;; -;;;; Copyright (C) 2008, Frode V. Fjeld -;;;; -;;;; For distribution policy, see the accompanying file COPYING. -;;;; -;;;; Filename: movitz.asd -;;;; Description: Movitz ASDF system definition. -;;;; Author: Frode Vatvedt Fjeld -;;;; Created at: Thu Jan 15 18:40:58 2004 -;;;; -;;;; $Id: binary-types.asd,v 1.2 2008/02/25 23:43:24 ffjeld Exp $ -;;;; -;;;;------------------------------------------------------------------ +;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: CL-USER -*- +;;; Copyright (C) 1999-2001 Department of Computer Science, University of Tromsø, Norway +;;; Copyright (c) 2024 by Steven Nunez. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause -(defpackage binary-types-asd - (:use :cl :asdf)) - -(in-package binary-types-asd) - -(defsystem binary-types +(defsystem "binary-types" :name "Binary-types" - :maintainer "ffjeld@common-lisp.net" + :maintainer "Steven Nunez" :author "Frode V. Fjeld" - :license "BSD-like, see accopanying file COPYING." + :version "1.0.0" + :license :BSD-3-Clause :description "A library for reading and writing binary records." + :long-description #.(uiop:read-file-string + (uiop:subpathname *load-pathname* "description.text")) :perform (load-op :after (op c) (provide 'binary-types)) - :components ((:file "binary-types"))) + :components ((:file "pkgdcl") + (:file "binary-types"))) + diff --git a/binary-types.lisp b/binary-types.lisp index b540d74..7a0ba34 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -1,77 +1,8 @@ -;;;;------------------------------------------------------------------ -;;;; -;;;; Copyright (C) 1999-2004, -;;;; Department of Computer Science, University of Tromsoe, Norway -;;;; -;;;; Filename: binary-types.lisp -;;;; Description: Reading and writing of binary data in streams. -;;;; Author: Frode Vatvedt Fjeld -;;;; Created at: Fri Nov 19 18:53:57 1999 -;;;; Distribution: See the accompanying file COPYING. -;;;; -;;;; $Id: binary-types.lisp,v 1.3 2004/04/20 08:32:50 ffjeld Exp $ -;;;; -;;;;------------------------------------------------------------------ - -(defpackage #:binary-types - (:use #:common-lisp) - (:export #:*endian* ; [dynamic-var] must be bound when reading integers - #:endianess ; [deftype] The set of endian names - ;; built-in types - #:char8 ; [type-name] 8-bit character - #:u8 ; [type-name] 8-bit unsigned integer - #:u16 ; [type-name] 16-bit unsigned integer - #:u32 ; [type-name] 32-bit unsigned integer - #:u64 ; [type-name] 64-bit unsigned integer - #:u128 ; [type-name] 128-bit unsigned integer - #:u256 ; [type-name] 256-bit unsigned integer - #:s8 ; [type-name] 8-bit signed integer - #:s16 ; [type-name] 16-bit signed integer - #:s32 ; [type-name] 32-bit signed integer - #:s64 ; [type-name] 64-bit signed integer - #:s128 ; [type-name] 128-bit signed integer - #:s256 ; [type-name] 256-bit signed integer - ; (you may define additional integer types - ; of any size yourself.) - ;; type defining macros - #:define-unsigned ; [macro] declare an unsigned-int type - #:define-signed ; [macro] declare a signed-int type - #:define-binary-struct ; [macro] declare a binary defstruct type - #:define-binary-class ; [macro] declare a binary defclass type - #:define-bitfield ; [macro] declare a bitfield (symbolic integer) type - #:define-enum ; [macro] declare an enumerated type - #:define-binary-string ; [macro] declare a string type - #:define-null-terminated-string ; [macro] declare a null-terminated string - ;; readers and writers - #:read-binary ; [func] reads a binary-type from a stream - #:read-binary-record ; [method] - #:write-binary ; [func] writes an binary object to a stream - #:write-binary-record ; [method] - #:read-binary-string - ;; record handling - #:binary-record-slot-names ; [func] list names of binary slots. - #:binary-slot-value ; [func] get "binary" version of slot's value - #:binary-slot-type ; [func] get binary slot's binary type - #:binary-slot-tags ; [func] get the tags of a binary slot - #:slot-offset ; [func] determine offset of slot. - ;; misc - #:find-binary-type ; [func] accessor to binary-types namespace - #:sizeof ; [func] The size in octets of a binary type - #:enum-value ; [func] Calculate numeric version of enum value - #:enum-symbolic-value ; [func] Inverse of enum-value. - #:with-binary-file ; [macro] variant of with-open-file - #:with-binary-output-to-list ; [macro] - #:with-binary-output-to-vector ; [macro] - #:with-binary-input-from-list ; [macro] - #:with-binary-input-from-vector ; [macro] - #:*binary-write-byte* ; [dynamic-var] - #:*binary-read-byte* ; [dynamic-var] - #:*padding-byte* ; [dynamic-var] The value filled in when writing paddings - #:split-bytes ; [func] utility - #:merge-bytes ; [func] utility - )) - -(in-package binary-types) +;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: BINARY-TYPES -*- +;;; Copyright (C) 1999-2001 Department of Computer Science, University of Tromsø, Norway +;;; Copyright (c) 2024 by Steven Nunez. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause +(in-package #:binary-types) (defvar *ignore-hidden-slots-for-pcl* nil "Really ugly hack to allow older PCL-infested lisps to work in the @@ -91,7 +22,7 @@ precense of :map-binary-read-delayed.") (loop for x on list by #'cddr collect (cons (first x) (second x)))) ;;; ---------------------------------------------------------------- -;;; +;;; ;;; ---------------------------------------------------------------- (eval-when (:compile-toplevel :load-toplevel :execute) @@ -141,7 +72,7 @@ or nil if TYPE is not constant-sized.")) (defmethod sizeof (obj) (sizeof (find-binary-type (type-of obj)))) - + (defmethod sizeof ((type symbol)) (sizeof (find-binary-type type))) @@ -187,7 +118,7 @@ or nil if TYPE is not constant-sized.")) (format stream "~D-BIT~@[ ~A~] INTEGER TYPE: ~A" (* 8 (slot-value type 'sizeof)) (slot-value type 'endian) - (binary-type-name type))) + (binary-type-name type))) (call-next-method type stream))) ;;; WRITE-BINARY is identical for SIGNED and UNSIGNED, but READ-BINARY @@ -252,7 +183,7 @@ or nil if TYPE is not constant-sized.")) (* 8 i))))))) (values unsigned-value (sizeof type))))) - + ;;; ---------------------------------------------------------------- ;;; Twos Complement Signed Integer Types ;;; ---------------------------------------------------------------- @@ -571,7 +502,7 @@ read are returned." and map-read = nil and map-read-delayed = nil and tags = nil - unless + unless (case slot-option (:binary-tag (prog1 t @@ -670,7 +601,7 @@ read are returned." (slot-value instance ',(first bs)) ',(fourth bs)))))) ',type-name))))))) - + (defun calculate-sizeof (slot-types) (loop @@ -918,7 +849,7 @@ record object." (third s) (fourth s))))))) spec))) - `(let ((type-obj (make-instance 'bitfield + `(let ((type-obj (make-instance 'bitfield 'name ',type-name 'sizeof (sizeof ',storage-type) 'storage-type (find-binary-type ',storage-type)))) @@ -1019,13 +950,13 @@ record object." (bitfield-entry-bytespec entry) 0) (bitfield-entry-value entry)))))) - + (defmethod read-binary ((type bitfield) stream &key &allow-other-keys) (multiple-value-bind (storage-obj num-octets-read) (read-binary (storage-type type) stream) (values (bitfield-compute-symbolic-value type storage-obj) num-octets-read))) - + (defmethod write-binary ((type bitfield) stream symbolic-value &rest key-args) (apply #'write-binary (storage-type type) @@ -1163,7 +1094,7 @@ otherwise the value of BODY." ,@body ,@(when (integerp vector-or-size-form) (list stream-var)))))) - + ;;; @@ -1181,7 +1112,8 @@ otherwise the value of BODY." (:big-endian (loop for byte in bytes append (loop for x from (1- (truncate from-size to-size)) downto 0 - collect (ldb (byte to-size (* x to-size)) byte)))))) + collect (ldb (byte to-size (* x to-size)) byte)))))) + (defun merge-bytes (bytes from-size to-size) "Combine BYTES sized FROM-SIZE bits into new bytes sized TO-SIZE bits." (assert (zerop (rem to-size from-size))) diff --git a/pkgdcl.lisp b/pkgdcl.lisp new file mode 100644 index 0000000..a134ac1 --- /dev/null +++ b/pkgdcl.lisp @@ -0,0 +1,62 @@ +;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: CL-USER -*- +;;; Copyright (C) 1999-2001 Department of Computer Science, University of Tromsø, Norway +;;; Copyright (c) 2024 by Steven Nunez. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause + +(uiop:define-package #:binary-types + (:use #:common-lisp) + (:export #:*endian* ; [dynamic-var] must be bound when reading integers + #:endianess ; [deftype] The set of endian names + ;; built-in types + #:char8 ; [type-name] 8-bit character + #:u8 ; [type-name] 8-bit unsigned integer + #:u16 ; [type-name] 16-bit unsigned integer + #:u32 ; [type-name] 32-bit unsigned integer + #:u64 ; [type-name] 64-bit unsigned integer + #:u128 ; [type-name] 128-bit unsigned integer + #:u256 ; [type-name] 256-bit unsigned integer + #:s8 ; [type-name] 8-bit signed integer + #:s16 ; [type-name] 16-bit signed integer + #:s32 ; [type-name] 32-bit signed integer + #:s64 ; [type-name] 64-bit signed integer + #:s128 ; [type-name] 128-bit signed integer + #:s256 ; [type-name] 256-bit signed integer + ; (you may define additional integer types + ; of any size yourself.) + ;; type defining macros + #:define-unsigned ; [macro] declare an unsigned-int type + #:define-signed ; [macro] declare a signed-int type + #:define-binary-struct ; [macro] declare a binary defstruct type + #:define-binary-class ; [macro] declare a binary defclass type + #:define-bitfield ; [macro] declare a bitfield (symbolic integer) type + #:define-enum ; [macro] declare an enumerated type + #:define-binary-string ; [macro] declare a string type + #:define-null-terminated-string ; [macro] declare a null-terminated string + ;; readers and writers + #:read-binary ; [func] reads a binary-type from a stream + #:read-binary-record ; [method] + #:write-binary ; [func] writes an binary object to a stream + #:write-binary-record ; [method] + #:read-binary-string + ;; record handling + #:binary-record-slot-names ; [func] list names of binary slots. + #:binary-slot-value ; [func] get "binary" version of slot's value + #:binary-slot-type ; [func] get binary slot's binary type + #:binary-slot-tags ; [func] get the tags of a binary slot + #:slot-offset ; [func] determine offset of slot. + ;; misc + #:find-binary-type ; [func] accessor to binary-types namespace + #:sizeof ; [func] The size in octets of a binary type + #:enum-value ; [func] Calculate numeric version of enum value + #:enum-symbolic-value ; [func] Inverse of enum-value. + #:with-binary-file ; [macro] variant of with-open-file + #:with-binary-output-to-list ; [macro] + #:with-binary-output-to-vector ; [macro] + #:with-binary-input-from-list ; [macro] + #:with-binary-input-from-vector ; [macro] + #:*binary-write-byte* ; [dynamic-var] + #:*binary-read-byte* ; [dynamic-var] + #:*padding-byte* ; [dynamic-var] The value filled in when writing paddings + #:split-bytes ; [func] utility + #:merge-bytes) ; [func] utility + (:documentation "BINARY-TYPES documenation")) From bf8f678f6e0a0b21d59ebdd1324917c1d0a92e71 Mon Sep 17 00:00:00 2001 From: Symbolics Date: Sat, 4 May 2024 10:51:56 +0800 Subject: [PATCH 07/13] Add binary integer vectors --- README.md | 15 ++++--- arrays.lisp | 66 ++++++++++++++++++++++++++++ binary-types.asd | 35 ++++++++++++--- binary-types.lisp | 2 +- tests/pkgdcl.lisp | 6 +++ tests/tests.lisp | 110 ++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 219 insertions(+), 15 deletions(-) create mode 100644 arrays.lisp create mode 100644 tests/pkgdcl.lisp create mode 100644 tests/tests.lisp diff --git a/README.md b/README.md index ebd0228..8419266 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@

BINARY-TYPES

- + A system for declarative specification of binary file readers and writers

Report Bugs @@ -71,16 +71,16 @@ Support most kinds of binary types including: * Compound records of other binary types. Maps to lisp `DEFCLASS` classes or, when you prefer, `DEFSTRUCT` structs. - * Vectors and arrays + * Vectors and arrays of integers and floats. - * 32 and 64 bit IEEE-754 floats map to lisp `single-float` and `double-float` + * 32 and 64 bit IEEE-754 floats map to lisp `single-float` and `double-float`. ### History BINARY-TYPES was developed over the years 1999-2003 by Frode Vatvedt Fjeld whilst working at the Department of Computer Science, University of Tromsø, Norway. It later served as the basis for [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) of the book [Practical Common Lisp](https://gigamonkeys.com/book/) by Peter Seibel. That chapter makes a good technical reference for the system, and you should read it if you want to extend BINARY-TYPES. -Frode's version was sufficiently well done that the system went largely unchanged since, except for some local additions for [slitch](https://github.com/sharplispers/slitch/tree/master) a low-level networking library in 2003 and then again in a [fork by Olof-Joachim Frahm](https://github.com/Ferada/binary-types/commits/master/) in 2013 that added 256 bit integers. +Frode's version was sufficiently well done that the system went largely unchanged since except for some local additions for [slitch](https://github.com/sharplispers/slitch/tree/master) a low-level networking library in 2003 and then again in a [fork by Olof-Joachim Frahm](https://github.com/Ferada/binary-types/commits/master/) in 2013 that added 256 bit integers. This repository began in 2024 and adds support for 32/64 bit IEEE-754 floats, binary arrays, improved documentation and refactored the repository/ASDF system. @@ -127,7 +127,7 @@ and, with that, we can read and print from the binary file with: (slot-value config 'hidden-dim))))) ``` -(Note: this isn't really the on-disk format for a llama LLM checkpoint, it's just an example that will be expanded on later) +(Note: this isn't really the on-disk format for a llama LLM checkpoint, it's just an example for demonstration purposes. Also see [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) for an extended example. @@ -210,8 +210,8 @@ declarations are enough to read the header of an ELF executable file with the form ```lisp - (let ((*endian* :big-endian)) - (read-binary 'elf-header stream) +(let ((*endian* :big-endian)) + (read-binary 'elf-header stream) ;;; ELF basic type declarations (define-unsigned word 4) @@ -290,6 +290,7 @@ For a second example, here's an approach to supporting floats: In version 1.0 or later BINARY-TYPES uses Marijn Haverbeke's [ieee-floats](https://github.com/marijnh/ieee-floats) system to convert floats. +### Generating a class diagram The postscript file "type-hierarchy.ps" shows the binary types hierarchy. It is generated using psgraph and closer-mop, which may be loaded via Quicklisp as shown below: diff --git a/arrays.lisp b/arrays.lisp new file mode 100644 index 0000000..60e0e36 --- /dev/null +++ b/arrays.lisp @@ -0,0 +1,66 @@ +;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: BINARY-TYPES -*- +;;; Copyright (C) 2011 Luke Gorrie +;;; Copyright (c) 2024 by Steven Nunez. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause +(in-package #:binary-types) + +;;; From: https://github.com/sharplispers/slitch/blob/master/src/binary-types-extra.lisp + +(export '(define-binary-vector binary-vector binary-vector-input-state)) + +(defun binary-vector-input-state (stream) + "Returns two values: the vector being read, and the current input position." + (values (cdr stream) (1+ (car stream)))) + +;; ---------------------------------------------------------------------- +;; Vectors + +(defclass binary-vector (binary-record) + ((element-type :initarg element-type :reader binary-vector-element-type) + (size :initarg size :reader binary-vector-size))) + +(defun binary-vector (element-type size) + "Directly return a binary-type." + (make-instance 'binary-vector + 'name `(binary-vector ,element-type ,size) + 'sizeof (* (sizeof element-type) size) + 'element-type element-type + 'size size)) + +(defmacro define-binary-vector (type-name element-type size) + (check-type size (integer 1 *)) + `(progn + (deftype ,type-name () '(array ,element-type ,size)) + (setf (find-binary-type ',type-name) + (make-instance 'binary-vector + 'name ',type-name + 'sizeof (* (sizeof ',element-type) + ,size) + 'element-type ',element-type + 'size ,size)) + ',type-name)) + +(defmethod read-binary ((type binary-vector) stream &key &allow-other-keys) + (read-binary-vector stream + (binary-vector-element-type type) + (binary-vector-size type))) + +(defun read-binary-vector (stream type size) + (let ((vec (make-array (list size) :element-type type)) + (read-bytes 0)) + (dotimes (i size) + (multiple-value-bind (obj bytes) + (read-binary type stream) + (setf (elt vec i) obj) + (incf read-bytes bytes))) + (values vec read-bytes))) + +(defmethod write-binary ((type binary-vector) stream object + &key &allow-other-keys) + (loop for x across object + do (write-binary (binary-vector-element-type type) stream x)) + (sizeof type)) + +(defmethod sizeof ((type binary-vector)) + (with-slots (size element-type) type + (* size (sizeof element-type)))) diff --git a/binary-types.asd b/binary-types.asd index 7b672ec..b1d43d3 100644 --- a/binary-types.asd +++ b/binary-types.asd @@ -4,16 +4,37 @@ ;;; SPDX-License-identifier: BSD-3-Clause (defsystem "binary-types" - :name "Binary-types" - :maintainer "Steven Nunez" - :author "Frode V. Fjeld" + :description "A library for reading and writing binary records." + :long-description #.(uiop:read-file-string + (uiop:subpathname *load-pathname* "description.text")) :version "1.0.0" + :author "Frode V. Fjeld" + :maintainer "Steven Nunez" :license :BSD-3-Clause - :description "A library for reading and writing binary records." - :long-description #.(uiop:read-file-string - (uiop:subpathname *load-pathname* "description.text")) + :depends-on ("ieee-floats") :perform (load-op :after (op c) (provide 'binary-types)) + :in-order-to ((test-op (test-op "binary-types/tests"))) :components ((:file "pkgdcl") - (:file "binary-types"))) + (:file "binary-types") + (:file "arrays"))) +(defsystem "binary-types/tests" + :description "Unit tests for BINARY-TYPES" + :author "Steven Nunez" + :license :BSD-3-Clause + :depends-on ("binary-types" + "clunit2" + "array-operations" + "flexi-streams" + "num-utils") + :pathname #P"tests/" + :serial t + :components ((:file "pkgdcl") + (:file "tests")) + :perform (test-op (o s) + (let ((*print-pretty* t)) ;work around clunit issue #9 + (symbol-call :clunit :run-suite + (find-symbol* :binary-types + :binary-types/tests) + :use-debugger nil)))) diff --git a/binary-types.lisp b/binary-types.lisp index 7a0ba34..05da2c3 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -713,7 +713,7 @@ read are returned." (t (setf (slot-value object (record-slot-name slot)) read-slot-value))) (incf total-read-bytes read-slot-bytes))) (values object total-read-bytes)))) - + (defmethod read-binary ((type binary-record) stream &key start stop &allow-other-keys) (read-binary-record (binary-type-name type) stream :start start :stop stop)) diff --git a/tests/pkgdcl.lisp b/tests/pkgdcl.lisp new file mode 100644 index 0000000..7d0051b --- /dev/null +++ b/tests/pkgdcl.lisp @@ -0,0 +1,6 @@ +;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-Lisp; Package: CL-USER -*- +;;; Copyright (c) 2024 by Symbolics Pte. Ltd. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause + +(uiop:define-package :binary-types/tests + (:use :cl :binary-types :clunit :array-operations :flexi-streams :num-utils.num=)) diff --git a/tests/tests.lisp b/tests/tests.lisp new file mode 100644 index 0000000..1651220 --- /dev/null +++ b/tests/tests.lisp @@ -0,0 +1,110 @@ +;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-Lisp; Package: BINARY-TYPES/TESTS -*- +;;; Copyright (c) 2024 by Symbolics Pte. Ltd. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause +(in-package #:binary-types/tests) + +(defsuite binary-types ()) + + +(deftest vectors (binary-types) + + ;; unsigned 32 bit + (let* ((binary-types:*endian* :little-endian) + (test-vector #(1 2 3 4 10 9 8 7)) + binary-to ;write lisp vector INTO this variable + binary-from) ;read lisp vector OUT of this variable + + (eval `(define-binary-vector binary-seq u32 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + + ;; signed 32 bit + (let* ((binary-types:*endian* :little-endian) + (test-vector #(1 -2 3 -4 10 -9 8 7)) + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq s32 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + + ;; signed 64 bit + (let* ((binary-types:*endian* :little-endian) + (test-vector #(-1152921504606846976 ;most-negative-fixnum (CCL64) + 1 -2 3 -4 10 -9 8 7 + 1152921504606846975)) ;most-positive-fixnum + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq s64 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + + ;; bignum + ;; Interesting that on CCL this fits into s64 + (let* ((binary-types:*endian* :little-endian) + (test-vector `#(,(1- -1152921504606846976) + 1 -2 3 -4 10 -9 8 7 + ,(1+ 1152921504606846975))) + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq s64 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + ;; Actually, up to (* 8 most-positive/negative-fixnum) fits into s64 + (let* ((binary-types:*endian* :little-endian) + (test-vector `#(,(* 8 -1152921504606846976) + 1 -2 3 -4 10 -9 8 7 + ,(* 8 1152921504606846975))) + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq s64 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + + ;; s128 + (let* ((binary-types:*endian* :little-endian) + (test-vector `#(,(* 9 -1152921504606846976) + 1 -2 3 -4 10 -9 8 7 + ,(* 9 1152921504606846975))) + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq-s64 s64 ,(length test-vector))) + (eval `(define-binary-vector binary-seq-s128 s128 ,(length test-vector))) + + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq-s64 out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq-s64 in))) + (assert-false (num= test-vector binary-from)) ;at this point s64 overflows + + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq-s128 out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq-s128 in))) + (assert-true (num= test-vector binary-from))) +) + From 7e80b52310115f4330540873fc18ccb6495a8f98 Mon Sep 17 00:00:00 2001 From: Symbolics Date: Sun, 5 May 2024 15:48:46 +0800 Subject: [PATCH 08/13] Add binary integer arrays --- arrays.lisp | 82 ++++++++++++++++++++++++---- binary-types.asd | 3 +- tests/tests.lisp | 136 ++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 204 insertions(+), 17 deletions(-) diff --git a/arrays.lisp b/arrays.lisp index 60e0e36..da401fb 100644 --- a/arrays.lisp +++ b/arrays.lisp @@ -4,9 +4,10 @@ ;;; SPDX-License-identifier: BSD-3-Clause (in-package #:binary-types) -;;; From: https://github.com/sharplispers/slitch/blob/master/src/binary-types-extra.lisp +;;; Partially from: https://github.com/sharplispers/slitch/blob/master/src/binary-types-extra.lisp -(export '(define-binary-vector binary-vector binary-vector-input-state)) +(export '(define-binary-vector binary-vector binary-vector-input-state + define-binary-array binary-array binary-array-input-state)) (defun binary-vector-input-state (stream) "Returns two values: the vector being read, and the current input position." @@ -20,12 +21,12 @@ (size :initarg size :reader binary-vector-size))) (defun binary-vector (element-type size) - "Directly return a binary-type." - (make-instance 'binary-vector - 'name `(binary-vector ,element-type ,size) - 'sizeof (* (sizeof element-type) size) - 'element-type element-type - 'size size)) + "Directly return a binary-vector type." + (make-instance 'binary-vector + 'name `(binary-vector ,element-type ,size) + 'sizeof (* (sizeof element-type) size) + 'element-type element-type + 'size size)) (defmacro define-binary-vector (type-name element-type size) (check-type size (integer 1 *)) @@ -58,9 +59,72 @@ (defmethod write-binary ((type binary-vector) stream object &key &allow-other-keys) (loop for x across object - do (write-binary (binary-vector-element-type type) stream x)) + do (write-binary (binary-vector-element-type type) stream x)) (sizeof type)) (defmethod sizeof ((type binary-vector)) (with-slots (size element-type) type (* size (sizeof element-type)))) + + +;; ---------------------------------------------------------------------- +;; Arrays + +(defun binary-array-input-state (stream) + "Returns two values: the vector being read, and the current input position." + (values (cdr stream) (1+ (car stream)))) + +(defclass binary-array (binary-record) + ((element-type :initarg element-type :reader binary-array-element-type) + (size :initarg size :reader binary-array-size) + (dimensions :initarg dimensions :reader binary-array-dimensions))) + +(defun binary-array (element-type dims) + "Directly return a binary-array type." + (let* ((size (if (listp dims) (apply #'* dims) dims))) ;in future combine binary-array and binary-vector + (make-instance 'binary-array + 'name `(binary-array ,element-type ,dims) + 'sizeof (* (sizeof element-type) size) + 'element-type element-type + 'size size + 'dimensions dims))) + +(defmacro define-binary-array (type-name element-type dims) + `(let* ((size (if (listp ,dims) (apply #'* ,dims) ,dims))) + (progn + (deftype ,type-name () '(array ,element-type ,dims)) + (setf (find-binary-type ',type-name) + (make-instance 'binary-array + 'name ',type-name + 'sizeof (* (sizeof ',element-type) + size) + 'element-type ',element-type + 'size size + 'dimensions ,dims)) + ',type-name))) + +(defmethod read-binary ((type binary-array) stream &key &allow-other-keys) + (read-binary-array stream + (binary-array-element-type type) + (binary-array-size type) + (binary-array-dimensions type))) + +(defun read-binary-array (stream type size dimensions) + (let ((arr (make-array dimensions :element-type type)) + (read-bytes 0)) + (dotimes (i size) + (multiple-value-bind (obj bytes) + (read-binary type stream) + (setf (row-major-aref arr i) obj) + (incf read-bytes bytes))) + (values arr read-bytes))) + +(defmethod write-binary ((type binary-array) stream object + &key &allow-other-keys) + (loop for x across (aops:flatten object) + do (write-binary (binary-array-element-type type) stream x)) + (sizeof type)) + +(defmethod sizeof ((type binary-array)) + (with-slots (size element-type) type + (* size (sizeof element-type)))) diff --git a/binary-types.asd b/binary-types.asd index b1d43d3..032b7de 100644 --- a/binary-types.asd +++ b/binary-types.asd @@ -11,7 +11,8 @@ :author "Frode V. Fjeld" :maintainer "Steven Nunez" :license :BSD-3-Clause - :depends-on ("ieee-floats") + :depends-on ("ieee-floats" + "array-operations") :perform (load-op :after (op c) (provide 'binary-types)) :in-order-to ((test-op (test-op "binary-types/tests"))) diff --git a/tests/tests.lisp b/tests/tests.lisp index 1651220..3ad0cbb 100644 --- a/tests/tests.lisp +++ b/tests/tests.lisp @@ -5,6 +5,20 @@ (defsuite binary-types ()) +;;; If these test are failing on your system, you might want to take +;;; note of the values you get from the following. The tests were +;;; developed on: +;; CL-USER> (lisp-implementation-type) +;; "Clozure Common Lisp" +;; CL-USER> (lisp-implementation-version) +;; "Version 1.12.2 (v1.12.2-16-gc4df19e6) WindowsX8664" + +;; (integer-length most-negative-fixnum) ;=> 60 +;; most-negative-fixnum = -1152921504606846976 +;; most-positive-fixnum = 1152921504606846975 +;; CL-USER> (expt 2 60) +;; 1152921504606846976 + (deftest vectors (binary-types) @@ -38,9 +52,9 @@ ;; signed 64 bit (let* ((binary-types:*endian* :little-endian) - (test-vector #(-1152921504606846976 ;most-negative-fixnum (CCL64) + (test-vector `#(,most-negative-fixnum 1 -2 3 -4 10 -9 8 7 - 1152921504606846975)) ;most-positive-fixnum + ,most-positive-fixnum)) binary-to binary-from) @@ -55,9 +69,9 @@ ;; bignum ;; Interesting that on CCL this fits into s64 (let* ((binary-types:*endian* :little-endian) - (test-vector `#(,(1- -1152921504606846976) + (test-vector `#(,(1- most-negative-fixnum) 1 -2 3 -4 10 -9 8 7 - ,(1+ 1152921504606846975))) + ,(1+ most-positive-fixnum))) binary-to binary-from) @@ -68,7 +82,9 @@ (read-binary 'binary-seq in))) (assert-true (num= test-vector binary-from))) - ;; Actually, up to (* 8 most-positive/negative-fixnum) fits into s64 + ;; Actually, up to (* 8 most-positive/negative-fixnum) fits into a + ;; s64 vector, which I find odd since fixnum is 60 bits on this + ;; platform/implementation. It breaks at 9 times most-postive-fixnum. (let* ((binary-types:*endian* :little-endian) (test-vector `#(,(* 8 -1152921504606846976) 1 -2 3 -4 10 -9 8 7 @@ -105,6 +121,112 @@ (write-binary 'binary-seq-s128 out test-vector))) (setf binary-from (with-input-from-sequence (in binary-to) (read-binary 'binary-seq-s128 in))) - (assert-true (num= test-vector binary-from))) -) + (assert-true (num= test-vector binary-from)))) + + +(deftest arrays (binary-types) + + ;; u32 + (let* ((binary-types:*endian* :little-endian) + (test-array #2A((1 2 3 4 10 9 8 7) + (10 20 30 40 50 60 70 80))) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr u32 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; s32 + (let* ((binary-types:*endian* :little-endian) + (test-array #2A((1 -2 3 -4 10 -9 8 7) + (-10 20 -30 40 50 60 70 -80))) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr s32 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; u64 + (let* ((binary-types:*endian* :little-endian) + (test-array (make-array '(2 8) + :initial-contents `((1 2 3 4 10 9 8 7) + (10 20 30 40 50 60 70 ,most-positive-fixnum)))) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr u64 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; s64 + (let* ((binary-types:*endian* :little-endian) + (test-array (make-array '(2 8) + :initial-contents `((,most-negative-fixnum 2 3 4 10 9 8 7) + (10 20 30 40 50 60 70 ,most-positive-fixnum)))) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr s64 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; u128 + ;; (integer-length (expt 2 125)) => 126 + (let* ((binary-types:*endian* :little-endian) + (test-array (make-array '(2 8) + :initial-contents `((1 2 3 4 10 9 8 7) + (10 20 30 40 50 60 70 ,(expt 2 125))))) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr u128 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; multi-dimensional arrays + (let* ((binary-types:*endian* :little-endian) + (test-array #3A(((12 5 9) + (6 5 6) + (3 8 1)) + ((7 4 5) + (9 59 3) + (44 947 88)) + ((583 13 9561) + (067 95 3326) + (8634 3364 0605)))) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr u32 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from)))) + + + ;; s128 + ;; The CLHS spec shows that for bignums, the representation for + ;; signed and unsigned are identical, so we don't test s128 here. + ;; When we get around to implementing IEEE 754-2008, which defines + ;; binary interchange formats for "half precision" (16-bit) and + ;; "quad precision" (128-bit) we'll add the tests. + From 8bbccedd22440e92b4cf84f79f6065ebbb6e108c Mon Sep 17 00:00:00 2001 From: Symbolics Date: Mon, 6 May 2024 16:50:05 +0800 Subject: [PATCH 09/13] Add IEEE-754 32/64-bit floats; finalise documentation --- NOTES.org | 322 +++++++++++++++++++++++++++++++++++++++++ README.md | 61 +++----- arrays.lisp | 5 - binary-types.lisp | 80 ++++++++-- bitfield-structs.lisp | 238 ++++++++++++++++++++++++++++++ doc/type-hierarchy.png | Bin 0 -> 45380 bytes doc/type-hierarchy.ps | Bin 0 -> 6503 bytes pkgdcl.lisp | 9 +- tests/pkgdcl.lisp | 2 +- tests/tests.lisp | 100 ++++++++++--- 10 files changed, 739 insertions(+), 78 deletions(-) create mode 100644 NOTES.org create mode 100644 bitfield-structs.lisp create mode 100644 doc/type-hierarchy.png create mode 100644 doc/type-hierarchy.ps diff --git a/NOTES.org b/NOTES.org new file mode 100644 index 0000000..62cae0e --- /dev/null +++ b/NOTES.org @@ -0,0 +1,322 @@ +* Floating Point Types + +As a rough conceptual guide, what float-types in common lisp are +/supposed/ to be is something like this: + +| short-float | 16-bit | +| single-float | 32-bit | +| double-float | 64-bit | +| long-float | 128-bit | + +However the CL [[https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node19.html][definitions for floating-point]] are somewhat +underspecified: + +#+BEGIN_QUOTE +"The precise definition of these categories is implementation-dependent." +#+END_QUOTE + +and so they are. Most implementations are not focused on numerical +computation, and implement only the minimum required for compliance +with the ANSI specification. + +The table below lays out the formats for some of the implementations: + +| Implementation | type | bits | +|----------------+--------------+------| +| CCL | short-float | 32 | +| | single-float | 32 | +| | double-float | 64 | +| | long-float | 64 | +| Lispworks | short-float | 64 | +| | single-float | 64 | +| | double-float | 64 | +| | long-float | 64 | +| SBCL | short-float | 32 | +| | single-float | 32 | +| | double-float | 64 | +| | long-float | 64 | + +SBCL has added [[https://github.com/sbcl/sbcl/blob/master/src/code/float.lisp/][support for long-float]] of 128 bits, but it appears to +be disabled due to bugs that assume the old way of just having two +formats. + +What this means for ~binary-types~ is that reading/writing numeric +types in bits not supported by the implementation: + +- Conversion to f32 for numbers in f16 binary format, with /no/ loss in precision +- Conversion to f64 for numbers in a larger binary format, /with/ a loss in precision + +Therefore we have only implemented f32 and f64. + +Should you wish to add support for [[https://en.wikipedia.org/wiki/Half-precision_floating-point_format][half-precision]] or [[https://en.wikipedia.org/wiki/Double-precision_floating-point_format][double-precision]] +floating point formats, the code is present, but commented out. See +implementation notes below for guidelines on adding these to your lisp +implementation. + +** Half Precision (16 bit) +In machine learning, 16-bit floating points ([[https://en.wikipedia.org/wiki/Half-precision_floating-point_format][half-precision]]) have +become popular both because storing large arrays of weights is more +space efficiency and because GPUs have optimisations for processing +16-bit numbers. + +However if you're /not/ using a GPU, then there's little benefit to +using half-precision. Here's what [[https://web.archive.org/web/20170813130756/https://software.intel.com/en-us/articles/performance-benefits-of-half-precision-floats][Intel has to say]] about +half-precision and performance. + +#+BEGIN_QUOTE +Because the half precision floating-point format is a storage format, +the only operation performed on half-floats is conversion to and from +32-bit floats. The 3rd generation Intel® Coreâ„¢ processor family +introduced two half-float conversion instructions: vcvtps2ph for +converting from 32-bit float to half-float, and vcvtph2ps for +converting from half-float to 32-bit float. + +[...] + +Half precision floats have several inherent advantages over 32-bit +floats when accessing memory: 1) they are half the size and thus may +fit into a lower level of cache with a lower latency, 2) they take up +half the cache space, which frees up cache space for other data in +your program, and 3) they require half the memory bandwidth, which +frees up that bandwidth for other operations in your program. +#+END_QUOTE + +Bottom line: Your lisp implemenation will probably encode short-floats +as 32-bit floats, and as the Intel article says, their CPUs will +convert that into 32 bit for processing. However GPUs can efficiently +work with half-precision floats, so if you're doing a lot of that it +may be worth looking into adding a true ~short-float~ to your lisp +implementation. + +** Double-precision (128 bit) +To decode floating point numbers of this size properly, we need to: + +1. Use an implementation of CL that supports ~long-float~ properly; /or/ +2. Decode the 128-bit number to a rational. This will be exact, but slow + +You can write custom decoders that find the closest rational. Using +the common lisp `coerce` function will result in a loss of accuracy +because we will convert the 128 bit float to 64 bit float and then +~coerce~ it. + +SBCL has an [[https://github.com/sbcl/sbcl/blob/ac267f21721663b196aefe4bfd998416e3cc4332/src/code/float.lisp#L757][accurate implementation of coerce]] that will find the +closest rational given the ~mantissa~, ~exponent~ and ~sign~. + +The algorithm is reproduced here: + +Algorithm (recursively presented): + If x is a rational number, return x. + If x = 0.0, return 0. + If x < 0.0, return (- (rationalize (- x))). + If x > 0.0: + Call (integer-decode-float x). It returns a m,e,s=1 (mantissa, + exponent, sign). + If m = 0 or e >= 0: return x = m*2^e. + Search a rational number between a = (m-1/2)*2^e and b = (m+1/2)*2^e + with smallest possible numerator and denominator. + Note 1: If m is a power of 2, we ought to take a = (m-1/4)*2^e. + But in this case the result will be x itself anyway, regardless of + the choice of a. Therefore we can simply ignore this case. + Note 2: At first, we need to consider the closed interval [a,b]. + but since a and b have the denominator 2^(|e|+1) whereas x itself + has a denominator <= 2^|e|, we can restrict the seach to the open + interval (a,b). + So, for given a and b (0 < a < b) we are searching a rational number + y with a <= y <= b. + Recursive algorithm fraction_between(a,b): + c := (ceiling a) + if c < b + then return c ; because a <= c < b, c integer + else + ; a is not integer (otherwise we would have had c = a < b) + k := c-1 ; k = floor(a), k < a < b <= k+1 + return y = k + 1/fraction_between(1/(b-k), 1/(a-k)) + ; note 1 <= 1/(b-k) < 1/(a-k) + +You can see that we are actually computing a continued fraction +expansion in the above version. + +Algorithm (iterative): + If x is rational, return x. + Call (integer-decode-float x). It returns a m,e,s (mantissa, + exponent, sign). + If m = 0 or e >= 0, return m*2^e*s. (This includes the case x = 0.0.) + Create rational numbers a := (2*m-1)*2^(e-1) and b := (2*m+1)*2^(e-1) + (positive and already in lowest terms because the denominator is a + power of two and the numerator is odd). + Start a continued fraction expansion + p[-1] := 0, p[0] := 1, q[-1] := 1, q[0] := 0, i := 0. + Loop + c := (ceiling a) + if c >= b + then k := c-1, partial_quotient(k), (a,b) := (1/(b-k),1/(a-k)), + goto Loop + finally partial_quotient(c). + Here partial_quotient(c) denotes the iteration + i := i+1, p[i] := c*p[i-1]+p[i-2], q[i] := c*q[i-1]+q[i-2]. + At the end, return s * (p[i]/q[i]). + This rational number is already in lowest terms because + p[i]*q[i-1]-p[i-1]*q[i] = (-1)^i. + +See also + Hardy, Wright: An introduction to number theory +and/or + + + +You can get the mantissa, exponent and sign using the [[http://clhs.lisp.se/Body/f_dec_fl.htm][floating point functions of Common Lisp]]. + +An alternative to implementing ~long-float~ in CL considered, but not +explored, is the [[https://github.com/jesseoff/ratmath][ratmath]] system, "a collection of utilities for +working with rational numbers, approximations, and intervals in Common +Lisp". It does not appear to work 'out of the box', but may be close. + + +** Integers +128 bit integers are becoming more common, are are now +[[https://developer.nvidia.com/blog/implementing-high-precision-decimal-arithmetic-with-cuda-int128/][implemented in CUDA 11.5]]. + + + +* Implementation Notes +The original ~binary-types~ system suggested the following for a ~single-float~ implementation: + +#+BEGIN_SRC lisp +(define-bitfield ieee754-single-float (u32) + (((:enum :byte (1 31)) + positive 0 + negative 1) + ((:numeric exponent 8 23)) + ((:numeric significand 23 0)))) +#+END_SRC + +that we considered for implementing floats. Since 1999, the date of +the original ~binary-types~, other systems have been developed to +encode/decode [[https://en.wikipedia.org/wiki/IEEE_754][IEEE-754 floating point formats]]. Rather than reinvent +the wheel, we adopted the [[https://github.com/marijnh/ieee-floats][ieee-floats]] system to convert floats. See +the [[https://ieee-floats.common-lisp.dev/][ieee-floats documentation]] for an overview. + +** ieee-floats +From the ieee-floats implementation notes, we can see that there's a +non-trival amount of work in properly implementing an encoder/decoder: + +The following macro may look a bit overcomplicated to the casual +reader. The main culprit is the fact that NaN and infinity can be +optionally included, which adds a bunch of conditional parts. + +Assuming you already know more or less how floating point numbers +are typically represented, I'll try to elaborate a bit on the more +confusing parts, as marked by letters: + +(A) Exponents in IEEE floats are offset by half their range, for + example with 8 exponent bits a number with exponent 2 has 129 + stored in its exponent field. + +(B) The maximum possible exponent is reserved for special cases + (NaN, infinity). + +(C) If the exponent fits in the exponent-bits, we have to adjust + the significand for the hidden bit. Because decode-float will + return a significand between 0 and 1, and we want one between 1 + and 2 to be able to hide the hidden bit, we double it and then + subtract one (the hidden bit) before converting it to integer + representation (to adjust for this, 1 is subtracted from the + exponent earlier). When the exponent is too small, we set it to + zero (meaning no hidden bit, exponent of 1), and adjust the + significand downward to compensate for this. + +(D) Here the hidden bit is added. When the exponent is 0, there is + no hidden bit, and the exponent is interpreted as 1. + +(E) Here the exponent offset is subtracted, but also an extra + factor to account for the fact that the bits stored in the + significand are supposed to come after the 'decimal dot'. + +This is a good reason not to reinvent the wheel. + + +** Vectors +The implementation of vectors was taken from [[https://github.com/sharplispers/slitch/blob/master/src/binary-types-extra.lisp][slitch]]. + + +** Lispworks +This is likely to fail out of the box on Lispworks, where all floats are encoded as u64. + +** Common Lisp +And this [[https://www.reddit.com/r/lisp/comments/7t48mv/comment/dtb9w0c/?utm_source=share&utm_medium=web3x&utm_name=web3xcss&utm_term=1&utm_content=share_button][quote from reddit]]: + +#+BEGIN_QUOTE +When Common Lisp was being developed, there were computers from many +different manufacturers with different word sizes and floating point +formats. For programs to produce the same results on different +architectures, the programmer had to be able to inquire as to the +details of the floating point format in use. So functions such as +integer-decode-float were created. Using this function we can examine +the floating point numbers in the region of 37.937045: + +#+BEGIN_SRC lisp + (defun list-neighbor-floats (start n) + (multiple-value-bind (signif expon sign) + (integer-decode-float start) + (loop for sig from signif + for return-float = (* sign (scale-float (coerce sig 'single-float) expon)) + repeat n do (format t "~8d ~12,6f~%" sig return-float)))) + + This produces significand floating point: + 9944967 37.937040 9944968 37.937042 9944969 37.937046 <= the closest float in the region 9944970 + 37.937050 9944971 37.937054 +#+END_SRC + +The floating point number is actually exactly 9944969/262144 +(#x97bc05/#x40000), or exactly 3.7937046051025390625 in decimal. Every +floating point number has an exact decimal representation, but not +every decimal has an exact floating point representation, that is +because floating point uses only powers of two while decimal uses +powers of two and powers of 5. This is unfortunate, as Guy Steele +pointed out. The imprecision that people see in floating point numbers +comes from the rounding that must be performed to fit the result in a +limited space, not from the individual number. Floating point numbers +are a brilliant engineering device, but they are not really numbers in +the mathematical sense. For instance, (= (expt 2.0 24) (1+ (expt 2.0 +24))) => t, from which it follows that 1 = 0, which pretty much causes +mathematics to fail. Be careful with floating point! +#+END_QUOTE + + +* Tests + +If these test are failing on your system, you might want to take +note of the values you get from the following. The tests were +developed on: +CL-USER> (lisp-implementation-type) +"Clozure Common Lisp" +CL-USER> (lisp-implementation-version) +"Version 1.12.2 (v1.12.2-16-gc4df19e6) WindowsX8664" + +(integer-length most-negative-fixnum) ;=> 60 +most-negative-fixnum = -1152921504606846976 +most-positive-fixnum = 1152921504606846975 +CL-USER> (expt 2 60) +1152921504606846976 + + +* Generating a class diagram +The postscript file "type-hierarchy.ps" shows the binary types +hierarchy. It is generated using psgraph and closer-mop, which may be +loaded via Quicklisp as shown below: + +#+BEGIN_SRC lisp +(ql:quickload "psgraph") +(ql:quickload "closer-mop") + +(with-open-file (*standard-output* "type-hierarchy.ps" + :direction :output + :if-exists :supersede) + (psgraph:psgraph *standard-output* 'binary-types::binary-type + (lambda (p) + (mapcar #'class-name + (closer-mop:class-direct-subclasses + (find-class p)))) + (lambda (s) (list (symbol-name s))) + t)) +#+END_SRC diff --git a/README.md b/README.md index 8419266..6414452 100644 --- a/README.md +++ b/README.md @@ -71,18 +71,20 @@ Support most kinds of binary types including: * Compound records of other binary types. Maps to lisp `DEFCLASS` classes or, when you prefer, `DEFSTRUCT` structs. - * Vectors and arrays of integers and floats. + * Vectors and arrays * 32 and 64 bit IEEE-754 floats map to lisp `single-float` and `double-float`. + * Supports NaN and infinities + ### History -BINARY-TYPES was developed over the years 1999-2003 by Frode Vatvedt Fjeld whilst working at the Department of Computer Science, University of Tromsø, Norway. It later served as the basis for [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) of the book [Practical Common Lisp](https://gigamonkeys.com/book/) by Peter Seibel. That chapter makes a good technical reference for the system, and you should read it if you want to extend BINARY-TYPES. +[BINARY-TYPES](https://github.com/frodef/binary-types) was developed over the years 1999-2003 by Frode Vatvedt Fjeld whilst working at the Department of Computer Science, University of Tromsø, Norway. It later served as the basis for [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) of the book [Practical Common Lisp](https://gigamonkeys.com/book/) by Peter Seibel. That chapter makes a good technical reference for the system, and you should read it if you want to extend BINARY-TYPES. -Frode's version was sufficiently well done that the system went largely unchanged since except for some local additions for [slitch](https://github.com/sharplispers/slitch/tree/master) a low-level networking library in 2003 and then again in a [fork by Olof-Joachim Frahm](https://github.com/Ferada/binary-types/commits/master/) in 2013 that added 256 bit integers. +Frode's version was sufficiently well done that the system went largely unchanged since except for some local additions for [slitch](https://github.com/sharplispers/slitch/tree/master) a low-level networking library in 2003 and then again in a [fork by Olof-Joachim Frahm](https://github.com/Ferada/binary-types/commits/master/) in 2013 that added 128 and 256 bit integers. -This repository began in 2024 and adds support for 32/64 bit IEEE-754 floats, binary arrays, improved documentation and refactored the repository/ASDF system. +This repository began in 2024 and adds support for 32/64 bit IEEE-754 floats, binary arrays, a test framework, improved documentation and refactored the repository/ASDF system. @@ -109,6 +111,20 @@ git clone https://github.com/snunez1/binary-types.git If you have installed the slime ASDF extensions, you can invoke this with a comma (',') from the slime REPL. +## Who uses? +`binary-types` is used by several systems, including: + +* [slitch](https://github.com/sharplispers/slitch), a low-level networking library +* [live-control](https://github.com/cbaggers/live-control), a way to fire data from your phone/tablet to your desktop +* [lispcap](https://github.com/marcmos/lispcap), passive L2 ARP host tracker with ARP request query feature +* [gdb-remote](https://github.com/deepfire/gdb-remote) +* [cl-websocket](https://github.com/Frechmatz/cl-websocket), a WebSocket-Server implemented in Common Lisp +* [cl-evdev](https://github.com/jtgans/cl-evdev), a simple driver for teasing out events from Linux’s /dev/input drivers +* [ovomorph](https://github.com/hanshuebner/ovomorph), an I/O-server for vintage computers +* [cl-gypsum-client](https://github.com/jtgans/cl-gypsum-client), a client for the [http://www.github.com/jtgans/gypsum](Gypsum) protocol +* [cl-lass](https://github.com/jl2/cl-las), library to read LAS Lidar files + + ## Using Typically, a complete binary record format/type can be specified in a single (nested) declaration statement. Such compound records may then be read and written with `READ-BINARY` and `WRITE-BINARY`. So start with the specification for the binary file or stream and map each element. Here's a simple example to take the first two bytes of a file: @@ -131,7 +147,6 @@ and, with that, we can read and print from the binary file with: Also see [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) for an extended example. - ### Declaring classes and structures Binary types may be declared with the `DEFINE-BINARY-CLASS` macro, which has the same syntax and semantics as `DEFCLASS`, only there is an additional slot-option (named `:BINARY-TYPE`) that declares that slot's binary type. Note that the binary aspects of slots are *not* inherited (the semantics of inheriting binary slots is unspecified). @@ -154,6 +169,8 @@ should be careful to always provide a legal value in the slot (as you must always do when declaring slots' types). If you find this confusing, just use `:BINARY-TYPE`. +![type hierarchy](./docs/type-hierarchy.png) + ### Bitfields @@ -276,40 +293,6 @@ with the form (e-shstrndx :binary-type half))) ``` -For a second example, here's an approach to supporting floats: -```lisp - (define-bitfield ieee754-single-float (u32) - (((:enum :byte (1 31)) - positive 0 - negative 1) - ((:numeric exponent 8 23)) - ((:numeric significand 23 0)))) -``` - - - -In version 1.0 or later BINARY-TYPES uses Marijn Haverbeke's [ieee-floats](https://github.com/marijnh/ieee-floats) system to convert floats. - -### Generating a class diagram -The postscript file "type-hierarchy.ps" shows the binary types -hierarchy. It is generated using psgraph and closer-mop, which may be -loaded via Quicklisp as shown below: -```lisp -(ql:quickload "psgraph") -(ql:quickload "closer-mop") - -(with-open-file (*standard-output* "type-hierarchy.ps" - :direction :output - :if-exists :supersede) - (psgraph:psgraph *standard-output* 'binary-types::binary-type - (lambda (p) - (mapcar #'class-name - (closer-mop:class-direct-subclasses - (find-class p)))) - (lambda (s) (list (symbol-name s))) - t)) -``` - ## Performance Performance has not really been a concern while designing this system. There's no obvious performance bottlenecks that we are aware of, diff --git a/arrays.lisp b/arrays.lisp index da401fb..eae79d7 100644 --- a/arrays.lisp +++ b/arrays.lisp @@ -4,11 +4,6 @@ ;;; SPDX-License-identifier: BSD-3-Clause (in-package #:binary-types) -;;; Partially from: https://github.com/sharplispers/slitch/blob/master/src/binary-types-extra.lisp - -(export '(define-binary-vector binary-vector binary-vector-input-state - define-binary-array binary-array binary-array-input-state)) - (defun binary-vector-input-state (stream) "Returns two values: the vector being read, and the current input position." (values (cdr stream) (1+ (car stream)))) diff --git a/binary-types.lisp b/binary-types.lisp index 05da2c3..650aceb 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -67,8 +67,7 @@ means that the endianess is determined by the dynamic value of *endian*." ;;; ---------------------------------------------------------------- (defgeneric sizeof (type) - (:documentation "Return the size in octets of the single argument TYPE, -or nil if TYPE is not constant-sized.")) + (:documentation "Return the size in octets of the single argument TYPE, or nil if TYPE is not constant-sized.")) (defmethod sizeof (obj) (sizeof (find-binary-type (type-of obj)))) @@ -95,7 +94,8 @@ or nil if TYPE is not constant-sized.")) :reader binary-type-name) (sizeof :initarg sizeof - :reader sizeof)) + :reader sizeof + :documentation "Size of BINARY-TYPE in bytes")) (:documentation "BINARY-TYPE is the base class for binary types meta-classes.")) (defmethod print-object ((object binary-type) stream) @@ -121,9 +121,7 @@ or nil if TYPE is not constant-sized.")) (binary-type-name type))) (call-next-method type stream))) -;;; WRITE-BINARY is identical for SIGNED and UNSIGNED, but READ-BINARY -;;; is not. - +;;; WRITE-BINARY is identical for SIGNED and UNSIGNED, but READ-BINARY is not. (defmethod write-binary ((type binary-integer) stream object &key &allow-other-keys) (check-type object integer) (if (= 1 (sizeof type)) @@ -174,8 +172,7 @@ or nil if TYPE is not constant-sized.")) ((:big-endian big-endian) (dotimes (i (sizeof type)) (setf unsigned-value (+ (* unsigned-value #x100) - (funcall *binary-read-byte* stream) - )))) + (funcall *binary-read-byte* stream))))) ((:little-endian little-endian) (dotimes (i (sizeof type)) (setf unsigned-value (+ unsigned-value @@ -218,8 +215,7 @@ or nil if TYPE is not constant-sized.")) ((:big-endian big-endian) (dotimes (i (sizeof type)) (setf unsigned-value (+ (* unsigned-value #x100) - (funcall *binary-read-byte* stream) - )))) + (funcall *binary-read-byte* stream))))) ((:little-endian little-endian) (dotimes (i (sizeof type)) (setf unsigned-value (+ unsigned-value @@ -234,8 +230,7 @@ or nil if TYPE is not constant-sized.")) ;;; Character Types ;;; ---------------------------------------------------------------- -;;; There are probably lots of things one _could_ do with character -;;; sets etc.. +;;; There are probably lots of things one _could_ do with character sets etc.. (defclass binary-char8 (binary-type) ()) @@ -1096,7 +1091,7 @@ otherwise the value of BODY." (list stream-var)))))) -;;; +;;; Utilities (defun split-bytes (bytes from-size to-size) "From a list of BYTES sized FROM-SIZE bits, split each byte into bytes of size TO-SIZE, @@ -1129,3 +1124,62 @@ otherwise the value of BODY." collect (loop for n from 0 below factor as sub-byte = (or (nth (- factor 1 n) bytes) 0) summing (ash sub-byte (* n from-size)))))))) + + +;;; ---------------------------------------------------------------- +;;; Float Types +;;; ---------------------------------------------------------------- + +;; 32 and 64 bit decoders are provided by default with ieee-floats system +;; (ieee-floats:make-float-converters encode-float16 decode-float16 5 10 nil) +;; (ieee-floats:make-float-converters encode-float128 decode-float128 15 112 nil) + +(defclass binary-float (binary-type) + ((endian :type endianess + :reader binary-integer-endian + :initarg endian + :initform nil))) + +(defmethod print-object ((type binary-float) stream) + (if (not *print-readably*) + (print-unreadable-object (type stream :type t) + (format stream "~D-BIT~@[ ~A~] FLOAT TYPE: ~A" + (* 8 (slot-value type 'sizeof)) + (slot-value type 'endian) + (binary-type-name type))) + (call-next-method type stream))) + +(defmacro define-float (name size &optional endian) + (check-type size (integer 1 *)) + (check-type endian endianess) + `(progn + (deftype ,name () '(ieee-754 ,(* 8 size))) + (setf (find-binary-type ',name) + (make-instance 'binary-float + 'name ',name + 'sizeof ,size + 'endian ,endian)) + ',name)) + +;; See NOTES.org for why these aren't defined. +;; (define-float f8 1) +;; (define-float f16 2) +(define-float f32 4) +(define-float f64 8) +;; (define-float f128 16) +;; (define-float f256 32) + +(defmethod write-binary ((type binary-float) stream object &key &allow-other-keys) + (check-type object float) + (let ((ieee-754-type (* 8 (slot-value type 'sizeof)))) + (case ieee-754-type + (32 (write-binary 'u32 stream (ieee-floats:encode-float32 object))) + (64 (write-binary 'u64 stream (ieee-floats:encode-float64 object)))))) + +(defmethod read-binary ((type binary-float) stream &key &allow-other-keys) + (let ((ieee-754-type (* 8 (slot-value type 'sizeof)))) + (case ieee-754-type + (32 (values (ieee-floats:decode-float32 (read-binary 'u32 stream)) + (sizeof type))) + (64 (values (ieee-floats:decode-float64 (read-binary 'u64 stream)) + (sizeof type)))))) diff --git a/bitfield-structs.lisp b/bitfield-structs.lisp new file mode 100644 index 0000000..89b8b15 --- /dev/null +++ b/bitfield-structs.lisp @@ -0,0 +1,238 @@ +;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: BINARY-TYPES -*- +;;; Copyright (C) 2011 Luke Gorrie +;;; Copyright (c) 2024 by Steven Nunez. All rights reserved. +;;; SPDX-License-identifier: BSD-3-Clause + +;;; This code came from the SLITCH system. + +;;; It is not part of the BINARY-TYPES system because we're not using +;;; BITFIELD-STRUCTS, but it seems like it may be useful to someone in +;;; future. + + +;; ---------------------------------------------------------------------- +;; Bit fields. Must be used in bitfield structs (see below) + +(defclass binary-unsigned-bitint (binary-integer) + ((bits :initarg bits + :reader bits))) + +(defmacro define-unsigned-bitint (name bits) + (check-type bits (integer 1 *)) + `(progn + (deftype ,name () '(unsigned-byte ,bits)) + (setf (find-binary-type ',name) + (make-instance 'binary-unsigned-bitint + 'name ',name + 'bits ,bits + 'sizeof (/ ,bits 8) + )) + ',name)) + +(defmethod read-binary ((type binary-unsigned-bitint) stream + &key start stop &allow-other-keys) + (declare (ignore start stop)) + (values (read-bits stream (bits type)) + (sizeof type))) + +(defmethod write-binary ((type binary-unsigned-bitint) stream object + &key &allow-other-keys) + (write-bits stream (bits type) object) + (/ (bits type) 8)) + +(defgeneric bit-sizeof (type) + (:documentation "Size of a binary type in bits.")) + +(defmethod bit-sizeof ((type binary-unsigned-bitint)) + (bits type)) + +(defmethod bit-sizeof ((type binary-type)) + (* 8 (sizeof type))) + +(defmethod bit-sizeof ((type symbol)) + (bit-sizeof (find-binary-type type))) + +;; Bitfield read/write + +(defvar *bitbuffer-size* 0 + "Number of bits in `*bitbuffer'") +(defvar *bitbuffer* 0 + "Bits of the current partial byte.") + +(defvar *bits-read-byte-function* nil) +(defvar *bits-write-byte-function* nil) + +(declaim (type (integer 0 8) *bitbuffer-size*) + (type (unsigned-byte 8) *bitbuffer*)) + +(defmacro with-bitint-env (&body body) + "Execute BODY in an environment for buffering bitints." + `(let ((*bitbuffer-size* 0) + (*bitbuffer* 0) + (*bits-read-byte-function* *binary-read-byte*) + (*bits-write-byte-function* *binary-write-byte*) + (*binary-read-byte* (lambda (stream) (read-bits stream 8))) + (*binary-write-byte* (lambda (x stream) (write-bits stream 8 x)))) + ,@body)) + +(defun read-bits (s n) + (cond ((zerop *bitbuffer-size*) + (read-new-bits s) + (read-bits s n)) + ((<= n *bitbuffer-size*) + (let* ((leftover (- *bitbuffer-size* n)) + (result (ldb (byte n leftover) *bitbuffer*))) + (setf *bitbuffer-size* leftover) + (setf *bitbuffer* (ldb (byte leftover 0) *bitbuffer*)) + result)) + (t + (let ((more (- n *bitbuffer-size*))) + (setf *bitbuffer-size* 0) + (logior (ash *bitbuffer* more) + (read-bits s more)))))) + +(defun read-new-bits (s) + "Refill our buffer with a new byte of bits." + (setf *bitbuffer-size* 8) + (setf *bitbuffer* (funcall *bits-read-byte-function* s))) + +(defun write-bits (s n byte) + (cond ((zerop n) + t) + ((< (+ n *bitbuffer-size*) 8) + (write-buffer-bits (byte n 0) byte)) + (t + (let* ((nibble (- 8 *bitbuffer-size*)) + (leftover (- n nibble))) + (write-buffer-bits (byte nibble (- n nibble)) byte) + (write-bits-out s) + (write-bits s leftover byte))))) + +(defun write-buffer-bits (bytespec bits) + "Write the BYTESPEC of BITS into the bit buffer." + (setf *bitbuffer* (dpb (ldb bytespec bits) + (byte (byte-size bytespec) + (- 8 (byte-size bytespec) *bitbuffer-size*)) + *bitbuffer*)) + (incf *bitbuffer-size* (byte-size bytespec))) + +(defun flush-bits (s) + (unless (zerop *bitbuffer-size*) + (funcall *bits-write-byte-function* *bitbuffer* s))) + +(defun write-bits-out (s) + "Write the bitbuffer to the stream S." + (funcall *bits-write-byte-function* *bitbuffer* s) + (setf *bitbuffer* 0) + (setf *bitbuffer-size* 0)) + +(defclass binary-bitflag (binary-unsigned-bitint) ()) + +;; Define the binary type 'bit' +(setf (find-binary-type 'bitflag) + (make-instance 'binary-bitflag + 'name 'bitflag + 'bits 1 + 'sizeof (/ 1 8))) + +(defmethod read-binary ((type binary-bitflag) stream + &key start stop &allow-other-keys) + (declare (ignore start stop)) + (values (= 1 (call-next-method)) 1)) + + +(defmethod write-binary ((type binary-bitflag) stream object + &key &allow-other-keys) + (call-next-method type stream (if object 1 0))) + +;; ---------------------------------------------------------------------- +;; Bitfield structs. These are byte-aligned structs whose fields don't +;; have to be individually byte aligned. + +(defclass binary-bitfield-struct (binary-struct) ()) + +(defmethod read-binary ((type binary-bitfield-struct) stream + &key start stop &allow-other-keys) + (declare (ignore start stop)) + (with-bitint-env + (call-next-method))) + +(defmethod write-binary ((type binary-bitfield-struct) stream object + &key &allow-other-keys) + (with-bitint-env + (call-next-method))) + +;; Cut & paste & hack from binary-types.lisp (for now) +(defmacro define-binary-bitfield-struct (name-and-options dummy-options &rest doc-slot-descriptions) + (declare (ignore dummy-options)) ; clisp seems to require this.. + (let (embedded-declarations) + (flet ((parse-slot-description (slot-description) + (cond + ((symbolp slot-description) + (values slot-description nil slot-description)) + ((>= 2 (list-length slot-description)) + (values slot-description nil (first slot-description))) + (t (loop for descr on (cddr slot-description) by #'cddr + with bintype = nil + and typetype = nil + if (member (first descr) + '(:bt :btt :binary-type :binary-lisp-type)) + do (multiple-value-bind (bt lisp-type nested-form) + (parse-bt-spec (second descr)) + (declare (ignore lisp-type)) + (setf bintype bt) + (when nested-form + (push nested-form embedded-declarations)) + (when (and (symbolp bt) + (member (first descr) + '(:btt :binary-lisp-type))) + (setf typetype bintype))) + else nconc + (list (first descr) (second descr)) into descriptions + finally + (return (values (list* (first slot-description) + (second slot-description) + (if typetype + (list* :type typetype descriptions) + descriptions)) + bintype + (first slot-description)))))))) + (multiple-value-bind (doc slot-descriptions) + (if (stringp (first doc-slot-descriptions)) + (values (list (first doc-slot-descriptions)) + (rest doc-slot-descriptions)) + (values nil doc-slot-descriptions)) + (let* ((type-name (if (consp name-and-options) + (first name-and-options) + name-and-options)) + (binslots (mapcan (lambda (slot-description) + (multiple-value-bind (options bintype slot-name) + (parse-slot-description slot-description) + (declare (ignore options)) + (if bintype + (list (make-record-slot :name slot-name + :type bintype)) + nil))) + slot-descriptions)) + (slot-types (mapcar #'record-slot-type binslots))) + `(progn + ,@embedded-declarations + (defstruct ,name-and-options + ,@doc + ,@(mapcar #'parse-slot-description slot-descriptions)) + (setf (find-binary-type ',type-name) + (make-instance 'binary-bitfield-struct + 'name ',type-name + 'sizeof (bitfield-struct-size ',slot-types) + 'slots ',binslots + 'offset 0 + 'constructor (find-symbol + (with-standard-io-syntax + (format nil "~A-~A" '#:make ',type-name))))) + ',type-name)))))) + +(defun bitfield-struct-size (slot-types) + (let ((bits (loop for s in slot-types sum (bit-sizeof s)))) + (if (zerop (rem bits 8)) + (/ bits 8) + (error "Bitfield struct is not byte-aligned")))) diff --git a/doc/type-hierarchy.png b/doc/type-hierarchy.png new file mode 100644 index 0000000000000000000000000000000000000000..6637a1714f5926094794b61a6ae941c7d23b60e2 GIT binary patch literal 45380 zcmeEu^;Z?x7q6foEhXJ0ja)$Kt_w(aNr$L(h#=j4X{5UZ36Ty(S{fAu2>}5SNd+X{ z=DXhe58jWn*36m(jtJ-Mv-hXAQJU&X_&8KJ*REZ|M=Hx}U%Q5GbM4x73M_Q^%+~7T zHTVyjyS9?-wVF|yP59u3z03odYuD-$aL+6;;A3nTWh3`%*Kmoi{zaQycyV^^T8$M_ zUPjl)e7nOt|F&M%i-oSuO~>1VB1(fISjs3Gc@)d--bnOdrbu}VB0@AYB7sO{RJQx* zCdxfrbrgNh>#y2Bo>95a-u;fRk~-(tMaNEy=HEE|_WoTdx}*177&I{$U4F#go9g)i%FvQl(b!|2N5<@q9W z|0T8I!L5Mf_pfNJW22-D(=M$p_S3s8sHTa(gk{IRbQ_cS>u^8!9WsgDovABG-?DdM&LrN*qS#=PV7bJxXD1pSMp z__Mu)fLK2IeSQr`V%u+LF8hDG>@T+UE3{e7T0OQW!w)7W@`?-KcpkpyzWjhkao6Ja zw~l~|gFIX^?hIDdwBO7O!^dt92dG>bJA1>569z8!*M<#hOlRAl9ehua`c{lgW}^<^B#*ix1;q*C91%A%fa*miz;#9X#L-{L-+EkaaGT!$7p%*^Llax5ZCT6h^vmd1i zm1mD%vBvW~-n9(2;1*Y@J^%MNPt2Rwb8C8Jb!((-jnmN4?D9UOgrm>gb6Puzb?@;F~Hj!MuXJ#fRNI}nXoG1l<4MbG_3zht%t zSMy1ns;n{de!!5hI6H8utKK{(Q$G9 z@4IsD^~n-dgBCa2`N1fL=l;~6D6Cglt6#E>N>i{H+61jWT0M-6Q}GCM6PC{$K|JjA zBW)J4aV}1!Vfx%Yd(uz;&}SJVwp^{wq9=Hv&Ab1}w9flKJvZrDgfW6|(TO)}3~jll7&0E&uPo^}SU*3#sxp34>D#mZ@g-5& zP_K=ZONJ` z29z7Ca^liJ5;K>6HA4u^y~l=dnl6k{w3`d?Bderx9t|)jcx;RZVKuT;F)uUYj%4sN zr)5b6NX|`teHj`T>wZ988AHye{_-A=jO68+dwqvo1cBwO{wrg6j(DCExqd0337A{K z`m>14sWJ@`qtxT)@HK98>gJQbD6xhgHSsW8#9g=*E(8uXx#j6>eVAE%z3qB78OS5(#*MUSvdjG?T=?a~h zeW-x4lFpZM@y)K^`=BOYb1h6}kluZ^zY4Ee+H7)l`F+ICnJQ=uBH2Sb0%PJK%gPtZ zywrjYccDl~IkYts*sx{Sl_)<;p6$LDdNl1YRr+x#l}kikt+8MFF{|$52dZ|etk~@J z?eN+&R}VL*L{d0(*o=8inz()LXKb>nXH)zuRnIXlixL~;78yFJ7wXIKiLj+qTEg4B zabihs>T|TEM}x#avCS2KR;reXaGWgu`0~E>n;bE3MbQP1u~aUDfl1##+eRI}p4t*; z5k3Q3lE+ISSwc>9;yy0hU+R3l-%1Ce%NxFVbQ|BH$!3sPTQu13Y_ETFs*LYp=h?}@ zkJ+nEFr3B%wLhpvb^odO^FNPMM4-X6$9PN>)Ju!^Z^(bEv%cBDnqxaR63UW#uh|P) z+2Mze<>`a&UV_QtGVj)D_{>`6DZ7YOG_FD0{r#HzJC<(Hb9M%n#~zFRf9p#2`2tRG zRj#jwMvr5w%jRu`6|ysT;oRnId^CeY&Zd&$@U8vXYNVEy7U}qH47J#jNHrR5QCZuM zS*i8aYT1I0lcsH6JbIP7(M-)2er zfK@7q!19L}a_8Cl5~yu$Cg-N*nAKBdiK`6(N*5&FLu7)K>El+O1M`hgbhq^y}okAzR;&PJR{Z;Qv~ zWIugCwy!9gdiF8A&umG5QT~9lJ*Bha6atW(#iq}%n~($R+40uQW+&q%J`uN zFYnFNKFkw5tm~)y+U#omXM6Vf;YN~Fz{QWefKF)DkFiy)Cyn-vH>IE$p|B|KKcx}v z?Tp6kUF-^w>a@X<{_)sz09p$9g;uceN?#oH&~o#V@>&dEC&SEpJ%?M%mYR;SD(Aw1 z`TP-wo$L(MtI>t8bL#I4!@WZDVrQtd8ANGep<1d8YPU4xgXN?c%lrGOFesB5w8srY zVO)vM{tCvxg)0hecct?x4pLu*VqvLnobV%!@JK6ipq|k7`H|x-e51z^2Kw2%Ok0{D zjtNW#iY6E`gE?aNji|Dg*>M=FbYwQEvc6$ByO+fK9!tPnw7mlgr^#aEqTd1j3Wr`L>AlHciE;1=_uVC# z)f9y7&~Q4Rj@-i$rBe2Yq`KvMLx)x|Zzsz%0*-f=VN9+_6)RBtg%fCG3nxJrLFgJ2 zCuW+qdPMa-*4l?Q94TirGQ^moCPiVqSYIA7Bc= z3@>6@l^4)0GbJ=zruM72FR+KNRG}o*IGD)z9{O)NlI-LST4-p;-L%OzmZXR23ZA{I z?C#xRLo)pAA(JQsHY>ghi;|-nniGOaNsD1TJ&N&hlP`6e5mBCbBMU(rrGQ=UCp8B5 z^^x}S{q>Kk_(Uwm`S@*|)K}$IAIt1Q?DD2=7>1BZqXUuO{o5{h+FEu|KMr5fXbX{RuVXIMd!EI3xA?XnH5Nyq`BqT02kA@|3q)2s;5sqx zVPV-Vs~B0R5IKA%%NRDIgxKI8x=V>DWz(>{RSJR$vknhZoylvS71}0Q9FaKMDJhDz zq1Yta$f3xCNba)A?(ynfBG-mw%e z7J6}Z9DSSX>0DzJ)ufmoawy}jrR?+v_gKFu{aKVSCcT7tvkThSiEG3x%7Gjtchvo0 z=DI08+GYA!ULdx~VavcKbZF(#fu=h0#_4m@qnS!Llaz`wehhF3rFx+6$viryzucoQ z4hg};-eY>{3q%^5)TVbQm6eHjY!JaUQ2R7lEPZsXhcw#5cuM%BQ)i zw|!0z9qY9@10v6cZXKoYbJ=##S0&t;)sq+xxA6eHa+83DLd1=Qzr-H?K>j-J?UMGIir_3i+{Ig5A-MIEeCMR)N`_!mEr*>T6Mw^*$tvf ze2=!EnK>_Zp8Nk@@P>{HbJ(&UkQ+I#X~uq~UX|u|fODT}A8On~hFp=a3T+Hp6mG7F zdw3{{0RxA0<4YZLR<%JbT^7qbXf6b_qVnGXDlUB&_1xO{D$SB}N-}2F=GAfj=WAny zS=*luKv>`V;;t&^Q+nW)nR{PZNR1{i?@K5A%AA5R07q8;;&z|C6+mb@#~1&8PcT{) z#Ws$A`&cSTWV> zu!Czl|GIdgsCI&FUhbpN4#{*Muv%x3%i{M2(Kq7V>`+y3ex0M@@hKRW}S zP>QFKDPfNrL7ky65j4*jgRdZH*@KsgWXi#YZC<}Te|{>E@L!8q;xeeIhT2$Y^&C#& zn0o8{a6TK}$4WMkty@GF%=_-OP`rxSSK>n|oIQZ^?-ooqRqnwzLjoNNozb$lP$7oX zsMkfA%XRf(%e#OUx3w%W?;ZHD$+-<*d;k7sJDfHV$omL;fOw|DIh9jyKxPn&->E{o zWSmZPnva;2OaJkFvum$Wos~kKq(8C33*DSkDB|yCD}-n$R@HD*qE%p)8P@~~;_PI5 z;Du`dQj3Jzrjzt*)+~@!j-lCuI|9WtW5W@F;Fjj(@ z4U#&=Yxy0T`KzZPkYajLL5MiuQ<8ol&&wn0VCp)E;gz za`!m*U7hj2b)`$6NUyg~7or)GNYLTHbaZv6nG?h(fk6Pc>H0J0v%ROMedqNu{ALWg7I4cGpz- zI^=`S5>_=97kdonN&PXAP3Z_*mH0wr7NgW0I}zTC+CV?ufcqz)q1?7*L!v_e2r@IA zu(p<%XO^t6zp^3SSMNaLlCY_Lskc>)AfVMQQwO0YmLF{tesBz2GMkZ%B=pj015bFY zZy(RrLklWYqzV6~NvlLe(RRv7c+ZwgXXW0rl$~uW6nrl ze&*xkj2;4E%NbOO@gMOSw}Q0B-@37n6TM};hZ+W<={NiiU6coK2<3-gC+I`VwK1Tq zu?}SuQydiy&nLOdT~>Or_sv4*N*_?qP+vV-fM#hECOM{h)tD)RySw^8{M$S>3&$A# z!GXh%Ume~WPC%>ThO7ky4BafOFCPoXCxSteZsDyneGxf_b}>93U{IgGHoY~TUvRh} zZ64^kpTWMt)w@S-PCRrh!q<@`jc-rYZuvC!B;CTO4`E#U27msb43ru+`4gU|XC=*Kbz$~raOp_73Uryc32GA{PEdqtTq?LrJE-iF7{v=7CRDQ&~F zcikV=|EBQTw9D*KS>ayR&(F0#J>N-KrIW;F*YK}DjJ2g4emyxD5Sf@7kJya=rdPDS zJ=*{sr%=1ATswCf7Os6BL;TrcSaqM2} z;QJOqU*+*@BaV+~tVf)QyYQ)pHzW){J%0h%>~&0hpU%KBJhpQC3Ly2MtuTP7 z22*cb%X*{>XBd%|YUTF95Rx-1wL&aI^MGaad0;USZBQfGJUejSv| z>EFNq?kxP%$Av!I=Qhg6A565N)6BeL#Il_^u#mCc zbq>aSdwi!imbvKXG6z6pFlZ64QsPZwf%@^{4Dl;^`zRgI`z~EGD-?%|i#gw9E$mYJwZ&nE9Va zKR?rpc|C^1gx;**PH9L+Dm8)D=qF(^wpZ z?)LSfz2J`XUse7jW`VRVu)$!tW$}wwx12EIbw!#8)%>=_3yC3aA|xQ2amALJ9!F(s{)TDX z;tIm`OG*FJaC~YqUen{%WDTpKz3=@7Rr+ya16uMXuPtQo`WMttEZFfj1kJls8dB#i z!k{3+Y?}Y{%B1D{NaA3=y`4#`hof%XLB&u^}Dw5(U@&t>gLk%9nLa zU78vMO3T1oALsdQRhW19YLy$-t@K8ba4^i}N<23QyaUsD8@*_0X(UtN(v)WBXqc}H z25o>Bd{vD_<>Z%BaA8#=0AmT>bsl{(88KB7NgqtUlRT%rSfO+0kq>vdX-j=Pg2_Z% z`xlk<$~F6Yb+O+NU0Zi*_SzNS^}%E%Bpr@X zr=JMrs(qfnBBD(70qZPv=Gqlz==6Wy@e3(B!06T)LFZd;-5(DEQyVBRLIBljpQ;4k zz-CWmTOZANDF>2wA!X(wJZ0a*4H?dg01`|J+s`#-3Nd7GL-VIl99wzrj12y)15l0D zzHU|}xg&9o0{k`_st9ZGIEJg{^UCD@BY;zi?D1}jrwsRwx2GsbZW^Y+&tZgL>;t$3 zT2b9d(xPsqE^@e$Ox_svQ{Fi9A-(~sD*B}H<-I4yYA2&&zpvCo!<#%wGmJd3ZZKM_ z<(|HMc3?L-4*1_q$0sEdBrwc1-u$nivS&*LxeMkFvq7Y+D z6ciKO9jeK9iwXIX(RU?Gu#%MPl#N39JCZOA`gn-{y}$KUv^$=2Zb$XYEMW)-4GNriMkV1R`^83{~-?YP73 z)5F^%PY&SK(+ay>d&YogIxy2G2ZDBnfc+@g5`ffQx4-b~sx-jV-^#=AKbkQ(;$Uk# z%o1^52iwUINb8k<0CjaWNI*+T0%C&twQM{`xC?ZmzxwJ|L2}xqOclrGF>m()?smvT zB`N17MgC(f;6fmi^_SxbcxTX^`~ac@NmKX&1HaQ{`JKT-{}1e-%g6(sthXIjMsCV} zCt_A)Q1zD|;^m*XTP8P4LGl+a>z2q(6Mel;@@d9t3i{>txh z?{zC!l)+BP{8jqkA z2YOz<9$Dbbyu^r9!tlSDYWf5WnXAV;4|usiE7lRkMzsTt71iBR)U(6aA6#b z%ew^D6ESIO-vRbFT0TXU%a`BtU?eE*J(UjPrLj7MC(^z@#08zP%CL?pqFgskt%rid z{`jrsZ&IBy^^ee3z?d=|0zI;aYRGM{-sh*w4c-flMqdv>G(hvVFUQ*!N~AYxcDy~uW56jykqzehd;Nz-<4SJ)}l)O2SYEFVfv=Y$2iO( zB_!7#lgYDFXalh?Idn=vJh{t6vOXP1bY!pGm(dKG75DqOvUi>S|KQ~*$>4IS-f_w% zsLMqU%kMj**+5%#Il4RKz36`*d^5oMNvbLY}dD+t{!XW!9?`P_TOr zNE43lJENN7(|$(XUS6d-Ef`!_vYAWs1W)OSnGl?;S&}L&Jry*%|jnqE+TzrxpYa0mQgVIW!XShm?Z60C7W!1LUSM|9^ive2-RGJ-+wh^I|*^ z9*TS{L1uOS+>QSClZi9PmfrvV{DOI-%W6Pv$ji|XUhna3+xi7j`<2$$ z1kGX?o*i^;-2?;?1@H9l%_ZWF15mJ;A3SYMBgOAu;_(VVC30XCyJ{ws14<6wiX2&3 ze(DzaI)#xU_~igE#=11+jN|wvWrUnycVu~1CWDAMwlCUUuBO0CVR>(JV!{J?UAgB> z<4L}yz2mx*(tFJOvHad-_Gxu^TvS|aRWH9KnSjp*ZU2oV=N--58^%u_ugCEHrUoe!JIQ5j@8+i-%bppwJZAKjWwHSqw_6x<1ESL;(dHEKMe<8Knig1K zyU1mtIS@?l8lAHE zZ(nq+aZuw>xrfveD*Gwqs4A`Ny}exJktX?6voU@0$v!EPlQ9F*s!wLjwS!dfa3i)FMz2U64fsJS?I#)Mz8A%^~A*hjvEQbz1ebI97%-4E=7J zA`y;NY?K+0*$6#uQBhIw0$AkOlc{*T*2$NMk(en)=e7^dLNUkRzqWi&CG?1exln_u zD6~5gfVkF*GBHxgHf^7MAquJLyG)m*6~!IJK(8ZbZJVtYXosT57nVn_Eb7&I=v#3A zV=^PVvTkGV)b^x#h&IPp*T|@Xw@`$d`HJr+P(1Gk>qnxWxsmB2NVZb7xp+zyI|4O( zCk*^Jrij^{!f#BZ#PZigN;SmVHs@CRLY@BlQujTUQb5ygm+$!H!|*qBV|BKh{dy|7 z>{m7`%vTsLKi;hn*W6XU)r_AyX$#ODXbRhhUc_0`Wewgbz^FGsZqyQF9J^Bj<$SHv%(Ke) z*_vGXNQNCg*qm5ni-AK3Rq9N8w<}T&iRN5Dd3*eN);tJR0NAv!3{rjDnP$wud98}` z1QqHWu&OgqE@gBcq6kbZK8S;)M6p#7;cpBun#$6k7qXHnh=9~7$cCPZ;B8$Y#I(ht zOn(QVj!e$f4IEtJ#I$YH4Qm8Ssv0RXWM2*XqK=#dKgg%uPSiDa3=G~cix$JL=74cqaOYqkKf!w)XWKMkhi^4q^swCk) zr<-NCr0j&{=u;a{3{9brvf<2=cT9^=HOtFvD4;#p8fU~2?6c&&v{5zj6*la&+{1uzEF$m{A$k+4JHBGhb#@6bG;CxcYvuTnSj4n0b;uEpSRp{%ae7s6Ss8xQ{@#vE|9T9 z;P4sL6x+DK@q=}w4iSOra; zhA5r_qe_rGWw*t&!a^^+Z-HK-lDhH@E{emtFE;W4J%Gh#A}(t&yLS^{Uqa;wFhyj% z2Oq_4eFTYWwdg^gFYP)i)_n6wuXUF+j7lR%RIfl5ql43@yw&%JlemO3q8S~u4mK(t z$g4yah-C6@uOxwUxo9>qk{6O+Qtth?@`yvkE>ZDEVyakhr9 z4c85ao17QHo3VUVdC!);df$}Grh830*mHe^QvSn~V&d~<0W+lb{q|rg5YO}*>>i+A zfr{FBarzUAC=cig;G76NO4$ZZy-Gr|y~LOClmd!GY-$;IU!3_Mnt=HQ?DpLJHTPz! ziv(S`6!;h916ICGR2$Y=!5fm%0=R*QE|kE(d%u;H`<@ll+1!}qzu1=q!kut;0N-uj zfpTlBa)>b+>cHwbQqbHA zsnR@ekMMPS>IAW%cv?tR4{upRH#1x(c z$Ayez?p6|g+VkZwa^(T`@vAJ@@6La`-YOCKpyxiGp!-TE;k&_xvU&l;hjd_hoROB} zyA;mjLFQRjbdJYRUF>q12-`1+XKZq4U8ulH=C1%_Zczy;M+h$h{9ts<;mBpXKhq^D zI}FXPp~^`c0(niM{!B~O=Efs&OO5iE(^J}(aK$kK!(Wxg_D$tG0@w}L4%R;o7La9N=jhv;I`%b|=WlMdr~eZ@$H zLkU{ulG=CdWV^u1gJ*w>;_fvuL?h`y!Ig)=Ww7({{$lZG`pe^fNcgzG1C@g`kk8%+ za-}$`66b4ZQ48?c1bg9Tfv7230v)6k^@xm)W*U@xtl~F|uou;@G0i-Te+TAY-t!$1 z0#~xfL0Zbv6JLQ>(gmEkb_l5`+3n9c)t;NI*4k#!<*H`fEik_>&P2$fwYoTJBWak2 z8I%+WBN#gV};OW?!tB&F~xV^b`I9 zH2ND{Iyg^wIS&l+<)1(E{_@(A-5w+z0RNvoOG_>scc4&LR38cV1LsbBkj8C3dUIFijX5JFKkJ~aUcJY(dP`he@zPw>LqI@{5 zI(-?2z4h%63>OR=*p;!j(c7v~pt9KJ0C6kJng~RX;Wn{g)WO%xgz?;T99W`*ygpo> z)^73PW}lU139C?w<26!UyG=Y}bfN9~lInZXagQs_X8G+1y{_9fZXpe=; zkXKJ;!*?rWZZZMt0VWxUX|$Ao)-}kAqtD(ag1-0Oyj;Ov0w&&7uc_2^G`XQ3v04qS zE6@KAnUMag2o=2z+stBDD-ZI)*pIr3g)ZfSMf|3{wudnuh$(S)?od(tD;t3ko)>ZS;@ES#dYgNLMaT7 zXL4TI4gXmWy@=;D3V5R`aC_Qp%1(GN_c(thQ>Cw@LvfW|M$lB+hW}8 zoM=d%6zf&#_m;61K(x#Z{u%jblimbe4f;}&NLpwqccM$ zqIK=4gn3-sL@$_zthcQCSiUq|D??<01)I!uPKRxeQ>*YsS)f5VxhY!OKakVkI(?4! z73Fl7r8xCgP)wln2k9T)yW5k@dxekYoB7GboxinTRqhqrcEJ;29on32xYIXj@Cdp8 z&F4Eln_M?!uBT$E;~B=JF2yY;#@xpwK7;lIQj(=mM~vzjR2(7?Lek7W*?(7J_)sJK z0V}W9Y&>(&jyUbt2-~vxrhJZ@lW8G$k}}u@{9f>Dy)CXm>Y1KY*ubnSjwu&g zV8W)V@qCfeEsud-O>W1hJ;4}AlRTdl?Dal&)B9}65OyFp_X%>B`D#;T>Rxj@J!jB~ z>i;#4mxfD*qlct?8m|dZD~}giQ*Y}>5v4X-dKPtymQx*-NTct4d;S~VQ|u0iL)MlZ z(43V91yaJU?V;i86iGd|FDb<@zD#zS){`d z=6HiGOKELIel^>eYL3)ZEL0&{+6bOb)040Dj~YT5vC|Ypw1+7%IE}K9!UMXyPM{7b zM>&*c2r_U_G$JrnD}6CkMJ9HW$@B}nS2K{WD`CJH54{;C+`7O`^eiCr{gB;mq5n7} zP+D3KaepR|7fXj#_O6_{<8;Fe4fIF_FNF~J>i{xXbGaJ4f1B5rr}3CfYEj<#G0MvH ziw$>L<0h7w38`|cVmf3m_%+VgB$d{h^0J@1JkesX=0~fcJHW09r?VY6@X;>#4B6T% z1F1t4LDu2H>_L{VQ_66lRXbe6+k-3pu~C(A*GLm2UATxq?bopW2o z{;bu=xEsX4{jqxjY%J(nxf#%)YJdT>41-QtZ}%|^MykFBnW?NT_}XD8zZ7AJ-PtUp zP(TLc!|Cw5AuR;)$UVCbAo>GJcx$usR1dLj5zaNpdCq zsp9xqOF!PWegH}6|d^XAWkl{yH3&(ab_h95cD2Vg<9(O;Z z8*&cNQ29Lylksy^9q3md@hcFQE8kc6tMwMy;ZU@YU$TS1n3)PQtGU**rs`?qu#nUp zAaf%TVXG4-%eoLmHRC=dWGPFOCZcl-ub<;}3Hi`Agx=o%20y5nADF*fG@<;xD;BmU z74}JzOh{ibtqkkh-2s7{ z_8?O^O2nW2=^k%4_6c)A!deg17+6yUho33j%j&oRiQE0>h(+IFMx2=_j`_$t5J7y9lkd49MFh*uosO}yr#;1 z?_wD73_*A$&0IyS@yZg;pV|oq{G&GF=K1@3QG>3JH`m%XGOjwFsG{c$Kq0o~?QGy#>>?+_T4tx>ZT@j3Z^<3gz_Rj^-DPRy6{^PS(jve;%d74kz z!Y#r}9--?0bJrQyTwL7KwNu(WS1RBI-S8nn5I-BQ1)9($9``I~q7UH62o~(+y5Y)? zX`b1yh=X6oU5tVOh9sF_aiWhh0E%TdmK*1U{4VOXt$bZ1Lk_}74xejsUfBMcF?e_t z(e#HMAZhXuU07$>%Df)KAz6g`!b*650(w$i8_-x7lGYrb^u2=q*jRHWwk}(EaX@#- zYftm#9Q0>?;`}j>y9v}==rGzPioF5O9YtXdJ-+PF6GRn;oiBRT8zUH!JQ zmN`~cG38khrL?F8%X(Aiz75BeW}n|*g%?E;R9;CWEeu>@o9hyP=R@q2=Oj-zia=}j z?u{g(MA%6CsK_~XYfZ|CtGqzsMAi-5C1f150!3!ClYQUBq0zMIF=Y$w>?2r)fRdBV z^sRpjohvD1#f{8pU7FlqMadG{3G{GbN7Hy3kqna@QO}Kf=vI#+<#vvNbWN-QOUA48 z$Rzn(W+l(ARVWV|K*F@d4zC+#I&Q}!FM z<+M7InS6sFudWS30or;U=`Vpy0mHJs+F2@`1YyX97uKYfU`Yh#!3Qs}De zvwOY3thicl>rrr13*-$A25;0wo1zBRkYG83f|kjS8K|mh0d~L_H>|;BiY=psRbo~N8mqyd^DP2x zHfF#OiezA%C@;Lmn!PPV!?cI90-%&;6IGH_#VGJtp7Y8sW&QyAelp*SKeP6N*7zkQ zej_TdS@gmNspJ(^+C`qS1!FCmLyK?rPJJ;ylCH%WU=$ZwCPN2rZJk%)h8Fegj7(9&RY`x(;~i=!CZ-d(4RSK#gC?S@J_cI#t@?J%_1#}=b+E4 z` z2-0g%OyqR0pPt!_&2On2EgS~3Z-H!Bq&|pl_1bi_uRlXr`y=sUo42!<(@doTj;go% zYgk@soQLcJT;B7eEd`Zde8*?#;`qD1OS${RE4GPuH0T1_`ZJn=Mf=|k^7wH5B7@(0 z;DAu>b*R?ho0+zFX_S25A4vO5*FL1z(Vl`72I4hT_SP%av==xxiplNHqwWaf4Cx<9 z=;1^L^$pc%a#(L_oNlNx$*NI}hh=V?;OR+!QF9~LP+YNNID%RlZok`-viIwbr-;~Vl2f~dc#Jo z;p@dz5|E@#7;8&@Ew=LyCcT$d8XYErpP%F2A^{mLG;CY_y>=D)Pv+s0wEcWGVI2Np zZ)|Sue8d!U>I92XkzR%SGmy^y9sMk$$}T{U)4N9829la-hp*n^!HpD6P$=CHG!;}h zJ%(LRJhDvXPy;|?O!;DAoM5B}W3tr#`ug@^ofXEr((qyR664A^sxA;SuU1F=j_-cf zKbj|!sJJm9Ei_N$d26m${%?#gCXRXZ4eTww3M?FT5sEO(d<0J>rzU|pr+9U_v_QCK z_L4_1c{ne@#>+nG?4gR z+ewT%flRTO5A`)Oz}6C@f+4i(UxOnaJEruXR6ad$laW3DWAW<8yht0Urh9X$NlXeb zRXuYAY=;D)-@%A?f77A@y$WXU)k+g|f)P)U81FwhBz|X}f{g%48WK+U^pdb~dT5H| zb~`=X1UN$y{ZjS;aPVew2t5vfyiw%x53r{PD02WTNRrdQ))_&u;*v0PD-EI?y8sdZ zb|wzmbWOP0GPtf-9QW-b+t<>%9deBIZgI%cs8=ej0WlqT_x8!xtMwO%CAkdQObRwb zQUk&&6)fiuGVU_ga(QJkY8bR*3j2a2t!Tr*I||v~s1flNDjHiAc?Awo!YRijoXYXOosqDXdecu|G(Z2ZR1j-|0&t$D z>VfH>5*lQ-`Wn5kaVS3u+j5oFE!;7Gm0tYJ{vZhJwSv_59)H6d3%v6n?d6?bbPx7XRrl;Dfvh&5t~!6FaLO(DSY;6`?rQiVQ z8Ni`IdP+3i8+sv37!P>jEe|4be!A>|Mi=8t2|bH!z7#-g#14GDQ^=2z@tKe45Dh(Fm4pK}oqPTv!Dl4*mD;7ngD42KdZJnY@1^%kn^E{TY$G%M|4XlNnNI z1Mf*x6dhsFQ#u-ePIoYbQr1WJgY)3b!B2DOK7*y<3~atY&<_p>cY!%y<#HhM<_kJD zpl*4!!aeO}j6Olgr}ejxbLwJ6k#T5;4j!-+T!ws6+q{Z+}B76PE5`)I5ND)6JpTvGM@cgBpvAS&is!T+uf&)> zTM!GEtAdC`U+^*YD?o$iAW6&jfnzKC3l6RDHz>=qlexz*n|n)Hnn(UX)({L(ndj2p zY<*nxT<&eyuvV>;qQN(5r1)bE2#Fb6gVhHd&H^xCbR`c)1jME9K2y&;h7p5VaYtYx z5*XT=@g7aL?z1qL6(BAJitGd~pS;TW>+migen6|fC{E>eIg=W@{IOlHyCC{!vEZUc zw!vy$?d5jF8{zV@aL?>_KWn=#CY0!1A0;)tRS!x7frEudlNA|`(>*zumYUKY5vG^g z&2E}$BGzRl?An1Dtnn|@tHny(Pc!lvM{|>?$|59IlM)N0d6~@%P%Lyrs07sWq&mh1 zC~uvy;g>;x^JZW_L0oBT?7_3ORD*E}r6i^bI(%i4kTKk=Z5H$*slW5?SL<~V@$^#a z)VUG6Y4JFAZ$R3Fb^gR zYA12rgW@rLon^v=_ujseU1a)oR~t=bKKiV-0xWXiy;(1)5uK1n6~H14>?Bx1>k=Wi zy=`-=dSDeF9&$m^qQh?SOrO;3Ld28*;Y6WA%hTzN2hZmY_LojIOUXGFu0ozb?A+E=csbfu zBj-~ffwz2bviY<5^Ej~&F2(*nNoAQ3Jj7CXkRzJfCdV0-i9^aRt@@NcK?nl>#S$l` z(E6TD?98_`Kmz%p|IzL52+Mud*kSh7Y7dZL?d%bE)U&%?zzdUr{vC*RU0Lo~g?nUi zViEM`#3)9 z@625U^=f%>wYkt>e+yq(*sy6p{7|0<_x|u-xB`tAAsn|u8?1+;`?Q9RrAvEnu<&vR zKmxcl*Q|zkf?bL1%OV4!gqT}B4e?`m#vslg{`0H2;MBqP{{DME@s-4{SKF+>fO-Q+ z0pKFMcTD~I2peI=1%t${>Hh`=@3Pt&!yY?EUct93n9T%ycMlq6<^d!hR6?fxOuYKyZ$`0;w`lH?njyg1@DgqVX{*vLI4N z5{L5q6fI&~n0KYV<%D0B=viz!Lg=!zpxRINh(C(rfOq9nqgDHx4{k{Py?OVsH%}L` zNKZfmSw-d*`En(cq_HSEv2XAQTP)iR50#sJvZ@Ijsz%9346|!S;$2XO{fAtFffC%4}$670-hue5MpsmvLv4!S+|>wa}HFo5{T{ zr+GoV}9m1|FH-45HqpIqLs-w?- z>Pkx}9U1Iy*O$|ZxY>Y{oT7zmQh)Okg03SdJCKTO_UiAjko3<&+!a(EgABFNg6?}_ zHS%zfvxF8vpJ{&n_bC}Itt~@%k=U@{b)vLCx{rK48Ttmd>=W>&SsIs+veQ$kOj?M+uEgy2Db!$&9@{YK4((*rq+Tc4p2Vp-jm9Js4Np{7ez)y z-y_(XH=mAsesS`HgYYh-FJbCuNjz_wbLTsZw)M5iBTYd^&1hj(XsrR7V7`Yk-j@o0 z0c#`~cxaCAx%8b`#$yAEUmmUq4cf3*o3^0R43ka&WZLIW@R9NVf;YY=Xaw{I8nvtF zslpxeP_?3Z) zD+FTlmRA*fnDPWI!e=W0WHLhyXz35gIPh4e4mT#gU&VsqvVa$lyfXkqrbO?b;+xhE zc31tEwT~~;!|dSZGh$~BU`i&4?_;TaqMxi&#-~JFEwF!yKPmyzd)1F$^<)hsQ0WV@ z^zTnYng||V!yGXQ5lXC{liw5$CPUz0dfxCiCLTq%Z1_K;H&Vw-*K-d6Z}O2`i+l4) z;JtL*I{iC*bY61uIP||OFbClMx`IejfuuQkVq%WBp@c!IY;CU2lEjXa;MV_)6L$O> zXm+y9Mg9+2?;VeI8~zVxW^Wl$c9)T@5VAK}6&V?qnF=YTNyuK=$)2UG5|XU!GE=l9 z2}vcoOUm>9e8120d!EC+yw}0@I(%9$ct>iZZEt)nZ_2*jH|31i z*f@s#{JNzrf*3l2dVIBYzJbo?6cn_0cI)xnxH2!@<3$?nWIS_-G&tf(V^nF{72S1kXAV< z-Zke}W=*z9PPj*T5$>_Q`!@eF+t8Le73tGAe|_^XGptvh4&qBU3%l%YsjQ<>51F`D z!zp$g0-B-k8Sph&;q>uJu@|2x4F1!+vS&R*k!IO7K-7vqub8dth46*GZ9I#m9gInL zPJ~)bpYF)`*=2X$tF+2efyUE|d(|^IXGH5PdysMc^XzV!VSB-tzCC9rzYS}vMOPND z3%TM@-BRv;?YsQzRZW4n+qOvPI&EAJ7PZJzW=I{mNBS|{m!lH7^^A@BDr8Fs9)(qU zlN$)Yu=d!S<~8)h_WRCue~NK&>)TT5)`*s*9%c}8@lPrUi3I3~3!ZPuU<*}*l;y7y+cy~SFnB!|8ned$Gib~2j#bCm&KSEWQg72^*uEUl;)?o-i`^BOp& zZKNV=bk5}4dZEouM@99gyotRnR=#@7)w2GA=ILHs)MKKQpPodVF1shTv()^&h}F;t zKIuhJYRY%5i=))}i5k0c+&+V9w=52x1w$lLj?awFJ|_JCjoThTKE`9TO6ZJ)zj&;vo&6^C5n7GwFBRB| zlRH>2_23FWiRJd-x+r37c1R@S1MDD9Eoa#aX}^xFEsR}r9!&$0T42akk)9%%61Dg_ zy6Ou0Ku@}Dwu}3J&vJ^qz!`?Tm6UB&P|Q?P)AsTCE$>TwClcPi>e?DQcJQ$QVHU#{B zzr;6AjaO}U^HjsefoGdPW%x8Yev}~9NHWOuqC->~QIJdr>`&P5^xcG17GFU^&ndqv z2Ht>MmAnQkV5fipEtwQ&1{E2Qb(7@zd7lh=nK+3saj)S59l%%^p9SJFFI^1==Uo+5 zrBiiCCh}gUq(coIA#R>hlJ;YB18QACZm4os6pv#+-ZC4o&ShgIg5q*)dU8i)T>rDxtTn!r7 zpUZDzDR*0YT`~w zDtn(TdI4EycBdxM;@doq!y7S!(zy=bi%L^@ajx_%WXk(0u z5kBH_Nq?A{^x2@a+8)~DYneOyl$A0i7ia{E{NtN!ziqy}8O0r@61{c;pxjbXGl#gT zm8)dC2&$%G#*!l6Blghxp``t-h*T0|fZ?(rJ|6~rCRn8~h)rQ_;j#AH4l253XfVtm zDn=TyK`P4dXNI{bICd|&Ut-CoZ=5cula*=ugD=Z{q75kT!Qlj|WkJWgEoZ`{hb|u0 zq}HQ5ax2iP`oRG{=V}HK(Zk_BnLP0>N}&c%WT=lvgua=IVY`sWEa164*LXPPoK!)B zj`{KDas34eTK{I}4;UsnfDU6I8mFfBzBxwI=y;F6ZcO3-*F&IEik+9?%J&~G2x}eb zq}q32_z0uV1dO&j?wU;f+P^b~P`gon&B!zfLNir-4hT|lFJ!DN0 ziQ^S%?rQMzh^$cQF0|)n2+(LgJ{7GJN15QOt)#9v0kjS?)Bn8m^k~lWXsbG^?tmn@>>*u#R8DO1)G4xJeh zYZ4mHJIv@<;PTK&_8 zK|Jm@vywL#g8+9L&G8fI5DV)&Z7k4z=DN)qe&P4WO!R(*_sxq&=l$0ntG`ms8miXi z^w{m;E_0wgwabt2L;`lMBYO{Ie1Yu#X_i9qA@W3ML-0tEp|Jh*;PESak|zjg?Bv_m znDpa=KDWKwKV3rcU*yBiQm;6_W(hos6` zf&0lL(yBdeIdebT#Qp2ZeI3p((YQ)|r*<@txz;!?&uV;4)Jx`TxCinC7$FspWnrX+G0UF6QF9p0YsQH@qywM_pll*Kb-MvMYX zp(&z8n$1?#4hkakDxLRK#B~GHPPysNP%nr&dX;Y8Xe(2ekZt;qEpSZdn_VlgG@!G} zC*N)?l;?Xn-ElZV({(d%@VJmpoqJuI?@jj<_vh#TuDz&)Tk98WgTMm2Pidp8LH<|U zZwcdM?Ta*D)Sf!-n>)Cd_uyg|DUdCO4FTT0sDQ4$Y6cu77%jv!s^Nm?vTFKS-5IBb-2gz;y`T1et zh8AO>ibmq1n3jG+@U=P`7uFAKX(ZBixY1k!PuR%F$oQDGoV-v_6cZnSPyHrL`s<~X zsb=dodJaDBm*|uvo<$cw&^)K@^?Z8s3&fcqK=Zi^A%ROd_<8QU#gQA-Di79QtJFv- zNFS0eGcBsQy!j8%VO=sTFfvfKZe`ukm8tO$-$WxIBn`g#NB3RRy%)x9j-6n=D^|cj z&B@Je5CkijnTwKf;xV%@qYSi4pCGRMo_q`eXZ#j3EkN^DI<8+k>pNmo*eIwScICAw zgMY0g&9Vyr+=@(bb80gY#ftyNjDhWKQAfH&Wu?jHoIz07( zJDermX>rISc^&!+dKSdh6cT^2xhfiAP!p)Uq&F(wMb<;}+HH<6dU;P>i(z!A%c-HZ zQVm(oZSB8|Sq?qO%45wM>Tmlm>!wop}aFg>X6=CUs2z>fu$|@?Zq`tf`t)H z5OSWgE%H@9>z(-m!mg0A~Id|ja*=XVVo*aB> zWdrz)z%?R(vBb|F<}c%xcNmW&4&VH@b`Na=q?AV<%U2CC61XliO;y>SM&B_6Rk^f< zPVd8O@jW~K5^ct={TfCep*thN>&2s^D009WvP}_KvCO~i??CU}%XR?L$w}z4&$K!*81! zpDCpUH}iXx#cR$#Xs7Jg=+m$-$r8TqP2oA<-rr=^nUgMeR4YSm+hj z>Fphos%xusy|mluxTi0yI19xOp*#ox^PC2{-3lI5^B9$_OuSbFk)lFaP|8|=Su z8RG+H$Io(c@-xU@>Q363^yS+m{^&5oXp&=-wP6t(+Kxemxqc{Jh>8W=wO?QMyp z?iM^ZD82RAXdMXlmWZq^>}UWCBYs=GE+zk^|Px{^J93k`B^MzH+i>I3;gr$Dvp05`zbCE4zJtA_~r~t zHBQ(_92tCp^w<;8ajbMEEcOkg`RjRECyfnLA3R(?VB~&D{mGz5tN6gV1rMpZ1PGVF zj$AD%!AAw+F2U@6XO`{FT3L3}apD6@oZbHz9gA4>l2>msOy|InfdEuH)YDcbySp3R zeVp6%w?BVBk$LkLAcgv9R&X)~A3;L;DES5iV@1nvGS_dKpNu@R^MWrxYRo4L<93}v zWtWojgNK>={ge2+jemZnQa=D4d2eexhN+$SVbXO@r?uXjrD>y@fa{`{y>SE>q}>mWMEw{ z)Do%U=I?$16{`F9RBpF-RdAZ9rg>GES~Bxt#|-sL8>-tD-ah(+g4Xx4aay2=FKM4q z(vFXYh{1`ENFpnP(1V1eTw%8YDMOsGD|0+q@EL?G{-^<|y$gWd*0&b*eG8Dfg&HOA z@m_6t0WEpYn_Y@7<7vSU&nYDHjM9qMnQf2yP{{Bh^^J|mvML55iEiOC(?X=w&NgPL z;+erf;_5@43u{P_yLeTq^hh{Qdb2I$1k8{VaQsR-7@vE^Gf^dFO|UR5!)_`mK@ri|5{5{IAeZ-^|9i0&l(ZDX$Ep*40`W1_R_`AvL17ns8a}13^MAPgmQ}_rk|e%@r~V`BPvUO@brOl zMs(x~^j^}?*uf#)8dy!`!J&*Y(8q46_EA0{^wAiHMQ~a+VMu z5d;Mtv}ZiZ^0m>aO+z4k!t_&m$t}XhANG_e!XaX>8^iqJ6(8q>mpOX z!&RT=8}0uE9o&z`tHhW>wC=feSy<>nS4JB-`O8liank^(??1DYwMg;#2S;N9*2mZpwf|Fo~$M%~KNF5x6 zqe!-$u)VnRW!JXo2#v33IRR-1bBp$fydWM~P6Xm5r%G7#KPoWf9H9oO*o-=y^566O`r-mjuNb(NF@=gs6?w#4FPdxo}|GyDA041aFE zt?XI6avc5CIz!r|srlnBF1t!@2$V8k?319k)RYsZ^+T(SwwGwGBYgF!8hkkDiku-S z>pt1}&(Y?7&X8*im1j&}1gh1!Z`18ig}UU; zwT!105B6ZXcorR(|L~7RhisCdicbwcJ%W_QpM1jDMqQBQk^u^k;s!;i^nBDcmK~=We zh;$rcygEzh5jBDc83t}Si@C^17iJ!Bwhu|W2s}) z19-6wjf@_HU{=`YcjvHLMY$p6m0y>RhI6tv>pwW-PCsteT3Q~9*9$U~ub4Ud-_FQ^ zPfZ#%TKND;A#wsU&5JZzeP3&9A18@9j zV`ZS~>N}%3Iu9Zk%P#7WZZ+9lb2d>sUs;)LS~%8Ef8W55a`T_G)_bzDdbD8+gZMk@WT>H$h=j zJ=fu_R(p_yWPdo66GTX)*;~BlO5|QEnB+Ekrh3#ZE%5iOeHCI5DPZIOEK3S67`S7z zL4EWVJaC7;N^M0s|oB+~_ z>J9Dpj=d+GfPR>iuTs1PJ0UracKhNYrzu0Q#{bFG@3$WB5G*via8%YL%6?VNLK&8; zI#5T1`g>Jm0Q!2ll0PUf2PLJ+N_p;X2Ta>oF8z~JhN8A{h5`oJL_oV<+SOa zZro#|61Fz3W*LZYOGjWcIwdl|L!d+YtjeyB25#>A5A8AD)=c0$Yo2#@ss>EMWq{W2 z%+cBWU*)u(sYnS7+K4>$8(}IA%YBl2aqfd=d(ktMB(OD|-IQ_C48ID-Amek@dG^ci zM*~H2dAv*bpOFaL=%!RILSGXuA!YS2~?K2uiM<7Y3Uo) z!gtdv*qdHryT|PZdXmL_-3LSNdz+ax@E@6*FuH1IGfi?74_NPbhDf9B8-bdf(Z4la znDy-$pwRmZtqiIg(FvT%Zg>`Loi%!grJMKE;Tc33v>yaWKDs|GACEmm6wQ!_kf?V~ ztF7FDhZIFt0qi=6pC@IIz3AG(n%V>%5}F8kPaw)M^+Di8WGk5kF(j_PUQe|6~~7gNM(C5!tW8=!-w!P5&&) zQxNa;AS?lIWg{FA4Psr0l6SAdM<_hgBKroK+tirC%em!C*}h5%!2T7~j}zIPaw4uL zs1dcbNA?+9kqkVt=2YD?P9*{TiuV+{U*CMaUenVh@{+Dvh!tYhCuo4v{3Txh1oZ-5?O4?+w_KQADeNkkOC0bn%4KYh980mSepaGs7Bxw1Xbp2PVd*2AI~uFslH1QH6p~yX;36#EUZV~ zYP<`ft%>i*mOoPxC(t)L$?q}vhVgS*jKM#Mflfh_g_cR2N30aew3px`Pe=1}%Mb6$ zzYzX&ZYY0f8Si5)ouH&g84;y7J&~MLB+Zg??CsLe4@q(@-zZsZ%ZTL#5WoO@$_Vv) zNo2dvU!(NhdG+VQ*w*t0tLy_YUS$PASOiT$Ly+yt{)X{WY1C=U{)CK8JUJM~9*dMp zZz8g*VbOpsQIR6Pmv6UIV-3P%fuK&aX`sZPZ2c{9SO`++oagw~9^+Ld@{S5!pt35yDm1drFA>jFZMq zcn~n0GAQ=Ko2ueFO3jVrrHhw0KJ4tX0%-F8E(|CUbr5WF#;Xd2$-!VVbJ~v;T3czl ziLicrHu@DJ-S#71rT=GJK>Y8Di#UeH(ujS#qGO_rmvG><@=gX*`^s|K{P!B&Pm0O0 zgk>|+gz{U^Z-5%FH=RzbU2GWVdM3C6h&d~V_}tT&f0~c&5Zt|d z1mP1~H337=S_^ZSTVcS#tJ5b?5<36>-M=sI@-D6WM(C_ZzW??P%oXhAE6_YaK*Mcq zVtMcIPs9JSOCavkyyXYzW>Oe4NY?JKwETb93HbLA>jXLr$fYGoFuG)^1{VFJzvN}W zW@F#721)QtFIu+beTortQ5Gh@h=ym_+>l?!`N?Z9ws-&UJ(yC>NFLMluMC ziTh!+J(v+=$wu2(D)oH=kSGe;CicCG;ELEn{DcNXkzYytv z4)t^GSGNM!xV={iDGAyUz$Qknc;Vq02|0v~G#+AyTQ8hret@43O*uaODg3wKsRfjM z*sikd)XI(j2`tl`m!`<1t8c@1Xx{v4Rpzt?HG<+#U?|?Zi{~8c&T_?m3~ZRD*U?p^ zG;xHT>Upi-h;#wja=FUg$LDoPW#z3pmny^1C)|Bf7w;+73*3cmyGimdD(@|x8Y!xQ z?sbNW^*~Eg_*3(Rw+r>?nhA6$&ns~(%_TKkmmNkgjA9#k*Z2kW4%d$1Vv`2*G;dHI zaknZxA$BIBKSxE{Q&&>Y0;bzaF;N@T?@1y8!0sf@E2`f|QaVnW!8hZ~+IdTDhWNV? zSvqQRipDG{r1}Apz(=+<q`@VP>F;& z1+OL2q?`8D;&#pItfZlk1{XQotlM(zA?60|6l=q%Vsey5X+-#Qg$hd)Z%`zsE; zA?RV&wM&$N0Y3?i2h8J;xlVm}GX2Atc1Azz)@lrwiHOPN1p^n}LDONyiYE9e6TZ(Q z+=%WVDalk>VVP z7Z1?N>td|7A{^YR!SzF5FB!cxG1DEfPN$2np`*1G5%!a3E+dtXWZ>@PVOQansmu1{SpNfyr9<=7wp zY?XYh!`<}40a6}QH>@>B@akH!(5&B+gq2|bKbm}d!yUR?0PY)$VBYpu*qY-2Sw19r zwW4)}6o&1NM-d$hIs%M}h+yi=_pCDEFO3;$r(pv;ES?hlo^3cPbdt{5%}S*>liV#V z0&qFqpMA>a0fi$*O)Y4HC{K>X96%6sVo)NS>pal*OXP&mv<2)84e*?7vu9nD?74 z_ow~`b{%FqgAJ6)>*m*wi<dRbC2AYKJG?qp}TRxhn1;1GY@a0nMhZWPfKAANiY z14L$WGG7xvPd@oG^j#+KOe1~CD)GcMat2BaJb?!2LLBu?I%=Yq zLL{rg31a%slw6>|IZdr5$>MgAssG$}ZEd+l1?i_*Hg=dFeNk<;!>J_hK1}XOkAXP{a)RxU6`$Z`y3i;j^ zF&B0C&0Bo^Y?B1~PzYz!Fn0AI%QcpT4*U7oz>)3Ul+7Mmi?v)2Biw`em2yX&{IYf= zim?=buHGf7#PGw-DZ;`N^@Mb6WiVMd+VFhC>PI%6`S3p};!UT)-|lAsv14=)@<2}s_qdZ19*r7#~0xg=M| z7wt>yhZ5_Qm%{CacR0^F7w{eFP#C{WOVxKu+hIY}Gt^hB-5wc3{RfQGx>FW6^9vLv zr7nKo>FL!WtKeJxUgY>m-Sdjp{PSIEg3lrYv-dwV6~DU2JZ5(w?~#)*R^IllCaeYm}+gBwVr-Z~>bosoEcL@|RfANi?^HgEr*uHkJ z@QUv@wzad-s>*uKInu(gCqwu_?p`~@}J=bRQiVa{_y!Z(P^?SV<4>d&t$l2^z2^v2vA2SW};*e6w;iY*-(`oW4Ek~O_VNpA^m}}_5?fMwe z%{g(mN!livABPcBzU=istwhZeHv3ulXbf19U}B4Y7TV+;zNeMcL|H$u%~>rQWK&8N z#r>nB-p;P$*RC1nv09$3D4k78Ecu8Noy1B!QFdvso(8Z&zR|%lx_0LoWph> zJ)Bsi2JlYbERG7N9u#gCG7dH)`zgz+#P?dSg+q%~=}Ig@!U~H&1LIXUysp#3FtU zAB4~p;pqkf!KERp^m)R1wB#sCYe9vWL16||5S@gqm>S5JwY$ydFcS#C;m9*b%M^QY zl7nDbvr=~}merhmr*)y*KE7kPG1=GFEAIW37&j-s=&MUHoza-D%P2-Fkjb$3k&hu; z*$4z-kSUz1Ys{`31<~ByWlIdCQW$o8m5(-y?`r(G>Rd zv~*qe=KC|vR24O3T+{m!L4<$cu(M5y9o~Mecf+^?c&7reeq;nEvz$o0;yX{|UQJ=L z%wtN;O=3!=jhJEU+c~+*K{7CT+m3#iZLZY_hKofyL!smd8vNYc=_(p$6bfpbVY1?gE5*T!~FS( z9Q+=ONlS!39^P~G{&Uc385}kyM4uY1uB}+IGyDsK7!Y*~7z%GH@iNVTrePC4=Z*6N zBgF%^PFfaWF)^a|a<4{J=eX9J<%>8I#M+F%>ab7Ff`L-w)LeX#a0{?rP5ALt(-TR_ z)M;1H*A!f-Sy+L$4S6XU*`h(Sdtn_8(jV`&wt0?sPyP#JFsIb_p_! zD|&$u_|g_eg-GNYjF4c!W)4qD4|Sd~W><4_C@~8OA4Y=eIqY{7NM(FWBmMyV$2-D3 zG67Z%qY%;gm3LM5p2no5x`c&=9x}m}_dsz3FOK^HJONe}iqM|nS4e?1xsZCeEcU%| z+}a8G&XE-IYH^a*;?(`mh^{pVu~Y)m2P5$W4)!}Ds^d3A6^hKSW76sW0F;_Jf_~#u zM91(FaRxi<;xCq%wE3x)LHR~74Lq!YbYGxq7B?fBRcv$^_qd62jp^7Mm<<|d?C)v} zW~`9ai((QBfWFa-$9E)C2vd9cS7cBtVkP25L*sx)osz;ShZJRLM)lLs1%_%E@li;( ze;fwxWPE^+Qmzi)dH~03{GKTM{t^kwSLLRpz``IiQ}OMD1)HHgTWK2FYt zajokhIRYj#t)SUxEvpDfb>T5R0ni<~Y-EKYhqOj#hFz6&J> z@eW)X zI8_|m9E_?EV_#Sp6;HM17ZsD?=H^y`TkSQ5zB&8`NApIA=#&zIbze_?1#~V+<200o zbn$AWWBMLhUxANn-z7i7JaYsc4{^&6-ZrH28i*k-(d#ram-JwJO~PtXFDK>92nx!VH}k19!O;iu1q1qB}v8IjDH$5pO%Yj_n3qaxMY}g@Zsb z3S~>8f77j$({=TPkI&Z+LD9m&{9ZwT^6ug4w}h<{0};4d%X}@tdc^~grOYuh=fp1d zaY?$GKB^uVfgG^P@d5S_`JNR_S9DY_GPlggKru61oV{s&!zEX7OcgvVGhJeQUrma7 zAr>kVM@^AKEYvkl$*vb_ubifHzrOCIw$YaQH3w``%!M2Qg}X7H7TlH%nA_1XB(~B? zpcP;LP1%npT*u#s^~T~4<0-am{Q$huOBkMLU%1QsPHkbk_TJjCB#KVJ-Rg)UX$>V7 zBq94Nh$3piUcRh_KKW%@jd4!NwvbVmy7h7zz9uiBeHj1fhnO<;O7m9eECObDqTwqLT`QE*Kocb}V z_TBE0!!G9xo+k4ZJ@F&wQx}>u({^MkN5@c`E72I~f=bmtJ#XQdD6(r#`;k^^iG(T_ zn}CQdx@A3JseKlco-D?h=jz0@X1X$$%FxHC%B?FhC(`O%$%xmrj2SV}M8{B7{fCGI z1c-xeM>hYv?}`AiBH9lfWuu8OV*b6Y^|u!GOs#LQ3Z~{SaGLhpZ{0V;yHRp-i`%}O zzBHehh$PBvlH-vg6Utjx*emrTx-#V^OEuT1>CL-^y>t`G!rayLJ)opLgzHzTfJg?K zc*_e6{%R4DlD1YCA`f2Rs+hDHj@f0LTmZBo_`SZdHf}kQiL*E&?}$<#LZq;dYEfTR zvr9I%63xLEktg~t6d4{^JNOQ5Sw#hj-&IlIs+^=p72y!`3KE-_lU&P?*{v3vA*OW3 zMr`<*CUS*Qi}U)q2t7?~PKZBdu{TTG2Tl(7h66a`F~B!nD(He<_^`7FHhS7uYG zQ(nuWYL{HRa&6|%MXW$fz2sboZy&hRbec!2+n=H02L+Ns3)6)2!%>$@PQRzRUgBnk63p5(uV&+zI^g^VkCU`cW z5ffYQv7 zNz#tfJhPVHkET30^+7H-Z6ff{Im<)k+cb7={3vi~2>p{;)34Z+_4o@}x;JmlFhs^{ z5mZKZUHravh~v;WfDGMgw&S+O=bI%R3EErEMi$GgBfz3dwzZQ!$R$_k6JzZSTAEA+ z(uUef=}d2XKF7PGpK|#>RUF8n@qW4%|HjNO{feH_V}JK2y{(%F32CZv8l7JJ8%0nc=PDRlZI3(fbM7TJ^R0O3 zY$DML#Y4~GWPuykHm!!GTeQ8xjgqyW(=T)9GJ5aIr`WYUcWyuZGpm(5Urj1gKmR;c z{VD%;lF#sp0w^EaiSsK5~#iT=FJSG?R z%X!Q&W_Z4CFI|3qJG1qJoC$!|49 zm-Ux+dbQ1-S_Ne74u77Vp7ur7xNdb*PxF($1=9)c_cyOOsOY?O!P78(d3`K@wMTeK z!Ym`+rR#-sgx8W^0o0MiZFmElv|Y+cTE*_yZkMX{d%7rO`ei=Ck!Jm~b7e7IHceaJ zNp`qia0RfX9}MZWH~-zQ13$D6oeZATE@dby^);4)f%N!+x;D?fN|Ug>Iohk{B@#TWeyvyLp8@*bAF()lXv&XjTJ7$Ioiw~uc0 zqv!hkA0_cndW`x+RbcBj-bnThV7|sj33b8dWiPK~(&faBVrTsEmk&fg!+3-hFIx@2&&OK=x%vah&~-@#&(57CNDUL z{Ci1GkMZe|3}A5jwUAiP$lkYSsXQ>*T>^?$&Q|-YnP#HF z(E8rR3GN`BL+9^@S83UOSb_?vr<3kT5HM$AD7=L^wSeza>y*Sp%yMHi z)fW9krkV;DzSO_)#WKGLGDJJ|7DlSnRyBHj-nP`^Gg~-#xb1Ts+$3wPZgp=clBhqv zo{HI+-R>yWw^?Iw`_LV9_WI1t*fgp^bI)iZ@`&-yKq(cR(`xHt+R4IyQ)DEpAdgMMYzI2mQ32h^3&r88c_W7R)#X8(h74 zeNhK}5weeQlpS0TYn)spuI$p({W!{V2WF$`!!&GmzWE+%;9*0TUXuP&9D$o?X6HyR zI6YF{rUc>pAgVn%*8UT!voaxr!QTowso4#DCLwt#aNcIOj8gvtZ6T%QhK9g`qfeU} znMtbjqy@oCA0L&oK7y-R9qSz8Yu0O@pKGf7dE_x^VA0;)2USwBlvE2)^;tV78t)ZO0k3SSN-H zC_+E{COQtgQ6_LQ1Wcm9NjCIEc}5VjfwI$p{gB2FCP75TKC$2HEg%fG8MFAv!}}%W z_eJIRranXNRsewJ3Qe$Xyf=Tl8hIJlW5`1J?a!tARGP^kI%8M#WwL&2lDm5ztvd@j zzNz@v<%UMR$4beX=g%l|OdL9xb5x=cJG`>D!AD8enWBaH)o#D(72gV+ZrOj1m~Wdz zP2OW3Uq~0yp$t;A*<1A+o1BW2rPz6QJgGwO-r=%Z>VcV{Rxo5GNdtW71*0FySe zsile5VeA7ci!j1CL*%_A5=L+YX5ax5|PC#n0lyAQ&4BKgWs>@1x}4>gpk@g zXoCB`W3=xedF7T1BO|z1gbj>N#HId?))lb1nml z9;?pl4Cm|tu3&HgnlF4rU2*5kSY)4&-Qcxb3*obn**yd&W@GO{dk;}UM!iDW zSKmr|1rPQgdUH@Ubd}UT8A;e4&;T;&I2@&ws8Wz%`SuRi4RQq2JPozOH)s-{G~;ff zSY@bIlG{BkfO2cTLJH8LvldJ3#8}+mRfFp)IpeY7=>|@hC5=fOGTYn_9S9e4&G1bu zGftVo=jqxN`H?Mf-axAOK!^QzhbrH}LU6trky+Ex5iYm~g{l08SdkV=?VVX0-Ik$} zQx*Ml_LR)W!E0If#2gX$BiQXOBUM>wP9@Q)ol9eDpp+JKmDhMFi{6h|k9~ZevTN6* zI~^7s@J6?eTS1%wD(pP)sazEf_f+#TfE~aWV8gkFRec6t1Q}5RP2*iC23rtu9dG;& zEIk&uZGFJL2^r19wmiBk=_&s{eisN}%scTeR5Cc$acZ!BH)V z!AHZTUR9`lL=L5Y>M{rqoi@z*bD=>WRBi9R2V=g1mgq33CibvI5b`XcJK(e^md}S; zN8{hG57ff^A%)28whQu$CsJDQeZhT@bcHZ3^ykVvB0a`w!pRN1T;@f|1|m&t-6OyQtJfr(Au59$tS`fld1(x zi9-31!Srj8m06fd?#e%WEw{rVtMC$2SaBL(qU@l>4R6+g8j##m6K`|Xpu+8VDaCDh{(`n!q4l4V_7@pW96Rm3W+!en zl;I+9FhPjYaj@K(VKL77rJ{fwEk83}AsXH9?Ysrs4ZQ*XH z$~0SNWt6otUy!1CpB|NWA!p%X`K`?r@~Eig`IkcRx;7(>Ghgx9+0_vv6YIWm7s7PUI;mex*HK@$PB3Jm z%Ym<4mqwy9<95l|Nm%81#O78pv2bl-$!p+`BS!z2$%jlBFh~{$K{Jlt)ineMMW(DO zUO@bl&`}3?1i;(aE1QfPTUChtryel9C5C3LDpjT$4M^{ey>cnOLuYV^=DpF=%!kcJ z?NOHS)Jety53F+2Bh}di$$4Hf7X^=V&*&xj?qGyN%C`|hv7$d#Rg>8IQw@+r8sdx2 z_!03Yd#aSve(yx|xa{Ed*?26YfCd+$kJJzjHyGgYkcg;|Wtwdd?)4BFUCM;-L9@&`6^`SK}`y`!{lDvRP@)EEt^kQ|&KE%cd`9n$H!|Kh$l) z+|C_K`JXp}QiOKU_#=Vf(!Qh%N%gnx3r(=D@c;)3RLic^l$#pqNAeke zpdf!QHDRi(H$ixDwjB*0`&(I_SEPfN4Ubnu4q~mFw@%LirZ6S@ zRs~Nq-U=Zw`ovt#_sInV8{CMc@l}JbqfJ5&BVrqUs@YK0xL+R$)#(yepQ$}W8+`#; zbcie}ctORg@om&hu69Og+nb~3zud>*fqrNoPG-E~gU#J3_4Zs)~;1 z9;SUkhSIMh+$`*OiOFJi&D~w>6)6!fiL7Qd#%8=3IXO3GVk;Qw6*%2T^StahB1~z> zEAXgT2h}JNf|3C-N6#TQLg8}!^dl|?AE}gD#>io zEa}WzK!dWQ-gFBDwd2xB=oY?P8p`9h$ohaC+S2K zQKV#V(c{czH(76zTo=1hEH>}tr?>#6#qiBS-|9F-w0!WXl@Fw1-0PTeWMUW}d-u`S z+&6%ubEp~h3e;`xVOYGuZTr9rQ~~h3_A?cckq`0eD!Zm274a)xfbLM!)b{2B_8Euk zhHiN1&s_iHCe!ajDDv^|z237V-fAP6h9rMPoAY14bTwPQSV)w-HIe^p*` z5mSl?CBy4F&p5?&2oi|>!eXgh#3D!{T9_-Gh(t|0ffBJQE^%AQal+HQFQY0_r@mD1+5QE-kSV|p8KPDUt2%` z;&L4!CKByCrgm(_(yRA^YCGghm^rVnitH@al$3EkYgMoh?5wP_kG8BqwuxURrINS1 z6LXn9bDi7m>UhOd_sIjlgCg0tKQu;FKlJuv*K>Ps(`>6WNs>;Z?`m-rusKMa&IiB)&1>XnglAXO=5(-lxvqAWUK#}*_rgOLB2^qZ%D;_^wtA;|9` zBf_?E=fT@`P>&yX2nk8c(JZp_4%GS!Yg!4ZepW3;j&q9tS+o>x4iW{0Yt=3 z;6i*;iu#*L&n_ZAJ7ytJ*xL?s$Z78=AAdZPIePNfH#Hmehd7-yA4$g@d8v3HhE4V8 zWTfJ!jtsrCH#t*otD2s_$?tv3m+G*Ir!(~#--4WJiJ;}^gzW1^rU;~G6Ce(!36Es* z?lX4VA(x!Is>2sv`_iT?m2p7t>NA6DSxO@nBchaV_>{}!Jm+6W!>A1&zvYJ$a2gAJe!h;1|g zqM?gr6VtKRUXcDoaRv#7$}|&)L|nNH%Lj*N&s01BlNYL&v}aW$UHGF2pJy6g87mX* zGSj0iarI&0LAGn|9aVFLDAZ7li_?RSY|?M+kr9+f`_g7;HCdfv?TuxD4l*%P1bzS< z{0=~#eHN*4AVI~-3eDsnp);^yAsbShJ5{&p$>L;USeWyy&y?6`ZS%WS57T^2*!TnF#WQA&oj$T90|xlb<*Y{%W=ulJo|z z@dZ^^?h^VhoD#l|M|0-l#q!P1A}1F`hV$Mx>coqGR=Ruls%5P3cqDCC$(B`d8Hi<; zp=4QG^oeg`-k`}>4gWlt^Te+rJudxwI`{x2Z`DkJMj^J7K`zabQbsiR=mbj5d4j4@ z^ax!z5DA$$OcR%|m&M^}z30FLyvGw36Em1%u{Ed_!b`l*zmSuPf%-{+zH9pU&O7xN zuxMckIdu}*af2V{GCiY*1dt&54u6I>+B_v=FnOaIP!r0CC-?GbDPzJl=Iv!p^0*Fz zI$w_~t|QIGXA^8@YD>e3H=(Emre9Y*#l!bQ6YMjMmoZrEiHvO-6BZGP(WjhWoo{Da zh-Sq=ik#QRSHHqp$J+SfpESvv+S#RD;-EN=z;qA&5@Mav8Q-WWbdm!xN)%kiAq~oN zXRL%Is0!~<(l7{UhNkt6#noDAJ!0Eo6u3JxT3Xv8r}wd>#Q?FMMpBiBB~Uh$Y35dt z`aSQdT$zyyZ?3zv4^pjt`Wl@~%ASh(o&nwurpiW$tF!ha7hOl?NQ%{Zw~RBLG1YzY zl){&RVY|hKpzo62*mYr=Xj4W}e)&fSpT{Nf4A0z-A6mzD#t9C*L!WKR*He@HMqR++ zufswwll|n$gMS4l^!u(FY&-6gsgmZI>B&z){pg;%RFxr9TBoeu{0GfB?W4(;=EJQk zc4^&ytX{`xp5;^ZjH&!TTKe$Vaf9|iH(clxfiEi3YtQ)#sV738)6I-!*6{v^8BG6& zvd3I5{~Nu{;0VQp>|LH^VN(j?48m^d+|k{4|M{f;wlxtLEUeB8dV<*}##*)Ow5W{I z`<8hFB@wfHjm&^nWe+nd+R`9E$-hzqn}jM>A^R5aoN_XpsS&5+92TYgpm;9TV=7=W zoAq$|`JSrzXjMr8v_^w@w{y!Y z;ccLhiEGoXT5gl7rj(X+?9*cpztV26ULvcwm3iD+WlB-=piANg|8ANN+NW2n%*{Vh zuGcZujm-PSh`k(5wYG0nQJ1ISpTALb?|m>S*%I#{y@O%SYu!)Jn7+?LQmo|GL9N1~ zyRh$W_`n*0Y^*Qd#$B;yK5Rnc%xo3HY{B+KSSxZm^cIiOY%qy>Er)4WFAe<(1{zBp z@7=t*JQ;PejPgU%iStvmnU<&6#&5^nZSs4m$k}2X7Ushif45jya74}VO|Yx#%_n$* zi73Mz`$%JEFWPxeZU4n{VTR7rRa>gjAwcGSc3C!9raU>V}I~-4ssP#O4a7BkrLx;ArAWemW-^#19lv$EX}GH=Mt!ujD7NS?l0gXs)4C$vMiA(7f2-HOfca{W?!g7*5Z`>wu`6N zRF8T!!j@rax<9sSY>N(EMgGB}eI{a@1(TqNjTf@y%Ma+9D9H*HdpInWULH&P^)ihs z`Nfsx7t3@`d^1X_)z-+v)d*dU`}Hsu{fImI=5J%>3q zstNLa@yqVdCuDC+F_I8cRsldbIZuRlo6okuW+jF|`yTq}HURfKwtWU_)%Q@@)xq0L zle3^r$~;7omDc@{mrwW@?RT~??hGrL`(0@jyf^P>*}6uB{vFP`W8PhtxEURDa+r!! zTZ~CxCx;wIZ$)`T3hZ%{2XvwfcZ;Ri*cO5e&7-9CJ|4Ja?7Ypb!$~`_!FLRT2Ni(I zGC)Mx!bOm_D@AUozgV5BZ1asiyi+=L!}Q5B6H<^Z{$$#pT$1$|RfWZHLWZ1o;6V&DYg< zFW)!ecN64^r!5od;wQd?YXa}tM%~!pWPYNHD1a4sRoJg}GaUi{Lhzj@UY`ZS0tTM0 zTm$j3iCSp&az`MG>AycC6X1;>x=BStAt143OCzO|V|V~xHht@0is;tspV+=6C_IK9 zKXF>UKET%Xw4PX1d{tiPsF4&r=o9-gZjmR&N7|1Y8+;v+94S#45NA}DO|h=nj~J{y z?%ZYZw|$1(`|F~)NlM!o6{PpkU!(35j&jxV1I(Na;_`F7<|1EQp~JiE-715^Py^U! zJDYdg46rqtx{C@0D)V`IEd?=*52wm%oBPojE1yZmg6GP+1rEewFHO?L>YyeW?HOLHQR2X zFX^CKfP!-bAlc251u}(p{(Dfqke}{3>Ih&MO4Ob#wYX^F#szr8b?u11?IJ_)n{MCL z1eV*PR}S*1EbtSa|Ba|;99Ao}HB_rLIC1uGDA(sy7; zf(?_5>h82AmA*^|l=ubUg_fh>z9xe_BK<|uP!ed&0u?7C6jXN7AmImGxnXlnW(@7c z0oOuI^)|>NKD%)%NRfR2ots@D5R`-z^4sYezAab5rR8B0{fTwJym|z91Kk-@0Xrcs zrV?l1biPAA00f$IIC4#fgGbp=!AoaFtLx7Ln6(e`^ zBbJSbClnXcYVu-ycm}aF8>k@C1GJjnHBZufme4-|=Buy^%w;cCmlsF)+O-V=r)4|j zWCFD*^jJErnxAdh{q5CSmLa>Dhs zi(%m1U=scKhTGsX|Gik9!~41%NuEHCgW_o(P~v(54P{_Z`fO*yDI#DUs=pp9A`0vi zzrWRWw@K(55oglg^Qh0}f@Xc`c_Py6q)G!^4x0*n-(+BUCIk$#$s%}m5RKdD7~-qM z9f&^M2mP0>@z2js_PpJDS_mUj(qhj-ou?)vZT$}*rj!BcH0~oL|EHDbVJwh`$1Hm} z+(d|Ip|#Z%|NOq?9Rx8~Ie$40K^O?27_4?fgtSlM31D7hQeZM^SqiuoGRy!D49ekd z15qEYp!x}6Xw-EVlgXlo<>}=3q#T^z=0JA`%2xY?`m>&6<^C>Onr(9R70-Fe=T0rF z6qlGnKv`Q+m9rAdXwLbrV5P4`gXQ_3Hb;9QGfv|Ym1&6ba*ApVtbl}p)t4PQe_0q*;5erK z(VQV)zQmf9Z#)nfcfcA@JU{47FuYc6I<6o)fX5P|nS2UYiwzz`mBgK`PX4q3I(n6Q zUG`~+wSn2(_EL3CA-3e;Rke9ukIn^I=cq!1kj!Lp!FV#;CqW?D?qjwl>czrj~nzT_jeKDc7Ns!w(SloX!dG8l`$@b?mzbQ~0ZEUirQ~jjdsb z@6%S$Lvt!SGNx$l;v?S;unOHMBzHt$r_^3&A%E5dF$Vugc)3<7iDYB7oYF5$8pe`S z-T3;W_0?WfCrYb@+s=eib(`XHUn!SYUd9<&H-(Vx{kmE!Cb`6#hgyr>EjmYn0#)JZ z(=cx7-f`&;B(}_Kbzm5JdMzNTk5%*?KmThK06;L+S_uMK57sBqH2hI?Qk6)zXvnl* z_SD=x-lpKs2iwea?cZp16&4dN6Hn1oaLi)`uHyyV7{)x~UTwKnw^S#mCvSUvxbqKp zGMe%<7a51=%)GsrMz>+fZ)P97uXOd|mAsm?-Rtc?#1zm+I_9Y(r^{MOmTp15Kz9QF z86E_FP;#^IF;H_3KFM;CxtyhHJ=k6Ur@U1K`-<#FfHWBdOkWsT&0NK5b*FrQ)b+7k zy)O1QgKcS*#q+H>3yW^t62^90Z>zta+tFX8?o#|)!Q`2@xj%$8s|@7jUe2+;xVoCg zVkswhiqEJT-;VTV`5wB=EK7|wZRT^;bzmD`*R|41MdgodNtKN=QvUFi9$kLJ|weCT94 z4Tv$wU=)>Lt5(l;^P`%KhR4fr{?MgXULOKVW8aYVOt>63&EKb?1^!<(FZdnniF;)J z^!pHnRanL54>p=7=WF0!oJ{rj8lGDE_5Hg&-iGp_3YfP!!mx2^#$fvBxi1Y| zx5=%DPXF>%CfDw6WGtbU##mi&(J3FG_LsbSPOfK|ya;`fMpb1ICzQOh2cDl2B)Xo4 zjH!|MZDzG*mW!^5R09pAFO_YpbMtW%$u5{7LvEW>r(N%}kMW(4f__H&Cf?w}^FIwY zkM2-L4B2zr4m}?&J+ijid!6K~Ds2UZwt?^ue{QH^LF*CC8K%QPRp_uXojp9<8p1u^ zGJ5|6BUc!G>&NCLYI?y>)%>z?YDQdLwagF=FLTBJ;j74OVep=;anX%2jQ zzBT@>%_L!LoW$e5T#4Z3<~Dl)^l)-CpTk>6mI|b?{Mobdv+HF1w>@wKSHw$(U07Ji zk)n7ZHjX3Ydm!j40l^CS(r6J#F^WYJDT3uhpufWdiRZ`h`0)ZECyMXHk%*H#c_LX{ ztcb(&AXssP;~8eT^AqsRi8Og5Fci5*JZOo>R|6cf91D`QhMN#G(~&x!J5 zuJK{hLlf)?q4)&f02v9v;?b7zvljf@6n#D2|IM0>R2DU0J$rM&f0*^VJ#+RsdwY{y oTu5vF*ygtzj5d$1pv&AnpEC*FLdK)F>YJT&PX!(mycMwJUuMtU(f|Me literal 0 HcmV?d00001 diff --git a/doc/type-hierarchy.ps b/doc/type-hierarchy.ps new file mode 100644 index 0000000000000000000000000000000000000000..cb63145ad61148f8ee687ed059dbb4ad9c6f085b GIT binary patch literal 6503 zcmbtZ&u{8D5WeTHm_1b5J+w{2@4Y;+U0z?Ms;ww*r5;lfASxv+gcgL}|GqQhiDQ$H zY~j!$nfUw0_RQF0_u{vw=gWSWyhfMamFrwwJO$I}PxuDkoa^^s3ws~N$#Mtt6!y_} zJo^Rl1eVG27lhFSo5TyftVHHXB?(8 z<9%m5Z}aErI{1iS5q&O$bmnYf2gtVy!g#ZWAPnI>`H0elKZps^Zb8x0^A3y;26#12 z6B?lThdf7s_J^<09Q68#;T`t+OMS&oOjp4U)=|p8`2H3zLYS_ib(*XqN1U(?R@BUE zfO=qm@-WLj%%e&A9;~M5??zj>>NPpkEHQS}M75f(YD6lT=#DSCe41L+2%KxwMBy|7 zKY!=GUl|G>#D1NwlD9~P@FSX|o8xf+6CB|rS)|~(upS54TYAAMpkK!rl?%WBb@$L8 zzFdx8o(6va^2Lj(>NIS15^Y8bM{ZVaupW2VU-wp2nu5H`U+{3}mhqZvV20V|3KX2-X+tGlV`~LHDt%0s?j|T1@ZfgNO4Y>KyA9ico zqx&=e-aU*4w}bjYd%2IF?`|Ik^?vZ!%N#^MAF43dIzTTUU+3|^nlkjET`HFobEX6(tvDts6IMRP3NKe8WA$tP<^Rt~lIT&$?#aSE>y)>m8&xvjMu>^B4BE`0yjg(Pw4j-?WUQ?m%DV=7 z!h(vj%xXJ_^7es+qXiXZ8MKo_c^?6Lf|ah+H{Be``w7_dt8}HvUXJ8_1?)Lex>6*j zh7Ki36WcYJvTUfBIXPHGjy=QJfP%c-vJp>e%K>YOMOVb8(Kf|iTgyduLZIyNTvrZw zy4aIqewKVnCJ+a9K1+A*rNzu!NK_V?B*lr%jv+P&C7F;&I+-j*C+BCA z10Ew}Rc4tyMGxu2#{o?qw31{dO~FIPAtvXc^Ei$wyJAu2ZjkJvkJ#1hqYV9cVZp0w zb|)j(3u@u$xiF6xbXQZffTK9af^1iv3JaK<=U9+k4XfUxW5B#Uu%JMNy^$9-WU^;T zHosPd1x)I5EXW?&sIY(ue~ty&N-;5x&Jr#L=U7lHNL47|N^xM|OTns^m#Rp@RpcB4 zYU!zRGc7UaSdew8DpqN?KQJLEBU(j6;aZ4RsRpWI3D=`DZAe-li6&g=#2 zXP1OW!Y9!n(In9#(I(L$(IwF%;VB4Xu&_7E3C+v(iNh5JOP^(fWs_x#Wt(M(WtU}- zC7NKcr+&1Nbu>;EA$`)OjP+LQcx85Y31;cDY_M#yY_V*!?6B;z?6E}i4EEHIHcw{> zymejTZ9VY)I!%YN>Rh$xGL`a|L&5Q~*Kx3P@Rn9Co0(A{coC~^pq>00EWiH3Fe={D z=0i6y|L^MTaPFM!x?8p^7b)WD|- YR6fzaKuE{Kaq>xA<6cTIh!&yq9|n|tdH?_b literal 0 HcmV?d00001 diff --git a/pkgdcl.lisp b/pkgdcl.lisp index a134ac1..5f439cd 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -3,7 +3,7 @@ ;;; Copyright (c) 2024 by Steven Nunez. All rights reserved. ;;; SPDX-License-identifier: BSD-3-Clause -(uiop:define-package #:binary-types +(uiop:define-package "BINARY-TYPES" (:use #:common-lisp) (:export #:*endian* ; [dynamic-var] must be bound when reading integers #:endianess ; [deftype] The set of endian names @@ -23,11 +23,16 @@ #:s256 ; [type-name] 256-bit signed integer ; (you may define additional integer types ; of any size yourself.) + #:f16 ; [type-name] IEEE-754 16-bit float + #:f32 ; [type-name] IEEE-754 32-bit float + #:f64 ; [type-name] IEEE-754 64-bit float ;; type defining macros #:define-unsigned ; [macro] declare an unsigned-int type #:define-signed ; [macro] declare a signed-int type #:define-binary-struct ; [macro] declare a binary defstruct type #:define-binary-class ; [macro] declare a binary defclass type + #:define-binary-vector ; [macro] declare a binary vector type + #:define-binary-array ; [macro] declare a binary array type #:define-bitfield ; [macro] declare a bitfield (symbolic integer) type #:define-enum ; [macro] declare an enumerated type #:define-binary-string ; [macro] declare a string type @@ -59,4 +64,4 @@ #:*padding-byte* ; [dynamic-var] The value filled in when writing paddings #:split-bytes ; [func] utility #:merge-bytes) ; [func] utility - (:documentation "BINARY-TYPES documenation")) + (:documentation "Read and write binary data to streams. This is useful when interfacing to external systems, like C, or in reading binary file formats, such as data files or music. Using a declarative syntax you can define the structure of the binary file, and then load it with all the definitions populated. There is also a stream based interface for reading/writing individual elements.")) diff --git a/tests/pkgdcl.lisp b/tests/pkgdcl.lisp index 7d0051b..88bc0e6 100644 --- a/tests/pkgdcl.lisp +++ b/tests/pkgdcl.lisp @@ -2,5 +2,5 @@ ;;; Copyright (c) 2024 by Symbolics Pte. Ltd. All rights reserved. ;;; SPDX-License-identifier: BSD-3-Clause -(uiop:define-package :binary-types/tests +(uiop:define-package "BINARY-TYPES/TESTS" (:use :cl :binary-types :clunit :array-operations :flexi-streams :num-utils.num=)) diff --git a/tests/tests.lisp b/tests/tests.lisp index 3ad0cbb..fc40f43 100644 --- a/tests/tests.lisp +++ b/tests/tests.lisp @@ -5,24 +5,10 @@ (defsuite binary-types ()) -;;; If these test are failing on your system, you might want to take -;;; note of the values you get from the following. The tests were -;;; developed on: -;; CL-USER> (lisp-implementation-type) -;; "Clozure Common Lisp" -;; CL-USER> (lisp-implementation-version) -;; "Version 1.12.2 (v1.12.2-16-gc4df19e6) WindowsX8664" - -;; (integer-length most-negative-fixnum) ;=> 60 -;; most-negative-fixnum = -1152921504606846976 -;; most-positive-fixnum = 1152921504606846975 -;; CL-USER> (expt 2 60) -;; 1152921504606846976 - (deftest vectors (binary-types) - ;; unsigned 32 bit + ;; u32 (let* ((binary-types:*endian* :little-endian) (test-vector #(1 2 3 4 10 9 8 7)) binary-to ;write lisp vector INTO this variable @@ -36,7 +22,7 @@ (assert-true (num= test-vector binary-from))) - ;; signed 32 bit + ;; s32 (let* ((binary-types:*endian* :little-endian) (test-vector #(1 -2 3 -4 10 -9 8 7)) binary-to @@ -50,7 +36,35 @@ (assert-true (num= test-vector binary-from))) - ;; signed 64 bit + ;; f32 + (let* ((binary-types:*endian* :little-endian) + (test-vector #(1.1s0 -2.2s0 3.3s0 -4.4s0 10.1s0 -9.9s0 8.8s0 7.7s0)) + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq f32 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + + ;; f64 + (let* ((binary-types:*endian* :little-endian) + (test-vector #(1.1d0 -2.2d0 3.3d0 -4.4d0 10.1d0 -9.9d0 8.8d0 7.7d0)) + binary-to + binary-from) + + (eval `(define-binary-vector binary-seq f64 ,(length test-vector))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-seq out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-seq in))) + (assert-true (num= test-vector binary-from))) + + + ;; s64 (let* ((binary-types:*endian* :little-endian) (test-vector `#(,most-negative-fixnum 1 -2 3 -4 10 -9 8 7 @@ -140,6 +154,7 @@ (read-binary 'binary-arr in))) (assert-true (num= test-array binary-from))) + ;; s32 (let* ((binary-types:*endian* :little-endian) (test-array #2A((1 -2 3 -4 10 -9 8 7) @@ -154,6 +169,21 @@ (read-binary 'binary-arr in))) (assert-true (num= test-array binary-from))) + + ;; f32 + (let* ((binary-types:*endian* :little-endian) + (test-array (aops:rand '(2 8) 'single-float)) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr f32 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; u64 (let* ((binary-types:*endian* :little-endian) (test-array (make-array '(2 8) @@ -169,6 +199,7 @@ (read-binary 'binary-arr in))) (assert-true (num= test-array binary-from))) + ;; s64 (let* ((binary-types:*endian* :little-endian) (test-array (make-array '(2 8) @@ -184,6 +215,21 @@ (read-binary 'binary-arr in))) (assert-true (num= test-array binary-from))) + + ;; f64 + (let* ((binary-types:*endian* :little-endian) + (test-array (aops:rand '(2 8) 'double-float)) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr f64 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + ;; u128 ;; (integer-length (expt 2 125)) => 126 (let* ((binary-types:*endian* :little-endian) @@ -200,7 +246,11 @@ (read-binary 'binary-arr in))) (assert-true (num= test-array binary-from))) - ;; multi-dimensional arrays + + + ;;; multi-dimensional arrays + + ;; u32 (let* ((binary-types:*endian* :little-endian) (test-array #3A(((12 5 9) (6 5 6) @@ -215,6 +265,20 @@ binary-from) (eval `(define-binary-array binary-arr u32 ',(aops:dims test-array))) + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-arr out test-array))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-arr in))) + (assert-true (num= test-array binary-from))) + + + ;; f64 + (let* ((binary-types:*endian* :little-endian) + (test-array (aops:rand '(3 3) 'double-float)) + binary-to + binary-from) + + (eval `(define-binary-array binary-arr f64 ',(aops:dims test-array))) (setf binary-to (with-output-to-sequence (out) (write-binary 'binary-arr out test-array))) (setf binary-from (with-input-from-sequence (in binary-to) From 42d4eaec8a16d2aaa0ee9ac746df909e3981ebdf Mon Sep 17 00:00:00 2001 From: Symbolics Date: Mon, 6 May 2024 17:03:19 +0800 Subject: [PATCH 10/13] Clean up documentation --- Makefile | 41 ----------------------------------------- NOTES.org | 14 ++++++++------ README.md | 4 ++-- 3 files changed, 10 insertions(+), 49 deletions(-) delete mode 100644 Makefile diff --git a/Makefile b/Makefile deleted file mode 100644 index d6e1cbe..0000000 --- a/Makefile +++ /dev/null @@ -1,41 +0,0 @@ -###################################################################### -## -## Copyright (C) 2001,2000,1999, 2003 -## Department of Computer Science, University of Tromsø, Norway -## -## Filename: Makefile -## Author: Frode Vatvedt Fjeld -## Created at: Wed Sep 29 19:28:52 1999 -## -## $Id: Makefile,v 1.1.1.1 2004/01/13 11:13:13 ffjeld Exp $ -## -###################################################################### - -SCP = scp -oProtocol=1 -SSH = ssh -1 -DIST_EXTRAS = README README-bitfield ChangeLog COPYING type-hierarchy.ps type-hierarchy.png - -dist: binary-types.lisp $(DIST_EXTRAS) - @ if [ ! "${VER}" ]; then echo 'You must set $$VER!'; exit 5; fi - mkdir binary-types-$(VER) - cp *.lisp $(DIST_EXTRAS) binary-types-$(VER) - tar czf binary-types-$(VER).tar.gz binary-types-$(VER) - rm -rf binary-types-$(VER) - -updist: dist - - $(SSH) www.stud "mv www/sw/binary-types/*.tar.gz www/sw/binary-types/old" - $(SCP) binary-types-$(VER).tar.gz www.stud:www/sw/binary-types/ - $(SCP) $(DIST_EXTRAS) www.stud:www/sw/binary-types/ - @ echo "Remember cvs TAG REL_x_xx" - -repdist: dist - - $(SSH) www.stud "rm www/sw/binary-types/*.tar.gz" - $(SCP) binary-types-$(VER).tar.gz www.stud:www/sw/binary-types/ - $(SCP) $(DIST_EXTRAS) www.stud:www/sw/binary-types/ - @ echo "Remember cvs TAG REL_x_xx" - -clean: - rm -f *.fasl memdump *~ - -force: - diff --git a/NOTES.org b/NOTES.org index 62cae0e..8afb456 100644 --- a/NOTES.org +++ b/NOTES.org @@ -103,7 +103,7 @@ SBCL has an [[https://github.com/sbcl/sbcl/blob/ac267f21721663b196aefe4bfd998416 closest rational given the ~mantissa~, ~exponent~ and ~sign~. The algorithm is reproduced here: - +#+BEGIN_EXAMPLE Algorithm (recursively presented): If x is a rational number, return x. If x = 0.0, return 0. @@ -132,10 +132,10 @@ Algorithm (recursively presented): k := c-1 ; k = floor(a), k < a < b <= k+1 return y = k + 1/fraction_between(1/(b-k), 1/(a-k)) ; note 1 <= 1/(b-k) < 1/(a-k) - +#+END_EXAMPLE You can see that we are actually computing a continued fraction expansion in the above version. - +#+BEGIN_EXAMPLE Algorithm (iterative): If x is rational, return x. Call (integer-decode-float x). It returns a m,e,s (mantissa, @@ -157,13 +157,14 @@ Algorithm (iterative): At the end, return s * (p[i]/q[i]). This rational number is already in lowest terms because p[i]*q[i-1]-p[i-1]*q[i] = (-1)^i. - +#+END_EXAMPLE +#+BEGIN_EXAMPLE See also Hardy, Wright: An introduction to number theory and/or - +#+END_EXAMPLE You can get the mantissa, exponent and sign using the [[http://clhs.lisp.se/Body/f_dec_fl.htm][floating point functions of Common Lisp]]. An alternative to implementing ~long-float~ in CL considered, but not @@ -288,6 +289,7 @@ mathematics to fail. Be careful with floating point! If these test are failing on your system, you might want to take note of the values you get from the following. The tests were developed on: +#+BEGIN_EXAMPLE CL-USER> (lisp-implementation-type) "Clozure Common Lisp" CL-USER> (lisp-implementation-version) @@ -298,7 +300,7 @@ most-negative-fixnum = -1152921504606846976 most-positive-fixnum = 1152921504606846975 CL-USER> (expt 2 60) 1152921504606846976 - +#+END_EXAMPLE * Generating a class diagram The postscript file "type-hierarchy.ps" shows the binary types diff --git a/README.md b/README.md index 6414452..09a8e57 100644 --- a/README.md +++ b/README.md @@ -75,7 +75,7 @@ Support most kinds of binary types including: * 32 and 64 bit IEEE-754 floats map to lisp `single-float` and `double-float`. - * Supports NaN and infinities + * NaN and infinities ### History @@ -169,7 +169,7 @@ should be careful to always provide a legal value in the slot (as you must always do when declaring slots' types). If you find this confusing, just use `:BINARY-TYPE`. -![type hierarchy](./docs/type-hierarchy.png) +![type hierarchy](./doc/type-hierarchy.png) ### Bitfields From e9066e3de51f585148a9cdfacb4c6424f6ab8e9d Mon Sep 17 00:00:00 2001 From: Symbolics Date: Wed, 8 May 2024 10:16:28 +0800 Subject: [PATCH 11/13] Address SBCL warnings, add tests for composite types --- binary-types.asd | 2 +- binary-types.lisp | 58 ++++++++++++++++++++++++----------------------- pkgdcl.lisp | 1 + tests/tests.lisp | 40 ++++++++++++++++++++++++++++++++ 4 files changed, 72 insertions(+), 29 deletions(-) diff --git a/binary-types.asd b/binary-types.asd index 032b7de..e0782e6 100644 --- a/binary-types.asd +++ b/binary-types.asd @@ -7,7 +7,7 @@ :description "A library for reading and writing binary records." :long-description #.(uiop:read-file-string (uiop:subpathname *load-pathname* "description.text")) - :version "1.0.0" + :version "1.0.1" :author "Frode V. Fjeld" :maintainer "Steven Nunez" :license :BSD-3-Clause diff --git a/binary-types.lisp b/binary-types.lisp index 650aceb..82e8bb9 100644 --- a/binary-types.lisp +++ b/binary-types.lisp @@ -35,33 +35,6 @@ means that the endianess is determined by the dynamic value of *endian*." "*endian* must be (dynamically) bound to either :big-endian or :little-endian while reading endian-sensitive types.") -;;; ---------------------------------------------------------------- -;;; Binary Types Namespace -;;; ---------------------------------------------------------------- - -(defvar *binary-type-namespace* (make-hash-table :test #'eq) - "Maps binary type's names (which are symbols) to their binary-type class object.") - -(defun find-binary-type (name &optional (errorp t)) - (or (gethash name *binary-type-namespace*) - (if errorp - (error "Unable to find binary type named ~S." name) - nil))) - -(defun (setf find-binary-type) (value name) - (check-type value binary-type) - (let ((old-value (find-binary-type name nil))) - (when (and old-value (not (eq (class-of value) (class-of old-value)))) - (warn "Redefining binary-type ~A from ~A to ~A." - name (type-of old-value) (type-of value)))) - (setf (gethash name *binary-type-namespace*) value)) - -(defun find-binary-type-name (type) - (maphash #'(lambda (key val) - (when (eq type val) - (return-from find-binary-type-name key))) - *binary-type-namespace*)) - ;;; ---------------------------------------------------------------- ;;; Base Binary Type (Abstract) ;;; ---------------------------------------------------------------- @@ -102,6 +75,33 @@ means that the endianess is determined by the dynamic value of *endian*." (print-unreadable-object (object stream :type 'binary-type) (format stream "~A" (binary-type-name object)))) +;;; ---------------------------------------------------------------- +;;; Binary Types Namespace +;;; ---------------------------------------------------------------- + +(defvar *binary-type-namespace* (make-hash-table :test #'eq) + "Maps binary type's names (which are symbols) to their binary-type class object.") + +(defun find-binary-type (name &optional (errorp t)) + (or (gethash name *binary-type-namespace*) + (if errorp + (error "Unable to find binary type named ~S." name) + nil))) + +(defun (setf find-binary-type) (value name) + (check-type value binary-type) + (let ((old-value (find-binary-type name nil))) + (when (and old-value (not (eq (class-of value) (class-of old-value)))) + (warn "Redefining binary-type ~A from ~A to ~A." + name (type-of old-value) (type-of value)))) + (setf (gethash name *binary-type-namespace*) value)) + +(defun find-binary-type-name (type) + (maphash #'(lambda (key val) + (when (eq type val) + (return-from find-binary-type-name key))) + *binary-type-namespace*)) + ;;; ---------------------------------------------------------------- ;;; Integer Type (Abstract) ;;; ---------------------------------------------------------------- @@ -1042,6 +1042,8 @@ binding is shadowed." (funcall ,save-brb-var s))))) ,@body))) +;; Siebel, and SBCL, warn against this style. Consider making them +;; all keyword parameters in the next release. (defmacro with-binary-output-to-vector ((stream-var &optional (vector-or-size-form 0) &key (adjustable (and (integerp vector-or-size-form) @@ -1153,7 +1155,7 @@ otherwise the value of BODY." (check-type size (integer 1 *)) (check-type endian endianess) `(progn - (deftype ,name () '(ieee-754 ,(* 8 size))) + (deftype ,name () 'float) (setf (find-binary-type ',name) (make-instance 'binary-float 'name ',name diff --git a/pkgdcl.lisp b/pkgdcl.lisp index 5f439cd..83a3863 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -29,6 +29,7 @@ ;; type defining macros #:define-unsigned ; [macro] declare an unsigned-int type #:define-signed ; [macro] declare a signed-int type + #:define-float ; [macro] declare a IEEE-754 float #:define-binary-struct ; [macro] declare a binary defstruct type #:define-binary-class ; [macro] declare a binary defclass type #:define-binary-vector ; [macro] declare a binary vector type diff --git a/tests/tests.lisp b/tests/tests.lisp index fc40f43..ef430b6 100644 --- a/tests/tests.lisp +++ b/tests/tests.lisp @@ -294,3 +294,43 @@ ;; "quad precision" (128-bit) we'll add the tests. + +(deftest composite (binary-types) + + ;; vector of vectors + (let* ((binary-types:*endian* :little-endian) + (test-vector #(#(0.9143338203430176d0 0.21972346305847168d0 0.9707512855529785d0 0.5962116718292236d0 0.6005609035491943d0 0.5940588712692261d0 0.2837725877761841d0 0.009566903114318848d0 0.8435225486755371d0 0.22492897510528564d0) + #(0.8314709663391113d0 0.2795267105102539d0 0.5844146013259888d0 0.7568612098693848d0 0.9189847707748413d0 0.007325291633605957d0 0.3114813566207886d0 0.5958571434020996d0 0.07142329216003418d0 0.7225879430770874d0) + #(0.6982585191726685d0 0.42384862899780273d0 0.8679864406585693d0 0.3627190589904785d0 0.3574702739715576d0 0.7974770069122314d0 0.5154801607131958d0 0.4812943935394287d0 0.48626482486724854d0 0.9495172500610352d0))) + binary-to + binary-from) + + (eval `(define-binary-vector bve f64 10)) ;binary vector elements + (eval `(define-binary-vector binary-vec bve 3)) ;the outmost vector + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-vec out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-vec in))) + (assert-true (num= test-vector binary-from))) + + ;; vector of arrays + ;; This really is an optional functionality. If you need to read vectors of arrays, do it in a loop + #+(or) + (let* ((binary-types:*endian* :little-endian) + #+nil + (test-vector `#(,(aops:rand '(3 3)) ;a vector of 4 3x3 arrays of single-float + ,(aops:rand '(3 3)) + ,(aops:rand '(3 3)) + ,(aops:rand '(3 3)))) + binary-to + binary-from) + + (eval `(define-binary-array bae f32 '(3 3))) ;binary array elements, a 3x3 array of single-float + (eval `(define-binary-vector binary-vec bae 4)) ;vector of 4 'bae + (setf binary-to (with-output-to-sequence (out) + (write-binary 'binary-vec out test-vector))) + (setf binary-from (with-input-from-sequence (in binary-to) + (read-binary 'binary-vec in))) + (assert-true (num= test-vector binary-from))) + + ) From ea2c9846f0ccf47c0f30b8e787ec7c64bbbf244a Mon Sep 17 00:00:00 2001 From: Symbolics Date: Sun, 29 Sep 2024 18:09:03 +0800 Subject: [PATCH 12/13] Return lisp types in vectors and arrays Previously binary-types (f32, etc) were being returned and these are not useful on the lisp side. --- arrays.lisp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/arrays.lisp b/arrays.lisp index eae79d7..58bd82c 100644 --- a/arrays.lisp +++ b/arrays.lisp @@ -42,7 +42,8 @@ (binary-vector-size type))) (defun read-binary-vector (stream type size) - (let ((vec (make-array (list size) :element-type type)) + (let ((vec (make-array (list size) :element-type (cond ((eq type 'f64) 'double-float) + ((eq type 'f32) 'single-float)))) (read-bytes 0)) (dotimes (i size) (multiple-value-bind (obj bytes) @@ -105,7 +106,8 @@ (binary-array-dimensions type))) (defun read-binary-array (stream type size dimensions) - (let ((arr (make-array dimensions :element-type type)) + (let ((arr (make-array dimensions :element-type (cond ((eq type 'f64) 'double-float) + ((eq type 'f32) 'single-float)))) (read-bytes 0)) (dotimes (i size) (multiple-value-bind (obj bytes) From 2120db129824758c9c8b14643329d043c672177b Mon Sep 17 00:00:00 2001 From: Steve Nunez Date: Wed, 26 Mar 2025 08:41:59 +0800 Subject: [PATCH 13/13] Add description .gitignore prevented description.text from appearing. Forced added because it is neccessary for compilation. --- description.text | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 description.text diff --git a/description.text b/description.text new file mode 100644 index 0000000..7380dfa --- /dev/null +++ b/description.text @@ -0,0 +1,34 @@ +BINARY-TYPES is a Common Lisp system for reading and writing binary files. Binary-types provides macros that are used to declare the mapping between lisp objects and most binary (i.e. octet-based) representations. Binary-types is *not* helpful in reading files with variable bit-length code-words, such as most compressed file formats. It will basically only work with file-formats based on 8-bit bytes (octets). + + +Objectives + +Support most kinds of binary types including: + + * Signed and unsigned integers of any octet-size, big-endian or + little-endian. Maps to lisp integers. + + * Enumerated types based on any integer type. Maps to lisp symbols. + + * Complex bit-field types based on any integer type. Sub-fields can + be numeric, enumerated, or bit-flags. Maps to lisp lists of symbols + and integers. + + * Fixed-length and null-terminated strings. Maps to lisp strings. + + * Compound records of other binary types. Maps to lisp `DEFCLASS` + classes or, when you prefer, `DEFSTRUCT` structs. + + * Vectors and arrays of integers and floats. + + * 32 and 64 bit IEEE-754 floats map to lisp `single-float` and `double-float`. + + + +History + +BINARY-TYPES was developed over the years 1999-2003 by Frode Vatvedt Fjeld whilst working at the Department of Computer Science, University of Tromsø, Norway. It later served as the basis for [Chapter 24: Parsing Binary Files](https://gigamonkeys.com/book/practical-parsing-binary-files) of the book [Practical Common Lisp](https://gigamonkeys.com/book/) by Peter Seibel. That chapter makes a good technical reference for the system, and you should read it if you want to extend BINARY-TYPES. + +Frode's version was sufficiently well done that the system went largely unchanged since except for some local additions for [slitch](https://github.com/sharplispers/slitch/tree/master) a low-level networking library in 2003 and then again in a [fork by Olof-Joachim Frahm](https://github.com/Ferada/binary-types/commits/master/) in 2013 that added 256 bit integers. + +This repository began in 2024 and adds support for 32/64 bit IEEE-754 floats, binary arrays/vectors, improved documentation and refactored the repository/ASDF system.