anchor.diff:  							 (first slot-type)
   							 slot-type)))
   
  +		  ;; check it is a real type
  +		  (unless (get-type slot-type)
  +			(error "Slot type ~S not found." slot-type))
  +
  +		  ;; check it it's an array that an integer length was provided
  +		  (when (and arrayp (not (integerp length)))
  +			(error "Array lenth ~S not an integer." length))
  +		  
  +		  ;; check it's not a string without length
  +		  (when (and (eq slot-type :string) (not arrayp))
  +			(error "Strings must be given an explicit length."))
  +
  +		  ;; all ok, push the slot info onto the list
   		  (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)))
  -
  +
  +		  ;; compute the offset of the next slot
  +		  (let ((type-size (type-size slot-type)))
  +			(setf offset 
  +				  (round-offset (+ offset (* type-size length))
  +								packing))))))
  +
  +	;; check the size, if given
  +	(when (and size (< size offset))
  +	  (error "Explicit packet size ~S smaller than minumum 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)
  +    (values (nreverse real-slots)
  +			offset
  +			(if size size offset))))
  +
  +;; we define some functions to pack/unpack CLOS objects.
  +;; It is probably possible to convert this to a generic function and have
  +;; defpacket generate a defmethod ??? That should be more efficient/nicer?
  +
  +(defun pack-object (object slots buffer start)
  +  "Pack an OBJECT specified by SLOTS into the BUFFER starting at offset START."
  +  (unless object
  +	(return-from pack-object buffer))
  +  
  +  ;; iterate over the structure slots
  +  (dolist (slot 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)
  +		   (error "Array for slot ~S is too large" slot-name))
  +		  (t 
  +		   (pack-array value slot-type buffer (+ start offset)))))))
  +  buffer)
  +
  +(defun unpack-object (object slots buffer start)
  +  "Unpack the SLOTS of OBJECT from BUFFER starting at offset START."
  +  (dolist (slot 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)
   
   (defmacro defpacket (name slots &rest options)
  -  "Macro to simplify defining the CLOS class and packet type.
  +  "Macro to define the CLOS class and packet type.
   
   SLOTS should be a list of format (SLOT-NAME SLOT-TYPE &rest SLOT-OPTIONS). 
   
  
positive.code: (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
    (let ((real-slots nil)
  		(offset 0))
      (dolist (slot slots)
  
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)
  