-- VarUtils.mesa
-- last edited by Sweet, June 20, 1980 10:01 AM
-- last edited by Satterthwaite, November 2, 1982 3:47 pm

DIRECTORY
Alloc: TYPE USING [Notifier],
BcdDefs: TYPE USING [Link],
Code: TYPE USING [catchcount, curctxlvl, firstTemp, tempcontext],
CodeDefs: TYPE USING [
Base, BdoVarIndex, BoVarIndex, Byte, codeType, Lexeme, IndVarIndex,
MoveDirection, OVarIndex, StackIndex, StackLocRec, TempAddr,
VarComponent, VarIndex, VarItem, VarNull, VarTag],
Environment: TYPE USING [bitsPerWord],
Inline: TYPE USING [BITAND, BITSHIFT],
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, Forget, KeepOnly, Load, Loc, MoveToTemp, Pop, TempStore, Top],
SymbolOps: TYPE USING [XferMode],
Symbols: TYPE USING [
Base, BitAddress, bodyType, BTNull, CBTIndex, ContextLevel, ctxType,
ISEIndex, ISENull, lG, lZ, RecordSEIndex, seType];

VarUtils: PROGRAM
IMPORTS CPtr: Code, Inline, LiteralOps, P5, P5U, P5L, Stack, SymbolOps
EXPORTS P5L, CodeDefs =
BEGIN OPEN CodeDefs, Symbols;

wordlength: CARDINAL = Environment.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 # 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: ctxb[seb[sei].idCtx].level]]]
 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: se Lexeme;
   IF vv1.level # ctxb[CPtr.tempcontext].level 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: se Lexeme = 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 Inline;
 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;
var.wSize ← wSize; var.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];
var.wSize ← wSize; var.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;
var.wSize ← wSize; var.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;


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 [bdo Lexeme] =
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 [bdo Lexeme] =
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.