DIRECTORY
Alloc USING [Notifier],
Basics USING [bitsPerWord, LongNumber],
Code USING [CodeNotImplemented, curctxlvl, stking],
CodeDefs USING [Base, BdoVarIndex, Byte, codeType, EvalStackSize, MaxParmsInStack, MoveDirection, StackIndex, StackLocRec, VarComponent, VarIndex],
FOpCodes USING [qADD, qAMUL, qDADD, qDESCB, qGADRB, qLADRB, qLCO, qLG, qLGD, qLI, qLL, qLLD, qLLK, qMUL, qPUSH, qR, qRD, qRDL, qRF, qRFL, qRFS, qRFSL, qRIG, qRIGL, qRIL, qRILL, qRL, qRSTR, qRSTRL, qRXGL, qRXL, qRXLL, qSG, qSGD, qSL, qSLD, qW, qWD, qWDL, qWF, qWFL, qWFS, qWFSL, qWIG, qWIGL, qWIL, qWILL, qWL, qWSTR, qWSTRL, qWXGL, qWXL, qWXLL],
Literals USING [Base, LTIndex, LTNull, ltType],
OpCodeParams USING [GlobalHB, HB, LocalHB],
P5L USING [AddrComponent, BaseComponent, EasilyLoadable, GenAdd, GenAnd, GenRFC, GenShift, GenVarItem, LoadBoth, LoadSum, ModComponent, ReleaseVarItem, TOSComponent, Words],
P5U USING [Out0, Out1, Out2],
PrincOps USING [FieldDescriptor, localbase],
PrincOpsUtils USING [BITAND, BITSHIFT],
Stack USING [Above, Also, Depth, Dump, Exchange, Forget, Load, Loc, Pop, TempStore, Top, VDepthOf],
Symbols USING [Base, ContextLevel, lG, lZ, seType];

VarMove: PROGRAM
IMPORTS CPtr: Code, P5U, P5L, PrincOpsUtils, Stack
EXPORTS P5L, CodeDefs =
BEGIN OPEN FOpCodes, CodeDefs, Symbols;

wordlength: CARDINAL = Basics.bitsPerWord;

cb: CodeDefs.Base;
seb: Symbols.Base;
ltb: Literals.Base;

VarMoveNotify: PUBLIC Alloc.Notifier =
BEGIN  -- called by allocator whenever table area is repacked
seb _ base[Symbols.seType];
cb _ base[codeType];
ltb _ base[Literals.ltType];
END;

LoadComponent: PUBLIC PROC [var: VarComponent] =
BEGIN
Mask: ARRAY [0..15] OF CARDINAL = [
0b, 1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b,
1777b, 3777b, 7777b, 17777b, 37777b, 77777b];
wS: CARDINAL = P5L.Words[var.wSize, var.bSize];
WITH vv: var SELECT FROM
faddr =>
BEGIN
w: CARDINAL _ vv.wd;
lvl: ContextLevel = vv.level;
SELECT lvl FROM
lZ => ERROR;
lG => P5U.Out1[qGADRB, w];
CPtr.curctxlvl => P5U.Out1[qLADRB, w];
ENDCASE =>
BEGIN
LoadComponent[P5L.BaseComponent[lvl]];
w _ w - PrincOps.localbase;
IF w # 0 THEN P5L.GenAdd[w];
END;
END;
frame =>
BEGIN
w: CARDINAL _ vv.wd; 
b: CARDINAL = vv.bd;
lvl: ContextLevel = vv.level;
delta: CARDINAL _ 0;
IF b # 0 THEN
BEGIN
IF Stack.Depth[] < EvalStackSize-2 AND b + var.bSize = wordlength THEN
BEGIN
LoadComponent[[wSize: 1, space: frame[wd: w, level: lvl]]];
P5L.GenAnd[Mask[var.bSize]];
var.bSize _ 0;
END
ELSE
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
IF var.wSize # 0 THEN ERROR;
cb[r] _ [body: bo[
base: P5L.AddrComponent[var],
offset: [bSize: var.bSize, space: frame[bd: b]]]];
MoveBo[r, load];
RETURN
END;
delta _ 1;
END;
BEGIN -- to declare LFOp
LFOp: ARRAY BOOL OF ARRAY [1..2] OF Byte = [[qLL, qLLD], [qLG, qLGD]];
IF var.wSize # 0 THEN SELECT lvl FROM
lZ => ERROR;
CPtr.curctxlvl, lG => 
BEGIN
IF var.wSize IN [1..2] THEN {
P5U.Out1[LFOp[lvl=lG][var.wSize], w+delta];
IF vv.immutable AND CPtr.stking THEN
Stack.Also[n: var.wSize, tOffset: w+delta, tLevel: lvl]}
ELSE
FOR i: CARDINAL IN [0..var.wSize) DO
P5U.Out1[LFOp[lvl=lG][1], w+delta+i];
IF vv.immutable AND CPtr.stking THEN
Stack.Also[tOffset: w+delta+i, tLevel: lvl];
ENDLOOP;
END;
ENDCASE =>
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[
base: P5L.BaseComponent[lvl],
offset: [wSize: var.wSize, space:
frame[wd: w+delta - PrincOps.localbase]]]];
MoveBo[r, load];
END;
END; -- scope of LFOp
IF var.bSize # 0 THEN
BEGIN -- delta = 0 in this case
IF Stack.Depth[] < EvalStackSize-2 THEN
BEGIN
LoadComponent[[wSize: 1, space: frame[wd: w+var.wSize, level: lvl]]];
P5L.GenShift[var.bSize - wordlength];
END
ELSE
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[
base: P5L.AddrComponent[var],
offset: [bSize: var.bSize, space: frame[wd: var.wSize]]]];
MoveBo[r, load];
END;
END;
END;
frameup =>
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[
base: [wSize: vv.pwSize, space: frame[wd: vv.wd, level: vv.level]],
offset: [wSize: var.wSize, space: frame[wd: vv.delta]]]];
MoveBo[r, load];
END;
linkup =>
BEGIN
P5U.Out1[qLLK, vv.wd];
P5U.Out1[IF var.wSize = 2 THEN qRD ELSE qR, vv.delta];
END;
caddr => P5U.Out1[qLCO, vv.wd];
code =>
BEGIN
w: CARDINAL _ vv.wd; 
b: CARDINAL = vv.bd;
lti: Literals.LTIndex = vv.lti;
delta: CARDINAL _ 0;
IF lti # Literals.LTNull THEN
BEGIN

LoadFirst: PROC [val: CARDINAL] =
BEGIN
IF b # 0 THEN
BEGIN
IF var.wSize # 0 AND var.bSize + b # wordlength THEN ERROR;
val _ PrincOpsUtils.BITAND[ 
PrincOpsUtils.BITSHIFT[val, b + var.bSize - wordlength], Mask[var.bSize]];
var.bSize _ 0;
END;
P5U.Out1[qLI, val];
END;

LoadLast: PROC [val: CARDINAL] =
BEGIN
IF var.bSize # 0 THEN
val _ PrincOpsUtils.BITSHIFT[val, var.bSize - wordlength];
P5U.Out1[qLI, val];
END;

WITH ll: ltb[lti] SELECT FROM
short => LoadFirst[ll.value];
long =>
BEGIN
LoadFirst[ll.value[0]];
FOR i: CARDINAL IN [1..wS-1) DO
P5U.Out1[qLI, ll.value[i]];
ENDLOOP;
IF wS > 1 THEN LoadLast[ll.value[wS-1]];
END;
ENDCASE => ERROR;
RETURN
END;
IF b # 0 THEN
BEGIN
IF var.wSize # 0 AND var.bSize + b # wordlength THEN ERROR;
P5U.Out1[qLCO, w];
P5L.GenRFC[0, b, var.bSize];
var.bSize _ 0; delta _ 1;
END;
FOR i: CARDINAL IN [0..var.wSize) DO
P5U.Out1[qLCO, w];
P5L.GenRFC[i+delta, 0, wordlength];
ENDLOOP;
IF var.bSize # 0 THEN
BEGIN
P5U.Out1[qLCO, w];
P5L.GenRFC[var.wSize, 0, var.bSize];
END;
END;
link => P5U.Out1[qLLK, vv.wd];
stack =>
BEGIN
w: CARDINAL = vv.wd;
b: [0..wordlength) = vv.bd;
IF w # 0 THEN
BEGIN
IF Stack.VDepthOf[vv.sti] # wS+w-1 THEN
BEGIN
nsti: StackIndex;
Stack.Dump[];
nsti _ Stack.Above[vv.sti, w];
Stack.Forget[vv.sti, w];
vv.sti _ nsti;
GO TO notOnTop;
END;
IF wS > 1 THEN
BEGIN
fvar: VarComponent _ Stack.TempStore[wS];
THROUGH [0..w) DO Stack.Pop[]; ENDLOOP;
WITH vv: fvar SELECT FROM
frame =>
BEGIN
vv.bd _ b;
IF var.bSize # 0 THEN
BEGIN
fvar.wSize _ fvar.wSize-1;  fvar.bSize _ var.bSize;
END;
END;
ENDCASE;
LoadComponent[fvar];
RETURN;
END
ELSE THROUGH [0..w) DO Stack.Exchange[]; Stack.Pop[] ENDLOOP;
vv.sti _ Stack.Top[1];
EXITS
notOnTop => NULL;
END;
IF b # 0 THEN
BEGIN
rest: StackIndex;
IF var.wSize # 0 THEN
BEGIN
rest _ Stack.Above[vv.sti, 1];
IF b+var.bSize # wordlength THEN ERROR;
END;
Stack.Load[vv.sti, 1];
SELECT b + var.bSize FROM
> wordlength => ERROR;
= wordlength => NULL;
ENDCASE => P5L.GenShift[b + var.bSize - wordlength];
P5L.GenAnd[Mask[var.bSize]];
var.bSize _ 0;
IF var.wSize # 0 THEN Stack.Load[rest, var.wSize];
END
ELSE Stack.Load[vv.sti, wS];
IF var.bSize # 0 THEN P5L.GenShift[var.bSize - wordlength];
END;
const => 
BEGIN
v1: CARDINAL _ vv.d1;
b: [0..wordlength) = vv.bd;
nw: CARDINAL = P5L.Words[var.wSize, var.bSize];
IF b # 0 THEN
BEGIN -- Field taking machinery takes care of less than word case
IF b + var.bSize # wordlength THEN ERROR;
v1 _ PrincOpsUtils.BITAND[v1, Mask[var.bSize]];
var.bSize _ 0;
END;
P5U.Out1[qLI, v1];
IF nw = 2 THEN 
IF var.bSize # 0 THEN
P5U.Out1[qLI, PrincOpsUtils.BITSHIFT[vv.d2, var.bSize - wordlength]]
ELSE P5U.Out1[qLI, vv.d2];
END;
pdesc => P5U.Out1[qDESCB, vv.ep];
ENDCASE => ERROR;
END;

LoadVar: PUBLIC PROC [r: VarIndex] =
BEGIN
WITH cb[r] SELECT FROM
o => {LoadComponent[var]; P5L.ReleaseVarItem[r]};
bo => MoveBo[r, load];
bdo => MoveBdo[r, load];
ind => MoveInd[r, load];
ENDCASE => ERROR;
END;

MoveBo: PROC [r: VarIndex, dir: MoveDirection] =
BEGIN
base, offset: VarComponent;
foffset: POINTER TO VarComponent.frame;
psize: CARDINAL;
RWFOp: ARRAY MoveDirection OF ARRAY [1..2] OF Byte =
[[qRF, qRFL], [qWF, qWFL]];

MoveInitialFragment: PROC =
BEGIN
SELECT foffset.bd+offset.bSize FROM
< wordlength => IF offset.wSize # 0 THEN ERROR;
> wordlength => ERROR;
ENDCASE;
LoadComponent[base];
P5U.Out2[
RWFOp[dir][psize],
foffset.wd,
LOOPHOLE[PrincOps.FieldDescriptor[
offset: 0, posn: foffset.bd, size: offset.bSize]]];
offset.bSize _ 0;
END;

MoveFinalFragment: PROC =
BEGIN
LoadComponent[base];
P5U.Out2[
RWFOp[dir][psize],
foffset.wd,
LOOPHOLE[PrincOps.FieldDescriptor[
offset: 0, posn: foffset.bd, size: offset.bSize]]];
END;

WITH cc: cb[r] SELECT FROM
bo => {base _ cc.base; offset _ cc.offset};
ENDCASE => ERROR;
P5L.ReleaseVarItem[r];
WITH oo: offset SELECT FROM
frame => foffset _ @oo;
code =>
BEGIN
IF dir = store THEN ERROR;
IF oo.bd # 0 THEN
BEGIN
IF offset.wSize # 0 THEN 
IF oo.bd + offset.bSize # wordlength THEN ERROR
ELSE IF offset.wSize # 0 THEN 
base _ P5L.EasilyLoadable[base, dir];
LoadComponent[base];
P5L.GenRFC[oo.wd, oo.bd, offset.bSize];
offset.bSize _ 0; oo.wd _ oo.wd + 1;
END;
IF offset.wSize > 1 OR offset.wSize # 0 AND offset.bSize # 0 THEN
base _ P5L.EasilyLoadable[base, dir];
FOR i: CARDINAL IN [0..offset.wSize) DO
LoadComponent[base];
P5L.GenRFC[oo.wd+i, 0, wordlength];
ENDLOOP;
IF offset.bSize # 0 THEN
BEGIN
LoadComponent[base];
P5L.GenRFC[oo.wd+offset.wSize, 0, offset.bSize];
END;
RETURN;
END;
ENDCASE => ERROR;
psize _ P5L.Words[base.wSize, base.bSize];
IF psize NOT IN [1..2] THEN ERROR;
IF foffset.level # lZ THEN
BEGIN -- a field descriptor
RWFSOp: ARRAY MoveDirection OF ARRAY [1..2] OF Byte =
[[qRFS, qRFSL], [qWFS, qWFSL]];
SIGNAL CPtr.CodeNotImplemented;
LoadComponent[base];
LoadComponent[offset];
P5U.Out0[ RWFSOp[dir][psize]];
RETURN
END;
WITH bb: base SELECT FROM
frame =>
BEGIN
RWilOp: ARRAY MoveDirection OF ARRAY [1..2] OF ARRAY BOOL OF Byte =
[[[qRIL, qRIG], [qRILL, qRIGL]], [[qWIL, qWIG], [qWILL, qWIGL]]];
IF offset.wSize # 1 OR foffset.wd NOT IN OpCodeParams.HB
OR foffset.bd # 0 OR offset.bSize # 0
OR base.bSize # 0 THEN GO TO notMagic;
SELECT bb.level FROM
lG => IF bb.wd NOT IN OpCodeParams.GlobalHB THEN GO TO notMagic;
CPtr.curctxlvl => IF bb.wd NOT IN OpCodeParams.LocalHB THEN
GO TO notMagic;
ENDCASE => GO TO notMagic;
P5U.Out2[
RWilOp[dir][psize][bb.level = lG],
bb.wd,
foffset.wd];
RETURN;
EXITS
notMagic => NULL;
END;
faddr =>
BEGIN
SELECT bb.level FROM
lG, CPtr.curctxlvl =>
IF offset.wSize IN [1..2] AND offset.bSize = 0 AND foffset.bd = 0 THEN
BEGIN
LSFOp: ARRAY MoveDirection OF ARRAY [1..2] OF ARRAY BOOL OF Byte =
[[[qLL, qLG], [qLLD, qLGD]], [[qSL, qSG], [qSLD, qSGD]]];
P5U.Out1[LSFOp[dir][offset.wSize][bb.level = lG], bb.wd + foffset.wd];
RETURN
END;
ENDCASE => 
BEGIN
tr: VarIndex = P5L.GenVarItem[bo];
cb[tr] _ [body: bo[base: P5L.BaseComponent[bb.level],
offset: [wSize: offset.wSize, bSize: offset.bSize,
space: frame[
wd: bb.wd - PrincOps.localbase + foffset.wd, bd: foffset.bd]]]];
MoveBo[tr, dir];
RETURN
END;
END;
stack => IF base.bSize = 0 AND base.wSize IN [1..2] THEN
BEGIN
loc: StackLocRec = Stack.Loc[bb.sti, base.wSize];
WITH loc SELECT FROM
inTemp =>
BEGIN -- let recursive call check other criteria
tr: VarIndex = P5L.GenVarItem[bo];
cb[tr] _ [body: bo[base: P5L.EasilyLoadable[base, dir], offset: offset]];
MoveBo[tr, dir];
RETURN;
END;
ENDCASE;
END;
ENDCASE;
IF foffset.bd # 0 OR offset.bSize # 0 THEN
BEGIN
IF offset.wSize # 0 THEN base _ P5L.EasilyLoadable[base, dir];
IF foffset.bd # 0 THEN
BEGIN
IF dir = load THEN MoveInitialFragment[];
foffset.wd _ foffset.wd+1;
END
ELSE IF dir = store THEN MoveFinalFragment[];
END;
SELECT offset.wSize FROM
0 => NULL;
> MaxParmsInStack => ERROR;
1, 2 => 
BEGIN
RWOp: ARRAY MoveDirection OF ARRAY [1..2] OF ARRAY [1..2] OF Byte =
[[[qR, qRL], [qRD, qRDL]], [[qW, qWL], [qWD, qWDL]]];
LoadComponent[base];
P5U.Out1[RWOp[dir][offset.wSize][psize], foffset.wd];
END;
ENDCASE =>
BEGIN
n, wo, s: CARDINAL;
tr: VarIndex;
base _ P5L.EasilyLoadable[base, dir];
n _ offset.wSize;
s _ MIN[n, 2];
wo _ IF dir = load THEN foffset.wd ELSE foffset.wd + n-s;
WHILE n # 0 DO
tr _ P5L.GenVarItem[bo];
cb[tr] _ [body: bo[base: base, offset: [wSize: s, space: frame[wd: wo]]]];
MoveBo[tr, dir];
n _ n - s;
IF dir = load THEN {wo _ wo + s; s _ MIN[n, 2]}
ELSE {s _ MIN[n, 2]; wo _ wo - s};
ENDLOOP;
END;
IF offset.bSize # 0 THEN
BEGIN
IF foffset.bd # 0 THEN foffset.wd _ foffset.wd - 1;
IF dir = load THEN MoveFinalFragment[]
ELSE IF foffset.bd # 0 THEN MoveInitialFragment[];
END;
END;

MoveBdo: PROC [r: VarIndex, dir: MoveDirection] =
BEGIN
base, disp, offset: VarComponent;
dpSize, bpSize: [1..2];
magicOffset: BOOL;
foffset: POINTER TO VarComponent.frame;

BDCommute: PROC =
BEGIN
t: VarComponent = base;
i: CARDINAL = bpSize;
base _ disp; disp _ t;
bpSize _ dpSize; dpSize _ i;
END;

MagicBase: PROC [b: VarComponent] RETURNS [BOOL] =
BEGIN
WITH bb: b SELECT FROM
frame =>
BEGIN
IF bb.bd # 0 OR b.bSize # 0 THEN RETURN [FALSE];
IF b.wSize = 1 AND bb.level = CPtr.curctxlvl THEN
RETURN [bb.wd IN OpCodeParams.LocalHB];
IF b.wSize = 2 THEN SELECT bb.level FROM
lG => RETURN [bb.wd IN OpCodeParams.GlobalHB];
CPtr.curctxlvl => RETURN [bb.wd IN OpCodeParams.LocalHB];
ENDCASE;
END;
ENDCASE;
RETURN [FALSE];
END;

WITH cc: cb[r] SELECT FROM
bdo => {base _ cc.base; disp _ cc.disp; offset _ cc.offset};
ENDCASE => ERROR;
P5L.ReleaseVarItem[r];


WITH vv: disp SELECT FROM
const =>
BEGIN
owd: CARDINAL;
ld: Basics.LongNumber;
bor: VarIndex;
IF disp.wSize > 1 OR disp.bSize # 0 THEN GO TO tooBig;
WITH offset SELECT FROM
frame => owd _ wd;
code => owd _ wd;
ENDCASE => ERROR;
ld.lc _ CARDINAL[vv.d1].LONG + owd.LONG;
IF ld.highbits # 0 THEN GO TO tooBig;
P5L.ModComponent[var: @offset, wd: vv.d1];
bor _ P5L.GenVarItem[bo];
cb[bor] _ [body: bo[base: base, offset: offset]];
MoveBo[bor, dir];
RETURN;
EXITS
tooBig => NULL;
END;
ENDCASE;

WITH oo: offset SELECT FROM
frame => foffset _ @oo;
code =>
BEGIN
tr: VarIndex = P5L.GenVarItem[bo];
LoadComponent[disp]; --more likely to be already loaded
LoadComponent[base];
P5U.Out0[qADD];
cb[tr] _ [body: bo[base: P5L.TOSComponent[1], offset: offset]];
MoveBo[tr, dir];
RETURN;
END;
ENDCASE => ERROR;

magicOffset _ offset.bSize = 0 AND offset.wSize = 1 AND
foffset.level = lZ AND foffset.wd IN OpCodeParams.HB;
bpSize _ P5L.Words[base.wSize, base.bSize];
dpSize _ P5L.Words[disp.wSize, disp.bSize];

BEGIN -- to set up some exit labels
SELECT bpSize FROM
>dpSize => GO TO different;
<dpSize => BEGIN BDCommute[]; GO TO different END;
=1 =>
BEGIN
IF ~magicOffset THEN GO TO notMagic;
IF MagicBase[base] THEN GO TO magic;
IF MagicBase[disp] THEN BEGIN BDCommute[]; GO TO magic END;
GO TO notMagic;
EXITS
magic =>
BEGIN
LoadComponent[disp];
WITH bb: base SELECT FROM
frame =>
P5U.Out2[IF dir = load THEN qRXL ELSE qWXL, bb.wd, foffset.wd];
ENDCASE;
RETURN;
END;
END;
=2 => GO TO notMagic;
ENDCASE => ERROR;
EXITS
different =>
BEGIN
IF magicOffset AND MagicBase[base] THEN
BEGIN
RWXFLOp: ARRAY MoveDirection OF ARRAY BOOL OF Byte =
[[qRXLL, qRXGL], [qWXLL, qWXGL]];
LoadComponent[disp];
WITH bb: base SELECT FROM
frame =>
P5U.Out2[RWXFLOp[dir][bb.level = lG], bb.wd, foffset.wd];
ENDCASE => ERROR;
RETURN;
END;
END;
notMagic => NULL;
END;
bpSize _ P5L.LoadSum[@disp, @base];
BEGIN
tr: VarIndex = P5L.GenVarItem[bo];
cb[tr] _ [body: bo[base: P5L.TOSComponent[bpSize], offset: offset]];
MoveBo[tr, dir];
END;
END;

MoveInd: PROC [r: VarIndex, dir: MoveDirection] =
BEGIN
base, index, offset: VarComponent;
packed, simple: BOOL;
eWords, grain: CARDINAL;

WITH cc: cb[r] SELECT FROM
ind =>
BEGIN
base _ cc.base;  index _ cc.index;  offset _ cc.offset;
simple _ cc.simple;
WITH pp: cc SELECT FROM
packed => {packed _ TRUE; grain _ pp.grain};
notPacked => {packed _ FALSE; eWords _ pp.eWords};
ENDCASE;
END;
ENDCASE => ERROR;
P5L.ReleaseVarItem[r];

IF ~packed THEN
BEGIN
tr: BdoVarIndex = LOOPHOLE[P5L.GenVarItem[bdo]];
cb[tr] _ [body: bdo[base: base, disp: TRASH, offset: offset]];
IF eWords = 1 THEN cb[tr].disp _ index
ELSE
BEGIN
WITH vv: index SELECT FROM
const =>
BEGIN
ld: Basics.LongNumber;
ld.lc _ CARDINAL[vv.d1].LONG * eWords.LONG;
vv.d1 _ ld.lowbits;
IF ld.highbits # 0 THEN {vv.wSize _ 2; vv.d2 _ ld.highbits};
cb[tr].disp _ index;
GO TO const;
END;
ENDCASE;
LoadComponent[index];
P5U.Out1[qLI, eWords];
IF simple THEN
BEGIN
P5U.Out0[qMUL];
cb[tr].disp _ P5L.TOSComponent[1];
END
ELSE
BEGIN
P5U.Out0[qAMUL];
P5U.Out0[qPUSH];
cb[tr].disp _ P5L.TOSComponent[2];
END;
EXITS
const => NULL;
END;
MoveBdo[tr, dir];
END
ELSE
BEGIN
shift: [4..7] _ (SELECT grain FROM
1 => 4, 2 => 5, 4 => 6, 8 => 7, ENDCASE => ERROR);
obd: [0..wordlength);
owd: CARDINAL;
fd: PrincOps.FieldDescriptor;
bpSize: CARDINAL;
RWFSOp: ARRAY MoveDirection OF ARRAY [1..2] OF Byte =
[[qRFS, qRFSL], [qWFS, qWFSL]];
WITH oo: offset SELECT FROM
code => {obd _ oo.bd; owd _ oo.wd};
frame =>
BEGIN
IF oo.level # lZ THEN ERROR;
obd _ oo.bd; owd _ oo.wd;
END;
ENDCASE => ERROR;
fd _ [offset: 0, posn: obd, size: offset.bSize];
bpSize _ P5L.Words[base.wSize, base.bSize];
IF bpSize NOT IN [1..2] OR offset.wSize # 0 OR offset.bSize = 0
THEN ERROR;
WITH oo: offset SELECT FROM
code =>
BEGIN
Mask: ARRAY [4..7] OF CARDINAL = [17b, 7b, 3b, 1b];
tr: VarIndex = P5L.GenVarItem[bdo];
fr: VarIndex = P5L.GenVarItem[ind];
iscomp, bscomp: VarComponent;
IF dir = store THEN ERROR;
IF owd # 0 THEN
BEGIN
LoadComponent[index];
P5L.GenAdd[owd];
index _ Stack.TempStore[1];
END
ELSE index _ P5L.EasilyLoadable[index, load];
LoadComponent[index];
P5L.GenShift[shift-8];
cb[tr] _ [body: bdo[
base: base, 
disp: P5L.TOSComponent[1], 
offset: [wSize: 1, space: code[wd: 0]]]];
MoveBdo[tr, load]; -- get word containing field
LoadComponent[P5L.AddrComponent[Stack.TempStore[1]]];
bscomp _ P5L.TOSComponent[1];
LoadComponent[index];
P5L.GenAnd[Mask[shift]];
iscomp _ P5L.TOSComponent[1];
cb[fr] _ [body: ind[
base: bscomp, index: iscomp,
offset: [bSize: offset.bSize, space: frame[bd: obd]],
simple: TRUE,
packinfo: packed[grain: grain]]];
MoveInd[fr, load];
RETURN
END;
ENDCASE;
IF fd = [offset: 0, posn: 0, size: 8] THEN
BEGIN
RWSTROp: ARRAY MoveDirection OF ARRAY [1..2] OF Byte =
[[qRSTR, qRSTRL], [qWSTR, qWSTRL]];
alpha: CARDINAL _ owd;
P5L.LoadBoth[@base, @index, FALSE];
IF alpha > Byte.LAST THEN
BEGIN
P5L.GenAdd[alpha-Byte.LAST];
alpha _ Byte.LAST;
END;
P5U.Out1[RWSTROp[dir][bpSize], alpha];
RETURN
END;
IF simple THEN
BEGIN
IF bpSize = 2 AND index.tag = stack THEN
index _ P5L.EasilyLoadable[index, dir]; -- move to temp
P5L.LoadBoth[@base, @index, FALSE];
IF owd # 0 THEN P5L.GenAdd[owd];
END
ELSE
BEGIN
Mask: ARRAY [4..7] OF CARDINAL = [17b, 7b, 3b, 1b];
IF owd # 0 THEN
BEGIN
LoadComponent[index];
P5L.GenAdd[owd];
index _ Stack.TempStore[1];
END
ELSE index _ P5L.EasilyLoadable[index, load];
LoadComponent[base];
LoadComponent[index];
P5L.GenShift[shift-8];
IF bpSize = 1 THEN P5U.Out0[FOpCodes.qADD]
ELSE {P5U.Out1[FOpCodes.qLI, 0]; P5U.Out0[FOpCodes.qDADD]};
LoadComponent[index];
P5L.GenAnd[Mask[shift]];
END;
P5L.GenShift[shift];
IF fd # LOOPHOLE[0] THEN P5L.GenAdd[fd];
P5U.Out0[RWFSOp[dir][bpSize]];
END;

END;

StoreComponent: PUBLIC PROC [var: VarComponent] =
BEGIN
w, b: CARDINAL;
lvl: ContextLevel;
WITH vv: var SELECT FROM
frame => {w _ vv.wd; b _ vv.bd; lvl _ vv.level};
frameup =>
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[
base: [wSize: vv.pwSize, space: frame[wd: vv.wd, level: vv.level]],
offset: [wSize: vv.wSize, space: frame[wd: vv.delta]]]];
MoveBo[r, store];
END;
linkup =>
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[
base: [wSize: 1, space: link[wd: vv.wd]],
offset: [wSize: vv.wSize, space: frame[wd: vv.delta]]]];
MoveBo[r, store];
END;
ENDCASE => ERROR;
IF b # 0 OR var.bSize # 0 THEN
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[
base: P5L.AddrComponent[var],
offset: [wSize: var.wSize, bSize: var.bSize, space: frame[bd: b]]]];
MoveBo[r, store];
END
ELSE
BEGIN
SFOp: ARRAY BOOL OF ARRAY [1..2] OF Byte = [[qSL, qSLD], [qSG, qSGD]];
SELECT lvl FROM
lZ => ERROR;
CPtr.curctxlvl, lG => IF var.wSize IN [1..2] THEN
P5U.Out1[SFOp[lvl=lG][var.wSize], w]
ELSE
FOR i: CARDINAL DECREASING IN [0..var.wSize) DO
P5U.Out1[SFOp[lvl=lG][1], w+i];
ENDLOOP;
ENDCASE =>
BEGIN
r: VarIndex = P5L.GenVarItem[bo];
cb[r] _ [body: bo[base: P5L.BaseComponent[lvl],
offset: [wSize: var.wSize,
space: frame[wd: w - PrincOps.localbase]]]];
MoveBo[r, store];
END;
END;
END;

StoreVar: PUBLIC PROC [r: VarIndex] =
BEGIN
WITH cb[r] SELECT FROM
o => {StoreComponent[var]; P5L.ReleaseVarItem[r]};
bo => MoveBo[r, store];
bdo => MoveBdo[r, store];
ind => MoveInd[r, store];
ENDCASE => ERROR;
END;

END.


®VarMove.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, March 13, 1981  2:56 PM
Satterthwaite, April 17, 1986 11:34:49 am PST
Maxwell, August 11, 1983 9:24 am
Russ Atkinson (RRA) March 6, 1985 11:34:01 pm PST
the following is only half baked, when field variables
happen, need to work through in detail
N.B. some of the following code is copied in MakeBo.  Any bugs should
be fixed in both places.
�Ê3˜
codeš
œ™Kšœ
Ïm
œ1™<Kš
œ™Kš
œ-™-K™ K™1—K˜š
Ïk	˜	Kšœžœ˜Kšœžœ˜'Kšœžœ)˜3Kšœ	žœ…
˜“
Kšœ	žœÊ˜ØKšœ	žœ!˜/Kšœ
žœžœ˜+Kšœžœ¤
˜­
Kšœžœ˜Kšœ	žœ˜,Kšœžœžœžœ˜'KšœžœX˜cKšœžœ&˜3K˜—šœ	ž˜Kšžœ+˜2Kšžœ˜Kšžœ
žœ˜'K˜Kšœžœ˜*K˜K˜K˜K˜K˜šœžœ˜&KšžœÏc6˜=K˜K˜K˜Kšžœ
˜K˜—šÏn
œžœ
žœ˜0Kš
ž˜šœžœ	žœ
žœ˜#K˜0K˜-—Kšœžœ#˜/šžœ	žœ
ž˜˜Kš
ž˜Kšœžœ	˜K˜šžœž˜Kšœžœ
˜K˜K˜&šžœ˜
Kš
ž˜K˜&K˜Kšžœžœ˜Kšžœ
˜——Kšžœ
˜—˜Kš
ž˜Kšœžœ
˜Kšœžœ	˜K˜Kšœžœ˜šžœž˜
Kš
ž˜šžœ!žœž˜FKš
ž˜K˜;K˜K˜Kš
ž˜—š
ž˜Kš
ž˜K˜!Kšžœžœ
žœ
˜˜K˜K˜2—K˜Kš
ž˜Kšžœ
˜—K˜
Kšžœ
˜—Kšžœ
Ÿ˜Kšœžœ
žœ
žœ
žœžœ#˜Fšžœžœ
žœž˜%Kšœžœ
˜˜Kš
ž˜šžœžœžœ˜K˜+šžœžœ
ž˜$K˜8——š
ž˜šžœžœ
žœž˜$K˜%šžœžœ
ž˜$K˜,—Kšžœ
˜——Kšžœ
˜—šžœ˜
Kš
ž˜K˜!˜K˜˜!K˜+——K˜Kšžœ
˜——KšžœŸ˜šžœž˜Kšžœ
Ÿ˜šžœ!ž˜'Kš
ž˜K˜EK˜%Kš
ž˜—š
ž˜Kš
ž˜K˜!˜K˜K˜:—K˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—˜
Kš
ž˜K˜!˜K˜CK˜9—K˜Kšžœ
˜—˜	Kš
ž˜K˜Kšœ	žœžœžœ˜6Kšžœ
˜—K˜˜Kš
ž˜Kšœžœ
˜Kšœžœ	˜K˜Kšœžœ˜šžœž˜Kš
ž˜K˜š 	œžœžœ˜!Kš
ž˜šžœž˜
Kš
ž˜Kšžœžœžœ
žœ
˜;šœžœ˜Kšœžœ4˜J—K˜Kšžœ
˜—K˜Kšžœ
˜K˜—š œžœžœ˜ Kš
ž˜šžœž˜Kšœžœ˜:—K˜Kšžœ
˜K˜—šžœžœ
ž˜K˜˜Kš
ž˜K˜šžœžœ
žœž˜K˜Kšžœ
˜—Kšžœžœ˜(Kšžœ
˜—Kšžœžœ
˜—Kš
ž˜Kšžœ
˜—šžœž˜
Kš
ž˜Kšžœžœžœ
žœ
˜;K˜K˜K˜Kšžœ
˜—šžœžœ
žœž˜$K˜K˜#Kšžœ
˜—šžœž˜Kš
ž˜K˜K˜$Kšžœ
˜—Kšžœ
˜—K˜˜Kš
ž˜Kšœžœ	˜K˜šžœž˜
Kš
ž˜šžœ!ž˜'Kš
ž˜K˜K˜
K˜K˜K˜Kšžœ
žœ
˜Kšžœ
˜—šžœž˜Kš
ž˜K˜)Kšžœžœžœ
˜'šžœ
žœ
ž˜˜Kš
ž˜K˜
šžœž˜Kš
ž˜K˜3Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—K˜Kšžœ
˜Kš
ž˜—Kšžœ
žœžœžœ
˜=K˜š
ž˜Kšœžœ
˜—Kšžœ
˜—šžœž˜
Kš
ž˜K˜šžœž˜Kš
ž˜K˜Kšžœžœ
žœ
˜'Kšžœ
˜—K˜šžœž˜Kšœžœ
˜Kšœžœ
˜Kšžœ-˜4—K˜K˜Kšžœžœ˜2Kš
ž˜—Kšžœ˜Kšžœžœ&˜;Kšžœ
˜—˜	Kš
ž˜Kšœžœ	˜K˜Kšœžœ#˜/šžœž˜
Kšžœ
Ÿ;˜AKšžœžœ
žœ
˜)Kšœžœ˜/K˜Kšžœ
˜—K˜šžœžœ
˜šžœž˜Kšœžœ ˜D—Kšžœ˜—Kšžœ
˜—K˜!Kšžœžœ
˜—Kšžœ
˜K˜—š œžœ
žœ˜$Kš
ž˜šžœžœ
ž˜K˜1K˜K˜K˜Kšžœžœ
˜—Kšžœ
˜K˜—š œžœ$˜0Kš
ž˜K˜Kšœ	žœ
žœ˜'Kšœžœ
˜š	œžœžœ
žœžœ˜4K˜K˜—š œžœ˜Kš
ž˜šžœž˜#Kšœžœžœ
žœ
˜/Kšœžœ
˜Kšžœ
˜—K˜˜	K˜K˜šžœ˜"K˜3——K˜Kšžœ
˜K˜—š œžœ˜Kš
ž˜K˜˜	K˜K˜šžœ˜"K˜3——Kšžœ
˜K˜—šžœžœ
ž˜K˜+Kšžœžœ
˜—K˜šžœžœ
ž˜K˜˜Kš
ž˜Kšžœ
žœ
žœ
˜šžœž˜Kš
ž˜šžœžœ
˜Kšžœ#žœ
ž˜/šžœ
žœžœ
˜K˜%——K˜K˜'K˜$Kšžœ
˜—šžœžœžœž˜AK˜%—šžœžœ
žœž˜'K˜K˜#Kšžœ
˜—šžœž˜Kš
ž˜K˜K˜0Kšžœ
˜—Kšžœ
˜Kšžœ
˜—Kšžœžœ
˜—K˜*Kš
žœžœ
žœžœ
žœ
˜"šžœž˜Kšžœ
Ÿ˜š	œžœžœ
žœžœ˜5K˜—Kšžœ˜Kš
œ6™6Kš
œ&™&K˜K˜K˜Kš
ž˜Kšžœ
˜—šžœ
žœ
ž˜˜Kš
ž˜šœžœžœ
žœžœ
žœ
žœ
žœ˜CK˜A—š	žœžœžœ
žœž˜8Kšžœžœ˜%Kšžœžœ
žœ
žœ
˜&—šžœ
ž˜Kš
œžœžœ
žœžœ
žœ
žœ
˜@šœžœžœ
žœž˜;Kšžœ
žœ
˜—Kšžœžœ
žœ
˜—˜	K˜"K˜K˜—Kšžœ
˜š
ž˜Kšœžœ
˜—Kšžœ
˜—˜Kš
ž˜šžœ
ž˜˜š	žœžœžœžœž˜FKš
ž˜šœžœžœ
žœžœ
žœ
žœ
žœ˜BK˜9—K˜FKš
ž˜Kšžœ
˜——šžœ˜Kš
ž˜K˜"˜5˜2˜
K˜@———K˜Kš
ž˜Kšžœ
˜——Kšžœ
˜—šœ	žœžœžœž˜8Kš
ž˜K˜1šžœžœ
ž˜˜	Kšžœ
Ÿ*˜0K˜"K˜IK˜Kšžœ
˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—šžœžœž˜*Kš
ž˜Kšžœžœ&˜>šžœž˜Kš
ž˜Kšžœžœ˜)K˜Kš
ž˜—Kšžœ
žœ
žœ˜-Kšžœ
˜—šžœž˜Kšœžœ
˜
Kšœžœ
˜˜Kš
ž˜š
œžœžœ
žœžœ
žœžœ˜CK˜5—K˜K˜5Kšžœ
˜—šžœ˜
Kš
ž˜Kšœ
žœ
˜K˜
K˜%K˜Kšœžœ˜Kšœžœžœžœ˜9šžœž˜K˜K˜JK˜K˜
Kšžœžœžœ˜/Kšžœžœ˜"Kšžœ
˜—Kšžœ
˜——šžœž˜Kš
ž˜Kšžœžœ˜3Kšžœžœ˜&Kšžœ
žœžœ˜2Kšžœ
˜—Kšžœ
˜K˜—š œžœ$˜1Kš
ž˜K˜!K˜Kšœ
žœ
˜Kšœ	žœ
žœ˜'K˜š 	œžœ˜Kš
ž˜K˜Kšœžœ
˜K˜K˜Kšžœ
˜K˜—š 	œžœžœžœ˜2Kš
ž˜šžœžœ
ž˜˜Kš
ž˜Kš
žœžœ
žœ
žœžœ˜0šžœ
žœž˜1Kšžœžœ˜'—šžœ
žœ
žœ
ž˜(Kšœžœžœ˜.Kšœžœžœ˜9Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—Kšžœžœ˜Kšžœ
˜K˜—šžœžœ
ž˜K˜<Kšžœžœ
˜—K˜K˜Kš
œE™EKš
œ™K˜šžœ
žœ
ž˜˜Kš
ž˜Kšœžœ
˜K˜K˜Kš
žœžœžœ
žœ
žœ˜6šžœžœ
ž˜K˜K˜Kšžœžœ
˜—Kšœžœžœžœ
˜(Kšžœžœ
žœ
žœ˜%K˜*K˜K˜1K˜Kšžœ
˜š
ž˜Kšœ
žœ
˜—Kšžœ
˜—Kšžœ
˜K˜—šžœžœ
ž˜K˜˜Kš
ž˜K˜"KšœŸ"˜7K˜K˜K˜?K˜Kšžœ
˜Kšžœ
˜—Kšžœžœ
˜K˜—šœžœž˜7Kšœžœžœžœ
˜5—K˜+K˜+K˜Kšžœ
Ÿ˜#šžœž˜Kšœžœ
žœ˜Kš	œžœžœ
žœžœ
˜2˜Kš
ž˜Kšžœžœ
žœ
žœ
˜$Kšžœžœ
žœ
žœ˜$Kšžœžœ
žœžœ
žœžœ
˜;Kšžœ
žœ
˜š
ž˜˜Kš
ž˜K˜šžœ
žœ
ž˜˜Kšœ	žœžœžœ˜?—Kšžœ
˜—Kšžœ
˜Kšžœ
˜——Kšžœ
˜—Kšœžœ
žœ
˜Kšžœžœ
˜—š
ž˜˜Kš
ž˜šžœ
žœž˜'Kš
ž˜šœ	žœžœ
žœ
žœ
žœ˜4K˜!—K˜šžœ
žœ
ž˜˜K˜9—Kšžœžœ
˜—Kšžœ
˜Kšžœ
˜—Kšžœ
˜—Kšœžœ
˜—Kšžœ
˜K˜#Kš
ž˜K˜"K˜DK˜Kšžœ
˜Kšžœ
˜K˜—š œžœ$˜1Kš
ž˜K˜"Kšœžœ
˜Kšœžœ
˜K˜šžœžœ
ž˜˜Kš
ž˜K˜7K˜šžœžœ
ž˜Kšœžœ˜,Kšœžœ˜2Kšžœ
˜—Kšžœ
˜—Kšžœžœ
˜—K˜K˜šžœ	ž˜Kš
ž˜Kšœžœ˜0Kšœ&žœ˜>Kšžœžœ˜&š
ž˜Kš
ž˜šžœžœ
ž˜˜Kš
ž˜K˜Kšœžœžœ
žœ
˜+K˜Kšžœžœ%˜<K˜Kšžœ
žœ˜Kšžœ
˜—Kšžœ
˜—K˜K˜šžœž˜Kš
ž˜K˜K˜"Kš
ž˜—š
ž˜Kš
ž˜K˜K˜K˜"Kšžœ
˜—š
ž˜Kšœ	žœ
˜—Kšžœ
˜—K˜Kš
ž˜—š
ž˜Kš
ž˜šœžœž˜"Kšœ žœžœ˜2—K˜Kšœžœ
˜K˜Kšœžœ
˜š	œžœžœ
žœžœ˜5K˜—šžœžœ
ž˜K˜#˜Kš
ž˜Kšžœžœ
žœ
˜K˜Kšžœ
˜—Kšžœžœ
˜—K˜0K˜+š
žœžœ
žœžœžœ˜?Kšžœ
žœ
˜—šžœžœ
ž˜˜Kš
ž˜Kšœžœžœ
žœ˜3K˜#K˜#K˜Kšžœ
žœ
žœ
˜šžœ	ž˜Kš
ž˜K˜K˜K˜Kš
ž˜—Kšžœ)˜-K˜K˜˜K˜K˜K˜)—KšœŸ˜/K˜5K˜K˜K˜K˜˜K˜K˜5Kšœžœ
˜
K˜!—K˜Kš
ž˜Kšžœ
˜—Kšžœ
˜—šžœ$ž˜*Kš
ž˜š	œ	žœžœ
žœžœ˜6K˜#—Kšœžœ˜Kšœžœ˜#šžœžœ
ž˜Kš
ž˜Kšœžœ˜Kšœ
žœ
˜Kšžœ
˜—K˜&Kš
ž˜Kšžœ
˜—šžœž˜Kš
ž˜šžœžœž˜(Kšœ(Ÿ˜7—Kšœžœ˜#Kšžœ	žœ˜ Kš
ž˜—š
ž˜Kš
ž˜Kšœžœžœ
žœ˜3šžœ	ž˜Kš
ž˜K˜K˜K˜Kš
ž˜—Kšžœ)˜-K˜K˜K˜Kšžœžœ˜*Kšžœ7˜;K˜K˜Kšžœ
˜—K˜Kšžœžœžœ˜(K˜Kšžœ
˜K˜—Kšžœ
˜K˜—š œžœ
žœ˜1Kš
ž˜Kšœžœ
˜K˜šžœ	žœ
ž˜K˜0˜
Kš
ž˜K˜!˜K˜CK˜8—K˜Kšžœ
˜—˜	Kš
ž˜K˜!˜K˜)K˜8—K˜Kšžœ
˜—Kšžœžœ
˜—šžœžœž˜Kš
ž˜K˜!˜K˜K˜D—K˜Kš
ž˜—š
ž˜Kš
ž˜Kšœžœ
žœ
žœ
žœžœ#˜Fšžœž˜Kšœžœ
˜šœžœžœž˜1K˜$—š
ž˜š	žœžœ
ž
œ
žœž˜/K˜Kšžœ
˜——šžœ˜
Kš
ž˜K˜!˜/˜K˜,——K˜Kšžœ
˜——Kšžœ
˜—Kšžœ
˜K˜—š œžœ
žœ˜%Kš
ž˜šžœžœ
ž˜K˜2K˜K˜K˜Kšžœžœ
˜—Kšžœ
˜K˜—Kšžœ
˜K˜——…—Mšj{