Permalink
Browse files

add stream functions for floats

  • Loading branch information...
froydnj committed Nov 3, 2012
1 parent 5329684 commit 736a9b339e195ed8f835f98e53c914a32aca8687
Showing with 99 additions and 5 deletions.
  1. +21 −0 macro-utils.lisp
  2. +20 −5 package.lisp
  3. +58 −0 streams.lisp
View
@@ -7,22 +7,43 @@
(intern (format nil "~:[U~;S~]B~D~A/~:[LE~;BE~]"
signedp bitsize desc big-endian-p))))
+(defun float-fun-name (float-type big-endian-p desc)
+ (let ((*package* (find-package :nibbles)))
+ (intern (format nil "IEEE-~A-~A/~:[LE~;BE~]"
+ float-type desc big-endian-p))))
+
(defun byte-ref-fun-name (bitsize signedp big-endian-p)
(byte-fun-name bitsize signedp big-endian-p "REF"))
+(defun float-ref-fun-name (float-type big-endian-p)
+ (float-fun-name float-type big-endian-p "REF"))
+
(defun byte-set-fun-name (bitsize signedp big-endian-p)
(byte-fun-name bitsize signedp big-endian-p "SET"))
+(defun float-set-fun-name (float-type big-endian-p)
+ (float-fun-name float-type big-endian-p "SET"))
+
(defun stream-ref-fun-name (bitsize readp signedp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~:[WRITE~;READ~]-~:[U~;S~]B~D/~:[LE~;BE~]"
readp signedp bitsize big-endian-p))))
+(defun stream-float-ref-fun-name (float-type readp big-endian-p)
+ (let ((*package* (find-package :nibbles)))
+ (intern (format nil "~:[WRITE~;READ~]-IEEE-~A~:[LE~;BE~]"
+ readp float-type big-endian-p))))
+
(defun stream-seq-fun-name (bitsize readp signedp big-endian-p)
(let ((*package* (find-package :nibbles)))
(intern (format nil "~:[WRITE~;READ~]-~:[U~;S~]B~D/~:[LE~;BE~]-SEQUENCE"
readp signedp bitsize big-endian-p))))
+(defun stream-float-seq-fun-name (float-type readp big-endian-p)
+ (let ((*package* (find-package :nibbles)))
+ (intern (format nil "~:[WRITE~;READ~]-IEEE-~A/~:[LE~;BE~]-SEQUENCE"
+ readp float-type big-endian-p))))
+
(defun internalify (s)
(let ((*package* (find-package :nibbles)))
(intern (concatenate 'string "%" (string s)))))
View
@@ -8,10 +8,6 @@
(:export #:ub16ref/le #:ub16ref/be #:sb16ref/le #:sb16ref/be
#:ub32ref/le #:ub32ref/be #:sb32ref/le #:sb32ref/be
#:ub64ref/le #:ub64ref/be #:sb64ref/le #:sb64ref/be)
- ;; Floating-point octet vector accessors.
- ;; Not supported on all platforms.
- (:export #:ieee-single-ref/be #:ieee-single-ref/le
- #:ieee-double-ref/be #:ieee-double-ref/le)
;; Stream readers.
(:export #:read-ub16/le #:read-ub16/be #:read-sb16/be #:read-sb16/le
#:read-ub32/le #:read-ub32/be #:read-sb32/be #:read-sb32/le
@@ -40,4 +36,23 @@
#:write-ub32/le-sequence #:write-ub32/be-sequence
#:write-sb32/le-sequence #:write-sb32/be-sequence
#:write-ub64/le-sequence #:write-ub64/be-sequence
- #:write-sb64/le-sequence #:write-sb64/be-sequence))
+ #:write-sb64/le-sequence #:write-sb64/be-sequence)
+ ;; The following floating-point functions are not supported on all platforms.
+ ;; Floating-point octet vector accessors.
+ (:export #:ieee-single-ref/be #:ieee-single-ref/le
+ #:ieee-double-ref/be #:ieee-double-ref/le)
+ ;; Floating-point stream readers.
+ (:export #:read-ieee-single/be #:read-ieee-single/le
+ #:read-ieee-double/be #:read-ieee-double/le)
+ ;; Stream readers for floating-point sequences.
+ (:export #:read-ieee-single/be-sequence #:read-ieee-single/le-sequence
+ #:read-ieee-double/be-sequence #:read-ieee-double/le-sequence)
+ ;; Non-consing variants akin to READ-SEQUENCE.
+ (:export #:read-ieee-single/be-into-sequence #:read-ieee-single/le-into-sequence
+ #:read-ieee-double/be-into-sequence #:read-ieee-double/le-into-sequence)
+ ;; Stream writers.
+ (:export #:write-ieee-single/be #:write-ieee-single/le
+ #:write-ieee-double/be #:write-ieee-double/le)
+ ;; Stream writers for sequences.
+ (:export #:write-ieee-single/be-sequence #:write-ieee-single/le-sequence
+ #:write-ieee-double/be-sequence #:write-ieee-double/le-sequence))
View
@@ -107,3 +107,61 @@
(read-into-vector* stream seq start end
,n-bytes #',byte-fun))))) into forms
finally (return `(progn ,@forms)))
+
+#.(loop for i from 0 upto #b111
+ for float-type = (if (logbitp 2 i) 'double 'single)
+ for readp = (logbitp 1 i)
+ for big-endian-p = (logbitp 0 i)
+ for name = (stream-float-ref-fun-name float-type readp big-endian-p)
+ for n-bytes = (ecase float-type (double 8) (single 4))
+ for single-fun = (if readp
+ (float-ref-fun-name float-type big-endian-p)
+ (float-set-fun-name float-type big-endian-p))
+ for arglist = (if readp '(stream) '(float stream))
+ for subfun = (if readp 'read-byte* 'write-byte*)
+ for element-type = (ecase float-type (double 'double-float) (single 'single-float))
+ collect `(defun ,name ,arglist
+ (,subfun ,@arglist ,n-bytes #',single-fun)) into forms
+ if readp
+ collect `(defun ,(stream-float-seq-fun-name float-type t big-endian-p)
+ (result-type stream count)
+ ,(format-docstring "Return a sequence of type RESULT-TYPE, containing COUNT elements read from STREAM. Each element is a ~A read in ~:[little~;big~]-endian byte order. RESULT-TYPE must be either CL:VECTOR or CL:LIST. STREAM must have an element type of (UNSIGNED-BYTE 8)."
+ element-type)
+ (ecase result-type
+ (list
+ (let ((list (make-list count)))
+ (read-into-list* stream list 0 count
+ ,n-bytes #',single-fun)))
+ (vector
+ (let ((vector (make-array count
+ :element-type ',element-type)))
+ (read-into-vector* stream vector 0 count
+ ,n-bytes #',single-fun))))) into forms
+ else
+ collect `(defun ,(stream-float-seq-fun-name float-type nil big-endian-p)
+ (seq stream &key (start 0) end)
+ ,(format-docstring "Write elements from SEQ between START and END as ~As in ~:[little~;big~]-endian byte order to STREAM. SEQ may be either a vector or a list. STREAM must have an element type of (UNSIGNED-BYTE 8)."
+ element-type)
+ (etypecase seq
+ (list
+ (mapc (lambda (e) (,name e stream))
+ (subseq seq start end)))
+ (vector
+ (loop with end = (or end (length seq))
+ for i from start below end
+ do (,name (aref seq i) stream)
+ finally (return seq))))) into forms
+ if readp
+ collect `(defun ,(intern (format nil "READ-IEEE-~A/~:[LE~;BE~]-INTO-SEQUENCE"
+ float-type big-endian-p))
+ (seq stream &key (start 0) end)
+ ,(format-docstring "Destructively modify SEQ by replacing the elements of SEQ between START and END with elements read from STREAM. Each element is a ~A read in ~:[little~;big~]-endian byte order. SEQ may be either a vector or a list. STREAM must have na element type of (UNSIGNED-BYTE 8)."
+ element-type)
+ (etypecase seq
+ (list (read-into-list* stream seq start end
+ ,n-bytes #',single-fun))
+ (vector
+ (let ((end (or end (length seq))))
+ (read-into-vector* stream seq start end
+ ,n-bytes #',single-fun))))) into forms
+ finally (return `(progn ,@forms)))

0 comments on commit 736a9b3

Please sign in to comment.