DIRECTORY
Alloc USING [Notifier],
Basics USING [bitsPerWord],
BcdDefs USING [Link, NullModule, ProcLimit],
Code USING [catchcount, curctxlvl, firstTemp, tempcontext],
CodeDefs USING [Base, BdoVarIndex, BoVarIndex, Byte, codeType, Lexeme, IndVarIndex, MoveDirection, OVarIndex, StackIndex, StackLocRec, TempAddr, VarComponent, VarIndex, VarItem, VarNull, VarTag],
LiteralOps USING [MasterString, Value],
Literals USING [Base, LTNull, MSTIndex, stType],
P5 USING [CreateTempLex, GenAnonLex, GenTempLex, ReleaseTempLex],
P5L USING [AddrComponent, LoadAddress, LoadComponent, LoadVar, MakeBo, MakeComponent, StoreComponent, VarVarAssign, Words],
P5U USING [FreeChunk, GetChunk],
PrincOpsUtils USING [BITAND, BITSHIFT],
Stack USING [Above, Forget, KeepOnly, Load, Loc, MoveToTemp, Pop, TempStore, Top],
SymbolOps USING [CtxLevel, XferMode],
Symbols
USING [Base, BitAddress, bodyType, BTNull, CBTIndex, ContextLevel, ctxType, ISEIndex, ISENull, lG, lZ, RecordSEIndex, seType];
VarUtils:
PROGRAM
IMPORTS CPtr: Code, LiteralOps, P5, P5U, P5L, PrincOpsUtils, Stack, SymbolOps
EXPORTS P5L, CodeDefs =
BEGIN OPEN CodeDefs, Symbols;
wordlength: CARDINAL = Basics.bitsPerWord;
cb: CodeDefs.Base;
seb, ctxb, bb: Symbols.Base;
stb: Literals.Base;
VarUtilsNotify:
PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
cb ← base[codeType];
bb ← base[Symbols.bodyType];
stb ← base[Literals.stType];
END;
AdjustComponent:
PUBLIC
PROC [var:
POINTER
TO VarComponent,
rSei: Symbols.RecordSEIndex, fSei: Symbols.ISEIndex, tBits: CARDINAL] =
BEGIN
length: CARDINAL = seb[rSei].length;
first: BOOL = (seb[fSei].idValue = 0);
delta: CARDINAL;
IF length < wordlength
AND (delta ← tBits - length) # 0
THEN
BEGIN
IF first
THEN
BEGIN
newB: CARDINAL = var.bSize + delta;
var.bSize ← newB MOD wordlength;
var.wSize ← newB / wordlength;
END
ELSE ModComponent[var: var, bd: delta];
END;
END;
AllLoaded:
PUBLIC
PROC [r: VarIndex, junkOk:
BOOL ←
FALSE]
RETURNS [BOOL] =
BEGIN -- is completely on stack (there may be stuff above it, tho)
WITH cb[r]
SELECT
FROM
o =>
WITH vv: var
SELECT
FROM
stack =>
IF (junkOk
OR vv.wd = 0)
AND vv.bd = 0
AND vv.bSize = 0
THEN
BEGIN
sti: StackIndex =
IF vv.wd # 0
THEN Stack.Above[vv.sti, vv.wd]
ELSE vv.sti;
loc: StackLocRec = Stack.Loc[sti, var.wSize];
IF loc.tag = onStack THEN RETURN [TRUE];
END;
ENDCASE;
ENDCASE;
RETURN [FALSE]
END;
ComponentForLex:
PUBLIC
PROC [l: Lexeme, allowFields:
BOOL ←
FALSE]
RETURNS [VarComponent] =
BEGIN
WITH ll: l
SELECT
FROM
bdo => RETURN [P5L.MakeComponent[ll.lexbdoi, allowFields]];
se => RETURN [ComponentForSE[ll.lexsei]];
literal =>
BEGIN OPEN Literals;
WITH ll
SELECT
FROM
word => RETURN [[wSize: 1, space: const[d1: LiteralOps.Value[lexlti]]]];
string =>
BEGIN
msti: MSTIndex = LiteralOps.MasterString[lexsti];
RETURN [
WITH s: stb[lexsti]
SELECT
FROM
heap => [wSize: 2, space: frame[wd: s.info, level: lG, immutable:TRUE]],
ENDCASE =>
[wSize: 1, space: faddr[
wd: stb[msti].info,
level: IF stb[msti].local THEN CPtr.curctxlvl - CPtr.catchcount ELSE lG]]];
END;
ENDCASE;
END;
stack => RETURN [[wSize: 1, space: stack[sti: ll.lexsti]]];
ENDCASE;
ERROR
END;
ComponentForSE:
PUBLIC
PROC [sei: ISEIndex]
RETURNS [var: VarComponent] =
BEGIN
SELECT
TRUE
FROM
sei = ISENull => ERROR;
seb[sei].linkSpace =>
BEGIN
a: BitAddress = seb[sei].idValue;
var ← [wSize: 1, space: link[wd: a.wd]];
END;
seb[sei].constant =>
SELECT SymbolOps.XferMode[seb[sei].idType]
FROM
proc =>
BEGIN
bti: CBTIndex = seb[sei].idInfo;
IF bti = BTNull THEN RETURN [[wSize: 1, space: const[d1: seb[sei].idValue]]]
ELSE
WITH bb[bti]
SELECT
FROM
Inner =>
RETURN [[wSize: 1,
space: faddr[wd: frameOffset, level: bb[bti].level - 1]]];
Outer => RETURN [[wSize: 1, space: pdesc[entryIndex]]];
ENDCASE;
END;
signal, error =>
BEGIN
lnk: BcdDefs.Link = seb[sei].idValue;
IF lnk.gfi # BcdDefs.NullModule
THEN
RETURN [[wSize: 1, space: pdesc[(lnk.gfi-1)*BcdDefs.ProcLimit + lnk.ep]]]
ELSE RETURN [[wSize: 1, space: const[d1: lnk]]];
END;
program =>
BEGIN
lnk: BcdDefs.Link = seb[sei].idValue;
IF lnk.gfi = 1
AND lnk.ep = 0
THEN
RETURN [[wSize: 1, space: faddr[wd: 0, level: lG]]];
ERROR
END;
ENDCASE => ERROR;
ENDCASE =>
BEGIN
a: Symbols.BitAddress = seb[sei].idValue;
s: CARDINAL = seb[sei].idInfo;
RETURN [[wSize: s / wordlength, bSize: s
MOD wordlength,
space: frame[
wd: a.wd, bd: a.bd,
immutable: seb[sei].immutable,
level: SymbolOps.CtxLevel[seb[sei].idCtx]]]]
END;
END;
CopyLex:
PUBLIC
PROC [l: Lexeme]
RETURNS [Lexeme] =
BEGIN
RETURN [
WITH l
SELECT
FROM
bdo => [bdo[CopyVarItem[lexbdoi]]],
ENDCASE => l]
END;
CopyToTemp:
PUBLIC
PROC [r: VarIndex, tsei: ISEIndex ← ISENull]
RETURNS [var: VarComponent, sei: ISEIndex] =
BEGIN -- needs work for non aligned things
tsei, if # ISENull, is an available temp of the right size
bd, bSize: [0..wordlength);
wSize, wS: CARDINAL;
rr: VarIndex;
sei ← tsei;
[bd: bd, bSize: bSize, wSize: wSize] ← VarAlignment[r, load];
wS ← P5L.Words[wSize, bSize];
WITH cc: cb[r]
SELECT
FROM
o =>
WITH vv: cc.var
SELECT
FROM
stack =>
IF vv.bd = 0
AND vv.bSize = 0
THEN
BEGIN -- rethink for non-aligned things
junk: CARDINAL ← vv.wd;
sti: StackIndex ← Stack.Above[vv.sti, junk];
IF sei = ISENull
THEN
-- can store anywhere
BEGIN
var ← Stack.MoveToTemp[firstIndex: sti, count: wS];
WITH vv1: var
SELECT
FROM
frame =>
BEGIN
tlex: Lexeme.se;
IF vv1.level # SymbolOps.CtxLevel[CPtr.tempcontext] THEN GO TO move;
tlex ← P5.CreateTempLex[wdoffset: vv1.wd, nwords: wS];
sei ← tlex.lexsei;
IF vv1.wd >= CPtr.firstTemp
THEN
-- not somebody's immutable
P5.ReleaseTempLex[tlex]; -- will be freed after stmt
END;
ENDCASE => GO TO move;
EXITS
move =>
BEGIN
tlex: Lexeme.se = P5.GenTempLex[wS];
sei ← tlex.lexsei;
[] ← P5L.VarVarAssign[
to: VarForLex[tlex], from: OVarItem[var], isexp: FALSE];
var ← ComponentForSE[sei];
END;
END
ELSE
BEGIN
tvar: VarComponent;
var ← ComponentForSE[sei];
FOR i: CARDINAL DECREASING IN [0..wS) DO
Stack.Load[Stack.Above[sti, i]];
tvar ← var;
FieldOfComponent[var: @tvar, wd: i, wSize: 1];
P5L.StoreComponent[tvar];
ENDLOOP;
END;
IF junk # 0 THEN Stack.Pop[junk];
ReleaseVarItem[r];
RETURN
END;
ENDCASE;
ENDCASE;
IF sei = ISENull THEN sei ← P5.GenTempLex[wS].lexsei;
var ← ComponentForSE[sei];
IF wS > 1
THEN
BEGIN
var.wSize ← wSize; var.bSize ← bSize;
WITH vv: var
SELECT
FROM
frame => vv.bd ← bd;
ENDCASE;
END;
rr ← OVarItem[var];
[] ← P5L.VarVarAssign[rr, r, FALSE];
RETURN
END;
CopyVarItem:
PUBLIC
PROC [r: VarIndex]
RETURNS [rr: VarIndex] =
BEGIN
LOOPHOLEs can go away when the compiler gets smarter
WITH cc: cb[r]
SELECT
FROM
o =>
BEGIN
tr: OVarIndex = LOOPHOLE[GenVarItem[o]];
rr ← tr; cb[tr] ← cc;
END;
bo =>
BEGIN
tr: BoVarIndex = LOOPHOLE[GenVarItem[bo]];
rr ← tr; cb[tr] ← cc;
END;
bdo =>
BEGIN
tr: BdoVarIndex = LOOPHOLE[GenVarItem[bdo]];
rr ← tr; cb[tr] ← cc;
END;
ind =>
BEGIN
tr: IndVarIndex = LOOPHOLE[GenVarItem[ind]];
rr ← tr; cb[tr] ← cc;
END;
ENDCASE => ERROR;
RETURN
END;
EasilyLoadable:
PUBLIC
PROC [var: VarComponent, dir: MoveDirection]
RETURNS [evar: VarComponent] =
BEGIN -- dir = store means it could be clobbered between loads
size: CARDINAL = P5L.Words[var.wSize, var.bSize]; -- < 3
IF EasyToLoad[var, dir] THEN RETURN [var];
WITH vv: var
SELECT
FROM
stack =>
IF vv.wd = 0
THEN
BEGIN
loc: StackLocRec ← Stack.Loc[vv.sti, size];
WITH loc
SELECT
FROM
inTemp =>
BEGIN
tvar: VarComponent = [wSize: vv.wSize, bSize: vv.bSize,
space: frame[immutable: TRUE, level: tLevel, wd: tOffset, bd: vv.bd]];
Stack.Forget[vv.sti, size];
RETURN [EasilyLoadable[tvar, dir]];
END;
inLink =>
BEGIN
tvar: VarComponent = [wSize: 1, space: link[wd: link]];
Stack.Forget[vv.sti, size];
RETURN [tvar];
END;
ENDCASE;
END;
ENDCASE;
P5L.LoadComponent[var];
RETURN [Stack.TempStore[size]]
END;
EasyToLoad:
PUBLIC
PROC [var: VarComponent, dir: MoveDirection]
RETURNS [BOOL] =
BEGIN -- dir = store means it could be clobbered between loads
lvl: ContextLevel;
WITH vv: var
SELECT
FROM
const, link, linkup, caddr, code => RETURN [TRUE];
faddr => lvl ← vv.level;
frame =>
BEGIN
IF vv.bd # 0
OR var.bSize # 0
OR var.wSize NOT IN [1..2]
OR (dir = store AND ~vv.immutable) THEN RETURN [FALSE];
lvl ← vv.level;
END;
frameup =>
BEGIN
IF dir = store AND ~vv.immutable THEN RETURN [FALSE];
lvl ← vv.level;
END;
ENDCASE => RETURN [FALSE];
SELECT lvl
FROM
lZ => ERROR;
lG, CPtr.curctxlvl => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
END;
FieldOfComponent:
PUBLIC
PROC [var:
POINTER
TO VarComponent,
wd, bd, wSize, bSize: CARDINAL ← 0] =
BEGIN
ModComponent[var, wd, bd];
IF wSize = 0
THEN
WITH vv: var^
SELECT
FROM
const =>
BEGIN OPEN PrincOpsUtils;
Mask:
ARRAY [0..15]
OF
CARDINAL = [
0b, 1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b,
1777b, 3777b, 7777b, 17777b, 37777b, 77777b];
vv.d1 ← BITAND[BITSHIFT[vv.d1, vv.bd+bSize-wordlength], Mask[bSize]];
wSize ← 1; bSize ← 0;
END;
ENDCASE;
FieldSizeAdjust[var: var, wSize: wSize, bSize: bSize];
END;
FieldOfComponentOnly:
PUBLIC
PROC [var:
POINTER
TO VarComponent,
wd, bd, wSize, bSize: CARDINAL ← 0] =
BEGIN
WITH vv: var^
SELECT
FROM
stack =>
BEGIN -- throw away anything above this new field
b: CARDINAL = vv.bd + bd;
ws: CARDINAL = P5L.Words[wSize, bSize];
vv.wd ← vv.wd + wd + b/wordlength;
vv.bd ← b MOD wordlength;
Stack.KeepOnly[Stack.Above[vv.sti, vv.wd], ws];
FieldSizeAdjust[var: var, wSize: wSize, bSize: bSize];
END;
ENDCASE => FieldOfComponent[var, wd, bd, wSize, bSize];
END;
FieldOfVar:
PUBLIC
PROC [r: VarIndex, wd, bd, wSize, bSize:
CARDINAL ← 0] =
BEGIN
ModField:
PROC [var:
LONG
POINTER
TO VarComponent] =
BEGIN -- had better not cause a compaction
b: CARDINAL;
WITH vv: var^
SELECT
FROM
frame =>
BEGIN
IF vv.level # lZ THEN ERROR;
b ← vv.bd + bd;
vv.wd ← vv.wd + wd + b/wordlength;
vv.bd ← b MOD wordlength;
END;
code =>
BEGIN
vv.lti ← Literals.LTNull;
b ← vv.bd + bd;
vv.wd ← vv.wd + wd + b/wordlength;
vv.bd ← b MOD wordlength;
END;
ENDCASE => ERROR;
FieldSizeAdjust[var: var, wSize: wSize, bSize: bSize];
END;
WITH cb[r]
SELECT
FROM
o =>
BEGIN
vComp: VarComponent ← var;
FieldOfComponent[@vComp, wd, bd, wSize, bSize]; var ← vComp;
END;
bo => ModField[@offset];
bdo => ModField[@offset];
ind => ModField[@offset];
ENDCASE;
END;
FieldOfVarOnly:
PUBLIC
PROC [r: VarIndex, wd, bd, wSize, bSize:
CARDINAL ← 0] =
BEGIN
WITH cb[r]
SELECT
FROM
o =>
BEGIN
vComp: VarComponent ← var;
FieldOfComponentOnly[@vComp, wd, bd, wSize, bSize]; var ← vComp;
END;
ENDCASE => FieldOfVar[r, wd, bd, wSize, bSize];
END;
FieldSizeAdjust:
PROC [var:
LONG
POINTER
TO VarComponent, wSize, bSize:
CARDINAL] =
BEGIN -- deal with INLINE expansions where you get a fullword field (
from the procedure RETURN record) of a partial word field (from the
inline substitution of the body
IF var.wSize = 0
AND var.bSize # 0
THEN {
-- 0 is a special case, allow to grow
bSize ← MIN[wSize * wordlength + bSize, var.bSize];
wSize ← 0};
var.wSize ← wSize; var.bSize ← bSize;
END;
varCount, varMax: CARDINAL ← 0;
GenVarItem:
PUBLIC
PROC [tag: VarTag]
RETURNS [r: VarIndex] =
BEGIN -- returns the cb-relative index of VarItem
varCount ← varCount + 1;
varMax ← MAX[varMax, varCount];
r ← P5U.GetChunk[(
SELECT tag
FROM
o => VarItem.o.SIZE,
bo => VarItem.bo.SIZE,
bdo => VarItem.bdo.SIZE,
ind => VarItem.ind.SIZE,
ENDCASE => ERROR)];
RETURN
END;
InCode:
PUBLIC
PROC [r: VarIndex]
RETURNS [
BOOL] =
BEGIN
RETURN [
WITH cb[r]
SELECT
FROM
o => var.tag = code,
bo => offset.tag = code,
bdo => offset.tag = code,
ind => offset.tag = code,
ENDCASE => ERROR]
END;
IsCopyKnown:
PUBLIC
PROC [var: VarComponent]
RETURNS [known: BOOL, cvar: VarComponent] =
BEGIN
wS: CARDINAL = P5L.Words[var.wSize, var.bSize];
WITH vv: var
SELECT
FROM
stack =>
BEGIN
sti: StackIndex ← Stack.Above[vv.sti, vv.wd];
tLevel: Symbols.ContextLevel;
tOffset: TempAddr;
WITH ss: cb[sti]
SELECT
FROM
onStack =>
SELECT
TRUE
FROM
ss.alsoLink =>
IF wS = 1 THEN RETURN [TRUE, [wSize: 1, space: link[wd: ss.tOffset]]]
ELSE GO TO nope;
ss.tLevel # lZ => {tLevel ← ss.tLevel; tOffset ← ss.tOffset};
ENDCASE => GO TO nope;
inLink =>
IF wS = 1 THEN RETURN [TRUE, [wSize: 1, space: link[wd: ss.link]]]
ELSE GO TO nope;
inTemp => {tLevel ← ss.tLevel; tOffset ← ss.tOffset};
ENDCASE => ERROR;
FOR i:
CARDINAL
IN (0..wS)
DO
sti ← Stack.Above[sti];
WITH ss: cb[sti]
SELECT
FROM
onStack =>
IF ss.tLevel # tLevel OR ss.tOffset # tOffset+i THEN GO TO nope;
inTemp =>
IF ss.tLevel # tLevel OR ss.tOffset # tOffset+i THEN GO TO nope;
ENDCASE => GO TO nope;
REPEAT
FINISHED =>
RETURN [
TRUE,
[wSize: var.wSize, bSize: var.bSize, space:
frame[wd: tOffset, level: tLevel, bd: vv.bd]]];
ENDLOOP;
END;
ENDCASE => GO TO nope;
EXITS
nope => RETURN [FALSE, [space: frame[]]]
END;
LongVarAddress:
PUBLIC
PROC [r: VarIndex]
RETURNS [
BOOL] =
BEGIN
RETURN [
WITH cb[r]
SELECT
FROM
o => FALSE,
bo => P5L.Words[base.wSize, base.bSize] > 1,
bdo =>
P5L.Words[disp.wSize, disp.bSize] > 1 OR P5L.Words[base.wSize, base.bSize] > 1,
ind => P5L.Words[base.wSize, base.bSize] > 1,
ENDCASE => ERROR]
END;
ModComponent:
PUBLIC
PROC [var:
POINTER
TO VarComponent,
wd, bd: CARDINAL ← 0] =
BEGIN
b: CARDINAL;
WITH vv: var^
SELECT
FROM
stack =>
BEGIN
nsti: StackIndex;
dwd: CARDINAL;
b ← vv.bd + bd;
dwd ← wd + b/wordlength;
IF dwd # 0
THEN
BEGIN
nsti ← Stack.Above[vv.sti, vv.wd + dwd];
vv.sti ← nsti;
vv.wd ← 0;
END;
vv.bd ← b MOD wordlength;
END;
frame =>
BEGIN
b ← vv.bd + bd;
vv.wd ← vv.wd + wd + b/wordlength;
vv.bd ← b MOD wordlength;
END;
code =>
BEGIN
vv.lti ← Literals.LTNull;
b ← vv.bd + bd;
vv.wd ← vv.wd + wd + b/wordlength;
vv.bd ← b MOD wordlength;
END;
const =>
BEGIN
b ← vv.bd + bd;
SELECT wd + b/wordlength
FROM
0 => NULL;
1 => vv.d1 ← vv.d2;
ENDCASE => ERROR;
vv.bd ← b MOD wordlength;
END;
ENDCASE => ERROR;
END;
NormalizeExp:
PUBLIC
PROC [
r: VarIndex, tempsei: ISEIndex ← ISENull, codeOk: BOOL ← FALSE]
RETURNS [nwords: CARDINAL, long: BOOL, tsei: ISEIndex] =
BEGIN
wSize: CARDINAL;
bSize: [0..wordlength);
tsei ← tempsei;
[wSize: wSize, bSize: bSize] ← VarAlignment[r, load];
nwords ← P5L.Words[wSize, bSize];
IF nwords <= 2 THEN {P5L.LoadVar[r]; long ← FALSE}
ELSE IF codeOk OR ~InCode[r] THEN long ← P5L.LoadAddress[r, codeOk]
ELSE
BEGIN
tvar: VarComponent;
IF tsei = ISENull THEN tsei ← P5.GenAnonLex[nwords].lexsei;
[var: tvar, sei: tsei] ← CopyToTemp[r, tsei];
P5L.LoadComponent[P5L.AddrComponent[tvar]];
long ← FALSE;
END;
RETURN
END;
NormalLex:
PUBLIC
PROC [nwords:
CARDINAL, long, code:
BOOL ←
FALSE]
RETURNS [Lexeme] =
BEGIN
RETURN [
SELECT
TRUE
FROM
(nwords <= 2) => TOSLex[nwords],
code => TOSCodeAddrLex[nwords],
ENDCASE => TOSAddrLex[nwords, long]]
END;
OVarItem:
PUBLIC
PROC [var: VarComponent]
RETURNS [r: VarIndex] =
BEGIN
r ← GenVarItem[o];
cb[r] ← [body: o[var: var]];
RETURN
END;
ReleaseLex:
PUBLIC
PROC [lex: Lexeme] =
BEGIN
WITH lex
SELECT
FROM
bdo => ReleaseVarItem[lexbdoi];
ENDCASE;
END;
PFSize: CARDINAL = 4;
pendingFree: ARRAY [0..PFSize) OF VarIndex ← ALL[VarNull];
pfFirst, pfLast: CARDINAL ← 0;
pfDebug: PUBLIC BOOL ← FALSE;
BadRelease: PUBLIC SIGNAL [badr: VarIndex] = CODE;
ReleaseVarItem:
PUBLIC
PROC [r: VarIndex] =
BEGIN
IF r = VarNull OR cb[r].free THEN GO TO bad;
IF ~pfDebug THEN ReleaseReally[r]
ELSE
BEGIN
FOR i:
CARDINAL
IN [0..PFSize)
DO
IF pendingFree[i] = r THEN GO TO bad;
ENDLOOP;
pfLast ← (pfLast+1) MOD PFSize;
IF pfLast = pfFirst
THEN
BEGIN
ReleaseReally[pendingFree[pfFirst]];
pfFirst ← (pfFirst+1) MOD PFSize;
END;
pendingFree[pfLast] ← r;
END;
EXITS
bad => SIGNAL BadRelease[r];
END;
ReleaseReally:
PROC [r: VarIndex] =
BEGIN
IF r = VarNull THEN RETURN;
varCount ← varCount - 1;
P5U.FreeChunk[r, (
WITH cb[r]
SELECT
FROM
o => VarItem.o.SIZE,
bo => VarItem.bo.SIZE,
bdo => VarItem.bdo.SIZE,
ind => VarItem.ind.SIZE,
ENDCASE => ERROR)];
END;
ReusableCopies:
PUBLIC
PROC [
r: VarIndex, dir: MoveDirection, stackOk: BOOL, stackFree: BOOL ← FALSE]
RETURNS [first, next: VarIndex] =
BEGIN -- make sure r has reusable pointer parts
first ← r; -- in case it's already reusable
BEGIN -- to set up "doBo" exit
WITH cc: cb[r]
SELECT
FROM
o =>
IF ~stackOk
THEN
WITH cc.var
SELECT
FROM
stack =>
BEGIN
knownCopy: BOOL;
cvar: VarComponent;
IF stackFree THEN GO TO storIt;
[knownCopy, cvar] ← IsCopyKnown[cc.var];
IF ~knownCopy THEN GO TO storIt;
next ← OVarItem[cvar];
RETURN
EXITS
storIt =>
BEGIN
tvar: VarComponent = CopyToTemp[r].var;
first ← OVarItem[tvar];
END;
END;
frameup => IF ~immutable THEN GO TO doBo;
ENDCASE;
bo =>
WITH cc.base
SELECT
FROM
stack =>
BEGIN
knownCopy: BOOL;
cvar: VarComponent;
IF stackFree THEN GO TO doBo;
[knownCopy, cvar] ← IsCopyKnown[cc.base];
IF ~knownCopy THEN GO TO doBo;
next ← GenVarItem[bo];
cb[next] ← [body: bo[base: cvar, offset: cc.offset]];
RETURN
END;
ENDCASE => GO TO doBo;
ind =>
IF cc.packtag = packed
THEN
BEGIN
cc.base ← EasilyLoadable[cc.base, dir];
cc.index ← EasilyLoadable[cc.index, dir];
END
ELSE GO TO doBo;
ENDCASE => GO TO doBo;
EXITS
doBo =>
BEGIN
bor: BoVarIndex = P5L.MakeBo[r];
cb[bor].base ← EasilyLoadable[cb[bor].base, dir];
first ← bor;
END;
END;
next ← CopyVarItem[first];
RETURN
END;
StackSpareAddr:
PUBLIC
PROC [r: VarIndex]
RETURNS [
BOOL] =
BEGIN -- no excess stack depth required to load address of r
WITH cc: cb[r]
SELECT
FROM
o =>
RETURN [
WITH vv: cc.var
SELECT
FROM
code => TRUE,
linkup => vv.delta = 0,
frameup => vv.delta = 0,
frame => vv.wd IN Byte,
ENDCASE => FALSE];
bo =>
BEGIN
opFree: BOOL;
br: VarIndex;
WITH oo: cc.offset
SELECT
FROM
frame => IF oo.wd # 0 THEN RETURN [FALSE];
code => IF oo.wd # 0 THEN RETURN [FALSE];
ENDCASE;
br ← OVarItem[cc.base];
opFree ← StackSpareLoad[br];
ReleaseVarItem[br];
RETURN [opFree]
END;
ENDCASE => RETURN [FALSE];
END;
StackSpareLoad:
PUBLIC
PROC [r: VarIndex]
RETURNS [
BOOL] =
BEGIN -- no excess stack depth required to load r
WITH cc: cb[r]
SELECT
FROM
o =>
RETURN [
WITH vv: cc.var
SELECT
FROM
code, caddr, const, pdesc, linkup, frameup => TRUE,
frame => vv.wd IN Byte,
faddr => vv.wd IN Byte,
stack => vv.wd = 0 AND vv.bd = 0 AND vv.bSize = 0,
const => TRUE,
ENDCASE => FALSE];
bo =>
BEGIN
br: VarIndex;
opFree: BOOL;
WITH oo: cc.offset
SELECT
FROM
frame => IF oo.wd NOT IN Byte THEN RETURN [FALSE];
code => IF oo.wd NOT IN Byte THEN RETURN [FALSE];
ENDCASE;
br ← OVarItem[cc.base];
opFree ← StackSpareLoad[br];
ReleaseVarItem[br];
RETURN [opFree]
END;
ENDCASE => RETURN [FALSE];
END;
TOSAddrLex:
PUBLIC
PROC [size:
CARDINAL, long:
BOOL ←
FALSE]
RETURNS [Lexeme.bdo] =
BEGIN
r: VarIndex = GenVarItem[bo];
base: VarComponent = TOSComponent[IF long THEN 2 ELSE 1];
IF size = 0 THEN ERROR;
cb[r] ← [body: bo[base: base, offset: [wSize: size, space: frame[]]]];
RETURN [[bdo[r]]]
END;
TOSCodeAddrLex:
PUBLIC
PROC [size:
CARDINAL]
RETURNS [Lexeme.bdo] =
BEGIN
r: VarIndex = GenVarItem[bo];
base: VarComponent = TOSComponent[1];
IF size = 0 THEN ERROR;
cb[r] ← [body: bo[base: base, offset: [wSize: size, space: code[]]]];
RETURN [[bdo[r]]]
END;
TOSComponent:
PUBLIC
PROC [size:
CARDINAL ← 1]
RETURNS [VarComponent] =
BEGIN
IF size = 0 THEN ERROR;
RETURN [[wSize: size, space: stack[sti: Stack.Top[size]]]]
END;
TOSLex:
PUBLIC
PROC [size:
CARDINAL ← 1]
RETURNS [Lexeme] =
BEGIN
r: VarIndex;
SELECT size
FROM
0 => ERROR;
1 => RETURN [[stack[Stack.Top[]]]];
ENDCASE;
r ← GenVarItem[o];
cb[r] ← [body: o[var: [wSize: size, space: stack[sti: Stack.Top[size]]]]];
RETURN [[bdo[r]]]
END;
VarAddressEasy:
PUBLIC
PROC [r: VarIndex]
RETURNS [
BOOL] =
BEGIN
WITH cc: cb[r]
SELECT
FROM
o =>
RETURN [
WITH vv: cc.var
SELECT
FROM
code => TRUE,
linkup => vv.delta = 0,
frame => vv.level = lG OR vv.level = CPtr.curctxlvl,
frameup =>
vv.delta = 0 AND (vv.level = lG OR vv.level = CPtr.curctxlvl),
ENDCASE => FALSE];
bo =>
WITH oo: cc.offset
SELECT
FROM
frame =>
IF oo.wd = 0
AND oo.level = lZ
THEN
RETURN [EasyToLoad[cc.base, store]];
code =>
IF oo.wd = 0
THEN
RETURN [EasyToLoad[cc.base, store]];
ENDCASE;
ENDCASE;
RETURN [FALSE]
END;
VarAlignment:
PUBLIC
PROC [r: VarIndex, dir: MoveDirection]
RETURNS [bd, bSize: [0..wordlength), wSize: CARDINAL] =
BEGIN
WITH cc: cb[r]
SELECT
FROM
o =>
BEGIN
WITH vv: cc.var
SELECT
FROM
frame => bd ← vv.bd;
code => {IF dir = store THEN ERROR; bd ← vv.bd};
stack => {IF dir = store THEN ERROR; bd ← vv.bd};
const => {IF dir = store THEN ERROR; bd ← vv.bd};
ENDCASE => {IF dir = store THEN ERROR; bd ← 0};
wSize ← cc.var.wSize; bSize ← cc.var.bSize;
END;
bo =>
BEGIN
WITH oo: cc.offset
SELECT
FROM
frame => bd ← oo.bd;
code => {IF dir = store THEN ERROR; bd ← oo.bd};
ENDCASE => ERROR;
wSize ← cc.offset.wSize; bSize ← cc.offset.bSize;
END;
bdo =>
BEGIN
WITH oo: cc.offset
SELECT
FROM
frame => bd ← oo.bd;
code => {IF dir = store THEN ERROR; bd ← oo.bd};
ENDCASE => ERROR;
wSize ← cc.offset.wSize; bSize ← cc.offset.bSize;
END;
ind =>
BEGIN
WITH oo: cc.offset
SELECT
FROM
frame => bd ← oo.bd;
code => {IF dir = store THEN ERROR; bd ← oo.bd};
ENDCASE => ERROR;
wSize ← cc.offset.wSize; bSize ← cc.offset.bSize;
END;
ENDCASE => ERROR;
RETURN
END;
VarFinal:
PUBLIC
PROC =
BEGIN
FOR i:
CARDINAL
IN [0..PFSize)
DO
IF pendingFree[i] # VarNull
THEN
BEGIN
ReleaseReally[pendingFree[i]];
pendingFree[i] ← VarNull;
END;
ENDLOOP;
END;
VarForLex:
PUBLIC
PROC [l: Lexeme]
RETURNS [r: VarIndex] =
BEGIN
var: VarComponent;
WITH ll: l
SELECT
FROM
bdo => RETURN [ll.lexbdoi];
ENDCASE => var ← ComponentForLex[l];
r ← GenVarItem[o];
cb[r] ← [body: o[var: var]];
END;
VarStackWords:
PUBLIC
PROC [r: VarIndex]
RETURNS [nW:
CARDINAL] =
BEGIN -- number of words on the virtual stack
nW ← 0;
WITH cb[r]
SELECT
FROM
o =>
WITH vv: var
SELECT
FROM
stack => nW ← nW + P5L.Words[vv.wSize, vv.bSize];
ENDCASE;
bo =>
WITH vv: base
SELECT
FROM
stack => nW ← nW + P5L.Words[vv.wSize, vv.bSize];
ENDCASE;
bdo =>
BEGIN
WITH vv: base
SELECT
FROM
stack => nW ← nW + P5L.Words[vv.wSize, vv.bSize];
ENDCASE;
WITH vv: disp
SELECT
FROM
stack => nW ← nW + P5L.Words[vv.wSize, vv.bSize];
ENDCASE;
END;
ind =>
BEGIN
WITH vv: base
SELECT
FROM
stack => nW ← nW + P5L.Words[vv.wSize, vv.bSize];
ENDCASE;
WITH vv: index
SELECT
FROM
stack => nW ← nW + P5L.Words[vv.wSize, vv.bSize];
ENDCASE;
END;
ENDCASE;
RETURN
END;
END.