VarUtils.mesa
last edited by Sweet, 25-Aug-82 11:34:21
last edited by Satterthwaite, January 22, 1986 4:29:02 pm PST
DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [BITAND, BITSHIFT],
BcdDefs: TYPE USING [Link],
Code: TYPE USING [catchcount, curctxlvl, firstTemp, tempcontext],
CodeDefs: TYPE USING [
Base, BdoVarIndex, BoVarIndex, BYTE, codeType, DataStackIndex, IndVarIndex,
Lexeme, MoveDirection, OVarIndex, StackBackup, StackIndex, StackLocRec,
TempAddr, VarComponent, VarIndex, VarItem, VarNull, VarTag, wordlength],
LiteralOps: TYPE USING [MasterString, Value],
Literals: TYPE USING [Base, LTNull, MSTIndex, stType],
P5: TYPE USING [CreateTempLex, GenAnonLex, GenTempLex, ReleaseTempLex],
P5L: TYPE USING [
AddrComponent, LoadAddress, LoadComponent, LoadVar, MakeBo, MakeComponent,
StoreComponent, VarVarAssign, Words],
P5U: TYPE USING [FreeChunk, GetChunk],
PrincOps: TYPE USING [EPRange, GFTNull],
Stack: TYPE USING [
Above, DataIndex, Forget, KeepOnly, Load, Loc, MoveToTemp, Pop,
TempStore, Top],
SymbolOps: TYPE USING [CtxLevel, XferMode],
Symbols: TYPE USING [
Base, BitAddress, bodyType, BTNull, CBTIndex, ContextLevel, ctxType,
ISEIndex, ISENull, lG, lZ, RecordSEIndex, seType];
VarUtils: PROGRAM
IMPORTS Basics, CPtr: Code, LiteralOps, P5, P5U, P5L, Stack, SymbolOps
EXPORTS P5L, CodeDefs =
BEGIN OPEN CodeDefs, Symbols;
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 # PrincOps.GFTNull THEN
RETURN [[wSize: 1, space: pdesc[(lnk.gfi-1)*PrincOps.EPRange + 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
junk: CARDINAL ← vv.wd;
originalFirst: StackIndex = vv.sti;
sti: StackIndex ← Stack.Above[vv.sti, junk];
IF sei = ISENull THEN -- can store anywhere
BEGIN
var ← Stack.MoveToTemp[firstIndex: sti, count: wS, preChaff: junk];
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;
IF junk # 0 THEN {
Stack.Load[originalFirst, junk]; -- in case they aren't on top
Stack.Pop[junk]};
END;
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
contig => WITH bb: place SELECT FROM
frame =>
BEGIN
tvar: VarComponent = [wSize: vv.wSize, bSize: vv.bSize,
space: frame[immutable: TRUE, level: bb.tLevel, wd: bb.tOffset, bd: vv.bd]];
Stack.Forget[vv.sti, size];
RETURN [EasilyLoadable[tvar, dir]];
END;
link =>
BEGIN
tvar: VarComponent = [wSize: 1, space: link[wd: bb.link]];
Stack.Forget[vv.sti, 1];
RETURN [tvar];
END;
ENDCASE;
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
Mask: ARRAY [0..15] OF CARDINAL = [
0b, 1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b,
1777b, 3777b, 7777b, 17777b, 37777b, 77777b];
vv.d1 ← Basics.BITAND[Basics.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 a 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: DataStackIndex ← Stack.DataIndex[Stack.Above[vv.sti, vv.wd]];
tLevel: Symbols.ContextLevel;
tOffset: TempAddr;
sb: StackBackup ← cb[sti].backup;
WITH bb: sb SELECT FROM
link =>
IF wS = 1 THEN RETURN [TRUE, [wSize: 1, space: link[wd: bb.link]]]
ELSE GO TO nope;
frame => {tLevel ← bb.tLevel; tOffset ← bb.tOffset};
const => IF vv.bSize = 0 AND vv.bd = 0 THEN
SELECT wS FROM
1 => RETURN [TRUE, [wSize: 1, space: const[d1: bb.value]]];
2 =>
BEGIN
nsti: DataStackIndex = Stack.DataIndex[Stack.Above[sti]];
WITH bb2: cb[nsti].backup SELECT FROM
const => RETURN[ TRUE, [wSize: 1, space: const[d1: bb.value, d2: bb2.value]]];
ENDCASE => GO TO nope;
END;
ENDCASE => GO TO nope;
ENDCASE => GO TO nope;
FOR i: CARDINAL IN (0..wS) DO
sti ← Stack.DataIndex[Stack.Above[sti]];
sb ← cb[sti].backup;
WITH bb: sb SELECT FROM
frame =>
IF bb.tLevel # tLevel OR bb.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
pendingFree ← ALL[VarNull]; -- don't bother to free, tables reset next
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.