(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED " 1-Nov-88 19:29:03" {ERIS}<LISPCORE>PATCHES>AR-10922-PATCH.\;1
 26117  

      |changes| |to:|  (VARS AR-10922-PATCHCOMS))


; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.

(PRETTYCOMPRINT AR-10922-PATCHCOMS)

(RPAQQ AR-10922-PATCHCOMS
 (
                               (* |;;| 

                             "Patch file AR-10922-PATCH.  Contains fixes for the AR(s) (10922).")


                               (ADDVARS (*FEATURES* :AR-10922))
                               (FUNCTIONS D-ASSEM::ASSEMBLE-CODE)
                               (PROP FILETYPE AR-10922-PATCH)))



(* |;;| "Patch file AR-10922-PATCH.  Contains fixes for the AR(s) (10922).")



(ADDTOVAR *FEATURES*
 :AR-10922)

(CL:DEFUN D-ASSEM::ASSEMBLE-CODE
 (D-ASSEM::LAP-CODE D-ASSEM::DEPTH D-ASSEM::BINDING-DEPTH)

(* |;;;| "Translate LAP code into D-machine bytecodes.")


   (CL:DO ((D-ASSEM::TAIL D-ASSEM::LAP-CODE (CDR D-ASSEM::TAIL))
           D-ASSEM::INST)
          ((CL:ENDP D-ASSEM::TAIL))
       (CL:SETQ D-ASSEM::INST (CL:FIRST D-ASSEM::TAIL))
       (CL:MACROLET
        ((D-ASSEM::INCR (D-ASSEM::VAR &OPTIONAL (D-ASSEM::DELTA 1))
                `(AND ,D-ASSEM::VAR (CL:SETQ ,D-ASSEM::VAR (+ ,D-ASSEM::VAR ,D-ASSEM::DELTA))))
         (D-ASSEM::DECR (D-ASSEM::VAR &OPTIONAL (D-ASSEM::DELTA 1))
                `(AND ,D-ASSEM::VAR (CL:SETQ ,D-ASSEM::VAR (- ,D-ASSEM::VAR ,D-ASSEM::DELTA)))))
        (CL:ECASE (CAR D-ASSEM::INST)
            ((:VAR) 
               (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::REF-VAR (CL:SECOND D-ASSEM::INST)))
               (D-ASSEM::INCR D-ASSEM::DEPTH)
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :VAR))
            ((:VAR_) (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::STORE-VAR (CL:SECOND D-ASSEM::INST)
                                                     (COND
                                                        ((EQ ':POP (CL:FIRST (CL:SECOND D-ASSEM::TAIL
                                                                                    )))
                                                         (CL:SETQ D-ASSEM::TAIL (CDR D-ASSEM::TAIL))
                                                         (D-ASSEM::DECR D-ASSEM::DEPTH)
                                                         (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                                                        (>= D-ASSEM::DEPTH 0))
                                                                NIL "Depth went negative in ~S." 
                                                                :VAR_)
                                                         T)
                                                        (T NIL)))))
            ((:COPY) 
               (D-ASSEM::EMIT-BYTE 'COPY)
               (D-ASSEM::INCR D-ASSEM::DEPTH)
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :COPY))
            ((:SWAP) (D-ASSEM::EMIT-BYTE 'SWAP))
            ((:CONST) 
               (LET* ((D-ASSEM::VALUE (CL:SECOND D-ASSEM::INST))
                      (D-ASSEM::LOOKUP (CL:ASSOC D-ASSEM::VALUE D-ASSEM::+CONSTANT-OPCODES+)))
                     (COND
                        ((NOT (NULL D-ASSEM::LOOKUP))
                         (D-ASSEM::EMIT-BYTE (CDR D-ASSEM::LOOKUP)))
                        ((CL:SYMBOLP D-ASSEM::VALUE)
                         (D-ASSEM::EMIT-BYTE-LIST `(ACONST (:SYM ,D-ASSEM::VALUE))))
                        ((CL:INTEGERP D-ASSEM::VALUE)
                         (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::PUSH-INTEGER D-ASSEM::VALUE)))
                        (T (D-ASSEM::EMIT-BYTE-LIST `(GCONST (:LIT ,D-ASSEM::VALUE))))))
               (D-ASSEM::INCR D-ASSEM::DEPTH)
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :CONST))
            ((:LAMBDA) 
               (LET ((D-ASSEM::DLAMBDA (CL:SECOND D-ASSEM::INST))
                     (D-ASSEM::LAMBDA-LEVEL (CL:THIRD D-ASSEM::INST)))
                    (COND
                       ((AND NIL (CL:ZEROP D-ASSEM::LAMBDA-LEVEL))
                                                             (* \; 

                           "We used to do something different for lambdas with empty environments.")

                        (D-ASSEM::EMIT-BYTE-LIST `(GCONST (:LAMBDA 0 ,D-ASSEM::DLAMBDA))))
                       (T 
                          (* |;;| "This will need to be a closure.  Find our best hunk for it and construct a closure object around it and the lambda.")


                          (D-ASSEM::EMIT-BYTE-LIST
                           `(SICX (:TYPE COMPILED-CLOSURE)
                                  CREATECELL GCONST (:LAMBDA ,D-ASSEM::LAMBDA-LEVEL 
                                                           ,D-ASSEM::DLAMBDA)
                                  RPLPTR.N 0 ,@(AND (NOT (CL:ZEROP D-ASSEM::LAMBDA-LEVEL))
                                                    `(,@(D-ASSEM::FETCH-HUNK D-ASSEM::LAMBDA-LEVEL)
                                                      RPLPTR.N 2))))))
                    (D-ASSEM::INCR D-ASSEM::DEPTH)
                    (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                   (>= D-ASSEM::DEPTH 0))
                           NIL "Depth went negative in ~S." :LAMBDA)))
            ((:POP) 
               (D-ASSEM::EMIT-BYTE 'POP)
               (D-ASSEM::DECR D-ASSEM::DEPTH)
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :POP))
            ((:NOTE-STACK)                                   (* \; 

                                                         "Now a no-op; used during stack analysis.")

)
            ((:SET-STACK :DSET-STACK) 
               (CL:FLET
                ((D-ASSEM::EMIT-UNWIND (D-ASSEM::DESIRED-DEPTH D-ASSEM::SAVE-TOS?)
                        (D-ASSEM::EMIT-BYTE-LIST `(UNWIND (:UNWIND ,D-ASSEM::DESIRED-DEPTH)
                                                         ,(CL:IF D-ASSEM::SAVE-TOS?
                                                              1
                                                              0)))))
                (LET*
                 ((D-ASSEM::SAVE-TOS? (EQ (CL:FIRST D-ASSEM::INST)
                                          :SET-STACK))
                  (D-ASSEM::LOOKUP (CL:GETHASH (CL:SECOND D-ASSEM::INST)
                                          D-ASSEM::*STACK-ENV*))
                  (D-ASSEM::DESIRED-DEPTH (CL:FIRST D-ASSEM::LOOKUP))
                  (D-ASSEM::DESIRED-BINDING-DEPTH (CL:MAPCAR 'CDR (CL:SECOND D-ASSEM::LOOKUP))))
                 (COND
                    ((NULL D-ASSEM::DEPTH)

                     (* |;;| "We don't know where we are: use UNWIND.")


                     (D-ASSEM::EMIT-UNWIND D-ASSEM::DESIRED-DEPTH D-ASSEM::SAVE-TOS?)
                     (CL:SETQ D-ASSEM::DEPTH D-ASSEM::DESIRED-DEPTH D-ASSEM::BINDING-DEPTH 
                            D-ASSEM::DESIRED-BINDING-DEPTH))
                    ((EQ (CL:FIRST D-ASSEM::BINDING-DEPTH)
                         (CL:FIRST D-ASSEM::DESIRED-BINDING-DEPTH))

                     (* |;;| "There are no intervening binds, so we can just pop.")


                     (CL:WHEN D-ASSEM::SAVE-TOS?
                         (CL:DECF D-ASSEM::DEPTH)
                         (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                        (>= D-ASSEM::DEPTH 0))
                                NIL "Depth went negative in ~S." :SET-STACK))
                     (LET ((D-ASSEM::ADJUSTMENT (- D-ASSEM::DEPTH D-ASSEM::DESIRED-DEPTH)))
                          (CL:IF (MINUSP D-ASSEM::ADJUSTMENT)
                                 (HELP "POP.N stack adjustment negative:  " D-ASSEM::ADJUSTMENT))
                          (CASE D-ASSEM::ADJUSTMENT
                              ((0) )
                              ((1) 
                                 (CL:IF D-ASSEM::SAVE-TOS?
                                     (D-ASSEM::EMIT-BYTE 'SWAP))
                                 (D-ASSEM::EMIT-BYTE 'POP))
                              (CL:OTHERWISE 
                                 (CL:IF D-ASSEM::SAVE-TOS?
                                     (CL:IF (<= D-ASSEM::ADJUSTMENT 128)

                                         (* |;;| 

                                     "STORE.N can only be used for distances less than this limit.")


                                         (D-ASSEM::EMIT-BYTE-LIST
                                          `(STORE.N ,(CL:* 2 (CL:1- D-ASSEM::ADJUSTMENT))
                                                  POP.N
                                                  ,(CL:1- D-ASSEM::ADJUSTMENT)))
                                         (D-ASSEM::EMIT-UNWIND D-ASSEM::DESIRED-DEPTH T))
                                     (CL:IF (<= D-ASSEM::ADJUSTMENT 256)

                                         (* |;;| 

                                       "POP.N can only be used for disatnces less than this limit.")


                                         (D-ASSEM::EMIT-BYTE-LIST `(POP.N ,(CL:1- D-ASSEM::ADJUSTMENT
                                                                                  )))
                                         (D-ASSEM::EMIT-UNWIND D-ASSEM::DESIRED-DEPTH NIL)))))
                          (CL:SETQ D-ASSEM::DEPTH D-ASSEM::DESIRED-DEPTH)))
                    ((AND (CL:EQUAL (CL:REST D-ASSEM::BINDING-DEPTH)
                                 D-ASSEM::DESIRED-BINDING-DEPTH)
                          (EQL D-ASSEM::DESIRED-DEPTH (CL:FIRST D-ASSEM::DESIRED-BINDING-DEPTH)))

                     (* |;;| "There is only one bind mark in the way - use UNBIND")


                     (D-ASSEM::EMIT-BYTE (CL:IF D-ASSEM::SAVE-TOS?
                                             'UNBIND
                                             'DUNBIND))
                     (CL:SETQ D-ASSEM::DEPTH (CL:POP D-ASSEM::BINDING-DEPTH))
                     (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                    (>= D-ASSEM::DEPTH 0))
                            NIL "Depth went negative in ~S." :|pop-of-binding-stack|))
                    (T 
                       (* |;;| "Use UNWIND in all other cases.")


                       (D-ASSEM::EMIT-UNWIND D-ASSEM::DESIRED-DEPTH D-ASSEM::SAVE-TOS?)
                       (CL:SETQ D-ASSEM::DEPTH D-ASSEM::DESIRED-DEPTH D-ASSEM::BINDING-DEPTH 
                              D-ASSEM::DESIRED-BINDING-DEPTH)
                       (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                      (>= D-ASSEM::DEPTH 0))
                              NIL "Depth went negative in ~S." :SET-STACK-USING-UNWIND)))
                 (CL:WHEN D-ASSEM::SAVE-TOS? (CL:INCF D-ASSEM::DEPTH)))))
            ((:BIND) (CL:LABELS
                      ((D-ASSEM::DO-BIND
                        (D-ASSEM::NUM-VALUES D-ASSEM::NUM-NILS D-ASSEM::STARTING-SLOT)
                        (COND
                           ((> D-ASSEM::NUM-VALUES 15)
                            (COMPILER:ASSEMBLER-ERROR 
                                 "Too many non-NIL values bound in a single :BIND: ~S.  Limit is 15."
                                   D-ASSEM::NUM-VALUES))
                           ((> D-ASSEM::NUM-NILS 15)
                            (D-ASSEM::DO-BIND D-ASSEM::NUM-VALUES 15 D-ASSEM::STARTING-SLOT)
                            (D-ASSEM::DO-BIND 0 (- D-ASSEM::NUM-NILS 15)
                                   (+ D-ASSEM::STARTING-SLOT D-ASSEM::NUM-VALUES 15)))
                           (T (D-ASSEM::EMIT-BYTE-LIST `(BIND
 ,(+ (LLSH D-ASSEM::NUM-NILS 4)
                                                                      D-ASSEM::NUM-VALUES)
                                                               ,(CL:1- (+ D-ASSEM::STARTING-SLOT 
                                                                          D-ASSEM::NUM-VALUES 
                                                                          D-ASSEM::NUM-NILS))))
                              (D-ASSEM::INCR D-ASSEM::DEPTH)))))
                      (LET* ((CL:VALUES (CL:SECOND D-ASSEM::INST))
                             (D-ASSEM::NUM-VALUES (CL:LENGTH CL:VALUES))
                             (D-ASSEM::NILS (CL:THIRD D-ASSEM::INST))
                             (D-ASSEM::NUM-NILS (CL:LENGTH D-ASSEM::NILS)))
                            (D-ASSEM::DECR D-ASSEM::DEPTH D-ASSEM::NUM-VALUES)
                            (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                           (>= D-ASSEM::DEPTH 0))
                                   NIL "Depth went negative in ~S." :BIND)
                            (CL:PUSH D-ASSEM::DEPTH D-ASSEM::BINDING-DEPTH)
                            (D-ASSEM::DO-BIND D-ASSEM::NUM-VALUES D-ASSEM::NUM-NILS
                                   (COND
                                      (CL:VALUES (D-ASSEM::DVAR-SLOT (CAR CL:VALUES)))
                                      (D-ASSEM::NILS (D-ASSEM::DVAR-SLOT (CAR D-ASSEM::NILS)))
                                      (T 1))))))
            ((:UNBIND :DUNBIND) 
               (LET ((BYTE (CASE (CL:FIRST D-ASSEM::INST)
                               (:UNBIND 'UNBIND)
                               (:DUNBIND 'DUNBIND))))
                    (CL:DOTIMES (D-ASSEM::I (CL:FLOOR (+ (CL:SECOND D-ASSEM::INST)
                                                         (CL:THIRD D-ASSEM::INST)
                                                         14)
                                                   15))
                        (D-ASSEM::EMIT-BYTE BYTE)))
               (CL:SETQ D-ASSEM::DEPTH (CL:POP D-ASSEM::BINDING-DEPTH))
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :UNBIND)
               (CL:IF (EQ (CL:FIRST D-ASSEM::INST)
                          ':UNBIND)
                      (D-ASSEM::INCR D-ASSEM::DEPTH)))
            ((:TAG) 
               (D-ASSEM::EMIT-BYTE `(:TAG ,(CL:SECOND D-ASSEM::INST)))
               (LET ((D-ASSEM::STACK-DEPTH (D-ASSEM::DTAG-STACK-DEPTH (CL:SECOND D-ASSEM::INST))))
                    (CL:SETQ D-ASSEM::DEPTH (CDR D-ASSEM::STACK-DEPTH))
                    (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                                   (>= D-ASSEM::DEPTH 0))
                           NIL "Depth went negative in ~S." :TAG)
                    (CL:SETQ D-ASSEM::BINDING-DEPTH (CL:MAPCAR 'CDR (CAR D-ASSEM::STACK-DEPTH)))))
            ((:PUSH-TAG) 
               (D-ASSEM::EMIT-BYTE D-ASSEM::INST)
               (D-ASSEM::INCR D-ASSEM::DEPTH))
            ((:JUMP)                                         (* \; 

                                                  "JUMP opcode does NOT pop anything off the stack")

               (D-ASSEM::EMIT-BYTE D-ASSEM::INST))
            ((:TJUMP :FJUMP :NTJUMP :NFJUMP)                 (* \; "Other jump opcodes DO pop (the NT & NF, only if the jump isn't taken).  Since we're looking at stack depth right after this instruction, this means we can assume the jump didn't happen....")

               (D-ASSEM::EMIT-BYTE D-ASSEM::INST)
               (D-ASSEM::DECR D-ASSEM::DEPTH)
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :JUMP))
            ((:CALL) 
               (DESTRUCTURING-BIND
                (D-ASSEM::FN-TO-CALL D-ASSEM::NUM-ARGS &KEY ((:NOT-INLINE D-ASSEM::NOT-INLINE?))
                       ((:SPREAD-LAST D-ASSEM::SPREAD-LAST?))(* \; "SPREAD-LAST? is the hook for APPLY and the interpreter hacks. Currently ignored. The idea is that you let the assembler put in the magic loop that spreads the last argument, and takes case of allocating the temps for that loop.")

                       )
                (CL:REST D-ASSEM::INST)
                (CL:TYPECASE D-ASSEM::FN-TO-CALL
                    (CL:SYMBOL                               (* \; "External call")

                       (LET ((D-ASSEM::DOPVAL (GET D-ASSEM::FN-TO-CALL 'DOPVAL)))
                            (CL:BLOCK :CALL-PROCESSING
                                (CL:UNLESS (OR D-ASSEM::NOT-INLINE? (NULL D-ASSEM::DOPVAL))
                                    (CL:ASSERT (CL:CONSP D-ASSEM::DOPVAL)
                                           '(D-ASSEM::FN-TO-CALL D-ASSEM::DOPVAL)
                                           "DOPVAL for ~S is not a list: ~S" D-ASSEM::FN-TO-CALL 
                                           D-ASSEM::DOPVAL)
                                    (FOR
 D-ASSEM::ITEM INSIDE
 (CL:IF (CL:ATOM (CAR 
                                                                                      D-ASSEM::DOPVAL
                                                                                           ))
                                                                          (LIST D-ASSEM::DOPVAL)
                                                                          D-ASSEM::DOPVAL)
                                       DO
 (COND
                                                 ((CL:ATOM D-ASSEM::ITEM)
                                                             (* \; 

                                         "The ITEM is OPT.COMPILERERROR.  Compile the call closed.")

                                                  (RETURN))
                                                 ((OR (NULL (CAR D-ASSEM::ITEM))
                                                      (= (CAR D-ASSEM::ITEM)
                                                         D-ASSEM::NUM-ARGS))
                                                  (COND
                                                     ((CL:CONSP (CDR D-ASSEM::ITEM))
                                                      (CL:MAPC 'D-ASSEM::EMIT-BYTE (CDR D-ASSEM::ITEM
                                                                                        ))
                                                      (CL:RETURN-FROM :CALL-PROCESSING))
                                                     (T      (* \; 

                    "The ITEM is something like (0 . OPT.COMPILERERROR).  Compile the call closed.")

                                                        (RETURN)))))))

                                (* |;;| 

                              "Either no DOPVAL or the DOPVAL failed.  Compile as a closed call.")


                                (COND
                                   ((<= D-ASSEM::NUM-ARGS 255)
                                    (D-ASSEM::EMIT-BYTE-LIST (CASE D-ASSEM::NUM-ARGS
                                                                 ((0) '(FN0))
                                                                 ((1) '(FN1))
                                                                 ((2) '(FN2))
                                                                 ((3) '(FN3))
                                                                 ((4) '(FN4))
                                                                 (CL:OTHERWISE 
                                                                    `(FNX ,D-ASSEM::NUM-ARGS))))
                                    (D-ASSEM::EMIT-BYTE `(:FN ,D-ASSEM::FN-TO-CALL)))
                                   (T 
                                      (* |;;| "Lots of arguments.  Call using APPLYFN.")


                                      (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::PUSH-INTEGER 
                                                                      D-ASSEM::NUM-ARGS))
                                      (D-ASSEM::EMIT-BYTE-LIST `(ACONST (:FN ,D-ASSEM::FN-TO-CALL)
                                                                       APPLYFN)))))))
                    (D-ASSEM::DVAR                           (* \; 

                                                         "Call a function that lives in a variable")

                       (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::PUSH-INTEGER D-ASSEM::NUM-ARGS))
                       (COND
                          ((EQ (D-ASSEM::DVAR-KIND D-ASSEM::FN-TO-CALL)
                               :FUNCTION)
                           (CL:ASSERT (NOT (NULL (D-ASSEM::DVAR-LEVEL D-ASSEM::FN-TO-CALL)))
                                  '(D-ASSEM::FN-TO-CALL)
                                  "BUG: The local function ~A should have a lexical level by now."
                                  (D-ASSEM::DVAR-NAME D-ASSEM::FN-TO-CALL))
                           (D-ASSEM::EMIT-BYTE-LIST `(GCONST (:LOCAL-FUNCTION ,D-ASSEM::FN-TO-CALL)))
                           (COND
                              ((AND NIL (CL:ZEROP (D-ASSEM::DVAR-LEVEL D-ASSEM::FN-TO-CALL)))
                                                             (* \; 

                                      "We used to do something different for an empty environment.")

                                                             (* \; "No non-locals -- use applyfn.")

                               (D-ASSEM::EMIT-BYTE 'APPLYFN))
                              (T (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::FETCH-HUNK (D-ASSEM::DVAR-LEVEL
                                                                                D-ASSEM::FN-TO-CALL))
                                        )
                                 (D-ASSEM::EMIT-BYTE 'ENVCALL))))
                          (T (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::REF-VAR D-ASSEM::FN-TO-CALL))
                             (D-ASSEM::EMIT-BYTE 'APPLYFN))))
                    (CONS (CL:ECASE (CL:FIRST D-ASSEM::FN-TO-CALL)
                              ((:OPCODES) (D-ASSEM::EMIT-BYTE-LIST (CL:REST D-ASSEM::FN-TO-CALL)))
                              ((:LAMBDA) 
                                 (D-ASSEM::EMIT-BYTE-LIST (D-ASSEM::PUSH-INTEGER D-ASSEM::NUM-ARGS))
                                 (LET ((D-ASSEM::DLAMBDA (CL:SECOND D-ASSEM::FN-TO-CALL))
                                       (D-ASSEM::LAMBDA-LEVEL (CL:THIRD D-ASSEM::FN-TO-CALL)))
                                      (COND
                                         ((AND NIL (CL:ZEROP D-ASSEM::LAMBDA-LEVEL))
                                                             (* \; 

                                      "We used to do something different for an empty environment.")


                                          (* |;;| "No closed-over variables: use APPLYFN.")


                                          (D-ASSEM::EMIT-BYTE-LIST `(GCONST (:LAMBDA 0 
                                                                                   ,D-ASSEM::DLAMBDA)
                                                                           APPLYFN)))
                                         (T 
                                            (* |;;| 

               "This will need to be a closure.  Find our best hunk for it and call using ENVCALL.")


                                            (D-ASSEM::EMIT-BYTE-LIST
                                             `(GCONST (:LAMBDA ,D-ASSEM::LAMBDA-LEVEL 
                                                             ,D-ASSEM::DLAMBDA)
                                                     ,@(D-ASSEM::FETCH-HUNK D-ASSEM::LAMBDA-LEVEL)
                                                     ENVCALL))))))))
                    (T (CL:ERROR "BUG: Weird argument to :CALL ~S" D-ASSEM::FN-TO-CALL)))
                (D-ASSEM::DECR D-ASSEM::DEPTH (CL:1- D-ASSEM::NUM-ARGS))
                (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                               (>= D-ASSEM::DEPTH 0))
                       NIL "Depth went negative in ~S." :CALL)))
            ((:STKCALL) 
               (D-ASSEM::EMIT-BYTE 'APPLYFN)
               (D-ASSEM::DECR D-ASSEM::DEPTH (CL:1+ (CL:SECOND D-ASSEM::INST)))
               (CL:ASSERT (OR (NOT D-ASSEM::DEPTH)
                              (>= D-ASSEM::DEPTH 0))
                      NIL "Depth went negative in ~S." :STKCALL))
            ((:RETURN) (D-ASSEM::EMIT-BYTE 'RETURN))
            ((:CLOSE)                                        (* \; 

                                                           "After digestion, this looks like this:")

                                                             (* \; 

                                                           "(:CLOSE dvars hunk-slot . code).")

               (D-ASSEM::CREATE-HUNK (+ (CL:LIST-LENGTH (CL:SECOND D-ASSEM::INST))
                                        (CL:IF (NULL D-ASSEM::*HUNK-MAP*)
                                                             (* \; "If this hunk is not at level 0, we need an extra hunk slot in order to link it to the previous one.")

                                            0
                                            1))
                      (CL:THIRD D-ASSEM::INST)
                      (CDAR D-ASSEM::*HUNK-MAP*)
                      T)
               (LET* ((D-ASSEM::*LEVEL* (CL:1+ D-ASSEM::*LEVEL*))
                      (D-ASSEM::*HUNK-MAP* (CONS (CONS D-ASSEM::*LEVEL* (CL:THIRD D-ASSEM::INST))
                                                 D-ASSEM::*HUNK-MAP*)))
                     (CL:SETQ D-ASSEM::DEPTH (D-ASSEM::ASSEMBLE-CODE (CDDDR D-ASSEM::INST)
                                                    D-ASSEM::DEPTH D-ASSEM::BINDING-DEPTH))
                     (CL:ASSERT (>= D-ASSEM::DEPTH 0)
                            (OR (NOT D-ASSEM::DEPTH))
                            NIL "Depth went negative in ~S." :CLOSE))))))
   D-ASSEM::DEPTH)

(PUTPROPS AR-10922-PATCH
 FILETYPE
 CL:COMPILE-FILE)
(PUTPROPS AR-10922-PATCH COPYRIGHT ("ENVOS Corporation" 1988))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP