anchor.diff:              (apply #'make-instance (or (ifr-id-symbol (op:id tc)) 'value-box)
                      initargs))
              (t (second initargs))))))
  -   buffer :signed))
  -           
  +   buffer :chunk-tag))
  +
  +
  +
  +;;;; AbstractInterface
  +
  +
  +(define-typecode abstract_interface-typecode
  +  :kind :tk_abstract_interface
  +  :cdr-syntax (complex :tk_string :tk_string)
  +  :params (id name)
  +  :share named-typecode :shared-params 2)
  +
  +
  +(defmacro define-abstract-interface (symbol super &key (id "") proxy (name "") mixin)
  +  `(progn
  +     (set-symbol-id/typecode ',symbol ,id (create-abstract-interface-tc ,id ,name))
  +     (setf (get ',symbol 'ifr-bases) ',super)
  +     (defclass ,mixin () ())
  +     (defclass ,symbol (,mixin ,@super) ())
  +     ,@(if proxy
  +         `((defclass ,(car proxy) (,mixin ,@(cdr proxy)) ())
  +           (register-proxy-class ,id ',(car proxy))))
  +     (defmethod object-id ((obj ,mixin))
  +       ,id)
  +     (defmethod object-is-a or ((obj ,mixin) interface-id)
  +       (string= interface-id ,id))))
  +  
  +
  +(defmethod marshal (obj (tc abstract_interface-typecode) buffer)
  +  (assert (or (null obj) (op:_is_a obj (op:id tc))))
  +  (etypecase obj
  +    (CORBA:Proxy
  +     (marshal-bool t buffer)
  +     (marshal-object obj buffer))
  +    ((or NULL CORBA:ValueBase)
  +     (marshal-bool nil buffer)
  +     (marshal-value obj buffer))
  +    ;; this is doubtful as the spec says requires that
  +    ;; "the object is already registered with the ORB/OA"
  +    (CORBA:Object
  +     (marshal-bool t buffer)
  +     (marshal-object obj buffer))))
  +
  +
  +(defmethod unmarshal ((tc abstract_interface-typecode) buffer)
  +  (let ((case-label (unmarshal-bool buffer)))
  +    (if case-label
  +      (unmarshal-object buffer (op:id tc))
  +      (unmarshal-value buffer))))
  
positive.code:   (marshal-record box
                    (lambda (box buffer)
                      (let ((chunking (not (zerop *chunking-level*))))
                        (marshal-value-header nil chunking buffer)
                        (marshal-value-state chunking
                                             (list (box-data box))
                                             (list (op:content_type tc))
  
negative.code: 
  
  
  ;;;; Marshall Value
  
  
  (defvar *chunk-tail* nil)
  
  (defvar *chunk-start* nil)
  
  (defun start-chunk (buffer)
    (with-out-buffer (buffer)
      (align 4)
      (setq *chunk-start* pos)
      (incf pos 4)))
  
  (defun end-chunk (buffer)
    (when *chunk-start*
      (with-out-buffer (buffer)
        (if (= *chunk-start* (- pos 4))
          (incf pos -4)                   ; empty chunk, remove
          (let ((old-pos pos))
            (setf pos *chunk-start*)
            (marshal-long (- old-pos pos 4) buffer)
            (setf pos old-pos))))
      (setf *chunk-start* nil)))
  
  
  
  (defun marshal-value-header (repoid chunking buffer)
    ;; Write the value header with chunking flag if indicated and
    ;; with repoid, can be NIL - no id, a string, or a list of strings.
    (end-chunk buffer)
    (let ((tag min-value-tag))
      (if chunking (incf tag #x08))
      (when repoid (incf tag (if (consp repoid) #x06 #x02)))
  