anchor.diff:  
   
   
  + 
   ;;;; PortableInterceptor::ORBInitializer
   ;;  local interface ORBInitializer {
  
positive.code:   (call-next-method))
  
  
  
  ;;;; PortableInterceptor:ORBInitInfo operations
  
  
negative.code:     ((:system_exception) PortableInterceptor::SYSTEM_EXCEPTION)
      ((:location_forward) PortableInterceptor::LOCATION_FORWARD)))
  
  
  (define-method "FORWARD_REFERENCE" ((self client-request-info))
    (object-forward (request-target (the-request self))))  
  
  
  
  ;; Local methods
  
  
  (define-method "TARGET" ((self client-request-info))
     (request-target (the-request self)))
  
  (define-method "EFFECTIVE_TARGET" ((self client-request-info))
    (let ((target (request-target (the-request self))))
      (or (object-forward target) target)))
  
  ;; readonly attribute IOP::TaggedProfile effective_profile;
  (define-method "EFFECTIVE_PROFILE" ((self client-request-info))
    (let* ((req (the-request self))
           (p (request-effective-profile req))
           (obj (op:effective_target self))
           (n (position p (object-profiles obj))))
      (elt (raw-profiles obj) n)))
  
  
  ;;; readonly attribute any received_exception;
  
  ;; This attribute is an any that contains the exception to be returned to the client.
  
  ;; If the exception is a user exception that cannot be inserted into an any (for
  ;; example, it is unknown or the bindings don't provide the TypeCode), then this
  ;; attribute will be an any containing the system exception UNKNOWN with 
  ;; a standard minor code of 1. However, the RepositoryId of the exception is available
  ;; in the received_exception_id attribute.
  
  (define-method "RECEIVED_EXCEPTION" ((self client-request-info))
    (let ((exc (request-exception (the-request self))))
      (CORBA:Any :any-value exc
                 :any-typecode (any-typecode exc))))
  
  
  ;;; readonly attribute CORBA::RepositoryId received_exception_id;
  ;; This attribute is the CORBA::RepositoryId of the exception to be returned to the client.
  
  (define-method "RECEIVED_EXCEPTION_ID" ((self client-request-info))
    (request-exception-id (the-request self)))
  
  
  (define-method "GET_EFFECTIVE_COMPONENT" ((self client-request-info) _ID)
    (DECLARE (IGNORE _ID))
    (raise-system-exception 'CORBA:NO_IMPLEMENT))
  
  (define-method "GET_EFFECTIVE_COMPONENTS" ((self client-request-info) _ID)
    (DECLARE (IGNORE _ID))
    (raise-system-exception 'CORBA:NO_IMPLEMENT))
  
  (define-method "GET_REQUEST_POLICY" ((self client-request-info)
                                       _TYPE)
    (DECLARE (IGNORE _TYPE))
    (raise-system-exception 'CORBA:NO_IMPLEMENT))
  
  (defmacro %add-service-context (req context-accessor service_context replace)
    `(let ((service_context ,service_context)
           (replace ,replace)
           (self ,req))
       (let* ((list (,context-accessor self))
              (old (find (op:context_id service_context) list
                         :key #'op:context_id)))
         (when old
           (unless replace
             (raise-system-exception 'CORBA:bad_inv_order 11 :completed_no))
           (setf list (delete old list)))
         (setf (,context-accessor self) (cons service_context list)))))
  
  (define-method "ADD_REQUEST_SERVICE_CONTEXT" ((self client-request-info)
                                                      service_context replace)
    (%add-service-context (the-request self) service-context-list 
                          service_context replace))
  
  
  
  
  ;;;; ServerRequestInfo methods
  
  (defclass server-request-info (base-request-info
                                 PortableInterceptor:ServerRequestInfo)
    ())
  
  
  ;; Base overrides
  
  (define-method "REPLY_STATUS" ((self server-request-info))
    (raise-system-exception 'CORBA:NO_IMPLEMENT))
  
  
  (define-method "FORWARD_REFERENCE" ((self server-request-info))
    (raise-system-exception 'CORBA:NO_IMPLEMENT))
  
  
  ;; Local methods
  
  (define-method "SENDING_EXCEPTION" ((self server-request-info))
    (request-exception (the-request self)))
  