From dc2d6f1f89baed05e6e7b6eb1eb3b9ad9b9e6e78 Mon Sep 17 00:00:00 2001 From: John Connors Date: Wed, 13 Aug 2008 02:20:34 +0100 Subject: [PATCH] Alignment bug --- lodematron-read.lisp | 38 +++++++++++++++++++------------------- lodematron-rw.lisp | 8 ++++---- lodematron-write.lisp | 24 ++++++++++++------------ package.lisp | 3 ++- 4 files changed, 37 insertions(+), 36 deletions(-) diff --git a/lodematron-read.lisp b/lodematron-read.lisp index b699298..92b76d1 100644 --- a/lodematron-read.lisp +++ b/lodematron-read.lisp @@ -47,23 +47,23 @@ performed by calling (align-for-read self bytes)." (,read-once)))))) -(defmethod read-value ((type (eql 'u8)) (self stream) &key (array-size 0) (alignment 1) (endian :little)) +(defmethod read-value ((type (eql :u8)) (self stream) &key (array-size 0) (alignment 0) (endian :little)) (declare (ignore endian)) (with-size-and-alignment-read (unsigned-byte 8) alignment array-size (read-byte self))) -(defmethod read-value ((type (eql 's8)) (self stream) &key (array-size 0) (alignment 1) (endian :little)) +(defmethod read-value ((type (eql :s8)) (self stream) &key (array-size 0) (alignment 0) (endian :little)) (declare (ignore endian)) (with-size-and-alignment-read (unsigned-byte 8) alignment array-size - (let ((u8 (read-value 'u8 self))) + (let ((u8 (read-value :u8 self))) (if (> u8 #X7F) (- u8 #X100) u8)))) -(defmethod read-value ((type (eql 'u16)) (self stream) &key (array-size 0) (alignment 1) (endian :little)) +(defmethod read-value ((type (eql :u16)) (self stream) &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-read (unsigned-byte 16) alignment array-size (ccase endian @@ -78,15 +78,15 @@ performed by calling (align-for-read self bytes)." (setf (ldb (byte 8 0) u16) (read-byte self)) u16))))) -(defmethod read-value ((type (eql 's16)) (self stream) &key (array-size 0) (alignment 1) (endian :little)) +(defmethod read-value ((type (eql :s16)) (self stream) &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-read (unsigned-byte 16) alignment array-size - (let ((u16 (read-value 'u16 self :endian endian))) + (let ((u16 (read-value :u16 self :endian endian))) (if (> u16 #X7FFF) (- u16 #X10000) u16)))) -(defmethod read-value ((type (eql 'u32)) (self stream) &key (array-size 0) (alignment 1) (endian :little)) +(defmethod read-value ((type (eql :u32)) (self stream) &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-read (unsigned-byte 32) alignment array-size (ccase endian @@ -105,15 +105,15 @@ performed by calling (align-for-read self bytes)." (setf (ldb (byte 8 0) u32) (read-byte self)) u32))))) -(defmethod read-value ((type (eql 's32)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :s32)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-read (unsigned-byte 32) alignment array-size - (let ((u32 (read-value 'u32 self :endian endian))) + (let ((u32 (read-value :u32 self :endian endian))) (if (> u32 #X7FFFFFFF) (- u32 #X100000000) u32)))) -(defmethod read-value ((type (eql 'u64)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :u64)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-read (unsigned-byte 64) alignment array-size (ccase endian @@ -140,27 +140,27 @@ performed by calling (align-for-read self bytes)." (setf (ldb (byte 8 0) u64) (read-byte self)) u64))))) -(defmethod read-value ((type (eql 's64)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :s64)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-read (unsigned-byte 32) alignment array-size - (let ((u64 (read-value 'u64 self :endian endian))) + (let ((u64 (read-value :u64 self :endian endian))) (if (> u64 #X7FFFFFFFFFFFFFFF) (- u64 #X10000000000000000) u64)))) -(defmethod read-value ((type (eql 'float32)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :float32)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-read (unsigned-byte 32) alignment array-size - (let ((u32 (read-value 'u32 self :endian endian))) + (let ((u32 (read-value :u32 self :endian endian))) (ieee-floats::decode-float32 u32)))) -(defmethod read-value ((type (eql 'float64)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :float64)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-read (unsigned-byte 32) alignment array-size - (let ((u64 (read-value 'u64 self :endian endian))) + (let ((u64 (read-value :u64 self :endian endian))) (ieee-floats::decode-float64 u64)))) -(defmethod read-value ((type (eql 'asciiz)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :asciiz)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) "Read a number of zero terminated ascii strings from the stream" (declare (ignorable endian)) (with-size-and-alignment-read @@ -172,13 +172,13 @@ performed by calling (align-for-read self bytes)." (vector-push-extend (code-char byte) result)) ;; to do - a byte isn't a char, use octets-to-string? result))) -(defmethod read-value ((type (eql 'nstring32)) (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod read-value ((type (eql :nstring32)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) "Read a string preceeded with a 32 bit length from the stream" (declare (ignorable endian)) (with-size-and-alignment-read t alignment array-size (let ((result (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))) - (let ((string-length (read-value 'u32 self :array-size 0 :alignment alignment :endian endian))) + (let ((string-length (read-value :u32 self :array-size 0 :alignment alignment :endian endian))) (iterate (for index from 0 below string-length) (for byte = (read-byte self)) diff --git a/lodematron-rw.lisp b/lodematron-rw.lisp index 7d5e445..5e4890c 100755 --- a/lodematron-rw.lisp +++ b/lodematron-rw.lisp @@ -25,11 +25,11 @@ (defun slot->read-value (spec file-data) (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec) - `(setf ,name (read-value ',(find-symbol (symbol-name type)) ,file-data ,@args)))) + `(setf ,name (read-value ,(as-keyword type) ,file-data ,@args)))) (defun slot->write-value (spec file-data) (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec) - `(write-value ',(find-symbol (symbol-name type)) ,file-data ,name ,@args))) + `(write-value ,(as-keyword type) ,file-data ,name ,@args))) @@ -41,7 +41,7 @@ (defclass ,name () ,(mapcar #'slot->defclass-slot slots)) ;; generate a method to read all slots - (defmethod read-value ((,typevar (eql ',name)) ,binary-data-var &key (alignment 1) (array-size 0) (endian :little)) + (defmethod read-value ((,typevar (eql,(as-keyword name))) ,binary-data-var &key (alignment 0) (array-size 0) (endian :little)) (declare (ignore endian)) (assert (= array-size 0)) (align-for-read ,binary-data-var alignment) @@ -51,7 +51,7 @@ ,@(mapcar #'(lambda (x) (slot->read-value x binary-data-var)) slots)) ,objectvar)) ;; generate a method to write all slots - (defmethod write-value ((,typevar (eql ',name)) ,binary-data-var ,objectvar &key (alignment 1) (array-size 0) (endian :little)) + (defmethod write-value ((,typevar (eql ,(as-keyword name))) ,binary-data-var ,objectvar &key (alignment 0) (array-size 0) (endian :little)) (declare (ignore endian)) (assert (= array-size 0)) (align-for-write ,binary-data-var alignment) diff --git a/lodematron-write.lisp b/lodematron-write.lisp index 127f711..c664717 100644 --- a/lodematron-write.lisp +++ b/lodematron-write.lisp @@ -31,19 +31,19 @@ (,write-once (elt ,value-sym ,index))) (,write-once ,value-sym)))))) -(defmethod write-value ((type (eql 'u8)) (self stream) value &key array-size alignment (endian :little)) +(defmethod write-value ((type (eql :u8)) (self stream) value &key array-size (alignment 0) (endian :little)) (declare (ignore endian)) (with-size-and-alignment-write alignment array-size value (write-byte value self))) -(defmethod write-value ((type (eql 's8)) (self stream) value &key array-size alignment (endian :little)) +(defmethod write-value ((type (eql :s8)) (self stream) value &key array-size (alignment 0) (endian :little)) (declare (ignore endian)) (with-size-and-alignment-write alignment array-size value (write-byte value self))) -(defmethod write-value ((type (eql 'u16)) (self stream) value &key array-size alignment (endian :little)) +(defmethod write-value ((type (eql :u16)) (self stream) value &key array-size alignment (endian :little)) (with-size-and-alignment-write alignment array-size value (ccase endian @@ -56,7 +56,7 @@ (write-byte (ldb (byte 8 8) u16) self) (write-byte (ldb (byte 8 0) u16) self)))))) -(defmethod write-value ((type (eql 's16)) (self stream) value &key (array-size 0) (alignment 1) (endian :little)) +(defmethod write-value ((type (eql :s16)) (self stream) value &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-write alignment array-size value (ccase endian @@ -70,7 +70,7 @@ (write-byte (ldb (byte 8 0) s16) self)))))) -(defmethod write-value ((type (eql 'u32)) (self stream) value &key (array-size 0) (alignment 1) (endian :little)) +(defmethod write-value ((type (eql :u32)) (self stream) value &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-write alignment array-size value (ccase endian @@ -87,7 +87,7 @@ (write-byte (ldb (byte 8 8) u32) self) (write-byte (ldb (byte 8 0) u32) self)))))) -(defmethod write-value ((type (eql 's32)) (self stream) value &key (array-size 0) (alignment 1) (endian :little)) +(defmethod write-value ((type (eql :s32)) (self stream) value &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-write alignment array-size value (ccase endian @@ -104,7 +104,7 @@ (write-byte (ldb (byte 8 8) s32) self) (write-byte (ldb (byte 8 0) s32) self)))))) -(defmethod write-value ((type (eql 'float32)) value (self stream) &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod write-value ((type (eql :float32)) value (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-write alignment array-size value (let ((u32 (ieee-floats::encode-float32 value))) @@ -120,7 +120,7 @@ (write-byte (ldb (byte 8 8) u32) self) (write-byte (ldb (byte 8 0) u32) self)))))) -(defmethod write-value ((type (eql 'u64)) (self stream) value &key (array-size 0) (alignment 1) (endian :little)) +(defmethod write-value ((type (eql :u64)) (self stream) value &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-write alignment array-size value (ccase endian @@ -145,7 +145,7 @@ (write-byte (ldb (byte 8 8) u64) self) (write-byte (ldb (byte 8 0) u64) self)))))) -(defmethod write-value ((type (eql 's64)) (self stream) value &key (array-size 0) (alignment 1) (endian :little)) +(defmethod write-value ((type (eql :s64)) (self stream) value &key (array-size 0) (alignment 0) (endian :little)) (with-size-and-alignment-write alignment array-size value (ccase endian @@ -170,7 +170,7 @@ (write-byte (ldb (byte 8 8) s64) self) (write-byte (ldb (byte 8 0) s64) self)))))) -(defmethod write-value ((type (eql 'float64)) (self stream) value &key ( array-size 0 ) ( alignment 1 ) (endian :little)) +(defmethod write-value ((type (eql :float64)) (self stream) value &key ( array-size 0 ) ( alignment 0 ) (endian :little)) (with-size-and-alignment-write alignment array-size value (let ((u64 (ieee-floats::encode-float64 value))) @@ -195,7 +195,7 @@ (write-byte (ldb (byte 8 0) u64) self)))))) -(defmethod write-value ((type (eql 'asciiz)) (self stream) string &key (array-size 0) (alignment 1) endian) +(defmethod write-value ((type (eql :asciiz)) (self stream) string &key (array-size 0) (alignment 0) endian) (declare (ignore endian)) (with-size-and-alignment-write alignment array-size string @@ -205,7 +205,7 @@ (write-char char self)) (write-char #\Nul self)))) -(defmethod write-value ((type (eql 'nstring32)) (self stream) string &key (array-size 0) (alignment 1) endian) +(defmethod write-value ((type (eql :nstring32)) (self stream) string &key (array-size 0) (alignment 0) endian) (with-size-and-alignment-write alignment array-size string (progn diff --git a/package.lisp b/package.lisp index ce6c13d..f42c5f6 100644 --- a/package.lisp +++ b/package.lisp @@ -2,6 +2,7 @@ (in-package :cl-user) (defpackage :lodematron - (:use :cl :cl-tuples :mixamesh :ieee-floats :iterate)) + (:use :cl :cl-tuples :mixamesh :ieee-floats :iterate) + (:export read-value write-value define-binary-class null-terminate string-id id-string)) (in-package :lodematron) -- 2.11.4.GIT