anchor.diff:     (buffer-contents buffer)))
   
   (defun marshal-add-encapsulation (closure buffer)
  -  (declare (optimize speed))
  -  (marshal-align 4 buffer)
  -  (let* ((octets (buffer-octets buffer))
  -         (len-pos (fill-pointer octets))
  -         (old-start-pos (buffer-start-pos buffer)))
  -    (cond ((< (array-total-size octets)
  -             (+ len-pos 50))
  -           (adjust-array octets (+ len-pos 200)
  -                         :fill-pointer (+ len-pos 4)))
  -          (t
  -           (incf (fill-pointer octets) 4)))
  -    (setf (buffer-start-pos buffer) (fill-pointer octets))
  -    (marshal-octet 1 buffer)            ;byte order
  -    (funcall closure buffer)
  -    (let ((pos (fill-pointer octets)))
  -      (setf (fill-pointer octets) len-pos)
  -      (marshal-ulong (- pos (buffer-start-pos buffer)) buffer)
  -      (setf (fill-pointer octets) pos))
  -    (setf (buffer-start-pos buffer) old-start-pos)))
  +  ;;(declare (optimize speed))
  +  (with-out-buffer (buffer)
  +    (align 4)
  +    (let ((len-pos pos)
  +          (old-start-pos start-pos))
  +      (cond ((< (array-total-size octets)
  +                (+ len-pos 50))
  +             (adjust-array octets (+ len-pos 200)
  +                           :fill-pointer (+ len-pos 4)))
  +            (t
  +             (incf pos 4)))
  +      (setf (buffer-start-pos buffer) pos)
  +      (put-octet 1)            ;byte order
  +      (funcall closure buffer)
  +      (let ((save-pos pos))
  +        (setf pos len-pos)
  +        (marshal-ulong (- save-pos (buffer-start-pos buffer)) buffer)
  +        (setf pos save-pos))
  +      (setf (buffer-start-pos buffer) old-start-pos))))
   
   
   (defvar *marshal-typecode-record* nil)
  
positive.code:     (marshal-typecode tc buffer)
      (marshal (any-value arg) tc buffer)))
  
  (defun marshal-enum (arg enum-tc buffer)
    (declare (optimize speed))
    ;;(check-type arg (or symbol integer) "a CORBA enum (ingeger or keyword)")
    (let ((symbols (tc-keywords enum-tc)))
      (marshal-ulong 
       (if (integerp arg)
           arg
         (or (position arg symbols)
             (error 'type-error 
                    :datum arg 
                    :expected-type (concatenate 'list '(member) symbols))))
       buffer))) 
  
  
  
  
negative.code: ;;;; Marshal
  
  (in-package :clorb)
  
  
  ;;; should be in buffer:
  
  (defmacro with-out-buffer ((buffer &key (resize 400)) &body body)
    "Open upp buffer.
  In body: 
  - buffer     the buffer,
  - octets     the octet vector,
  - start-pos  start pos in octets for this work,
  - pos        current pos in octets (setf-able),
  - (align n)  align output to n octets (n must be litteral),
  - (put-octet n)  output octet n. "
    `(let* ((buffer ,buffer)
            (start-pos (buffer-start-pos buffer))
            (octets (buffer-octets buffer)))
       (declare (ignorable start-pos octets)
                (type buffer-index start-pos))
       (macrolet ((put-octet (n)
                    `(vector-push-extend ,n octets ,',resize))
                  (align (n) 
                    `(let ((skip (- ,n (logand (the buffer-index (- (fill-pointer octets) start-pos))
                                               (- ,n 1)))))
                       (declare (fixnum skip))
                       (when (< skip ,n)
                         (dotimes (x skip)
                           (declare (fixnum x))
                           (vector-push-extend 0 octets ,',resize))))))
         (symbol-macrolet ((pos (fill-pointer octets)))
           ,@body))))
  
  (defun buffer-pos (buffer)
    (fill-pointer (buffer-octets buffer)))
  
  
  
  (defun marshal-octet (n buffer)
    (declare (type buffer buffer)
             (optimize (speed 3) (debug 0)))
    (with-out-buffer (buffer) (put-octet n)))
  
  (defun marshal-bool (s buffer)
    (marshal-octet (if s 1 0) buffer))
  
  
  (defmacro %marshal-number (n size buffer &optional (align size))
    (let ((nvar '#:nvar)
          (nnvar '#:nnvar))
      `(with-out-buffer (,buffer)
         (let* (,@(if (> size 3) 
                    `((,nnvar ,n) 
                      (,nvar (logand ,nnvar #xFFFFFF)))
                    `((,nvar ,n))))
           (declare (type (integer #x-FFFFFF #xFFFFFF) ,nvar))
           (align ,align)
           (put-octet (logand #xFF ,nvar))
           ,@(loop for p from 8 by 8
                   for c from 1 below size
                   collect `(put-octet (ldb (byte 8 ,p) 
                                            ,(if (>= c 3) nnvar nvar))))))))
  
  
  (defun marshal-short (n buffer)
    (declare (type CORBA:short n)
             (optimize speed))
    (%marshal-number n 2 buffer))
  
  (defun marshal-ushort (n buffer)
    (declare (type (or CORBA:ushort CORBA:short) n)
             (optimize speed))
    (%marshal-number n 2 buffer))
  
  (defun marshal-ulong (n buffer)
    (declare (type CORBA:ulong n)
             (optimize speed))
    (%marshal-number n 4 buffer))
  
  (defun marshal-long (n buffer)
    (declare (type CORBA:long n)
             (optimize speed))
    (%marshal-number n 4 buffer))
  
  (defun marshal-longlong (arg buffer)
    (%marshal-number arg 8 buffer))
  
  (defun marshal-ulonglong (arg buffer)
    (%marshal-number arg 8 buffer))
  
  (defun marshal-char (char buffer)
    (marshal-octet (char-code char) buffer))
  
  (defun float-as-ieee-integer (number sign-bit fraction-bits bias)
    (multiple-value-bind (frac expn sign)
  