(FILECREATED "18-Sep-86 14:24:19" {ERIS}<LISPCORE>SOURCES>ASTACK.;10
 40598  

      changes to:  (FNS \STKNAME)
                   (VARS ASTACKCOMS)

      previous date: "21-Jul-86 06:08:25" {ERIS}<LISPCORE>SOURCES>ASTACK.;9)


(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT ASTACKCOMS)

(RPAQQ ASTACKCOMS
 [(COMS (* ; "ARG and SETARG, unusual cases")
                         (FNS ARG SETARG \ARG \ARGPTR \SETARG))
                   (COMS (FNS \RETURN \STACKARGPTR))
                   (COMS (* ; "User level stack management")
                         (FNS STKNTH STKNTHNAME STKNAME SETSTKNAME \COPYFNHEADER)
                         (FNS STKPOS STKSCAN SETCLINK RETFROM RETTO RESUME \RESUME RESET ERROR!)
                         (FNS STKARG SETSTKARG STKARGNAME \SPREADFRAMEP SETSTKARGNAME STKNARGS 
                              FRAMESCAN \INTERPFRAMENT \FRAMESCAN \VAROFFSET))
                   (LOCALVARS . T)
                   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                          (ADDVARS (NLAMA)
                                 (NLAML SETARG ARG)
                                 (LAMA])



(* ; "ARG and SETARG, unusual cases")


(DEFINEQ

(ARG

  [NLAMBDA (VAR M)
                                           (* lmm "24-JUL-81 07:43")

    (GETBASEPTR \STACKSPACE (\ARGPTR
 VAR (\EVAL M])

(SETARG

  [NLAMBDA (VAR M X)
                                         (* lmm "24-JUL-81 07:43")

    (PUTBASEPTR \STACKSPACE (\ARGPTR
 VAR (\EVAL M))
           (\EVAL X])

(\ARG

  [LAMBDA (VAR M)
                                            (* lmm "24-JUL-81 07:43")

                                                             (* Version of ARG which doesn't EVAL 

                                                             2nd argument)

    (GETBASEPTR \STACKSPACE (\ARGPTR
 VAR M])

(\ARGPTR

  [LAMBDA (VAR N)
                                            (* lmm "13-FEB-83 14:17")

          
          (* * Returns a pointer to the basic frame corresponding to the lambda* variable 

          VAR, and tests that N is a legal arg#)


    (PROG ((FRAME (\MYALINK))
           (A (\ATOMVALINDEX VAR))
           (INTERPDEF (fetch
 (LITATOM DEFPOINTER) of
 (QUOTE \INTERPRETER)))
           BFLINK P DEF NARGS)
      LP  (COND
             ((fetch
 (FX INVALIDP) of
 FRAME)                 (* No frame found)

              (LISPERROR "ILLEGAL ARG" VAR)))
          (COND
             ((EQ (SETQ DEF (fetch
 (FX FNHEADER) of
 FRAME))
                  INTERPDEF)                                 (* See if this is \INTERPRETER running 

                                                             a LAMBDA*)

              (OR [AND (SETQ P (\VAROFFSET
 FRAME A))
                       (EQ P (IPLUS (fetch
 (BF IVAR) of
 (SETQ BFLINK (fetch
 (FX BLINK) of
 FRAME)))
                                    (UNFOLD (SETQ NARGS (SUB1 (fetch
 (BF NARGS) of
 BFLINK)))
                                           WORDSPERCELL]
                  (GO NXT)))
             [(AND (EQ (fetch
 (FNHEADER NA) of
 DEF)
                       -1)
                   (SETQ P (\VAROFFSET
 FRAME A))
                   (EQ P (fetch
 (FX FIRSTPVAR) of
 FRAME)))
              (SETQ NARGS (fetch
 (BF NARGS) of
 (SETQ BFLINK (fetch
 (FX BLINK) of
 FRAME]
             (T (GO NXT)))                                   (* Found the variable as the first 

                                                             PROG variable of a LSTARP frame)

          [RETURN (COND
                     ((AND (IGREATERP N 0)
                           (NOT (IGREATERP N NARGS)))
                      (IPLUS (fetch
 (BF IVAR) of
 BFLINK)
                             (UNFOLD (SUB1 N)
                                    WORDSPERCELL)))
                     (T (LISPERROR "ILLEGAL ARG" N]
      NXT (SETQ FRAME (fetch
 (FX ALINK) of
 FRAME))
          (GO LP])

(\SETARG

  [LAMBDA (VAR M X)
                                          (* lmm "24-JUL-81 07:43")

                                                             (* VERSION OF SETARG WHICH DOESN'T 

                                                             EVAL 2ND AND 3RD ARGUMENTS.)

    (PUTBASEPTR \STACKSPACE (\ARGPTR
 VAR M)
           X])
)
(DEFINEQ

(\RETURN

  [LAMBDA (X)
                                                (* lmm " 6-OCT-81 23:28")

    (DECLARE
 (LOCALVARS . T))                                (* for use by the LLBREAK package)

    (RAID X)
    (PROG1 X (\SMASHLINK NIL (SETQ X (fetch
 (FX CLINK) of
 (\MYALINK)))
                    X])

(\STACKARGPTR

  [LAMBDA (POS)
                                              (* lmm " 2-Jul-86 12:55")

                                                             (* return the index of the frame 

                                                             extension corresponding to POS or 

                                                             cause appropriate error)

    (COND
       [(OR (STACKP POS)
            (TYPENAMEP POS (QUOTE PROCESS)))                 (* if POS is STACKP, it is merely the 

                                                             contents)

        (COND
           ((EQ (fetch
 EDFXP of
 POS)
                0)
            (LISPERROR "STACK PTR HAS BEEN RELEASED" POS))
           (T (fetch
 EDFXP of
 POS]
       (T (PROG ((FX (\MYALINK))
                 (P POS))
                [COND
                   ((NULL POS)                               (* those functions which allow NIL 

                                                             should explicitly check for it.)

                    (LISPERROR "ILLEGAL STACK ARG" POS))
                   [(EQ POS T)                               (* scan up for top frame.

                                                             This could possibly be a constant, 

                                                             although there might be some 

                                                             circumstances where it could move)

                    (PROG NIL
                      TOPLP
                          (COND
                             ([NOT (fetch
 (FX INVALIDP) of
 (SETQ P (fetch
 (FX CLINK) of
 FX]
                              (SETQ FX P)
                              (GO TOPLP]
                   [(NUMBERP POS)
                    (COND
                       ((EQ (SETQ P (FIX POS))
                            0)
                        (SETQ P 1)))
                    (COND
                       [(IGREATERP P 0)
                        (PROG NIL
                          ALP (COND
                                 ((fetch
 (FX INVALIDP) of
 (SETQ FX (fetch
 (FX ALINK) of
 FX)))
                                  (LISPERROR "ILLEGAL STACK ARG" POS))
                                 ((NEQ (SETQ P (SUB1 P))
                                       0)
                                  (GO ALP]
                       (T (PROG NIL
                                (SETQ P (IMINUS P))
                            CLP (COND
                                   ((fetch
 (FX INVALIDP) of
 (SETQ FX (fetch
 (FX CLINK) of
 FX)))
                                    (LISPERROR "ILLEGAL STACK ARG" POS))
                                   ((NEQ (SETQ P (SUB1 P))
                                         0)
                                    (GO CLP]
                   (T                                        (* implicit STKPOS searching for a 

                                                             given name)

                      (PROG NIL
                        SCNLP
                            (COND
                               ((fetch
 (FX INVALIDP) of
 (SETQ FX (fetch
 (FX CLINK) of
 FX)))
                                (LISPERROR "ILLEGAL STACK ARG" POS))
                               ((NOT (EQMEMB (\STKNAME FX)
                                            POS))
                                (GO SCNLP]
                (COND
                   ((IGEQ (fetch
 (FX USECNT) of
 FX)
                          \MAXSAFEUSECOUNT)
                    (LISPERROR "ILLEGAL STACK ARG" POS)))
                (RETURN FX])
)



(* ; "User level stack management")


(DEFINEQ

(STKNTH

  [LAMBDA (N IPOS OPOS)
                                      (* bvm: " 5-Feb-85 15:50")

    (PROG ((I (OR N -1))
           CFLAG FRAME)
          [COND
             ((ILESSP I 0)
              (SETQ CFLAG T)
              (SETQ I (IMINUS I]
          [SETQ FRAME (COND
                         (IPOS (\STACKARGPTR
 IPOS))
                         ((EQ I 0)
                          (LISPERROR "ILLEGAL STACK ARG" N))
                         (T (add
 I -1)
                            (\MYALINK]
      LP  [COND
             ((fetch
 (FX INVALIDP) of
 FRAME)
              (RELSTK OPOS)
              (RETURN))
             ((EQ I 0)
              (RETURN (\MAKESTACKP OPOS FRAME)))
             (CFLAG (SETQ FRAME (fetch
 (FX CLINK) of
 FRAME)))
             (T (SETQ FRAME (fetch
 (FX ALINK) of
 FRAME]
          (SETQ I (SUB1 I))
          (GO LP])

(STKNTHNAME

  [LAMBDA (N POS)
                                            (* bvm: " 5-Feb-85 15:51")

    (PROG ((I (OR N -1))
           CFLAG FRAME)
          [COND
             ((ILESSP I 0)
              (SETQ CFLAG T)
              (SETQ I (IMINUS I]
          [SETQ FRAME (COND
                         (POS (\STACKARGPTR
 POS))
                         ((EQ I 0)
                          (LISPERROR "ILLEGAL STACK ARG" N))
                         (T (add
 I -1)
                            (\MYALINK]
      LP  [COND
             ((fetch
 (FX INVALIDP) of
 FRAME)
              (RETURN))
             ((EQ I 0)
              (RETURN (fetch
 (FX FRAMENAME) of
 FRAME)))
             (CFLAG (SETQ FRAME (fetch
 (FX CLINK) of
 FRAME)))
             (T (SETQ FRAME (fetch
 (FX ALINK) of
 FRAME]
          (SETQ I (SUB1 I))
          (GO LP])

(STKNAME

  [LAMBDA (POS)
                                              (* lmm " 2-Jul-86 12:37")

    (\STKNAME (\STACKARGPTR
 POS])

(SETSTKNAME

  [LAMBDA (POS NAME)
                                         (* bvm: "15-Aug-84 11:13")

    (PROG ((FRAME (\STACKARGPTR
 POS))
           FNH)
          [COND
             ((fetch
 (FX VALIDNAMETABLE) of
 FRAME)           (* There is already a copied nametable 

                                                             here, just smash it)

              (SETQ FNH (fetch
 (FX NAMETABLE#) of
 FRAME))
              (UNINTERRUPTABLY
                  (replace
 (FX VALIDNAMETABLE) of
 FRAME with
 NIL)
                                                             (* Do this so that the stack remains 

                                                             consistent, even while 

                                                             uninterruptable. This for SPY etc.)

                  (COND
                     ((EQ (\HILOC FNH)
                          \STACKHI)                          (* Don't refcnt on the stack)

                      (replace
 (FNHEADER #FRAMENAME) of
 FNH with
 NAME))
                     (T (replace
 (FNHEADER FRAMENAME) of
 FNH with
 NAME)))
                  (replace
 (FX VALIDNAMETABLE) of
 FRAME with
 T)))
             (T (SETQ FNH (\COPYFNHEADER
 (fetch
 (FX FNHEADER) of
 FRAME)))
                (replace
 (FNHEADER FRAMENAME) of
 FNH with
 NAME)
                (UNINTERRUPTABLY
                    (replace
 (FX NAMETABLE) of
 FRAME with
 FNH))]
          (RETURN NAME])

(\COPYFNHEADER

  [LAMBDA (FNHD)
                                             (* bvm: " 5-Feb-85 15:51")

    (PROG ((HEADWORDS (UNFOLD (fetch
 (FNHEADER NTSIZE) of
 FNHD)
                             2))
           NEWFNHD)
          [SETQ HEADWORDS (IPLUS (fetch
 (FNHEADER OVERHEADWORDS) of
 T)
                                 (COND
                                    ((EQ HEADWORDS 0)        (* No name table, but still need to 

                                                             copy quad of zeros)

                                     WORDSPERQUAD)
                                    (T HEADWORDS]
          (SETQ NEWFNHD (\ALLOCBLOCK (FOLDHI HEADWORDS WORDSPERCELL)
                               NIL HEADWORDS))
          (\BLT NEWFNHD FNHD HEADWORDS)
          (RETURN NEWFNHD])
)
(DEFINEQ

(STKPOS

  [LAMBDA (FRAMENAME N IPOS OPOS)
                            (* lmm " 2-Jul-86 13:02")

    (PROG (FLAG [FX (COND
                       ((NULL IPOS)
                        (\MYALINK))
                       (T (\STACKARGPTR
 IPOS]
                (I (OR N -1)))
          [COND
             ((IGREATERP 0 I)
              (SETQ FLAG (SETQ I (IDIFFERENCE 0 I]
      LP  [COND
             ((EQ (\STKNAME FX)
                  FRAMENAME)
              (COND
                 ((ILEQ (SETQ I (SUB1 I))
                        0)
                  (RETURN (\MAKESTACKP OPOS FX]
          (COND
             ([fetch
 (FX INVALIDP) of
 (SETQ FX (COND
                                                  (FLAG (fetch
 (FX CLINK) of
 FX))
                                                  (T (fetch
 (FX ALINK) of
 FX]
              (RELSTK OPOS)
              (RETURN)))
          (GO LP])

(STKSCAN

  [LAMBDA (VAR IPOS OPOS)
                                    (* lmm "13-FEB-83 14:15")

    (AND (LITATOM VAR)
         (PROG ([FX (COND
                       ((NULL IPOS)
                        (\MYALINK))
                       (T (\STACKARGPTR
 IPOS]
                (A (\ATOMVALINDEX VAR)))
           LP  (COND
                  ((\FRAMESCAN
 FX A)
                   (RETURN (\MAKESTACKP OPOS FX)))
                  ((fetch
 (FX INVALIDP) of
 (SETQ FX (fetch
 (FX ALINK) of
 FX)))
                   (RELSTK OPOS)
                   (RETURN))
                  (T (GO LP])

(SETCLINK

  [LAMBDA (FRAME NEWLINK RELEASEFLG)
                         (* lmm " 6-OCT-81 23:34")

    (PROG (PX (FX (\STACKARGPTR
 FRAME))
              (NX (\STACKARGPTR
 NEWLINK)))
          (SETQ PX NX)
      LP  (COND
             ((EQ PX FX)                                     (* Circular stack would result)

              (RETURN NIL))
             ((fetch
 (FX INVALIDP) of
 PX)                    (* Got to the top first.

                                                             We're safe)

              (GO OUT)))
          (SETQ PX (fetch
 (FX CLINK) of
 PX))
          (GO LP)
      OUT (\SMASHLINK FX NIL NX)
          (COND
             (RELEASEFLG (RELSTK NEWLINK)))
          (RETURN FRAME])

(RETFROM

  [LAMBDA (POS VAL FLG)
                                      (* bvm: " 5-Feb-85 15:52")

    (PROG ((P (\STACKARGPTR
 POS)))
          (COND
             ((fetch
 (FX INVALIDP) of
 (SETQ P (fetch
 (FX CLINK) of
 P)))
              (LISPERROR "ILLEGAL RETURN" VAL)))
          (\SMASHLINK NIL P P)
          (AND FLG (RELSTK POS))
          (RETURN VAL])

(RETTO

  [LAMBDA (POS VAL FLG)
                                      (* lmm "13-Mar-85 11:56")

    (if
 (EQ POS T)
        then
 (RESET
)
      else
 (PROG ((P (\STACKARGPTR
 POS)))
                 (\SMASHLINK NIL P P)
                 (AND FLG (RELSTK POS))
                 (RETURN VAL])

(RESUME

  [LAMBDA (FROMPTR TOPTR VAL)
                                (* lmm " 6-OCT-81 23:35")

          
          (* FROMPTR is a stkptr which is smashed to contain a pointer to the caller of 

          RESUME. Control is transfered to the frame specified by TOPTR, releasing that 

          stack pointer. A call to this RESUME returns VAL as the value of the RESUME 

          specified by TOPTR.)


    (PROG [[FROMFX (fetch
 EDFXP of
 (\DTEST FROMPTR (QUOTE STACKP]
           (TOFX (fetch
 EDFXP of
 (\DTEST TOPTR (QUOTE STACKP]
          (COND
             ((fetch
 (FX INVALIDP) of
 TOFX)
              (LISPERROR "STACK PTR HAS BEEN RELEASED" TOPTR)))
          (UNINTERRUPTABLY
              (COND
                 ((NOT (fetch
 (FX INVALIDP) of
 FROMFX))      (* Release FROMPTR if it hasn't been 

                                                             yet)

                  (\DECUSECOUNT FROMFX)))
              (replace
 EDFXP of
 FROMPTR with
 (\MYALINK))
              (replace
 EDFXP of
 TOPTR with
 0)
              (\RESUME
 TOFX)))
    VAL])

(\RESUME

  [LAMBDA (FRAME)
                                            (* bvm: " 5-Jun-85 17:08")

    (replace
 (FX ACLINK) of
 (\MYALINK) with
 FRAME)
    FRAME])

(RESET

  [LAMBDA NIL
                                                (* bvm: "24-JUL-83 16:28")

    (PROG ((FX (\MYALINK)))
      LP  [COND
             ((SELECTQ (fetch
 (FX FRAMENAME) of
 FX)
                  ((T \MAKE.PROCESS0 \REPEATEDLYEVALQT) 
                       T)
                  NIL)
          
          (* In process world, try to return to top level exec frame

          (\REPEATEDLYEVALQT), or to the top of the process, which will decide whether to 

          restart or kill the process. In non-process world, we eventually return to the 

          T frame)


              (\SMASHLINK NIL FX FX)
              (RETURN \PROC.RESETME))
             ((fetch
 (FX INVALIDP) of
 (SETQ FX (fetch
 (FX CLINK) of
 FX)))
              (RETURN (printout PROMPTWINDOW .TAB0 0 "Can't find top of stack!!!"]
          (GO LP])

(ERROR!

  [LAMBDA NIL
                                                (* lmm " 6-OCT-81 23:36")

    (PROG ((FX (\MYALINK))
           NFX)
      LP  (COND
             ((EQ (fetch
 (FX FRAMENAME) of
 FX)
                  (QUOTE ERRORSET))
              (\SMASHLINK NIL (fetch
 (FX CLINK) of
 FX)
                     (fetch
 (FX ALINK) of
 FX))
              (RETURN))
             ([NOT (fetch
 (FX INVALIDP) of
 (SETQ NFX (fetch
 (FX CLINK) of
 FX]
              (SETQ FX NFX)
              (GO LP))
             (T                                              (* return to top)

                (\SMASHLINK NIL FX FX)
                (RETURN])
)
(DEFINEQ

(STKARG

  [LAMBDA (N POS DEFAULT)
                                    (* lmm " 1-Jun-86 17:38")

    (PROG ((FRAME (\STACKARGPTR
 POS))
           (INDEX N)
           BLINK NARGS NT NTSIZE)
          (SETQ NT (\INTERPFRAMENT
 FRAME))
          [COND
             ((LITATOM N)
              (SETQ INDEX (OR (\FRAMESCAN
 FRAME (\ATOMVALINDEX N)
                                     NT)
                              (LISPERROR "ILLEGAL STACK ARG" N]
          (COND
             ((ILESSP INDEX 1)
              (LISPERROR "ILLEGAL STACK ARG" INDEX))
             [NT                                             (* Interpreter frame)

                 (COND
                    [(\SPREADFRAMEP
 FRAME)
                     (OR [AND (IGREATERP INDEX 0)
                              (ILEQ INDEX (SETQ NARGS (fetch
 (BF NARGS) of
 (SETQ BLINK
                                                                            (fetch
 (FX BLINK)
                                                                               of
 FRAME]
                         (LISPERROR "ILLEGAL STACK ARG" INDEX))
                     (SETQ INDEX (IPLUS (fetch
 (BF IVAR) of
 BLINK)
                                        (UNFOLD (SUB1 INDEX)
                                               WORDSPERCELL]
                    ((OR (IGEQ INDEX (SETQ NTSIZE (fetch
 (FNHEADER NTSIZE) of
 NT)))
                         (EQ (\GETBASE NT (IPLUS (fetch
 (FNHEADER OVERHEADWORDS) of
 T)
                                                 INDEX -1))
                             0))                             (* Out of range)

                     (LISPERROR "ILLEGAL STACK ARG" INDEX))
                    (T (SETQ INDEX (IPLUS (SELECTC [fetch
 (NAMETABLESLOT VARTYPE)
                                                      of
 (SETQ NT (\ADDBASE
                                                                   NT
                                                                   (IPLUS NTSIZE (fetch
 (FNHEADER
                                                                                         
                                                                                        OVERHEADWORDS
                                                                                         )
                                                                                    of
 T)
                                                                          INDEX -1]
                                              (\NT.IVAR (fetch
 (BF IVAR) of
 (fetch
 (FX BLINK)
                                                                               of
 FRAME)))
                                              (\NT.PVAR (fetch
 (FX FIRSTPVAR) of
 FRAME))
                                              (SHOULDNT))
                                          (UNFOLD (fetch
 (NAMETABLESLOT VAROFFSET) of
 NT)
                                                 WORDSPERCELL]
             [[ILEQ INDEX (SETQ NARGS (fetch
 (BF NARGS) of
 (SETQ BLINK (fetch
 (FX BLINK) of
 FRAME]
              (SETQ INDEX (IPLUS (fetch
 (BF IVAR) of
 BLINK)
                                 (UNFOLD (SUB1 INDEX)
                                        WORDSPERCELL]
             [(ILEQ (SETQ INDEX (IDIFFERENCE INDEX NARGS))
                    (fetch
 (FX FNHEADER NLOCALS) of
 FRAME))
              (SETQ INDEX (IPLUS (fetch
 (FX FIRSTPVAR) of
 FRAME)
                                 (UNFOLD (SUB1 INDEX)
                                        WORDSPERCELL]
             (T (LISPERROR "ILLEGAL STACK ARG" N)))
          (RETURN (COND
                     ((NOT (fetch
 (PVARSLOT BOUND) of
 (STACKADDBASE INDEX)))
                      DEFAULT)
                     (T (STACKGETBASEPTR INDEX])

(SETSTKARG

  [LAMBDA (N POS VAL)
                                        (* bvm: " 5-Feb-85 15:55")

    (PROG ((FRAME (\STACKARGPTR
 POS))
           (INDEX N)
           BLINK NARGS NT NTSIZE)
          (SETQ NT (\INTERPFRAMENT
 FRAME))
          [COND
             ((LITATOM N)
              (SETQ INDEX (OR (\FRAMESCAN
 FRAME (\ATOMVALINDEX N)
                                     NT)
                              (LISPERROR "ILLEGAL STACK ARG" N]
          [SETQ INDEX (COND
                         ((ILESSP INDEX 1)
                          (LISPERROR "ILLEGAL STACK ARG" INDEX))
                         [NT                                 (* Interpreter frame)

                             (COND
                                ((OR (IGEQ INDEX (SETQ NTSIZE (fetch
 (FNHEADER NTSIZE) of
 NT)))
                                     (EQ (\GETBASE NT (IPLUS (fetch
 (FNHEADER OVERHEADWORDS)
                                                                of
 T)
                                                             INDEX -1))
                                         0))                 (* Out of range)

                                 (LISPERROR "ILLEGAL STACK ARG" INDEX))
                                (T (IPLUS (SELECTC [fetch
 (NAMETABLESLOT VARTYPE)
                                                      of
 (SETQ NT (\ADDBASE
                                                                   NT
                                                                   (IPLUS NTSIZE (fetch
 (FNHEADER
                                                                                         
                                                                                        OVERHEADWORDS
                                                                                         )
                                                                                    of
 T)
                                                                          INDEX -1]
                                              (\NT.IVAR (fetch
 (BF IVAR) of
 (fetch
 (FX BLINK)
                                                                               of
 FRAME)))
                                              (\NT.PVAR (fetch
 (FX FIRSTPVAR) of
 FRAME))
                                              (SHOULDNT))
                                          (UNFOLD (fetch
 (NAMETABLESLOT VAROFFSET) of
 NT)
                                                 WORDSPERCELL]
                         ([ILEQ INDEX (SETQ NARGS (fetch
 (BF NARGS) of
 (SETQ BLINK
                                                                        (fetch
 (FX BLINK)
                                                                           of
 FRAME]
                          (IPLUS (fetch
 (BF IVAR) of
 BLINK)
                                 (UNFOLD (SUB1 INDEX)
                                        WORDSPERCELL)))
                         ((ILEQ (SETQ INDEX (IDIFFERENCE INDEX NARGS))
                                (fetch
 (FX FNHEADER NLOCALS) of
 FRAME))
                          (IPLUS (fetch
 (FX FIRSTPVAR) of
 FRAME)
                                 (UNFOLD (SUB1 INDEX)
                                        WORDSPERCELL)))
                         (T (LISPERROR "ILLEGAL STACK ARG" N]
          (RETURN (COND
                     ((fetch
 (PVARSLOT BOUND) of
 (STACKADDBASE INDEX))
                      (STACKPUTBASEPTR INDEX VAL))
                     (T (LISPERROR "ILLEGAL STACK ARG" N])

(STKARGNAME

  [LAMBDA (N POS)
                                            (* lmm " 1-Jun-86 17:41")

    (PROG ((FRAME (\STACKARGPTR
 POS))
           NT NM (NTENTRY N)
           NARGS)
          (SETQ NT (\INTERPFRAMENT
 FRAME))
          [COND
             ((LITATOM NTENTRY)
              (SETQ NTENTRY (\FRAMESCAN
 FRAME (\ATOMVALINDEX NTENTRY)
                                   NT]
          [COND
             (NT                                             (* Interpreted frame)

                 (RETURN (COND
                            ((\SPREADFRAMEP
 FRAME)           (* LIST (QUOTE ARG) (\INDEXATOMVAL

                                                             (\GETBASE NT (fetch (FNHEADER 

                                                             OVERHEADWORDS) of T))) N)

                             NIL)
                            (T (OR [AND (IGREATERP NTENTRY 0)
                                        (ILESSP NTENTRY (fetch
 (FNHEADER NTSIZE) of
 NT))
                                        (\INDEXATOMVAL (\GETBASE NT (IPLUS (fetch
 (FNHEADER 
                                                                                        OVERHEADWORDS
                                                                                         )
                                                                              of
 T)
                                                                           NTENTRY -1]
                                   (LISPERROR "ILLEGAL STACK ARG" N]
          (SETQ NT (fetch
 (FX NAMETABLE) of
 FRAME))
          [SETQ NTENTRY (COND
                           ((ILEQ NTENTRY 0)
                            (LISPERROR "ILLEGAL STACK ARG" N))
                           ([ILEQ NTENTRY (SETQ NARGS (fetch
 (BF NARGS) of
 (fetch
 (FX BLINK)
                                                                              of
 FRAME]
                            (LOGOR (SUB1 NTENTRY)
                                   IVARCODE))
                           ((ILEQ (SETQ NTENTRY (IDIFFERENCE NTENTRY NARGS))
                                  (fetch
 (FNHEADER NLOCALS) of
 NT))
                            (COND
                               ([NOT (fetch
 (PVARSLOT BOUND) of
 (STACKADDBASE
                                                                 (IPLUS (fetch
 (FX FIRSTPVAR)
                                                                           of
 FRAME)
                                                                        (UNFOLD (SUB1 NTENTRY)
                                                                               WORDSPERCELL]
                                (RETURN)))
                            (LOGOR (SUB1 NTENTRY)
                                   PVARCODE))
                           (T (LISPERROR "ILLEGAL STACK ARG" N]
          (RETURN (for
 NT1 from
 (fetch
 (FNHEADER OVERHEADWORDS) of
 T) as
 NT2
                     from
 (IPLUS (fetch
 (FNHEADER OVERHEADWORDS) of
 NT)
                                 (fetch
 (FNHEADER NTSIZE) of
 NT))
                     until
 (EQ (SETQ NM (\GETBASE NT NT1))
                               0) do
 (COND
                                        ((EQ NTENTRY (\GETBASE NT NT2))
                                         (RETURN (\INDEXATOMVAL NM])

(\SPREADFRAMEP

  [LAMBDA (FRAME)
                                            (* lmm " 1-Jun-86 17:19")

    (LET (NARGS BFLINK)
         (EQ (\GETBASEPTR \STACKSPACE (IPLUS (fetch
 (BF IVAR) of
 (SETQ BFLINK (fetch
 (FX BLINK)
                                                                                 of
 FRAME)))
                                             (UNFOLD (SETQ NARGS (SUB1 (fetch
 (BF NARGS) of
 BFLINK)))
                                                    WORDSPERCELL)))
             NARGS])

(SETSTKARGNAME

  [LAMBDA (N POS NAME)
                                       (* bvm: " 5-Feb-85 15:56")

    (PROG ((FRAME (\STACKARGPTR
 POS))
           NT NM (NTENTRY N)
           NARGS)
          (SETQ NT (\INTERPFRAMENT
 FRAME))
          [COND
             ((LITATOM NTENTRY)
              (SETQ NTENTRY (\FRAMESCAN
 FRAME (\ATOMVALINDEX NTENTRY)
                                   NT]
          [COND
             (NT                                             (* Interpreted frame)

                 (RETURN (OR [AND (IGREATERP NTENTRY 0)
                                  (ILESSP NTENTRY (fetch
 (FNHEADER NTSIZE) of
 NT))
                                  (\INDEXATOMVAL (\GETBASE NT (IPLUS (fetch
 (FNHEADER OVERHEADWORDS)
                                                                        of
 T)
                                                                     NTENTRY -1]
                             (LISPERROR "ILLEGAL STACK ARG" N]
          (SETQ NT (\COPYFNHEADER
 (fetch
 (FX NAMETABLE) of
 FRAME)))
                                                             (* Need to copy nametable in order to 

                                                             smash the var name)

          [SETQ NTENTRY (COND
                           ((ILEQ NTENTRY 0)
                            (LISPERROR "ILLEGAL STACK ARG" N))
                           ([ILEQ NTENTRY (SETQ NARGS (fetch
 (BF NARGS) of
 (fetch
 (FX BLINK)
                                                                              of
 FRAME]
                            (IPLUS (SUB1 NTENTRY)
                                   IVARCODE))
                           ((ILEQ (SETQ NTENTRY (IDIFFERENCE NTENTRY NARGS))
                                  (fetch
 (FNHEADER NLOCALS) of
 NT))
                            (IPLUS (SUB1 NTENTRY)
                                   PVARCODE))
                           (T (LISPERROR "ILLEGAL STACK ARG" N]
          (for
 NT1 from
 (fetch
 (FNHEADER OVERHEADWORDS) of
 T) as
 NT2
             from
 (IPLUS (fetch
 (FNHEADER OVERHEADWORDS) of
 T)
                         (fetch
 (FNHEADER NTSIZE) of
 NT)) until
 (EQ (SETQ NM (\GETBASE NT NT1))
                                                                    0)
             do
 (COND
                   ((EQ NTENTRY (\GETBASE NT NT2))
                    (\PUTBASE NT NT1 (\ATOMVALINDEX NAME))
                    (UNINTERRUPTABLY
                        (replace
 (FX NAMETABLE) of
 FRAME with
 NT))
                    (RETURN NAME])

(STKNARGS

  [LAMBDA (POS INCLUDEPVARS)
                                 (* lmm "21-Jul-86 06:05")

    (PROG ((FRAME (\STACKARGPTR
 POS))
           NA INTERPNT)
          (RETURN (COND
                     ((EQ (fetch
 (FX FRAMENAME) of
 FRAME)
                          (QUOTE \INTERPRETER))
                      (SETQ NA (fetch
 (BF NARGS) of
 (fetch
 (FX BLINK) of
 FRAME)))
                      (RETURN (SUB1 NA)))
                     ((SETQ INTERPNT (\INTERPFRAMENT
 FRAME)) (* this is an interpreted frame.

                                                             INTERPNT points at the name table of 

                                                             the frame)

                      [COND
                         ((\SPREADFRAMEP
 FRAME)
                          (RETURN (SUB1 (fetch
 (BF NARGS) of
 (fetch
 (FX BLINK) of
 FRAME]
                      (SETQ NA (fetch
 (FNHEADER NTSIZE) of
 INTERPNT))
                                                             (* Return number of vars in nt.

                                                             Padded with up to 4 zeros at end, so 

                                                             have to check)

                      [COND
                         ((IGREATERP NA 0)
                          (do
 (add
 NA -1) repeatwhile
 (EQ (\GETBASE INTERPNT
                                                                 (IPLUS (fetch
 (FNHEADER 
                                                                                      OVERHEADWORDS)
                                                                           of
 T)
                                                                        NA -1))
                                                          0]
                      NA)
                     (T (SETQ NA (fetch
 (BF NARGS) of
 (fetch
 (FX BLINK) of
 FRAME)))
                        (RETURN (COND
                                   (INCLUDEPVARS (IPLUS NA (fetch
 (FX FNHEADER NLOCALS) of
 FRAME)))
                                   (T NA])

(FRAMESCAN

  [LAMBDA (ATOM POS)
                                         (* lmm "13-FEB-83 14:17")

    (PROG ((FX (\STACKARGPTR
 POS)))
          (RETURN (\FRAMESCAN
 FX (COND
                                    ((LITATOM ATOM)
                                     (\ATOMVALINDEX ATOM))
                                    (T (RETURN NIL)))
                         (\INTERPFRAMENT
 FX])

(\INTERPFRAMENT

  [LAMBDA (FX)
                                               (* bvm: " 2-OCT-81 23:32")

                                                             (* If FX is an interpreter frame

                                                             (nametable is on stack), returns its 

                                                             nametable)

    (AND (fetch
 (FX VALIDNAMETABLE) of
 FX)
         (EQ (fetch
 (FX NAMETABHI) of
 FX)
             \STACKHI)
         (fetch
 (FX NAMETABLE#) of
 FX])

(\FRAMESCAN

  [LAMBDA (FRAME ATOM# INTERPNT)
                             (* bvm: " 5-Feb-85 15:57")


                                                  (* ;;; "Returns index of binding of atom number ATOM# in FRAME.  Indices of ivars start at 1, of pvars at nargs+1.  If INTERPNT is given, this is an interpreter frame, and we merely return index of atom in its nametable, regardless of type")

    (for
 OFFSET from
 (fetch
 (FNHEADER OVERHEADWORDS) of
 T)
       bind
 (NT _ (OR INTERPNT (fetch
 (FX NAMETABLE) of
 FRAME)))
            TMP NAME until
 (EQ (SETQ NAME (\GETBASE NT OFFSET))
                               0)
       do
 (COND
             ((EQ NAME ATOM#)
                     (* ;; "Found ATOM# in nametable.  Now look in second half of table to see what kind of binding and where it lies")

              (COND
                 [INTERPNT (RETURN (ADD1 (IDIFFERENCE OFFSET (fetch
 (FNHEADER OVERHEADWORDS)
                                                                of
 T]
                 (T (SELECTC (LOGAND [SETQ TMP (\GETBASE NT (IPLUS OFFSET (fetch
 (FNHEADER NTSIZE)
                                                                             of
 NT]
                                    VARCODEMASK)
                        (IVARCODE (RETURN (ADD1 (IDIFFERENCE TMP IVARCODE))))
                        (PVARCODE (AND [fetch
 (PVARSLOT BOUND)
                                          of
 (ADDSTACKBASE (IPLUS (fetch
 (FX FIRSTPVAR) of
 FRAME)
                                                                  (UNFOLD (SETQ TMP (IDIFFERENCE
                                                                                     TMP PVARCODE))
                                                                         WORDSPERCELL]
                                       (RETURN (IPLUS TMP (fetch
 (BF NARGS)
                                                             of
 (fetch
 (FX BLINK) of
 FRAME))
                                                      1))))
                        (FVARCODE (RETURN))
                        (RAID])

(\VAROFFSET

  [LAMBDA (FRAME ATN)
                                        (* bvm: " 5-Feb-85 15:57")

          
          (* * Returns stack offset to binding of atom number ATN in FRAME, or NIL if it 

          is not bound here.)


    (for
 OFFSET from
 (fetch
 (FNHEADER OVERHEADWORDS) of
 T) bind
 (NT _ (fetch
 (FX NAMETABLE)
                                                                         of
 FRAME))
                                                                TMP NAME
       until
 (EQ (SETQ NAME (\GETBASE NT OFFSET))
                 0)
       do
 (COND
             ((EQ NAME ATN)                                  (* Found ATN in nametable.

                                                             Now look in second half of table to 

                                                             see what kind of binding and where it 

                                                             lies)

              (SELECTC (LOGAND [SETQ TMP (\GETBASE NT (IPLUS OFFSET (fetch
 (FNHEADER NTSIZE)
                                                                       of
 NT]
                              VARCODEMASK)
                  (IVARCODE (RETURN (IPLUS (fetch
 (BF IVAR) of
 (fetch
 (FX BLINK) of
 FRAME))
                                           (UNFOLD (IDIFFERENCE TMP IVARCODE)
                                                  WORDSPERCELL))))
                  (PVARCODE (AND [fetch
 (PVARSLOT BOUND)
                                    of
 (ADDSTACKBASE (SETQ TMP (IPLUS (fetch
 (FX FIRSTPVAR)
                                                                         of
 FRAME)
                                                                      (UNFOLD (IDIFFERENCE TMP 
                                                                                     PVARCODE)
                                                                             WORDSPERCELL]
                                 (RETURN TMP)))
                  (FVARCODE (RETURN))
                  (RAID])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 SETARG ARG)

(ADDTOVAR LAMA
 )
)
(PUTPROPS ASTACK COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1251 4463 (ARG 1261 . 1420) (SETARG 1422 . 1606) (\ARG 1608 . 1943) (\ARGPTR 1945 . 
4094) (\SETARG 4096 . 4461)) (4464 8514 (\RETURN 4474 . 4801) (\STACKARGPTR 4803 . 8512)) (8559 12891 
(STKNTH 8569 . 9466) (STKNTHNAME 9468 . 10354) (STKNAME 10356 . 10501) (SETSTKNAME 10503 . 12058) (
\COPYFNHEADER 12060 . 12889)) (12892 18819 (STKPOS 12902 . 13823) (STKSCAN 13825 . 14444) (SETCLINK 
14446 . 15199) (RETFROM 15201 . 15589) (RETTO 15591 . 15907) (RESUME 15909 . 17057) (\RESUME 17059 . 
17242) (RESET 17244 . 18124) (ERROR! 18126 . 18817)) (18820 40306 (STKARG 18830 . 22696) (SETSTKARG 
22698 . 26305) (STKARGNAME 26307 . 29714) (\SPREADFRAMEP 29716 . 30257) (SETSTKARGNAME 30259 . 32894) 
(STKNARGS 32896 . 35068) (FRAMESCAN 35070 . 35477) (\INTERPFRAMENT 35479 . 36043) (\FRAMESCAN 36045 . 
38194) (\VAROFFSET 38196 . 40304)))))
STOP