(FILECREATED " 5-Jun-85 17:25:33" {ERIS}<LISPCORE>SOURCES>ASTACK.;5
 27832  

      changes to:  (FNS \RESUME \STACKARGPTR)

      previous date: "13-Mar-85 11:56:55" {ERIS}<LISPCORE>SOURCES>ASTACK.;4)


(* Copyright (c) 1982, 1983, 1984, 1985 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 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)                                              (* bvm: " 5-Jun-85 17:18")

                                                             (* 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
 (fetch
 (FX FRAMENAME) of
 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 " 6-OCT-81 23:32")

    (fetch
 (FX FRAMENAME) of
 (\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-NOV-81 20:25")

    (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 (fetch
 (FX FRAMENAME) of
 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)                                    (* bvm: " 5-Feb-85 15:54")

    (
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

		  ((
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)                                            (* 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 (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])

(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)                                 (* bvm: " 5-Feb-85 15:57")

    (
PROG
 ((FRAME (\STACKARGPTR
 POS))
	   NA INTERPNT)
          (
RETURN
 (
COND

		    ((
SETQ
 INTERPNT (\INTERPFRAMENT
 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))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (968 3311 (ARG 978 . 1107) (SETARG 1109 . 1254) (\ARG 1256 . 1469) (\ARGPTR 1471 . 3073)
 (\SETARG 3075 . 3309)) (3312 6085 (\RETURN 3322 . 3577) (\STACKARGPTR 3579 . 6083)) (6126 9738 (
STKNTH 6136 . 6932) (STKNTHNAME 6934 . 7718) (STKNAME 7720 . 7858) (SETSTKNAME 7860 . 9101) (
\COPYFNHEADER 9103 . 9736)) (9739 14669 (STKPOS 9749 . 10433) (STKSCAN 10435 . 10858) (SETCLINK 10860
 . 11501) (RETFROM 11503 . 11904) (RETTO 11906 . 12214) (RESUME 12216 . 13187) (\RESUME 13189 . 13368)
 (RESET 13370 . 14135) (ERROR! 14137 . 14667)) (14670 27545 (STKARG 14680 . 16812) (SETSTKARG 16814 . 
18946) (STKARGNAME 18948 . 20885) (SETSTKARGNAME 20887 . 22886) (STKNARGS 22888 . 23852) (FRAMESCAN 
23854 . 24120) (\INTERPFRAMENT 24122 . 24547) (\FRAMESCAN 24549 . 26209) (\VAROFFSET 26211 . 27543))))
)
STOP