Peter Siebel - Practical Common Lisp

With this macro defined, the define-binary-typeform given previously expands to this code:

(progn

(defmethod read-value ((#:g1618 (eql 'iso-8859-1-string)) in &key length)

(let ((string (make-string length)))

(dotimes (i length)

(setf (char string i) (code-char (read-byte in))))

string))

(defmethod write-value ((#:g1618 (eql 'iso-8859-1-string)) out string &key length)

(dotimes (i length)

(write-byte (char-code (char string i)) out))))

Of course, now that you've got this nice macro for defining binary types, it's tempting to make it do a bit more work. For now you should just make one small enhancement that will turn out to be pretty handy when you start using this library to deal with actual formats such as ID3 tags.

ID3 tags, like many other binary formats, use lots of primitive types that are minor variations on a theme, such as unsigned integers in one-, two-, three-, and four-byte varieties. You could certainly define each of those types with define-binary-typeas it stands. Or you could factor out the common algorithm for reading and writing n -byte unsigned integers into helper functions.

But suppose you had already defined a binary type, unsigned-integer, that accepts a :bytesparameter to specify how many bytes to read and write. Using that type, you could specify a slot representing a one-byte unsigned integer with a type specifier of (unsigned-integer :bytes 1). But if a particular binary format specifies lots of slots of that type, it'd be nice to be able to easily define a new type—say, u1—that means the same thing. As it turns out, it's easy to change define-binary-typeto support two forms, a long form consisting of a :readerand :writerpair and a short form that defines a new binary type in terms of an existing type. Using a short form define-binary-type, you can define u1like this:

(define-binary-type u1 () (unsigned-integer :bytes 1))

which will expand to this:

(progn

(defmethod read-value ((#:g161887 (eql 'u1)) #:g161888 &key)

(read-value 'unsigned-integer #:g161888 :bytes 1))

(defmethod write-value ((#:g161887 (eql 'u1)) #:g161888 #:g161889 &key)

(write-value 'unsigned-integer #:g161888 #:g161889 :bytes 1)))

To support both long- and short-form define-binary-typecalls, you need to differentiate based on the value of the specargument. If specis two items long, it represents a long-form call, and the two items should be the :readerand :writerspecifications, which you extract as before. On the other hand, if it's only one item long, the one item should be a type specifier, which needs to be parsed differently. You can use ECASE to switch on the LENGTH of specand then parse specand generate an appropriate expansion for either the long form or the short form.

(defmacro define-binary-type (name (&rest args) &body spec)

(ecase (length spec)

(1

(with-gensyms (type stream value)

(destructuring-bind (derived-from &rest derived-args) (mklist (first spec))

`(progn

(defmethod read-value ((,type (eql ',name)) ,stream &key ,@args)

(read-value ',derived-from ,stream ,@derived-args))

(defmethod write-value ((,type (eql ',name)) ,stream ,value &key ,@args)

(write-value ',derived-from ,stream ,value ,@derived-args))))))

(2

(with-gensyms (type)

`(progn

,(destructuring-bind ((in) &body body) (rest (assoc :reader spec))

`(defmethod read-value ((,type (eql ',name)) ,in &key ,@args)

,@body))

,(destructuring-bind ((out value) &body body) (rest (assoc :writer spec))

`(defmethod write-value ((,type (eql ',name)) ,out ,value &key ,@args)

,@body)))))))

One last bit of functionality you'll need in the next chapter is a way to get at the binary object being read or written while reading and writing. More generally, when reading or writing nested composite objects, it's useful to be able to get at any of the objects currently being read or written. Thanks to dynamic variables and :aroundmethods, you can add this enhancement with about a dozen lines of code. To start, you should define a dynamic variable that will hold a stack of objects currently being read or written.

(defvar *in-progress-objects* nil)

Then you can define :aroundmethods on read-objectand write-objectthat push the object being read or written onto this variable before invoking CALL-NEXT-METHOD .

(defmethod read-object :around (object stream)

(declare (ignore stream))

(let ((*in-progress-objects* (cons object *in-progress-objects*)))

(call-next-method)))

(defmethod write-object :around (object stream)

(declare (ignore stream))

(let ((*in-progress-objects* (cons object *in-progress-objects*)))

(call-next-method)))

Note how you rebind *in-progress-objects*to a list with a new item on the front rather than assigning it a new value. This way, at the end of the LET , after CALL-NEXT-METHOD returns, the old value of *in-progress-objects*will be restored, effectively popping the object of the stack.

With those two methods defined, you can provide two convenience functions for getting at specific objects in the in-progress stack. The function current-binary-objectwill return the head of the stack, the object whose read-objector write-objectmethod was invoked most recently. The other, parent-of-type, takes an argument that should be the name of a binary object class and returns the most recently pushed object of that type, using the TYPEP function that tests whether a given object is an instance of a particular type.

(defun current-binary-object () (first *in-progress-objects*))

(defun parent-of-type (type)

(find-if #'(lambda (x) (typep x type)) *in-progress-objects*))

These two functions can be used in any code that will be called within the dynamic extent of a read-objector write-objectcall. You'll see one example of how current-binary-objectcan be used in the next chapter. [270] The ID3 format doesn't require the parent-of-type function since it's a relatively flat structure. This function comes into its own when you need to parse a format made up of many deeply nested structures whose parsing depends on information stored in higher-level structures. For example, in the Java class file format, the top-level class file structure contains a constant pool that maps numeric values used in other substructures within the class file to constant values that are needed while parsing those substructures. If you were writing a class file parser, you could use parent-of-type in the code that reads and writes those substructures to get at the top-level class file object and from there to the constant pool.