-- StackImpl.mesa
-- Edited by Sweet, February 3, 1981 4:54 PM
-- Edited by Satterthwaite, February 15, 1983 2:17 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [codeptr, stking, tempcontext, tempstart],
CodeDefs: TYPE USING [
Base, Byte, CCIndex, CCNull, codeType, EvalStackSize, LabelCCNull,
Lexeme, StackIndex, StackItem, StackLocRec, StackNull, StackPos,
TempAddr, VarComponent],
FOpCodes: TYPE USING [qBNDCK, qDUP, qEXCH, qLLK, qNILCK, qNILCKL, qPOP],
P5: TYPE USING [GenTempLex, PopEffect, PushEffect],
P5L: TYPE USING [LoadComponent, StoreComponent],
P5U: TYPE USING [CreateLabel, DeleteCell, FreeChunk, GetChunk, Out0, Out1],
Stack: TYPE,
Symbols: TYPE USING [Base, BitAddress, ContextLevel, ctxType, lZ, seType];
StackImpl: PROGRAM
IMPORTS LCPtr: Code, P5, P5L, P5U
EXPORTS Stack =
BEGIN OPEN CodeDefs;
CPtr: POINTER TO FRAME [Code] = LCPtr;
cb: CodeDefs.Base;
seb, ctxb: Symbols.Base;
uBound: StackPos;
StackImplNotify: PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
cb ← base[codeType];
END;
stkHead: StackIndex ← StackNull;
stkPtr: StackIndex;
StackModelingError: PUBLIC SIGNAL = CODE;
StkError: PRIVATE PROC =
BEGIN SIGNAL StackModelingError END;
Above: PUBLIC PROC [s: StackIndex, count: CARDINAL ← 1, nullOk: BOOL ← FALSE]
RETURNS [StackIndex] =
BEGIN
THROUGH [0..count) DO
IF s = StackNull THEN StkError[];
s ← cb[s].uplink;
ENDLOOP;
IF s = StackNull AND ~nullOk THEN StkError[];
RETURN [s]
END;
Also: PUBLIC PROC [
n: CARDINAL ← 1, inLink: BOOL ← FALSE, tOffset: TempAddr,
tLevel: Symbols.ContextLevel ← Symbols.lZ] =
BEGIN
s: StackIndex ← Top[n];
THROUGH [0..n) DO
IF cb[s].tag # onStack THEN StkError[];
cb[s].data ← onStack[alsoLink: inLink, tOffset: tOffset, tLevel: tLevel];
tOffset ← tOffset+1;
s ← cb[s].uplink;
ENDLOOP;
END;
Check: PUBLIC PROC [b: Byte] =
BEGIN
pusheffect: CARDINAL = P5.PushEffect[b];
popeffect: CARDINAL = P5.PopEffect[b];
extra: CARDINAL ← 0;
s: StackIndex ← stkPtr;
IF ~CPtr.stking THEN RETURN;
THROUGH [0..popeffect) DO s ← cb[s].downlink ENDLOOP;
WHILE s # stkHead DO
IF cb[s].tag = onStack THEN extra ← extra + 1;
s ← cb[s].downlink;
ENDLOOP;
IF extra + pusheffect > uBound THEN Dump[];
SELECT b FROM
FOpCodes.qNILCK => Load[Top[1],1];
FOpCodes.qNILCKL => Load[Top[2],2];
FOpCodes.qBNDCK => {Load[Top[2],2]; Decr[1]};
ENDCASE =>
BEGIN
IF popeffect # 0 THEN LoadToDepth[popeffect];
Incr[pusheffect];
END;
END;
Clear: PUBLIC PROC =
BEGIN
saveStking: BOOL = CPtr.stking;
CPtr.stking ← FALSE; -- Off[];
WHILE stkPtr # stkHead DO
WITH cb[stkPtr] SELECT FROM
inTemp, inLink => NULL;
onStack => P5U.Out0[FOpCodes.qPOP];
ENDCASE => StkError[]; -- shouldn't go over a mark
DelStackItem[stkPtr];
ENDLOOP;
CPtr.stking ← saveStking;
END;
Decr: PUBLIC PROC [count: CARDINAL ← 1] =
BEGIN
THROUGH [0..count) DO
IF cb[stkPtr].tag = mark THEN StkError[];
DelStackItem[stkPtr]; -- won't delete stkHead
ENDLOOP;
END;
DeleteToMark: PUBLIC PROC =
BEGIN
ResetToMark[];
DelStackItem[stkPtr];
END;
DelStackItem: PRIVATE PROC [s: StackIndex] =
BEGIN
up: StackIndex = cb[s].uplink;
down: StackIndex = cb[s].downlink;
WITH cb[s] SELECT FROM
mark =>
BEGIN
IF s = stkHead THEN StkError[]; -- fell off the end
IF CPtr.codeptr = label THEN CPtr.codeptr ← cb[label].blink;
P5U.DeleteCell[label];
END;
ENDCASE;
P5U.FreeChunk[s, StackItem.SIZE];
IF up # StackNull THEN cb[up].downlink ← down
ELSE stkPtr ← down;
cb[down].uplink ← up;
END;
Depth: PUBLIC PROC RETURNS [d: StackPos] =
BEGIN
d ← 0;
FOR s: StackIndex ← stkPtr, cb[s].downlink UNTIL s = stkHead DO
WITH cb[s] SELECT FROM
onStack => d ← d+1;
ENDCASE;
ENDLOOP;
END;
Dump: PUBLIC PROC =
BEGIN
extra: CARDINAL ← 0;
s: StackIndex ← stkPtr;
wa: CARDINAL;
savec: CodeDefs.CCIndex = CPtr.codeptr;
next: CodeDefs.CCIndex;
saveStking: BOOL = CPtr.stking;
CPtr.stking ← FALSE; -- Off[];
WHILE s # stkHead DO
WITH cb[s] SELECT FROM
onStack => IF ~alsoLink AND tLevel = Symbols.lZ THEN extra ← extra + 1;
ENDCASE;
s ← cb[s].downlink;
ENDLOOP;
IF extra # 0 THEN
BEGIN
tlex: se Lexeme = P5.GenTempLex[extra];
a: Symbols.BitAddress = seb[tlex.lexsei].idValue;
wa ← a.wd + extra-1;
END;
s ← stkPtr;
WHILE s # stkHead DO
WITH cb[s] SELECT FROM
onStack => wa ← Store[s, wa];
mark => CPtr.codeptr ← label;
ENDCASE;
s ← cb[s].downlink;
ENDLOOP;
CPtr.codeptr ← savec;
UNTIL (next ← cb[CPtr.codeptr].flink) = CCNull DO CPtr.codeptr ← next ENDLOOP;
CPtr.stking ← saveStking;
END;
Dup: PUBLIC PROC [load: BOOL ← FALSE] =
BEGIN
oldTop: StackIndex = stkPtr;
saveStking: BOOL = CPtr.stking;
CPtr.stking ← FALSE; -- Off[];
IF Depth[]+1 > uBound THEN Dump[];
Incr[1];
WITH ss: cb[oldTop] SELECT FROM
onStack =>
BEGIN
P5U.Out0[FOpCodes.qDUP];
cb[stkPtr].data ← onStack[alsoLink: ss.alsoLink,
tOffset: ss.tOffset, tLevel: ss.tLevel];
END;
inTemp =>
BEGIN
cb[stkPtr].data ← inTemp[tOffset: ss.tOffset, tLevel: ss.tLevel];
IF load THEN LoadItem[stkPtr];
END;
inLink =>
BEGIN
cb[stkPtr].data ← inLink[link: ss.link];
IF load THEN LoadItem[stkPtr];
END;
ENDCASE => StkError[];
CPtr.stking ← saveStking;
END;
Exchange: PUBLIC PROC =
BEGIN
st1: StackIndex = stkPtr;
st2: StackIndex = cb[st1].downlink;
IF st2 = stkHead OR cb[st2].tag = mark THEN StkError[];
WITH cb[st1] SELECT FROM
onStack => Load[st2, 1];
inTemp, inLink =>
BEGIN
t: StackIndex = cb[st2].downlink;
cb[t].uplink ← st1; cb[st1].downlink ← t;
cb[st1].uplink ← st2; cb[st2].downlink ← st1;
cb[st2].uplink ← StackNull;
END;
ENDCASE => StkError[];
stkPtr ← st2;
END;
Forget: PUBLIC PROC [s: StackIndex, count: CARDINAL ← 1] =
BEGIN
next: StackIndex;
THROUGH [0..count) DO
IF s = StackNull THEN StkError[];
next ← cb[s].uplink;
DelStackItem[s];
s ← next;
ENDLOOP;
END;
Incr: PUBLIC PROC [count: CARDINAL ← 1] =
BEGIN
s: StackIndex;
THROUGH [0..count) DO
cb[stkPtr].uplink ← s ← P5U.GetChunk[StackItem.SIZE];
cb[s] ← [downlink: stkPtr, data: NULL];
cb[s].data ← onStack[];
stkPtr ← s;
ENDLOOP;
END;
Init: PUBLIC PROC =
BEGIN
uBound ← EvalStackSize - 2;
stkHead ← P5U.GetChunk[StackItem.SIZE];
cb[stkHead] ← [downlink: stkHead, data: mark[LabelCCNull]];
stkPtr ← stkHead;
CPtr.stking ← FALSE;
END;
KeepOnly: PUBLIC PROC [s: StackIndex, count: CARDINAL] =
BEGIN -- used when taking initial field of larger stacked record
n: CARDINAL ← 0;
THROUGH [0..count) DO
IF s = StackNull THEN StkError[];
s ← cb[s].uplink;
ENDLOOP;
WHILE s # StackNull DO
n ← n+1;
s ← cb[s].uplink;
ENDLOOP;
IF n # 0 THEN Pop[n];
END;
Load: PUBLIC PROC [s: StackIndex, count: CARDINAL ← 1] =
BEGIN
loc: StackLocRec ← Loc[s, count];
first: StackIndex = s;
last: StackIndex ← Above[first, count-1];
ts: StackIndex;
saveStking: BOOL = CPtr.stking;
CPtr.stking ← FALSE; -- Off[];
BEGIN -- to set up linkToTop label
WITH ll: loc SELECT FROM
onStack =>
BEGIN
ad: CARDINAL;
IF ll.depth = 0 THEN GO TO done;
ad ← 0;
ts ← stkPtr;
THROUGH [0..ll.depth) DO
WITH cb[ts] SELECT FROM
onStack => ad ← ad+1;
ENDCASE => NULL;
ts ← cb[ts].downlink;
ENDLOOP;
IF ad = 0 THEN GO TO linkToTop;
IF ad = 1 AND count = 1 THEN {P5U.Out0[FOpCodes.qEXCH]; GO TO linkToTop};
StoreItems[cb[last].uplink, ll.depth];
GO TO linkToTop;
END;
inTemp =>
BEGIN
IF Depth[] + count > uBound THEN Dump[];
ts ← first;
THROUGH [0..count) DO
LoadItem[ts];
ts ← cb[ts].uplink;
ENDLOOP;
GO TO linkToTop;
END;
inLink =>
BEGIN -- count = 1
IF Depth[] + 1 > uBound THEN Dump[];
LoadItem[first];
GO TO linkToTop;
END;
ENDCASE =>
BEGIN -- usually some things in temps with some loaded above
toLoad: CARDINAL ← count;
extra: CARDINAL;
ts ← first;
THROUGH [0..count) DO
IF cb[ts].tag = onStack THEN toLoad ← toLoad-1;
ts ← cb[ts].uplink;
ENDLOOP;
IF Depth[] + toLoad > uBound THEN Dump[];
IF toLoad = count-1 AND count <= 4 AND cb[last].tag = onStack THEN
BEGIN
IF ts # StackNull THEN StoreItems[ts, VDepthOf[ts]+1]; -- unlikely
ts ← first;
THROUGH [0..toLoad) DO
LoadItem[ts];
P5U.Out0[FOpCodes.qEXCH];
ts ← cb[ts].uplink;
ENDLOOP;
GO TO linkToTop;
END;
ts ← first; extra ← count;
THROUGH [0..count) DO
IF cb[ts].tag # onStack THEN EXIT;
extra ← extra-1;
ts ← cb[ts].uplink;
ENDLOOP;
StoreItems[ts, VDepthOf[ts]+1]; -- in the unlikely case stuff is above
THROUGH [0..extra) DO
LoadItem[ts];
ts ← cb[ts].uplink;
ENDLOOP;
GO TO linkToTop;
END;
EXITS
linkToTop =>
BEGIN
rest: StackIndex = Above[first, count, TRUE];
IF rest # StackNull THEN
BEGIN
down: StackIndex = cb[first].downlink;
cb[stkPtr].uplink ← first;
cb[first].downlink ← stkPtr;
cb[rest].downlink ← down;
cb[down].uplink ← rest;
cb[last].uplink ← StackNull;
stkPtr ← last;
END;
END;
done => NULL;
END;
CPtr.stking ← saveStking;
END;
LoadItem: PRIVATE PROC [s: StackIndex] =
BEGIN -- stking is off when called
off: TempAddr;
lvl: Symbols.ContextLevel;
var: VarComponent;
WITH cb[s] SELECT FROM
inTemp =>
BEGIN
off ← tOffset;
lvl ← tLevel;
END;
inLink =>
BEGIN
P5U.Out1[FOpCodes.qLLK, link];
cb[s].data ← onStack [alsoLink: TRUE, tOffset: link];
RETURN;
END;
onStack => RETURN;
ENDCASE => StkError[];
var ← [wSize: 1, space: frame[level: lvl, wd: off, immutable: TRUE]];
P5L.LoadComponent[var];
cb[s].data ← onStack[tOffset: off, tLevel: lvl];
END;
LoadToDepth: PRIVATE PROC [n: StackPos] =
BEGIN
IF n = 0 THEN RETURN;
Load[Top[n], n];
Decr[n];
END;
Loc: PUBLIC PROC [s: StackIndex, count: CARDINAL ← 1] RETURNS [StackLocRec] =
BEGIN
WITH cb[s] SELECT FROM
onStack =>
BEGIN
d: StackPos ← 0;
THROUGH (0..count) DO
s ← cb[s].uplink;
WITH cb[s] SELECT FROM
onStack => NULL;
mark => StkError[];
ENDCASE => RETURN [[mixed[]]];
ENDLOOP;
WHILE s # stkPtr DO d ← d+1; s ← cb[s].uplink ENDLOOP;
RETURN [[onStack[d]]];
END;
inTemp =>
BEGIN
lvl: Symbols.ContextLevel ← tLevel;
off: TempAddr ← tOffset;
FOR i: CARDINAL IN (0..count) DO
s ← cb[s].uplink;
WITH cb[s] SELECT FROM
inTemp => IF tLevel # lvl OR tOffset # off+i THEN RETURN [[mixed[]]];
mark => StkError[];
ENDCASE => RETURN [[mixed[]]];
ENDLOOP;
RETURN [[inTemp[tSize: count, tLevel: lvl, tOffset: off]]];
END;
inLink => RETURN [IF count # 1 THEN [mixed[]] ELSE [inLink[link]]];
ENDCASE => StkError[]; -- shouldn't be a mark
ERROR; -- Since compiler doesn't know StkError doesn't return
END;
Mark: PUBLIC PROC =
BEGIN
down: StackIndex = stkPtr;
stkPtr ← P5U.GetChunk[StackItem.SIZE];
cb[stkPtr] ← [downlink: down, data: mark[P5U.CreateLabel[]]];
cb[down].uplink ← stkPtr;
END;
MoveToTemp: PUBLIC PROC [firstIndex: StackIndex, count: CARDINAL ← 1]
RETURNS [VarComponent] =
BEGIN -- store "count" words from stack into contiguous temps
s: StackIndex;
tStart, tempPrev: TempAddr;
ctlvl: Symbols.ContextLevel = ctxb[CPtr.tempcontext].level;
lvlPrev: Symbols.ContextLevel;
first: BOOL ← TRUE;
remaining: CARDINAL ← count;
saveStking: BOOL = CPtr.stking;
above: StackIndex = Above[s: firstIndex, count: count, nullOk: TRUE];
PutBackJunk: PROC =
BEGIN
cb[stkPtr].uplink ← above;
cb[above].downlink ← stkPtr;
UNTIL cb[stkPtr].uplink = StackNull DO stkPtr ← cb[stkPtr].uplink ENDLOOP;
END;
CPtr.stking ← FALSE; -- Stack.Off[];
IF above # StackNull THEN
BEGIN -- unlikely
n: StackPos = VDepthOf[above];
IF cb[above].tag # mark --AND n # 0 -- THEN StoreItems[above, n+1]; -- ??? (EHS)
stkPtr ← cb[above].downlink;
cb[stkPtr].uplink ← StackNull; -- temporarily unlink
END;
IF count = 1 THEN
BEGIN -- trade space for clarity
var: VarComponent;
WITH cb[firstIndex] SELECT FROM
onStack => StoreItems[firstIndex, 1];
ENDCASE;
WITH cb[firstIndex] SELECT FROM
inTemp => var ← [wSize: 1, space:
frame[wd: tOffset, immutable: TRUE, level: tLevel]];
inLink => var ← [wSize: 1, space: link[wd: link]];
ENDCASE;
DelStackItem[firstIndex];
CPtr.stking ← saveStking;
IF above # StackNull THEN PutBackJunk[];
RETURN[var]
END;
BEGIN -- to set up moveRest label
BEGIN -- to set up moveAll label
FOR s ← firstIndex, cb[s].uplink WHILE s # StackNull DO
WITH ss: cb[s] SELECT FROM
inTemp =>
BEGIN
IF first THEN
BEGIN
tStart ← ss.tOffset;
lvlPrev ← ss.tLevel;
first ← FALSE;
END
ELSE
BEGIN
IF ss.tLevel # lvlPrev OR ss.tOffset # tempPrev+1 THEN
GO TO moveAll; -- not worth a check for hole after prev
END;
tempPrev ← ss.tOffset;
remaining ← remaining-1;
END;
inLink => GO TO moveAll;
onStack =>
BEGIN
IF ss.tLevel # Symbols.lZ THEN
BEGIN
IF first THEN
BEGIN
tStart ← tempPrev ← ss.tOffset;
lvlPrev ← ss.tLevel;
first ← FALSE;
END
ELSE
BEGIN
IF ss.tLevel # lvlPrev OR ss.tOffset # tempPrev+1 THEN
GO TO moveAll; -- not worth a check for hole after prev
END;
tempPrev ← ss.tOffset;
remaining ← remaining-1;
LOOP;
END;
IF first OR lvlPrev # ctlvl OR tempPrev # CPtr.tempstart-1 THEN
GO TO moveAll;
GO TO moveRest;
END;
ENDCASE => StkError[];
ENDLOOP;
EXITS
moveAll =>
BEGIN
remaining ← count;
tStart ← CPtr.tempstart;
lvlPrev ← ctlvl;
GO TO moveRest;
END;
END;
EXITS
moveRest =>
BEGIN
tlex: se Lexeme = P5.GenTempLex[remaining];
a: Symbols.BitAddress = seb[tlex.lexsei].idValue;
wa: CARDINAL ← a.wd + remaining - 1;
THROUGH [0..remaining) DO -- fix someday to look for doubles
LoadItem[stkPtr];
wa ← Store[stkPtr, wa, TRUE];
DelStackItem[stkPtr]; -- this updates stkPtr
ENDLOOP;
END;
END;
IF remaining < count THEN Pop[count-remaining];
CPtr.stking ← saveStking;
IF above # StackNull THEN PutBackJunk[];
RETURN [[wSize: count, space: frame[wd: tStart, immutable: TRUE, level: lvlPrev]]];
END;
New: PUBLIC PROC RETURNS [old: StackIndex] =
BEGIN
old ← cb[stkHead].uplink;
cb[stkHead].uplink ← StackNull;
stkPtr ← stkHead;
END;
Off: PUBLIC PROC = {CPtr.stking ← FALSE};
On: PUBLIC PROC = {CPtr.stking ← TRUE};
Pop: PUBLIC PROC [count: CARDINAL ← 1] =
BEGIN
saveStking: BOOL = CPtr.stking;
s, next: StackIndex;
CPtr.stking ← FALSE; -- Off[];
FOR s ← stkPtr, next WHILE count > 0 DO
next ← cb[s].downlink;
SELECT cb[s].tag FROM
onStack, inTemp, inLink =>
BEGIN
IF cb[s].tag = onStack THEN P5U.Out0[FOpCodes.qPOP];
count ← count - 1; DelStackItem[s];
END;
mark => NULL;
ENDCASE => StkError[];
ENDLOOP;
CPtr.stking ← saveStking;
END;
Prefix: PUBLIC PROC [sti: StackIndex] =
BEGIN
ts, bs: StackIndex;
IF sti = StackNull THEN RETURN;
FOR ts ← sti, cb[ts].uplink UNTIL cb[ts].uplink = StackNull DO
ENDLOOP;
bs ← cb[stkHead].uplink;
cb[ts].uplink ← bs;
IF bs = StackNull THEN stkPtr ← ts ELSE cb[bs].downlink ← ts;
cb[stkHead].uplink ← sti; cb[sti].downlink ← stkHead;
END;
Require: PUBLIC PROC [n: StackPos] =
BEGIN
extra: CARDINAL ← 0;
s: StackIndex ← stkPtr;
THROUGH [0..n) DO s ← cb[s].downlink ENDLOOP;
WHILE s # stkHead DO
IF cb[s].tag = onStack THEN extra ← extra + 1;
s ← cb[s].downlink;
ENDLOOP;
IF extra # 0 THEN Dump[];
END;
Reset: PUBLIC PROC =
BEGIN
WHILE stkPtr # stkHead DO DelStackItem[stkPtr] ENDLOOP;
END;
ResetToMark: PUBLIC PROC =
BEGIN
n: CARDINAL ← 0;
FOR s: StackIndex ← stkPtr, cb[s].downlink DO
WITH cb[s] SELECT FROM
mark => IF s = stkHead THEN StkError[] ELSE EXIT;
ENDCASE => n ← n+1;
ENDLOOP;
IF n # 0 THEN LoadToDepth[n];
END;
Restore: PUBLIC PROC [s: StackIndex] =
BEGIN
Reset[]; -- free all but head
cb[stkHead].uplink ← s;
stkPtr ← stkHead;
UNTIL s = StackNull DO
stkPtr ← s;
s ← cb[stkPtr].uplink;
ENDLOOP;
END;
RoomFor: PUBLIC PROC [n: CARDINAL] RETURNS [BOOL] =
BEGIN
RETURN [Depth[]+n <= uBound]
END;
Store: PRIVATE PROC [
s: StackIndex,
addr: TempAddr,
storeNew: BOOL ← FALSE] RETURNS [nextAddr: TempAddr] =
BEGIN -- stack is off when called
-- Store the top element at addr
-- if storeNew = FALSE and in memory, then generate POP instead
lvl: Symbols.ContextLevel;
off: TempAddr;
link: BOOL;
BEGIN -- to set up label: store
WITH cb[s] SELECT FROM
onStack => IF storeNew OR ~(alsoLink OR tLevel # Symbols.lZ) THEN
GO TO store
ELSE
BEGIN
P5U.Out0[FOpCodes.qPOP];
lvl ← tLevel; off ← tOffset; link ← alsoLink;
END;
inTemp, inLink => RETURN;
ENDCASE => StkError[];
EXITS
store =>
BEGIN
link ← FALSE;
off ← addr;
lvl ← ctxb[CPtr.tempcontext].level;
StoreWord[addr, lvl];
addr ← addr-1;
END;
END;
IF link THEN cb[s].data ← inLink[off]
ELSE cb[s].data ← inTemp[tOffset: off, tLevel: lvl];
RETURN[addr];
END;
StoreItems: PRIVATE PROC [start: StackIndex, count: CARDINAL] =
BEGIN -- not necessarily contiguously
needed: CARDINAL ← 0;
s, last: StackIndex;
wa: CARDINAL;
s ← start;
THROUGH [0..count) DO
IF s = StackNull THEN StkError[];
WITH ss: cb[s] SELECT FROM
inTemp, inLink => NULL;
onStack => IF ~(ss.alsoLink OR ss.tLevel # Symbols.lZ) THEN needed ← needed+1;
ENDCASE => StkError[];
last ← s;
s ← cb[s].uplink;
ENDLOOP;
IF needed # 0 THEN
BEGIN
tlex: se Lexeme ← P5.GenTempLex[needed];
a: Symbols.BitAddress ← seb[tlex.lexsei].idValue;
wa ← a.wd + needed - 1;
END;
s ← last;
THROUGH [0..count) DO
WITH cb[s] SELECT FROM
inTemp, inLink => NULL;
onStack => wa ← Store[s, wa, FALSE];
ENDCASE;
s ← cb[s].downlink;
ENDLOOP;
END;
StoreWord: PRIVATE PROC [offset: TempAddr, lvl: Symbols.ContextLevel] =
BEGIN
var: VarComponent = [wSize: 1, space: frame[wd: offset, level: lvl]];
P5L.StoreComponent[var];
END;
TempStore: PUBLIC PROC [count: CARDINAL ← 1] RETURNS [VarComponent] =
BEGIN -- store top of stack into contiguous temps
RETURN [MoveToTemp[Top[count], count]];
END;
Top: PUBLIC PROC [count: CARDINAL ← 1] RETURNS [s: StackIndex] =
BEGIN
s ← stkPtr;
THROUGH (0..count) DO s ← cb[s].downlink ENDLOOP;
IF s = stkHead THEN StkError[];
RETURN
END;
UnMark: PUBLIC PROC =
BEGIN
n: CARDINAL ← 0;
FOR s: StackIndex ← stkPtr, cb[s].downlink DO
WITH cb[s] SELECT FROM
mark =>
BEGIN
IF s = stkHead THEN StkError[]; -- fell off the end
DelStackItem[s];
LoadToDepth[n]; -- make sure loaded, also forget from where
Incr[n]; -- remember how many things loaded
RETURN
END;
ENDCASE => n ← n+1;
ENDLOOP;
END;
VDepth: PUBLIC PROC RETURNS [StackPos] =
BEGIN
RETURN [VDepthOf[stkHead]];
END;
VDepthOf: PUBLIC PROC [s: StackIndex] RETURNS [d: StackPos] =
BEGIN
d ← 0;
IF s = StackNull THEN StkError[];
DO
s ← cb[s].uplink;
IF s = StackNull THEN RETURN;
IF cb[s].tag # mark THEN d ← d+1;
ENDLOOP;
END;
END.