-- StackImpl.mesa
-- Edited by Sweet, 5-Mar-82 21:15:48
-- Edited by Satterthwaite, December 16, 1982 10:08 am
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [codeptr, tempcontext, tempstart, warnStackOverflow],
CodeDefs: TYPE USING [
Base, BYTE, CCIndex, codeType, DataStackIndex, EvalStackSize, LabelCCNull,
Lexeme, StackBackup, StackIndex, StackItem, StackLocRec, StackNull, StackPos,
TempAddr, VarComponent],
FOpCodes: TYPE USING [
qBNDCK, qDDUP, qDEXCH, qDIS, qDUP, qEXCH, qLI, qLLK, qNILCK, qNILCKL],
Log: TYPE USING [Warning],
P5: TYPE USING [GenTempLex, PopEffect, PushEffect],
P5L: TYPE USING [LoadComponent, StoreComponent],
P5U: TYPE USING [CreateLabel, DeleteCell, FreeChunk, GetChunk, Out0, Out1],
Stack: TYPE USING [],
Symbols: TYPE USING [Base, BitAddress, ContextLevel, ctxType, lZ, seType];
StackImpl: PROGRAM
IMPORTS CPtr: Code, Log, P5, P5L, P5U
EXPORTS Stack =
BEGIN OPEN CodeDefs;
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;
stking: PUBLIC BOOL;
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 [place: StackBackup, n: CARDINAL←1] =
BEGIN
s: StackIndex ← Top[n];
fp: POINTER TO frame StackBackup;
forget: BOOL ← FALSE;
IF n = 1 THEN {
WITH ss: cb[s] SELECT FROM
data => ss.backup ← place;
ENDCASE => StkError[];
RETURN};
WITH pp: place SELECT FROM
frame => fp ← @pp;
none => forget ← TRUE;
ENDCASE => StkError[];
THROUGH [0..n) DO
WITH ss: cb[s] SELECT FROM
data => ss.backup ← place;
ENDCASE => StkError[];
IF ~forget THEN fp.tOffset ← fp.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;
THROUGH [0..popeffect) DO s ← cb[s].downlink ENDLOOP;
WHILE s # stkHead DO
WITH ss: cb[s] SELECT FROM
data => IF ss.loaded THEN extra ← extra + 1;
ENDCASE;
s ← cb[s].downlink;
ENDLOOP;
IF extra + pusheffect > uBound THEN DumpAndComplain[];
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 = stking;
stking ← FALSE; -- Off[];
WHILE stkPtr # stkHead DO
WITH cc: cb[stkPtr] SELECT FROM
data => IF cc.loaded THEN P5U.Out0[FOpCodes.qDIS];
ENDCASE => StkError[]; -- shouldn't go over a mark
DelStackItem[stkPtr];
ENDLOOP;
stking ← saveStking;
END;
ComponentForBackup: PUBLIC PROC [sb: StackBackup, words: CARDINAL←1] RETURNS [VarComponent] =
BEGIN
WITH bb: sb SELECT FROM
frame => RETURN [[wSize: words, space:
frame[wd: bb.tOffset, level: bb.tLevel, immutable: TRUE]]];
link =>
IF words # 1 THEN StkError[]
ELSE RETURN [[wSize: 1, space: link[bb.link]]];
const =>
IF words # 1 THEN StkError[]
ELSE RETURN [[wSize: 1, space: const[d1: bb.value]]];
ENDCASE => StkError[];
ERROR; -- can't get here, but it makes the compiler happy
END;
DataIndex: PUBLIC PROC [s: StackIndex] RETURNS [DataStackIndex] =
BEGIN
IF s = StackNull THEN RETURN[LOOPHOLE[s]];
WITH cb[s] SELECT FROM
data => RETURN [LOOPHOLE[s]];
ENDCASE => StkError[];
ERROR; -- to remove compiler warning
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 (which is mark anyway)
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 ss: cb[s] SELECT FROM
mark =>
BEGIN
IF s = stkHead THEN StkError[]; -- fell off the end
IF CPtr.codeptr = ss.label THEN CPtr.codeptr ← cb[ss.label].blink;
P5U.DeleteCell[ss.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 ss: cb[s] SELECT FROM
data => IF ss.loaded THEN d ← d+1;
ENDCASE;
ENDLOOP;
END;
Dump: PUBLIC PROC =
BEGIN
extra: CARDINAL ← 0;
s: StackIndex ← stkPtr;
wa: CARDINAL;
savec: CodeDefs.CCIndex = CPtr.codeptr;
target: CodeDefs.CCIndex = cb[savec].flink;
next: CodeDefs.CCIndex;
saveStking: BOOL = stking;
stking ← FALSE; -- Off[];
WHILE s # stkHead DO
WITH ss: cb[s] SELECT FROM
data => IF ss.backup.where = none THEN extra ← extra + 1;
ENDCASE;
s ← cb[s].downlink;
ENDLOOP;
IF extra # 0 THEN
BEGIN
tlex: Lexeme.se = P5.GenTempLex[extra];
a: Symbols.BitAddress = seb[tlex.lexsei].idValue;
wa ← a.wd + extra-1;
END;
s ← stkPtr;
WHILE s # stkHead DO
WITH ss: cb[s] SELECT FROM
data => IF ss.loaded THEN wa ← Store[s, wa];
mark => CPtr.codeptr ← ss.label;
ENDCASE;
s ← cb[s].downlink;
ENDLOOP;
CPtr.codeptr ← savec;
UNTIL (next ← cb[CPtr.codeptr].flink) = target DO
CPtr.codeptr ← next;
ENDLOOP;
stking ← saveStking;
END;
DumpAndComplain: PRIVATE PROC = {
Dump[];
IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
Dup: PUBLIC PROC [load: BOOL←FALSE] =
BEGIN
oldTop: DataStackIndex = DataIndex[stkPtr];
ds: DataStackIndex;
saveStking: BOOL = stking;
stking ← FALSE; -- Off[];
IF Depth[]+1 > uBound THEN DumpAndComplain[];
Incr[1]; ds ← LOOPHOLE[stkPtr]; -- Incr adds data ones
cb[ds].backup ← cb[oldTop].backup;
IF cb[oldTop].loaded THEN P5U.Out0[FOpCodes.qDUP]
ELSE {
cb[ds].loaded ← FALSE;
IF cb[oldTop].backup.where = none THEN StkError[]
ELSE IF load THEN LoadItem[stkPtr]};
stking ← saveStking;
END;
DDup: PUBLIC PROC [load: BOOL←FALSE] =
BEGIN
old2: DataStackIndex = DataIndex[stkPtr];
old1: DataStackIndex = DataIndex[cb[old2].downlink];
ds1, ds2: DataStackIndex;
saveStking: BOOL = stking;
stking ← FALSE; -- Off[];
IF Depth[]+2 > uBound THEN DumpAndComplain[];
Incr[1]; ds1 ← LOOPHOLE[stkPtr]; -- Incr adds data ones
Incr[1]; ds2 ← LOOPHOLE[stkPtr];
cb[ds1].backup ← cb[old1].backup;
cb[ds2].backup ← cb[old2].backup;
IF cb[old1].loaded AND cb[old2].loaded THEN P5U.Out0[FOpCodes.qDDUP]
ELSE {
cb[ds1].loaded ← FALSE;
cb[ds2].loaded ← FALSE;
IF load THEN {LoadItem[ds1]; LoadItem[ds2]}};
stking ← saveStking;
END;
Exchange: PUBLIC PROC =
BEGIN
st1: DataStackIndex = DataIndex[stkPtr];
st2: DataStackIndex = DataIndex[cb[st1].downlink];
IF cb[st1].loaded THEN Load[st2, 1]
ELSE
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;
stkPtr ← st2;
END;
END;
DExchange: PUBLIC PROC =
BEGIN
st1: DataStackIndex = DataIndex[stkPtr];
st2: DataStackIndex = DataIndex[cb[st1].downlink];
st3: DataStackIndex = DataIndex[cb[st2].downlink];
st4: DataStackIndex = DataIndex[cb[st3].downlink];
IF cb[st1].loaded OR cb[st2].loaded THEN Load[st3, 2]
ELSE
BEGIN
t: StackIndex = cb[st4].downlink;
cb[t].uplink ← st2; cb[st2].downlink ← t;
cb[st1].uplink ← st4; cb[st4].downlink ← st1;
cb[st3].uplink ← StackNull;
stkPtr ← st3;
END;
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, info: data[]];
stkPtr ← s;
ENDLOOP;
END;
Init: PUBLIC PROC =
BEGIN
uBound ← EvalStackSize - 1; -- might want to store into temp outside first page
stkHead ← P5U.GetChunk[StackItem.SIZE];
cb[stkHead] ← [downlink: stkHead, info: mark[LabelCCNull]];
stkPtr ← stkHead;
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: DataStackIndex = DataIndex[s];
last: DataStackIndex ← DataIndex[Above[first, count-1]];
ts: StackIndex;
saveStking: BOOL = stking;
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 ss: cb[ts] SELECT FROM
data => IF ss.loaded THEN 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};
IF ad = 2 AND count = 2 THEN {P5U.Out0[FOpCodes.qDEXCH]; GO TO linkToTop};
StoreItems[cb[last].uplink, ll.depth];
GO TO linkToTop;
END;
contig, stored =>
BEGIN
IF Depth[] + count > uBound THEN DumpAndComplain[];
ts ← first;
THROUGH [0..count) DO
LoadItem[ts];
ts ← cb[ts].uplink;
ENDLOOP;
GO TO linkToTop;
END;
ENDCASE =>
BEGIN -- usually some things in temps with some loaded above
toLoad: CARDINAL ← count;
extra: CARDINAL;
xs: StackIndex ← first;
ds: DataStackIndex;
THROUGH [0..count) DO
ds ← DataIndex[xs];
IF cb[ds].loaded THEN toLoad ← toLoad-1;
xs ← cb[ds].uplink;
ENDLOOP;
IF Depth[] + toLoad > uBound THEN DumpAndComplain[];
IF toLoad = count-1 AND count <= 3 AND cb[last].loaded
AND ds # StackNull THEN
BEGIN
ts ← first;
THROUGH [0..toLoad) DO
LoadItem[ts];
P5U.Out0[FOpCodes.qEXCH];
ts ← cb[ts].uplink;
ENDLOOP;
GO TO linkToTop;
END;
IF toLoad = count-2 AND count <= 6 AND count MOD 2 = 0
AND cb[last].loaded
AND cb[LOOPHOLE[cb[last].downlink, DataStackIndex]].loaded
AND ds # StackNull THEN
BEGIN
ts ← first;
THROUGH [0..toLoad/2) DO
LoadItem[ts];
ts ← cb[ts].uplink;
LoadItem[ts];
P5U.Out0[FOpCodes.qDEXCH];
ts ← cb[ts].uplink;
ENDLOOP;
GO TO linkToTop;
END;
xs ← first; extra ← count;
THROUGH [0..count) DO
ds ← DataIndex[xs];
IF ~cb[ds].loaded THEN EXIT;
extra ← extra-1;
xs ← cb[ds].uplink;
ENDLOOP;
StoreItems[ds, VDepthOf[ds]+1]; -- in the unlikely case stuff is above
ts ← ds;
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;
stking ← saveStking;
END;
LoadItem: PRIVATE PROC [s: StackIndex] =
BEGIN -- stking is off when called
ds: DataStackIndex = DataIndex[s];
sb: StackBackup = cb[ds].backup;
IF cb[ds].loaded THEN RETURN;
WITH bb: sb SELECT FROM
frame =>
BEGIN
var: VarComponent ← [
wSize: 1,
space: frame[level: bb.tLevel, wd: bb.tOffset, immutable: TRUE]];
P5L.LoadComponent[var];
END;
link => P5U.Out1[FOpCodes.qLLK, bb.link];
const => P5U.Out1[FOpCodes.qLI, bb.value];
faddr =>
BEGIN
var: VarComponent ← [
wSize: 1,
space: faddr[level: bb.tLevel, wd: bb.tOffset]];
P5L.LoadComponent[var];
END;
ENDCASE => StkError[];
cb[ds].loaded ← TRUE;
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
ds: DataStackIndex ← DataIndex[s];
sb: StackBackup;
contig: BOOL ← TRUE;
i: CARDINAL ← 0;
off: TempAddr;
lvl: Symbols.ContextLevel;
IF cb[ds].loaded THEN
BEGIN
d: StackPos ← 0;
THROUGH (0..count) DO
ds ← DataIndex[cb[ds].uplink];
IF ~cb[ds].loaded THEN RETURN[[mixed[]]];
ENDLOOP;
s ← ds;
WHILE s # stkPtr DO -- note: this counts marks, used by Load
d ← d+1;
s ← cb[s].uplink;
ENDLOOP;
RETURN[[onStack[d]]];
END;
DO
sb ← cb[ds].backup;
WITH bb: sb SELECT FROM
frame =>
IF i = 0 THEN {lvl ← bb.tLevel; off ← bb.tOffset}
ELSE {IF bb.tLevel # lvl OR bb.tOffset # off+i THEN contig ← FALSE};
link, const, faddr =>
IF count = 1 THEN RETURN [[contig[sb]]]
ELSE contig ← FALSE;
ENDCASE;
i ← i+1;
IF i = count THEN EXIT;
ds ← DataIndex[cb[ds].uplink];
IF cb[ds].loaded THEN RETURN[[mixed[]]];
ENDLOOP;
IF contig THEN RETURN [[contig[[frame[tOffset: off, tLevel: lvl]]]]]
ELSE RETURN [[stored[]]];
END;
Mark: PUBLIC PROC =
BEGIN
down: StackIndex = stkPtr;
stkPtr ← P5U.GetChunk[StackItem.SIZE];
cb[stkPtr] ← [downlink: down, info: mark[P5U.CreateLabel[]]];
cb[down].uplink ← stkPtr;
END;
MoveToTemp: PUBLIC PROC [
firstIndex: StackIndex, count: CARDINAL, preChaff: CARDINAL]
RETURNS [VarComponent] =
BEGIN -- store "count" words from stack into contiguous temps
-- and pop off preChaff words ahead of firstIndex
s: StackIndex;
tStart, tempPrev: TempAddr;
ctlvl: Symbols.ContextLevel = ctxb[CPtr.tempcontext].level;
lvlPrev: Symbols.ContextLevel;
first: BOOL ← TRUE;
remaining: CARDINAL ← count;
saveStking: BOOL = 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;
stking ← FALSE; -- Stack.Off[];
IF above # StackNull THEN
BEGIN -- unlikely
StoreItems[above, VDepthOf[above]+1];
stkPtr ← cb[above].downlink;
cb[stkPtr].uplink ← StackNull; -- temporarily unlink
END;
IF count = 1 THEN
BEGIN -- trade space for clarity
ds: DataStackIndex = DataIndex[firstIndex];
sb: StackBackup ← cb[ds].backup;
var: VarComponent;
IF cb[ds].loaded THEN {StoreItems[ds, 1]; sb ← cb[ds].backup};
WITH bb: sb SELECT FROM
frame => var ← [wSize: 1, space:
frame[wd: bb.tOffset, immutable: TRUE, level: bb.tLevel]];
link =>
var ← [wSize: 1, space: link[wd: bb.link]];
faddr => var ← [wSize: 1, space:
faddr[wd: bb.tOffset, level: bb.tLevel]];
const =>
var ← [wSize: 1, space: const[d1: bb.value]];
ENDCASE;
DelStackItem[firstIndex];
IF preChaff # 0 THEN Pop[preChaff];
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
ds: DataStackIndex = DataIndex[s];
sb: StackBackup = cb[ds].backup;
WITH bb: sb SELECT FROM
frame =>
BEGIN
IF first THEN
BEGIN
tStart ← bb.tOffset;
lvlPrev ← bb.tLevel;
first ← FALSE;
END
ELSE
BEGIN
IF bb.tLevel # lvlPrev OR bb.tOffset # tempPrev+1 THEN
GO TO moveAll; -- not worth a check for hole after prev
END;
tempPrev ← bb.tOffset;
remaining ← remaining-1;
END;
link, const, faddr, none =>
IF first OR lvlPrev # ctlvl OR tempPrev # CPtr.tempstart-1 THEN GO TO moveAll
ELSE GO TO moveRest;
ENDCASE => StkError[];
ENDLOOP;
EXITS
moveAll =>
BEGIN
remaining ← count;
tStart ← CPtr.tempstart;
lvlPrev ← ctlvl;
GO TO moveRest;
END;
END;
EXITS
moveRest =>
BEGIN
n: CARDINAL ← remaining;
k: CARDINAL;
tlex: Lexeme.se = P5.GenTempLex[remaining];
a: Symbols.BitAddress = seb[tlex.lexsei].idValue;
wa: CARDINAL ← a.wd + remaining - 1;
WHILE n > 0 DO
k ← MIN[n, 2];
Load[Top[k], k];
THROUGH [0..k) DO
wa ← Store[stkPtr, wa, TRUE];
DelStackItem[stkPtr]; -- this updates stkPtr
ENDLOOP;
n ← n - k;
ENDLOOP;
END;
END;
IF remaining < count THEN Pop[count-remaining];
IF preChaff # 0 THEN Pop[preChaff];
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;
Pop: PUBLIC PROC [count: CARDINAL←1] =
BEGIN
saveStking: BOOL = stking;
stking ← FALSE; -- Off[];
THROUGH [0..count) DO
ds: DataStackIndex = DataIndex[stkPtr];
IF cb[ds].loaded THEN P5U.Out0[FOpCodes.qDIS];
DelStackItem[stkPtr];
ENDLOOP;
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
WITH ss: cb[s] SELECT FROM
data => IF ss.loaded THEN extra ← extra + 1;
ENDCASE;
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;
ds: DataStackIndex = DataIndex[s];
sb: StackBackup = cb[ds].backup;
IF ~cb[ds].loaded THEN RETURN[addr];
IF storeNew OR sb.where = none THEN
BEGIN
lvl ← ctxb[CPtr.tempcontext].level;
StoreWord[addr, lvl];
cb[ds].backup ← [frame[tLevel: lvl, tOffset: addr]];
addr ← addr-1;
END
ELSE P5U.Out0[FOpCodes.qDIS];
cb[ds].loaded ← FALSE;
RETURN [addr];
END;
StoreItems: PRIVATE PROC [start: StackIndex, count: CARDINAL] =
BEGIN -- not necessarily contiguously
needed: CARDINAL ← 0;
s, last: DataStackIndex;
ts: StackIndex;
wa: CARDINAL;
ts ← start;
THROUGH [0..count) DO
IF ts = StackNull THEN StkError[];
s ← DataIndex[ts];
IF cb[s].loaded AND cb[s].backup.where = none THEN needed ← needed + 1;
last ← s;
ts ← cb[s].uplink;
ENDLOOP;
IF needed # 0 THEN
BEGIN
tlex: Lexeme.se ← P5.GenTempLex[needed];
a: Symbols.BitAddress ← seb[tlex.lexsei].idValue;
wa ← a.wd + needed - 1;
END;
ts ← last;
THROUGH [0..count) DO
s ← DataIndex[ts];
IF cb[s].loaded THEN wa ← Store[s, wa, FALSE];
ts ← 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, 0]];
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.