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],
SymbolOps: TYPE USING [CtxLevel];
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;
Load:
PUBLIC
PROC [s: StackIndex, count:
CARDINAL𡤁] =
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;
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 = SymbolOps.CtxLevel[CPtr.tempcontext];
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;
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 ← SymbolOps.CtxLevel[CPtr.tempcontext];
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;