-- StackImpl.mesa Edited by Sweet, January 10, 1980 11:20 AM
DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE],
Code: FROM "code" USING [
codeptr, dStar, stking, tempcontext, tempstart],
CodeDefs: FROM "codedefs" USING [
CCIndex, CCNull, EvalStackSize, LabelCCNull, Lexeme, StackIndex,
StackItem, StackLocRec, StackNull, StackPos, TempAddr, VarComponent],
FOpCodes: FROM "fopcodes" USING [qDUP, qEXCH, qLLK, qPOP],
P5: FROM "p5" USING [GenTempLex, MinimalStack, PopEffect, PushEffect],
P5L: FROM "p5l" USING [LoadComponent, StoreComponent],
P5U: FROM "p5u" USING [
CreateLabel, DeleteCell, FreeChunk, GetChunk, Out0, Out1],
Stack: FROM "stack",
Symbols: FROM "symbols" USING [
BitAddress, ContextLevel, ctxType, lZ, seType],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [treeType];
StackImpl: PROGRAM
IMPORTS LCPtr: Code, CodeDefs, P5, P5L, P5U, Stack
EXPORTS CodeDefs, Stack =
BEGIN OPEN CodeDefs;
CPtr: POINTER TO FRAME [Code] = LCPtr;
cb, seb, ctxb: Table.Base;
uBound: StackPos;
StackImplNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
cb ← base[Tree.treeType];
RETURN
END;
stkHead: StackIndex ← StackNull;
stkPtr: StackIndex;
StackModelingError: PUBLIC SIGNAL = CODE;
StkError: PRIVATE PROCEDURE =
BEGIN SIGNAL StackModelingError END;
Above: PUBLIC PROCEDURE
[s: StackIndex, count: CARDINAL ← 1, nullOk: BOOLEAN ← 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 PROCEDURE [
n: CARDINAL ← 1, inLink: BOOLEAN ← 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 PROCEDURE [b: AltoDefs.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[];
IF popeffect # 0 THEN LoadToDepth[popeffect];
IF ~CPtr.dStar AND P5.MinimalStack[b] AND Depth[] # 0 THEN
StkError[];
Incr[pusheffect];
END;
Clear: PUBLIC PROCEDURE =
BEGIN
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;
END;
Decr: PUBLIC PROCEDURE [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 PROCEDURE =
BEGIN
ResetToMark[];
DelStackItem[stkPtr];
END;
DelStackItem: PRIVATE PROCEDURE [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, SIZE[StackItem]];
IF up # StackNull THEN cb[up].downlink ← down
ELSE stkPtr ← down;
cb[down].uplink ← up;
END;
Depth: PUBLIC PROCEDURE RETURNS [d: StackPos] =
BEGIN
s: StackIndex;
d ← 0;
FOR s ← stkPtr, cb[s].downlink UNTIL s = stkHead DO
WITH cb[s] SELECT FROM
onStack => d ← d+1;
ENDCASE;
ENDLOOP;
END;
Dump: PUBLIC PROCEDURE =
BEGIN
extra: CARDINAL ← 0;
s: StackIndex;
wa: CARDINAL;
savec: CodeDefs.CCIndex = CPtr.codeptr;
next: CodeDefs.CCIndex;
saveStking: BOOLEAN ← CPtr.stking;
CPtr.stking ← FALSE; -- Off[];
s ← stkPtr;
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 PROCEDURE [load: BOOLEAN ← FALSE] =
BEGIN
oldTop: StackIndex = stkPtr;
saveStking: BOOLEAN ← 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 PROCEDURE =
BEGIN
st1: StackIndex = stkPtr;
st2: StackIndex = cb[st1].downlink;
t: StackIndex = cb[st2].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[];
END;
Forget: PUBLIC PROCEDURE [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 PROCEDURE [count: CARDINAL ← 1] =
BEGIN
s: StackIndex;
THROUGH [0..count) DO
cb[stkPtr].uplink ← s ← P5U.GetChunk[SIZE[StackItem]];
cb[s] ← [downlink: stkPtr, data: NULL];
cb[s].data ← onStack[];
stkPtr ← s;
ENDLOOP;
END;
Init: PUBLIC PROCEDURE =
BEGIN
uBound ← EvalStackSize - 2;
stkHead ← P5U.GetChunk[SIZE[StackItem]];
cb[stkHead] ← [downlink: stkHead, data: mark[LabelCCNull]];
stkPtr ← stkHead;
CPtr.stking ← FALSE;
END;
KeepOnly: PUBLIC PROCEDURE [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 PROCEDURE [s: StackIndex, count: CARDINAL ← 1] =
BEGIN
loc: StackLocRec ← Loc[s, count];
first: StackIndex = s;
last: StackIndex ← Above[first, count-1];
ts: StackIndex;
saveStking: BOOLEAN ← 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
BEGIN P5U.Out0[FOpCodes.qEXCH]; GO TO linkToTop END;
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 PROCEDURE [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 PROCEDURE [n: StackPos] =
BEGIN
IF n = 0 THEN RETURN;
Load[Top[n], n];
Decr[n];
END;
Loc: PUBLIC PROCEDURE [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;
i: CARDINAL;
FOR i 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 => IF count # 1 THEN RETURN [[mixed[]]]
ELSE RETURN [[inLink[link]]];
ENDCASE => StkError[]; -- shouldn't be a mark
ERROR; -- Since compiler doesn't know StkError doesn't return
END;
Mark: PUBLIC PROCEDURE =
BEGIN
down: StackIndex ← stkPtr;
stkPtr ← P5U.GetChunk[SIZE[StackItem]];
cb[stkPtr] ← [downlink: down,
data: mark[P5U.CreateLabel[]]];
cb[down].uplink ← stkPtr;
END;
New: PUBLIC PROCEDURE RETURNS [old: StackIndex] =
BEGIN
old ← cb[stkHead].uplink;
cb[stkHead].uplink ← StackNull;
stkPtr ← stkHead;
END;
Off: PUBLIC PROCEDURE =
BEGIN
CPtr.stking ← FALSE;
END;
On: PUBLIC PROCEDURE =
BEGIN
CPtr.stking ← TRUE;
END;
Pop: PUBLIC PROCEDURE [count: CARDINAL ← 1] =
BEGIN
saveStking: BOOLEAN ← CPtr.stking;
CPtr.stking ← FALSE; -- Off[];
THROUGH [0..count) 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;
Prefix: PUBLIC PROCEDURE [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 PROCEDURE [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 PROCEDURE =
BEGIN
WHILE stkPtr # stkHead DO
DelStackItem[stkPtr];
ENDLOOP;
END;
ResetToMark: PUBLIC PROCEDURE =
BEGIN
n: CARDINAL ← 0;
s: StackIndex;
FOR s ← 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
BEGIN
LoadToDepth[n];
END;
END;
Restore: PUBLIC PROCEDURE [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;
Store: PRIVATE PROCEDURE [
s: StackIndex,
addr: TempAddr,
storeNew: BOOLEAN ← 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: BOOLEAN;
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 PROCEDURE [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 PROCEDURE [offset: TempAddr, lvl: Symbols.ContextLevel] =
BEGIN
var: VarComponent;
var ← [wSize: 1, space: frame[wd: offset, level: lvl]];
P5L.StoreComponent[var];
END;
TempStore: PUBLIC PROCEDURE [count: CARDINAL ← 1] RETURNS [VarComponent] =
BEGIN -- store top of stack into contiguous temps
firstIndex: StackIndex ← Top[count];
s: StackIndex;
tStart, tempPrev: TempAddr;
ctlvl: Symbols.ContextLevel = ctxb[CPtr.tempcontext].level;
lvlPrev: Symbols.ContextLevel;
first: BOOLEAN ← TRUE;
remaining: CARDINAL ← count;
saveStking: BOOLEAN ← CPtr.stking;
CPtr.stking ← FALSE; -- Stack.Off[];
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;
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;
RETURN [[wSize: count,
space: frame[wd: tStart, immutable: TRUE, level: lvlPrev]]];
END;
Top: PUBLIC PROCEDURE [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 PROCEDURE =
BEGIN
s: StackIndex;
FOR s ← stkPtr, cb[s].downlink DO
WITH cb[s] SELECT FROM
mark =>
BEGIN
IF s = stkHead THEN StkError[]; -- fell off the end
DelStackItem[s];
RETURN
END;
ENDCASE;
ENDLOOP;
END;
VDepth: PUBLIC PROCEDURE RETURNS [StackPos] =
BEGIN
RETURN[VDepthOf[stkHead]];
END;
VDepthOf: PUBLIC PROCEDURE [s: StackIndex] RETURNS [d: StackPos] =
BEGIN
d ← 0;
IF s = StackNull THEN StkError[];
DO
s ← cb[s].uplink;
IF s = StackNull THEN RETURN;
d ← d+1;
ENDLOOP;
END;
END.