Fix problems due to FX record incompatibly on SPY, miscompiled (#1561)
* Fix problems due to FX record incompatibly on SPY, miscompiled * PROC recompile for safe measure * Add ASTACK.LCOM, also needed recompile!
This commit is contained in:
Larry Masinter
GitHub
164
library/SPY
164
library/SPY
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;4 64149
|
||||
(FILECREATED "27-Feb-2024 20:25:02" {DSK}<home>larry>il>medley>SPY.;1 53724
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS SPYCOMS)
|
||||
(FNS \SPY.INTERRUPT SPY.BUFFER.ENTRY SPY.ADD.ENTRY)
|
||||
:CHANGES-TO (RECORDS FX)
|
||||
(VARS SPYOBJCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 4-Jan-2022 14:09:48" {DSK}<home>larry>il>medley>library>SPY.;1)
|
||||
:PREVIOUS-DATE "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT SPYCOMS)
|
||||
@@ -114,7 +114,7 @@
|
||||
(FUNCTION SPYOBJ.BUTTON)
|
||||
(FUNCTION SPYOBJ.COPYIN)
|
||||
NIL NIL NIL NIL NIL NIL 'SPYNODE]
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS FX SPYOBJDATA))
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS SPYOBJDATA))
|
||||
(INITRECORDS SPYOBJDATA)))
|
||||
(DEFINEQ
|
||||
|
||||
@@ -189,134 +189,6 @@
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* ; "frame extension index")
|
||||
(BLOCKRECORD FXBLOCK ((FLAGS BITS 3) (* ; "= \STK.FX")
|
||||
(FAST FLAG)
|
||||
(NIL FLAG)
|
||||
(INCALL FLAG) (* ;
|
||||
"set when fncall microcode has to punt")
|
||||
(VALIDNAMETABLE FLAG) (* ;
|
||||
"if on, NAMETABLE field is filled in. If off, is same as FNHEADER")
|
||||
(NOPUSH FLAG) (* ;
|
||||
"when returning to this frame, don't push a value. Set by interrupt code")
|
||||
(USECNT BITS 8)
|
||||
(%#ALINK WORD) (* ; "low bit is SLOWP")
|
||||
(FNHEADER FULLXPOINTER)
|
||||
(NEXTBLOCK WORD)
|
||||
(PC WORD)
|
||||
(NAMETABLE# FULLXPOINTER)
|
||||
(%#BLINK WORD)
|
||||
(%#CLINK WORD)))
|
||||
(BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
|
||||
(NIL BYTE)
|
||||
(NIL BITS 15) (* ; "most of the bits of #ALINK")
|
||||
(SLOWP FLAG) (* ;
|
||||
"if on, then BLINK and CLINK fields are valid. If off, they are implicit")
|
||||
(NIL FULLXPOINTER 2)
|
||||
(NAMETABHI WORD)
|
||||
(NAMETABLO WORD)))
|
||||
(TYPE? (IEQ (fetch (FX FLAGS) of DATUM)
|
||||
\STK.FX))
|
||||
[ACCESSFNS FX ((NAMETABLE (COND
|
||||
((fetch (FX VALIDNAMETABLE) of DATUM)
|
||||
(fetch (FX NAMETABLE#) of DATUM))
|
||||
(T (fetch (FX FNHEADER) of DATUM)))
|
||||
(PROGN (replace (FX FAST) of DATUM with NIL)
|
||||
(replace (FX NAMETABLE#) of DATUM with NEWVALUE)
|
||||
(replace (FX VALIDNAMETABLE) of DATUM with T)))
|
||||
(FRAMENAME (fetch (FNHEADER FRAMENAME) of (fetch (FX NAMETABLE)
|
||||
of DATUM)))
|
||||
(INVALIDP (EQ DATUM 0)) (* ;
|
||||
"true when A/CLink points at nobody, i.e. FX is bottom of stack")
|
||||
[FASTP (NOT (fetch (FX SLOWP) of DATUM))
|
||||
(PROGN (CHECK (NULL NEWVALUE))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[BLINK (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX DUMMYBF) of DATUM))
|
||||
(T (fetch (FX %#BLINK) of DATUM)))
|
||||
(PROGN (replace (FX %#BLINK) of DATUM with NEWVALUE)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[CLINK (IDIFFERENCE (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX %#ALINK) of DATUM))
|
||||
(T (fetch (FX %#CLINK) of DATUM)))
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN (replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET)
|
||||
)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[ALINK (IDIFFERENCE (FLOOR (fetch (FX %#ALINK) of DATUM)
|
||||
WORDSPERCELL)
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM]
|
||||
(replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET
|
||||
(SUB1
|
||||
WORDSPERCELL
|
||||
]
|
||||
[ACLINK (SHOULDNT)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM]
|
||||
(replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET)
|
||||
)
|
||||
(replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET
|
||||
(SUB1
|
||||
WORDSPERCELL
|
||||
]
|
||||
(* ;
|
||||
"replaces A & C Links at once more efficiently than separately")
|
||||
(DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
|
||||
|
||||
(* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too.")
|
||||
|
||||
(IVAR (fetch (BF IVAR) of (fetch (FX DUMMYBF) of DATUM)))
|
||||
[CHECKED (AND (type? FX DATUM)
|
||||
(OR (IEQ (fetch (FX DUMMYBF) of DATUM)
|
||||
(fetch (FX BLINK) of DATUM))
|
||||
(AND (fetch (BF RESIDUAL) of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(IEQ (fetch (BF IVAR) of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(fetch (BF IVAR) of (fetch (FX BLINK)
|
||||
of DATUM]
|
||||
(FIRSTPVAR (IPLUS DATUM (fetch (FX FXSIZE) of T)))
|
||||
(* ; "stack offset of PVAR0")
|
||||
(FXSIZE (PROGN 10)) (* ;
|
||||
"fixed overhead from flags thru clink")
|
||||
(PADDING (PROGN 4)) (* ;
|
||||
"doublecell of garbage for microcode use")
|
||||
(FIRSTTEMP (IPLUS (fetch (FX FIRSTPVAR) of DATUM)
|
||||
(fetch (FX NPVARWORDS) of DATUM)
|
||||
(fetch (FX PADDING) of DATUM)))
|
||||
(* ;
|
||||
"note that NPVARWORDS is obtained from the FNHEADER")
|
||||
(SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM)
|
||||
DATUM])
|
||||
|
||||
(RECORD SPYOBJDATA (CACHEDLABEL PERCENT LABEL))
|
||||
)
|
||||
)
|
||||
@@ -1053,17 +925,17 @@
|
||||
|
||||
(MOVD? 'NILL 'MODERNWINDOW)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4707 7314 (SPYOBJ 4717 . 5006) (SPYOBJ.BUTTON 5008 . 5118) (SPYOBJ.SAVE 5120 . 5239) (
|
||||
SPYOBJ.COPY 5241 . 5303) (SPYOBJ.GET 5305 . 5434) (SPYOBJ.IMAGEBOX 5436 . 5960) (SPYOBJ.DISPLAY 5962
|
||||
. 6261) (SPYOBJ.LABEL 6263 . 6399) (SPYOBJ.HEIGHT 6401 . 6614) (SPYOBJ.COPYIN 6616 . 6659) (
|
||||
SPY.COPYBUTTON 6661 . 6753) (SPY.MERGEINFO 6755 . 7312)) (18156 60387 (SPY.FIND.TREE 18166 . 18575) (
|
||||
SPY.TOGGLE 18577 . 18767) (SPY.TREE 18769 . 19881) (SPY.LEGEND 19883 . 20233) (SPY.GRAPH.EDITOR 20235
|
||||
. 29800) (SPY.END 29802 . 30044) (SPY.MAKEGRAPHNODES 30046 . 32146) (SPY.MAX 32148 . 33031) (
|
||||
SPY.MERGE 33033 . 34464) (SPY.MERGE1 34466 . 40949) (SPY.MERGETREE 40951 . 43881) (SPY.NEXT.TREE 43883
|
||||
. 44557) (SPY.SUM 44559 . 45248) (SPY.TITLE 45250 . 45467) (SPY.MAKE.TREE 45469 . 47494) (
|
||||
SPY.UPDATE.TITLE 47496 . 50072) (SPY.DELETE 50074 . 50609) (SPY.DRAWBOX 50611 . 51136) (
|
||||
SPY.BUFFER.ENTRY 51138 . 51481) (SPY.BUTTON 51483 . 52052) (SPY.END.ENTRY 52054 . 52134) (SPY.START
|
||||
52136 . 52420) (SPY.INIT 52422 . 52657) (\SPY.INTERRUPT 52659 . 54064) (SPY.DUMP.BUFFER 54066 . 55526)
|
||||
(SPY.START.ENTRY 55528 . 55656) (SPY.ADD.ENTRY 55658 . 56090) (SPY.ORIGINAL 56092 . 56919) (
|
||||
SPY.OVERFLOW 56921 . 57022) (SPY.MERGE.CALLEES 57024 . 60060) (SPY.PRINT 60062 . 60385)))))
|
||||
(FILEMAP (NIL (4660 7267 (SPYOBJ 4670 . 4959) (SPYOBJ.BUTTON 4961 . 5071) (SPYOBJ.SAVE 5073 . 5192) (
|
||||
SPYOBJ.COPY 5194 . 5256) (SPYOBJ.GET 5258 . 5387) (SPYOBJ.IMAGEBOX 5389 . 5913) (SPYOBJ.DISPLAY 5915
|
||||
. 6214) (SPYOBJ.LABEL 6216 . 6352) (SPYOBJ.HEIGHT 6354 . 6567) (SPYOBJ.COPYIN 6569 . 6612) (
|
||||
SPY.COPYBUTTON 6614 . 6706) (SPY.MERGEINFO 6708 . 7265)) (7731 49962 (SPY.FIND.TREE 7741 . 8150) (
|
||||
SPY.TOGGLE 8152 . 8342) (SPY.TREE 8344 . 9456) (SPY.LEGEND 9458 . 9808) (SPY.GRAPH.EDITOR 9810 . 19375
|
||||
) (SPY.END 19377 . 19619) (SPY.MAKEGRAPHNODES 19621 . 21721) (SPY.MAX 21723 . 22606) (SPY.MERGE 22608
|
||||
. 24039) (SPY.MERGE1 24041 . 30524) (SPY.MERGETREE 30526 . 33456) (SPY.NEXT.TREE 33458 . 34132) (
|
||||
SPY.SUM 34134 . 34823) (SPY.TITLE 34825 . 35042) (SPY.MAKE.TREE 35044 . 37069) (SPY.UPDATE.TITLE 37071
|
||||
. 39647) (SPY.DELETE 39649 . 40184) (SPY.DRAWBOX 40186 . 40711) (SPY.BUFFER.ENTRY 40713 . 41056) (
|
||||
SPY.BUTTON 41058 . 41627) (SPY.END.ENTRY 41629 . 41709) (SPY.START 41711 . 41995) (SPY.INIT 41997 .
|
||||
42232) (\SPY.INTERRUPT 42234 . 43639) (SPY.DUMP.BUFFER 43641 . 45101) (SPY.START.ENTRY 45103 . 45231)
|
||||
(SPY.ADD.ENTRY 45233 . 45665) (SPY.ORIGINAL 45667 . 46494) (SPY.OVERFLOW 46496 . 46597) (
|
||||
SPY.MERGE.CALLEES 46599 . 49635) (SPY.PRINT 49637 . 49960)))))
|
||||
STOP
|
||||
|
||||
BIN
library/SPY.LCOM
BIN
library/SPY.LCOM
Binary file not shown.
Binary file not shown.
606
sources/LLSTK
606
sources/LLSTK
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-Jan-93 18:07:37" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>LLSTK.;9| 112417
|
||||
|
||||
changes to%: (RECORDS FVARSLOT)
|
||||
(FILECREATED "27-Feb-2024 22:46:53" {DSK}<home>larry>il>medley>sources>LLSTK.;5 105300
|
||||
|
||||
previous date%: "17-Dec-92 18:17:01" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>LLSTK.;8|)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (RECORDS FX)
|
||||
(VARS LLSTKCOMS)
|
||||
|
||||
:PREVIOUS-DATE "27-Feb-2024 22:31:40" {DSK}<home>larry>il>medley>sources>LLSTK.;4)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLSTKCOMS)
|
||||
|
||||
@@ -28,10 +28,10 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
|
||||
(CONSTANTS \NT.IVAR \NT.PVAR \NT.FVAR))
|
||||
(RECORDS STACKCELL))
|
||||
(COMS (* ;
|
||||
"For LAMBDA* and Common Lisp functions.")
|
||||
"For LAMBDA* and Common Lisp functions.")
|
||||
(FNS \MYARGCOUNT \ARG0 \SETARG0))
|
||||
(COMS (* ;
|
||||
"basic spaghetti for allocating, moving and reclaiming stack frames")
|
||||
"basic spaghetti for allocating, moving and reclaiming stack frames")
|
||||
(FNS \HARDRETURN \DOHARDRETURN \DOGC1 \DOGC \DOHARDRETURN1 \DOSTACKOVERFLOW \MOVEFRAME
|
||||
\INCUSECOUNT \DECUSECOUNT \MAKESTACKP \SMASHLINK \FREESTACKBLOCK \EXTENDSTACK))
|
||||
(COMS (* ; "Some ugly stack-munging ufns")
|
||||
@@ -82,192 +82,186 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
|
||||
EVAL@COMPILE
|
||||
(ADDVARS (DONTCOMPILEFNS SETUPSTACK)))
|
||||
(LOCALVARS . T)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA SI::INTERNAL-THROW
|
||||
|
||||
SI::NON-LOCAL-RETURN
|
||||
])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA SI::INTERNAL-THROW-VALUES SI::INTERNAL-THROW SI::NON-LOCAL-RETURN-VALUES
|
||||
SI::NON-LOCAL-RETURN])
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* ; "basic frame pointer")
|
||||
(BLOCKRECORD BFBLOCK ((FLAGS BITS 3)
|
||||
(NIL BITS 3)
|
||||
(RESIDUAL FLAG) (* ; "true if this is not a full BF")
|
||||
(PADDING BITS 1)
|
||||
(USECNT BITS 8)
|
||||
(IVAR WORD)))
|
||||
(TYPE? (IEQ (fetch (BF FLAGS) of DATUM)
|
||||
\STK.BF))
|
||||
[ACCESSFNS BF ((NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (fetch
|
||||
(BF IVAR)
|
||||
of DATUM))
|
||||
WORDSPERCELL)
|
||||
(fetch (BF PADDING) of DATUM)))
|
||||
[SIZE (IPLUS 2 (IDIFFERENCE DATUM (fetch (BF IVAR) of DATUM]
|
||||
(CHECKED (AND (type? BF DATUM)
|
||||
(for I from (fetch (BF IVAR) of DATUM)
|
||||
to (IDIFFERENCE DATUM 2) by 2
|
||||
always (IEQ \STK.NOTFLAG (fetch
|
||||
(BF FLAGS)
|
||||
of I])
|
||||
(ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* ; "basic frame pointer")
|
||||
(BLOCKRECORD BFBLOCK ((FLAGS BITS 3)
|
||||
(NIL BITS 3)
|
||||
(RESIDUAL FLAG) (* ; "true if this is not a full BF")
|
||||
(PADDING BITS 1)
|
||||
(USECNT BITS 8)
|
||||
(IVAR WORD)))
|
||||
(TYPE? (IEQ (fetch (BF FLAGS) of DATUM)
|
||||
\STK.BF))
|
||||
[ACCESSFNS BF ((NARGS (IDIFFERENCE (FOLDLO (IDIFFERENCE DATUM (fetch (BF IVAR)
|
||||
of DATUM))
|
||||
WORDSPERCELL)
|
||||
(fetch (BF PADDING) of DATUM)))
|
||||
[SIZE (IPLUS 2 (IDIFFERENCE DATUM (fetch (BF IVAR) of DATUM]
|
||||
(CHECKED (AND (type? BF DATUM)
|
||||
(for I from (fetch (BF IVAR) of DATUM)
|
||||
to (IDIFFERENCE DATUM 2) by 2
|
||||
always (IEQ \STK.NOTFLAG (fetch (BF FLAGS) of I])
|
||||
|
||||
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* ; "frame extension index")
|
||||
(BLOCKRECORD FXBLOCK ((FLAGS BITS 3) (* ; "= \STK.FX")
|
||||
(FAST FLAG)
|
||||
(NIL FLAG)
|
||||
(INCALL FLAG) (* ;
|
||||
"set when fncall microcode has to punt")
|
||||
(VALIDNAMETABLE FLAG)(* ;
|
||||
"if on, NAMETABLE field is filled in. If off, is same as FNHEADER")
|
||||
(NOPUSH FLAG) (* ;
|
||||
"when returning to this frame, don't push a value. Set by interrupt code")
|
||||
(USECNT BITS 8)
|
||||
(%#ALINK WORD) (* ; "low bit is SLOWP")
|
||||
(FNHEADER FULLXPOINTER)
|
||||
(NEXTBLOCK WORD)
|
||||
(PC WORD)
|
||||
(NAMETABLE# FULLXPOINTER)
|
||||
(%#BLINK WORD)
|
||||
(%#CLINK WORD)))
|
||||
(BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
|
||||
(NIL BYTE)
|
||||
(NIL BITS 15) (* ; "most of the bits of #ALINK")
|
||||
(SLOWP FLAG) (* ;
|
||||
"if on, then BLINK and CLINK fields are valid. If off, they are implicit")
|
||||
(NIL FULLXPOINTER 2)
|
||||
(NAMETABHI WORD)
|
||||
(NAMETABLO WORD)))
|
||||
(TYPE? (IEQ (fetch (FX FLAGS) of DATUM)
|
||||
\STK.FX))
|
||||
[ACCESSFNS FX ((NAMETABLE (COND
|
||||
((fetch (FX VALIDNAMETABLE) of DATUM)
|
||||
(fetch (FX NAMETABLE#) of DATUM))
|
||||
(T (fetch (FX FNHEADER) of DATUM)))
|
||||
(PROGN (replace (FX FAST) of DATUM with NIL)
|
||||
(replace (FX NAMETABLE#) of DATUM with
|
||||
NEWVALUE)
|
||||
(replace (FX VALIDNAMETABLE) of DATUM
|
||||
with T)))
|
||||
(FRAMENAME (fetch (FNHEADER FRAMENAME)
|
||||
of (fetch (FX NAMETABLE) of DATUM)))
|
||||
(INVALIDP (EQ DATUM 0)) (* ;
|
||||
"true when A/CLink points at nobody, i.e. FX is bottom of stack")
|
||||
[FASTP (NOT (fetch (FX SLOWP) of DATUM))
|
||||
(PROGN (CHECK (NULL NEWVALUE))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with
|
||||
T]
|
||||
[BLINK (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX DUMMYBF) of DATUM))
|
||||
(T (fetch (FX %#BLINK) of DATUM)))
|
||||
(PROGN (replace (FX %#BLINK) of DATUM with
|
||||
NEWVALUE)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with
|
||||
T]
|
||||
[CLINK (IDIFFERENCE (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX %#ALINK) of DATUM))
|
||||
(T (fetch (FX %#CLINK) of DATUM)))
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN (replace (FX %#CLINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with
|
||||
T]
|
||||
[ALINK (IDIFFERENCE (FLOOR (fetch (FX %#ALINK) of DATUM)
|
||||
WORDSPERCELL)
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM]
|
||||
(replace (FX %#ALINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET
|
||||
(SUB1 WORDSPERCELL]
|
||||
[ACLINK (SHOULDNT)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM]
|
||||
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* ; "frame extension index")
|
||||
(BLOCKRECORD FXBLOCK ((FLAGS BITS 3) (* ; "= \STK.FX")
|
||||
(FAST FLAG)
|
||||
(NIL FLAG)
|
||||
(INCALL FLAG) (* ;
|
||||
"set when fncall microcode has to punt")
|
||||
(VALIDNAMETABLE FLAG) (* ;
|
||||
"if on, NAMETABLE field is filled in. If off, is same as FNHEADER")
|
||||
(NOPUSH FLAG) (* ;
|
||||
"when returning to this frame, don't push a value. Set by interrupt code")
|
||||
(USECNT BITS 8)
|
||||
(%#ALINK WORD) (* ; "low bit is SLOWP")
|
||||
(FNHEADER FULLXPOINTER)
|
||||
(NEXTBLOCK WORD)
|
||||
(PC WORD)
|
||||
(NAMETABLE# FULLXPOINTER)
|
||||
(%#BLINK WORD)
|
||||
(%#CLINK WORD)))
|
||||
(BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
|
||||
(NIL BYTE)
|
||||
(NIL BITS 15) (* ; "most of the bits of #ALINK")
|
||||
(SLOWP FLAG) (* ;
|
||||
"if on, then BLINK and CLINK fields are valid. If off, they are implicit")
|
||||
(NIL FULLXPOINTER) (* ; "FNHEADER")
|
||||
(NIL WORD) (* ; "NEXSTBLOCK")
|
||||
(NIL WORD) (* ; "PC")
|
||||
(NAMETABHI WORD)
|
||||
(NAMETABLO WORD)))
|
||||
(TYPE? (IEQ (fetch (FX FLAGS) of DATUM)
|
||||
\STK.FX))
|
||||
[ACCESSFNS FX ((NAMETABLE (COND
|
||||
((fetch (FX VALIDNAMETABLE) of DATUM)
|
||||
(fetch (FX NAMETABLE#) of DATUM))
|
||||
(T (fetch (FX FNHEADER) of DATUM)))
|
||||
(PROGN (replace (FX FAST) of DATUM with NIL)
|
||||
(replace (FX NAMETABLE#) of DATUM with NEWVALUE)
|
||||
(replace (FX VALIDNAMETABLE) of DATUM with T)))
|
||||
(FRAMENAME (fetch (FNHEADER FRAMENAME) of (fetch (FX NAMETABLE)
|
||||
of DATUM)))
|
||||
(INVALIDP (EQ DATUM 0)) (* ;
|
||||
"true when A/CLink points at nobody, i.e. FX is bottom of stack")
|
||||
[FASTP (NOT (fetch (FX SLOWP) of DATUM))
|
||||
(PROGN (CHECK (NULL NEWVALUE))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET))
|
||||
(replace (FX %#ALINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET
|
||||
(SUB1 WORDSPERCELL]
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[BLINK (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX DUMMYBF) of DATUM))
|
||||
(T (fetch (FX %#BLINK) of DATUM)))
|
||||
(PROGN (replace (FX %#BLINK) of DATUM with NEWVALUE)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[CLINK (IDIFFERENCE (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX %#ALINK) of DATUM))
|
||||
(T (fetch (FX %#CLINK) of DATUM)))
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN (replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET)
|
||||
)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[ALINK (IDIFFERENCE (FLOOR (fetch (FX %#ALINK) of DATUM)
|
||||
WORDSPERCELL)
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM]
|
||||
(replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET
|
||||
(SUB1
|
||||
WORDSPERCELL
|
||||
]
|
||||
[ACLINK (SHOULDNT)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM]
|
||||
(replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET)
|
||||
)
|
||||
(replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET
|
||||
(SUB1
|
||||
WORDSPERCELL
|
||||
]
|
||||
(* ;
|
||||
"replaces A & C Links at once more efficiently than separately")
|
||||
(DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
|
||||
"replaces A & C Links at once more efficiently than separately")
|
||||
(DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
|
||||
|
||||
(* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too.")
|
||||
(* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too.")
|
||||
|
||||
(IVAR (fetch (BF IVAR) of (fetch (FX DUMMYBF)
|
||||
of DATUM)))
|
||||
[CHECKED (AND (type? FX DATUM)
|
||||
(OR (IEQ (fetch (FX DUMMYBF) of DATUM)
|
||||
(fetch (FX BLINK) of DATUM))
|
||||
(AND (fetch (BF RESIDUAL)
|
||||
of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(IEQ (fetch (BF IVAR)
|
||||
of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(fetch (BF IVAR)
|
||||
of (fetch (FX BLINK)
|
||||
of DATUM]
|
||||
(FIRSTPVAR (IPLUS DATUM (fetch (FX FXSIZE) of T)))
|
||||
(IVAR (fetch (BF IVAR) of (fetch (FX DUMMYBF) of DATUM)))
|
||||
[CHECKED (AND (type? FX DATUM)
|
||||
(OR (IEQ (fetch (FX DUMMYBF) of DATUM)
|
||||
(fetch (FX BLINK) of DATUM))
|
||||
(AND (fetch (BF RESIDUAL) of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(IEQ (fetch (BF IVAR) of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(fetch (BF IVAR) of (fetch (FX BLINK)
|
||||
of DATUM]
|
||||
(FIRSTPVAR (IPLUS DATUM (fetch (FX FXSIZE) of T)))
|
||||
(* ; "stack offset of PVAR0")
|
||||
(FXSIZE (PROGN 10)) (* ;
|
||||
"fixed overhead from flags thru clink")
|
||||
(PADDING (PROGN 4)) (* ;
|
||||
"doublecell of garbage for microcode use")
|
||||
(FIRSTTEMP (IPLUS (fetch (FX FIRSTPVAR) of DATUM)
|
||||
(fetch (FX NPVARWORDS) of DATUM)
|
||||
(fetch (FX PADDING) of DATUM)))
|
||||
(FXSIZE (PROGN 10)) (* ;
|
||||
"fixed overhead from flags thru clink")
|
||||
(PADDING (PROGN 4)) (* ;
|
||||
"doublecell of garbage for microcode use")
|
||||
(FIRSTTEMP (IPLUS (fetch (FX FIRSTPVAR) of DATUM)
|
||||
(fetch (FX NPVARWORDS) of DATUM)
|
||||
(fetch (FX PADDING) of DATUM)))
|
||||
(* ;
|
||||
"note that NPVARWORDS is obtained from the FNHEADER")
|
||||
(SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM)
|
||||
DATUM])
|
||||
"note that NPVARWORDS is obtained from the FNHEADER")
|
||||
(SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM)
|
||||
DATUM])
|
||||
|
||||
(ACCESSFNS FSB
|
||||
(* ;; "FREE STACK BLOCK -- ")
|
||||
(* ;; "FREE STACK BLOCK -- ")
|
||||
|
||||
(* ;; " A piece of stack space that's free.")
|
||||
(* ;; " A piece of stack space that's free.")
|
||||
|
||||
(* ;; "The first word contains 120000Q")
|
||||
(* ;; "The first word contains 120000Q")
|
||||
|
||||
(* ;; "The 2nd word is the size of the block, in words.")
|
||||
(* ;; "The 2nd word is the size of the block, in words.")
|
||||
|
||||
((FSBBLOCK (ADDSTACKBASE DATUM))
|
||||
(CHECKED (IEQ (fetch (FSB FLAGWORD) of DATUM)
|
||||
\STK.FSB.WORD)))
|
||||
(BLOCKRECORD FSBBLOCK ((FLAGS BITS 3)
|
||||
(DUMMY BITS 13)
|
||||
(SIZE WORD)))
|
||||
(BLOCKRECORD FSBBLOCK ((FLAGWORD WORD)
|
||||
(SIZE WORD))) (* ; "free stack block")
|
||||
(TYPE? (IEQ (fetch (FSB FLAGS) of DATUM)
|
||||
\STK.FSB)))
|
||||
((FSBBLOCK (ADDSTACKBASE DATUM))
|
||||
(CHECKED (IEQ (fetch (FSB FLAGWORD) of DATUM)
|
||||
\STK.FSB.WORD)))
|
||||
(BLOCKRECORD FSBBLOCK ((FLAGS BITS 3)
|
||||
(DUMMY BITS 13)
|
||||
(SIZE WORD)))
|
||||
(BLOCKRECORD FSBBLOCK ((FLAGWORD WORD)
|
||||
(SIZE WORD))) (* ; "free stack block")
|
||||
(TYPE? (IEQ (fetch (FSB FLAGS) of DATUM)
|
||||
\STK.FSB)))
|
||||
|
||||
(ACCESSFNS STK ((STKBLOCK (ADDSTACKBASE DATUM))) (* ; "unspecified stack block")
|
||||
(BLOCKRECORD STKBLOCK ((FLAGS BITS 3)))
|
||||
(BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
|
||||
(ACCESSFNS STK ((STKBLOCK (ADDSTACKBASE DATUM))) (* ; "unspecified stack block")
|
||||
(BLOCKRECORD STKBLOCK ((FLAGS BITS 3)))
|
||||
(BLOCKRECORD STKBLOCK ((FLAGWORD WORD))))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -287,47 +281,44 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
|
||||
(PUTPROPS ADDSTACKBASE DMACRO (= . STACKADDBASE))
|
||||
|
||||
(PUTPROPS STACKADDBASE DMACRO ((N)
|
||||
(VAG2 \STACKHI N)))
|
||||
(VAG2 \STACKHI N)))
|
||||
|
||||
(PUTPROPS STACKGETBASE DMACRO ((N)
|
||||
(\GETBASE (STACKADDBASE N)
|
||||
0)))
|
||||
(\GETBASE (STACKADDBASE N)
|
||||
0)))
|
||||
|
||||
(PUTPROPS STACKGETBASEPTR DMACRO ((N)
|
||||
(\GETBASEPTR (STACKADDBASE N)
|
||||
0)))
|
||||
(\GETBASEPTR (STACKADDBASE N)
|
||||
0)))
|
||||
|
||||
(PUTPROPS STACKPUTBASE DMACRO ((N V)
|
||||
(\PUTBASE (STACKADDBASE N)
|
||||
0 V)))
|
||||
(\PUTBASE (STACKADDBASE N)
|
||||
0 V)))
|
||||
|
||||
(PUTPROPS STACKPUTBASEPTR DMACRO ((N V)
|
||||
(\PUTBASEPTR (STACKADDBASE N)
|
||||
0 V)))
|
||||
(\PUTBASEPTR (STACKADDBASE N)
|
||||
0 V)))
|
||||
|
||||
(PUTPROPS \MISCAPPLY* MACRO ((FN ARG1 ARG2)
|
||||
(UNINTERRUPTABLY
|
||||
(replace (IFPAGE MISCSTACKFN) of \InterfacePage
|
||||
with FN)
|
||||
(replace (IFPAGE MISCSTACKARG1) of \InterfacePage
|
||||
with ARG1)
|
||||
(replace (IFPAGE MISCSTACKARG2) of \InterfacePage
|
||||
with ARG2)
|
||||
(\CONTEXTSWITCH \MiscFXP)
|
||||
(fetch (IFPAGE MISCSTACKRESULT) of \InterfacePage))))
|
||||
(UNINTERRUPTABLY
|
||||
(replace (IFPAGE MISCSTACKFN) of \InterfacePage with FN)
|
||||
(replace (IFPAGE MISCSTACKARG1) of \InterfacePage with ARG1)
|
||||
(replace (IFPAGE MISCSTACKARG2) of \InterfacePage with ARG2)
|
||||
(\CONTEXTSWITCH \MiscFXP)
|
||||
(fetch (IFPAGE MISCSTACKRESULT) of \InterfacePage))))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD STACKP ((STACKP0 WORD)
|
||||
(EDFXP WORD))
|
||||
(BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER)))
|
||||
(TYPE? (STACKP DATUM)))
|
||||
(EDFXP WORD))
|
||||
(BLOCKRECORD STACKP ((STACKPOINTER FULLXPOINTER)))
|
||||
(TYPE? (STACKP DATUM)))
|
||||
)
|
||||
|
||||
(RPAQQ STACKTYPES (\STK.GUARD \STK.FX \STK.BF \STK.NOTFLAG \STK.FSB \STK.FLAGS.SHIFT
|
||||
(\STK.FSB.WORD (LLSH \STK.FSB \STK.FLAGS.SHIFT))
|
||||
(\STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT))
|
||||
(\STK.BF.WORD (LLSH \STK.BF \STK.FLAGS.SHIFT))))
|
||||
(\STK.FSB.WORD (LLSH \STK.FSB \STK.FLAGS.SHIFT))
|
||||
(\STK.GUARD.WORD (LLSH \STK.GUARD \STK.FLAGS.SHIFT))
|
||||
(\STK.BF.WORD (LLSH \STK.BF \STK.FLAGS.SHIFT))))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \STK.GUARD 7)
|
||||
@@ -375,44 +366,44 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD NAMETABLESLOT ((VARTYPE BYTE)
|
||||
(VAROFFSET BYTE)))
|
||||
(VAROFFSET BYTE)))
|
||||
|
||||
(BLOCKRECORD FVARSLOT ((BINDLO WORD)
|
||||
(BINDHI WORD))
|
||||
[ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (fetch BINDLO of DATUM)))
|
||||
(BINDINGPTR (\VAG2 (fetch BINDHI of DATUM)
|
||||
(fetch BINDLO of DATUM))
|
||||
(PROGN (replace BINDLO of DATUM
|
||||
with (\LOLOC NEWVALUE))
|
||||
(replace BINDHI of DATUM
|
||||
with (\HILOC NEWVALUE])
|
||||
(BINDHI WORD))
|
||||
[ACCESSFNS FVARSLOT ((LOOKEDUP (EVENP (fetch BINDLO of DATUM)))
|
||||
(BINDINGPTR (\VAG2 (fetch BINDHI of DATUM)
|
||||
(fetch BINDLO of DATUM))
|
||||
(PROGN (replace BINDLO of DATUM with (\LOLOC
|
||||
NEWVALUE
|
||||
))
|
||||
(replace BINDHI of DATUM with (\HILOC
|
||||
NEWVALUE
|
||||
])
|
||||
|
||||
(BLOCKRECORD PVARSLOT ((PVHI BITS 4)
|
||||
(PVVALUE XPOINTER))
|
||||
[ACCESSFNS PVARSLOT ((BOUND (EQ (fetch (PVARSLOT PVHI) of DATUM)
|
||||
0)
|
||||
(if (NULL NEWVALUE)
|
||||
then (replace (PVARSLOT PVHI)
|
||||
of DATUM with 255)
|
||||
else (ERROR "Illegal replace" NEWVALUE])
|
||||
(PVVALUE XPOINTER))
|
||||
[ACCESSFNS PVARSLOT ((BOUND (EQ (fetch (PVARSLOT PVHI) of DATUM)
|
||||
0)
|
||||
(if (NULL NEWVALUE)
|
||||
then (replace (PVARSLOT PVHI) of DATUM
|
||||
with 255)
|
||||
else (ERROR "Illegal replace" NEWVALUE])
|
||||
|
||||
(BLOCKRECORD STKTEMPSLOT ((STKTMPHI BITS 4)
|
||||
(VALUE XPOINTER))
|
||||
[ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (NEQ (fetch STKTMPHI
|
||||
of DATUM)
|
||||
0])
|
||||
(VALUE XPOINTER))
|
||||
[ACCESSFNS STKTEMPSLOT ((BINDINGPTRP (NEQ (fetch STKTMPHI of DATUM)
|
||||
0])
|
||||
|
||||
(BLOCKRECORD BINDMARKSLOT ((BINDMARKP FLAG)
|
||||
(NIL BITS 15))
|
||||
(BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD)
|
||||
(BINDLASTPVAR WORD)))
|
||||
[ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN
|
||||
(NIL BITS 15))
|
||||
(BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD)
|
||||
(BINDLASTPVAR WORD)))
|
||||
[ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN
|
||||
(* ;
|
||||
"Value stored in high half is one's complement of number of values bound")
|
||||
(LOGXOR (fetch
|
||||
BINDNEGVALUES
|
||||
of DATUM)
|
||||
65535])
|
||||
"Value stored in high half is one's complement of number of values bound")
|
||||
(LOGXOR (fetch BINDNEGVALUES
|
||||
of DATUM)
|
||||
65535])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -432,13 +423,12 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD STACKCELL ((STACKNONPOINTERBITS BITS 8)
|
||||
(STACKHIBITS BITS 8)
|
||||
(STACKLOBITS WORD))
|
||||
[ACCESSFNS STACKCELL ((VALIDPOINTERP (EQ 0 (fetch (STACKCELL
|
||||
STACKNONPOINTERBITS
|
||||
)
|
||||
of DATUM)))
|
||||
(VALIDPOINTER (\GETBASEPTR DATUM 0])
|
||||
(STACKHIBITS BITS 8)
|
||||
(STACKLOBITS WORD))
|
||||
[ACCESSFNS STACKCELL ((VALIDPOINTERP (EQ 0 (fetch (STACKCELL
|
||||
STACKNONPOINTERBITS)
|
||||
of DATUM)))
|
||||
(VALIDPOINTER (\GETBASEPTR DATUM 0])
|
||||
)
|
||||
)
|
||||
|
||||
@@ -1221,10 +1211,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 b
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQQ *HARDRESET-IGNORE-VARS* (SI::*CLEANUP-FORMS* SI::*DUMMY-FOR-CATCH* SI::*CATCH-RETURN-FROM*
|
||||
SI::*CATCH-RETURN-TO* *FORM* *ARGVAL* *FN* *TAIL*
|
||||
*FIRSTTAIL* \INTERNAL \INTERRUPTABLE SI::*NLSETQFLAG*
|
||||
*PROCEED-CASES*))
|
||||
(RPAQQ *HARDRESET-IGNORE-VARS* (SI::*CLEANUP-FORMS* SI::*DUMMY-FOR-CATCH* SI::*CATCH-RETURN-FROM*
|
||||
SI::*CATCH-RETURN-TO* *FORM* *ARGVAL* *FN* *TAIL* *FIRSTTAIL*
|
||||
\INTERNAL \INTERRUPTABLE SI::*NLSETQFLAG* *PROCEED-CASES*))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *HARDRESET-IGNORE-VARS*)
|
||||
@@ -1303,118 +1292,31 @@ EVAL@COMPILE
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA SI::INTERNAL-THROW SI::NON-LOCAL-RETURN)
|
||||
)
|
||||
(PRETTYCOMPRINT LLSTKCOMS)
|
||||
|
||||
(RPAQQ LLSTKCOMS
|
||||
[(DECLARE%: DONTCOPY (EXPORT (RECORDS BF FX FSB STK)
|
||||
(CONSTANTS \#ALINK.OFFSET)
|
||||
(GLOBALVARS \PENDINGINTERRUPT \KBDSTACKBASE \MISCSTACKBASE
|
||||
\STACKOVERFLOW)
|
||||
(MACROS \MYALINK ADDSTACKBASE STACKADDBASE STACKGETBASE
|
||||
STACKGETBASEPTR STACKPUTBASE STACKPUTBASEPTR \MISCAPPLY*)
|
||||
(RECORDS STACKP)
|
||||
(CONSTANTS * STACKTYPES)
|
||||
(CONSTANTS \StackAreaSize (\InitStackSize (ITIMES \StackAreaSize
|
||||
12)))
|
||||
(CONSTANTS \MAXSAFEUSECOUNT)
|
||||
(RECORDS NAMETABLESLOT FVARSLOT PVARSLOT STKTEMPSLOT BINDMARKSLOT)
|
||||
(CONSTANTS \NT.IVAR \NT.PVAR \NT.FVAR))
|
||||
(RECORDS STACKCELL))
|
||||
(COMS (* ;
|
||||
"For LAMBDA* and Common Lisp functions.")
|
||||
(FNS \MYARGCOUNT \ARG0 \SETARG0))
|
||||
(COMS (* ;
|
||||
"basic spaghetti for allocating, moving and reclaiming stack frames")
|
||||
(FNS \HARDRETURN \DOHARDRETURN \DOGC1 \DOGC \DOHARDRETURN1 \DOSTACKOVERFLOW \MOVEFRAME
|
||||
\INCUSECOUNT \DECUSECOUNT \MAKESTACKP \SMASHLINK \FREESTACKBLOCK \EXTENDSTACK))
|
||||
(COMS (* ; "Some ugly stack-munging ufns")
|
||||
(FNS \SLOWRETURN \COPY.N.UFN \POP.N.UFN \STORE.N.UFN \UNWIND.UFN))
|
||||
(COMS (* ; "The unwinder")
|
||||
(FNS SI::NON-LOCAL-GO SI::NON-LOCAL-RETURN SI::NON-LOCAL-RETURN-VALUES
|
||||
SI::INTERNAL-THROW SI::INTERNAL-THROW-VALUES SI::UNWIND-TO-BLIP SI::UNWIND
|
||||
SI::VARIABLE-NAME-IN-FRAME SI::PVAR-VALUE-IN-FRAME)
|
||||
(FNS \DISCARDFRAME \SMASHRETURN))
|
||||
(COMS (* ; "parsing stack for gc")
|
||||
(FNS \GCSCANSTACK))
|
||||
(COMS (* ; "setting up stack from scratch")
|
||||
(FNS CLEARSTK HARDRESET RELSTK RELSTKP)
|
||||
(FNS SETUPSTACK \SETUPSTACK1 \MAKEFRAME \RESETSTACK \RESETSTACK0 \SETUPUSERSTACK
|
||||
\SETUPGUARDBLOCK \MAKEFREEBLOCK \REPEATEDLYEVALQT \DUMMYKEYHANDLER \DUMMYTELERAID
|
||||
\CAUSEINTERRUPT \CONTEXTAPPLY \INTERRUPTFRAME \INTERRUPTED \CODEFORTFRAME
|
||||
\DOMISCAPPLY \DOMISCAPPLY1)
|
||||
(INITVARS \SAVED.USER.CONTEXT \NEED.HARDRESET.CLEANUP)
|
||||
(GLOBALVARS \SAVED.USER.CONTEXT \NEED.HARDRESET.CLEANUP))
|
||||
(COMS (* ; "HARDRESET recovery code")
|
||||
(FNS \GATHER-CLEANUP-FORMS \GATHER-CLEANUP-FORMS1 \GATHER-SPECIAL-BINDINGS
|
||||
\HARDRESET-CLEANUP \HARDRESET-CLEANUP1 \HARDRESET-CLEANUP-RUN)
|
||||
(VARS *HARDRESET-IGNORE-VARS*)
|
||||
(GLOBALVARS *HARDRESET-IGNORE-VARS*))
|
||||
(COMS (* ; "Ufns for RETCALL")
|
||||
(FNS \DORETCALL \RETCALL))
|
||||
(INITVARS (STACKTESTING T))
|
||||
(COMS (* ; "Stack overflow handler")
|
||||
(FNS \DOSTACKFULLINTERRUPT STACK.FULL.WARNING \CLEANUP.STACKFULL)
|
||||
(INITVARS (\PENDINGINTERRUPT)
|
||||
(\STACKOVERFLOW)
|
||||
(AUTOHARDRESETFLG T))
|
||||
(ADDVARS (RESETFORMS (SETQ \STACKOVERFLOW)))
|
||||
(GLOBALVARS AUTOHARDRESETFLG))
|
||||
(DECLARE%: DONTCOPY
|
||||
(ADDVARS [INEWCOMS (FNS SETUPSTACK \SETUPSTACK1 \SETUPGUARDBLOCK \MAKEFREEBLOCK)
|
||||
(ALLOCAL (ADDVARS (LOCKEDFNS \RESETSTACK0 \MAKEFRAME \SETUPSTACK1
|
||||
\MAKEFREEBLOCK \FAULTHANDLER \KEYHANDLER
|
||||
\DUMMYKEYHANDLER \DOTELERAID \DUMMYTELERAID
|
||||
\DOHARDRETURN \DOGC \CAUSEINTERRUPT
|
||||
\INTERRUPTFRAME \CODEFORTFRAME
|
||||
\DOSTACKOVERFLOW \UNLOCKPAGES \DOMISCAPPLY)
|
||||
(LOCKEDVARS \InterfacePage \DEFSPACE \STACKSPACE
|
||||
\KBDSTACKBASE \MISCSTACKBASE
|
||||
\SAVED.USER.CONTEXT \RUNNING.PROCESS
|
||||
\NEED.HARDRESET.CLEANUP]
|
||||
(EXPANDMACROFNS ADDSTACKBASE STACKADDBASE))
|
||||
EVAL@COMPILE
|
||||
(ADDVARS (DONTCOMPILEFNS SETUPSTACK)))
|
||||
(LOCALVARS . T)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA SI::INTERNAL-THROW-VALUES SI::INTERNAL-THROW SI::NON-LOCAL-RETURN-VALUES
|
||||
SI::NON-LOCAL-RETURN])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA SI::INTERNAL-THROW-VALUES SI::INTERNAL-THROW SI::NON-LOCAL-RETURN-VALUES
|
||||
SI::NON-LOCAL-RETURN)
|
||||
SI::NON-LOCAL-RETURN)
|
||||
)
|
||||
(PUTPROPS LLSTK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
||||
1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (26973 28438 (\MYARGCOUNT 26983 . 27268) (\ARG0 27270 . 27836) (\SETARG0 27838 . 28436))
|
||||
(28522 45444 (\HARDRETURN 28532 . 28748) (\DOHARDRETURN 28750 . 28929) (\DOGC1 28931 . 29146) (\DOGC
|
||||
29148 . 29253) (\DOHARDRETURN1 29255 . 33570) (\DOSTACKOVERFLOW 33572 . 34472) (\MOVEFRAME 34474 .
|
||||
38001) (\INCUSECOUNT 38003 . 38769) (\DECUSECOUNT 38771 . 39916) (\MAKESTACKP 39918 . 40378) (
|
||||
\SMASHLINK 40380 . 41833) (\FREESTACKBLOCK 41835 . 44576) (\EXTENDSTACK 44578 . 45442)) (45490 49233 (
|
||||
\SLOWRETURN 45500 . 45638) (\COPY.N.UFN 45640 . 45805) (\POP.N.UFN 45807 . 46482) (\STORE.N.UFN 46484
|
||||
. 46658) (\UNWIND.UFN 46660 . 49231)) (49263 60146 (SI::NON-LOCAL-GO 49273 . 49771) (
|
||||
SI::NON-LOCAL-RETURN 49773 . 50498) (SI::NON-LOCAL-RETURN-VALUES 50500 . 51073) (SI::INTERNAL-THROW
|
||||
51075 . 51743) (SI::INTERNAL-THROW-VALUES 51745 . 52251) (SI::UNWIND-TO-BLIP 52253 . 55986) (SI::UNWIND
|
||||
55988 . 57544) (SI::VARIABLE-NAME-IN-FRAME 57546 . 58466) (SI::PVAR-VALUE-IN-FRAME 58468 . 60144)) (
|
||||
60147 63781 (\DISCARDFRAME 60157 . 62105) (\SMASHRETURN 62107 . 63779)) (63819 70819 (\GCSCANSTACK
|
||||
63829 . 70817)) (70866 72307 (CLEARSTK 70876 . 71570) (HARDRESET 71572 . 71693) (RELSTK 71695 . 71893)
|
||||
(RELSTKP 71895 . 72305)) (72308 84299 (SETUPSTACK 72318 . 73336) (\SETUPSTACK1 73338 . 75247) (
|
||||
\MAKEFRAME 75249 . 75602) (\RESETSTACK 75604 . 75907) (\RESETSTACK0 75909 . 79013) (\SETUPUSERSTACK
|
||||
79015 . 80719) (\SETUPGUARDBLOCK 80721 . 80887) (\MAKEFREEBLOCK 80889 . 81128) (\REPEATEDLYEVALQT
|
||||
81130 . 81261) (\DUMMYKEYHANDLER 81263 . 81565) (\DUMMYTELERAID 81567 . 81680) (\CAUSEINTERRUPT 81682
|
||||
. 82730) (\CONTEXTAPPLY 82732 . 82944) (\INTERRUPTFRAME 82946 . 83140) (\INTERRUPTED 83142 . 83354) (
|
||||
\CODEFORTFRAME 83356 . 83612) (\DOMISCAPPLY 83614 . 83689) (\DOMISCAPPLY1 83691 . 84297)) (84513
|
||||
102751 (\GATHER-CLEANUP-FORMS 84523 . 84899) (\GATHER-CLEANUP-FORMS1 84901 . 88530) (
|
||||
\GATHER-SPECIAL-BINDINGS 88532 . 91506) (\HARDRESET-CLEANUP 91508 . 95965) (\HARDRESET-CLEANUP1 95967
|
||||
. 102300) (\HARDRESET-CLEANUP-RUN 102302 . 102749)) (103213 104265 (\DORETCALL 103223 . 104165) (
|
||||
\RETCALL 104167 . 104263)) (104333 105268 (\DOSTACKFULLINTERRUPT 104343 . 104551) (STACK.FULL.WARNING
|
||||
104553 . 104921) (\CLEANUP.STACKFULL 104923 . 105266)))))
|
||||
(FILEMAP (NIL (25672 27137 (\MYARGCOUNT 25682 . 25967) (\ARG0 25969 . 26535) (\SETARG0 26537 . 27135))
|
||||
(27221 44143 (\HARDRETURN 27231 . 27447) (\DOHARDRETURN 27449 . 27628) (\DOGC1 27630 . 27845) (\DOGC
|
||||
27847 . 27952) (\DOHARDRETURN1 27954 . 32269) (\DOSTACKOVERFLOW 32271 . 33171) (\MOVEFRAME 33173 .
|
||||
36700) (\INCUSECOUNT 36702 . 37468) (\DECUSECOUNT 37470 . 38615) (\MAKESTACKP 38617 . 39077) (
|
||||
\SMASHLINK 39079 . 40532) (\FREESTACKBLOCK 40534 . 43275) (\EXTENDSTACK 43277 . 44141)) (44189 47932 (
|
||||
\SLOWRETURN 44199 . 44337) (\COPY.N.UFN 44339 . 44504) (\POP.N.UFN 44506 . 45181) (\STORE.N.UFN 45183
|
||||
. 45357) (\UNWIND.UFN 45359 . 47930)) (47962 58845 (SI::NON-LOCAL-GO 47972 . 48470) (
|
||||
SI::NON-LOCAL-RETURN 48472 . 49197) (SI::NON-LOCAL-RETURN-VALUES 49199 . 49772) (SI::INTERNAL-THROW
|
||||
49774 . 50442) (SI::INTERNAL-THROW-VALUES 50444 . 50950) (SI::UNWIND-TO-BLIP 50952 . 54685) (SI::UNWIND
|
||||
54687 . 56243) (SI::VARIABLE-NAME-IN-FRAME 56245 . 57165) (SI::PVAR-VALUE-IN-FRAME 57167 . 58843)) (
|
||||
58846 62480 (\DISCARDFRAME 58856 . 60804) (\SMASHRETURN 60806 . 62478)) (62518 69518 (\GCSCANSTACK
|
||||
62528 . 69516)) (69565 71006 (CLEARSTK 69575 . 70269) (HARDRESET 70271 . 70392) (RELSTK 70394 . 70592)
|
||||
(RELSTKP 70594 . 71004)) (71007 82998 (SETUPSTACK 71017 . 72035) (\SETUPSTACK1 72037 . 73946) (
|
||||
\MAKEFRAME 73948 . 74301) (\RESETSTACK 74303 . 74606) (\RESETSTACK0 74608 . 77712) (\SETUPUSERSTACK
|
||||
77714 . 79418) (\SETUPGUARDBLOCK 79420 . 79586) (\MAKEFREEBLOCK 79588 . 79827) (\REPEATEDLYEVALQT
|
||||
79829 . 79960) (\DUMMYKEYHANDLER 79962 . 80264) (\DUMMYTELERAID 80266 . 80379) (\CAUSEINTERRUPT 80381
|
||||
. 81429) (\CONTEXTAPPLY 81431 . 81643) (\INTERRUPTFRAME 81645 . 81839) (\INTERRUPTED 81841 . 82053) (
|
||||
\CODEFORTFRAME 82055 . 82311) (\DOMISCAPPLY 82313 . 82388) (\DOMISCAPPLY1 82390 . 82996)) (83212
|
||||
101450 (\GATHER-CLEANUP-FORMS 83222 . 83598) (\GATHER-CLEANUP-FORMS1 83600 . 87229) (
|
||||
\GATHER-SPECIAL-BINDINGS 87231 . 90205) (\HARDRESET-CLEANUP 90207 . 94664) (\HARDRESET-CLEANUP1 94666
|
||||
. 100999) (\HARDRESET-CLEANUP-RUN 101001 . 101448)) (101862 102914 (\DORETCALL 101872 . 102814) (
|
||||
\RETCALL 102816 . 102912)) (102982 103917 (\DOSTACKFULLINTERRUPT 102992 . 103200) (STACK.FULL.WARNING
|
||||
103202 . 103570) (\CLEANUP.STACKFULL 103572 . 103915)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user