anchor.diff:  (defparameter *default-packing* 4
     "Default packing boundary.")
   
  -(defun %define-packet-type (name slots &key packing size)
  -  "Define a new composite type.
  -
  -NAME is any symbol to refer to the new type.
  -
  -SLOTS is a list of (SLOT-NAME SLOT-TYPE &rest SLOT-OPTIONS) where SLOT-NAME 
  -is a symbol for access to the CLOS object's slot. SLOT-TYPE is either a symbol
  -for the slot's type or (SLOT-TYPE LENGTH) for an array of objects.
  -
  -Set PACKING to an integer to use a non-default packing width.
  -
  -Set SIZE to set the total type size. This cannot be smaller than the minumum required buffer size."
  -  (unless packing 
  -    (setf packing *default-packing*))
  -  ;; first need to go through the slots and find the starting offsets for each slot and total packet size
  +(defun compute-real-slots (slots packing &optional size)
  +  "Compute the offsets of each slot. We use this information in the closures
  +generated by DEFPACKET to pack/unpack the object."
     (let ((real-slots nil)
   		(offset 0))
       (dolist (slot slots)
  
positive.code: 							 (first slot-type)
  							 slot-type)))
  
  		  (push (list slot-name slot-type arrayp length offset)
  				real-slots)
  		  
  		  (setf offset 
  				(round-offset (+ offset (* (type-size slot-type) length))
  							  packing)))))
      (cond
        ((not size)
         (setf size offset))
        ((< size offset)
         (error "Packet size ~S is smaller than total packet size ~S" size offset)))
  
      ;; we have to reverse them becuase they were pushed on so are in reverse order
      (setf real-slots (nreverse real-slots))
  
      (%define-type name 
  				  (lambda (object buffer start)
  					(block packer
  					  ;; if the object is null then return immediately
  					  (unless object
  						(return-from packer buffer))
  					  ;; iterate over the structure slots
  					  (dolist (slot real-slots)
  						(destructuring-bind (slot-name slot-type arrayp length offset) slot
  						  (let ((value (slot-value object slot-name)))
  							(cond
  							  ((not arrayp)
  							   (pack-type value  slot-type buffer (+ start offset)))
  							  ((null value)
  							   ;; ignore arrays given as nil, this means an empty array
  							   nil)
  							  ((eq slot-type :string)
  							   ;; special case handling for strings. there must be a better way of doing this!!!
  							   (if (stringp value)
  								   (pack-string value length buffer (+ start offset))
  								   (error "Cannot pack ~S as :string for slot ~S" value slot-name)))
  							  ((<= (length value) length)
  							   (pack-array value slot-type buffer (+ start offset)))
  							  (t (error "Array for slot ~S is too large" slot-name))))))
  					  buffer))
  				  (lambda (buffer start)
  					(block unpacker			
  					  (let ((object (make-instance name)))
  						(dolist (slot real-slots)
  						  (destructuring-bind (slot-name slot-type arrayp length offset) slot
  							(cond
  							  ((not arrayp)
  							   (setf (slot-value object slot-name)
  									 (unpack-type slot-type buffer (+ start offset))))
  							  ((eq slot-type :string)
  							   (setf (slot-value object slot-name)
  									 (unpack-string length buffer (+ start offset))))
  							  (t
  							   (setf (slot-value object slot-name)
  									 (unpack-array length slot-type buffer (+ start offset)))))))
  
  						object)))
  				  size))
    name)
  
  (defmacro defpacket (name slots &rest options)
    "Macro to simplify defining the CLOS class and packet type.
  
  SLOTS should be a list of format (SLOT-NAME SLOT-TYPE &rest SLOT-OPTIONS). 
  
  
negative.code: 
  OPTIONS can contain (:packing PACKING) and (:size SIZE). These are used to 
  set the packing width and total packet size. All other options are passed to defclass."
    (let ((gpacking (gensym "PACKING"))
  		(gsize (gensym "SIZE")))
  	`(progn
  	   ;; define the CLOS class
  	   (defclass ,name ()
  		 ,(mapcar (lambda (slot)
  					(destructuring-bind (slot-name slot-type &rest slot-options) slot
  					  (declare (ignore slot-type))
  					  `(,slot-name ,@slot-options)))
  				  slots)
  		 ,@(mapcan (lambda (option)
  					 (unless (member (car option) '(:packing :size))
  					   (list option)))
  				   options))
  	   
  	   ;; define the new packet type
  	   (let ((,gpacking ,(let ((p (cadr (assoc :packing options))))
  							  (if p p '*default-packing*))))
  		 (multiple-value-bind (slots ,gsize)
  			 (compute-real-slots
  			  (list ,@(mapcar (lambda (slot)
  								(destructuring-bind (slot-name slot-type &rest slot-options) slot
  								  (declare (ignore slot-options))
  								  (if (listp slot-type)
  									  `(list ',slot-name (list ',(car slot-type) ,(cadr slot-type)))
  									  `(list ',slot-name ',slot-type))))
  							  slots))
  			  ,gpacking
  			  ,(cadr (assoc :size options)))
  		   (%define-type ',name
  						 (lambda (object buffer start)
  						   (pack-object object slots buffer start))
  						 (lambda (buffer start)
  						   (unpack-object (make-instance ',name) slots buffer start))
  						 ,gsize)))
  	   ',name)))
  
  
  (defun pack (object type)
  