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];
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;
the following is only half baked, when field variables
happen, need to work through in detail
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;
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];
N.B. some of the following code is copied in MakeBo. Any bugs should
be fixed in both places.
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;
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;
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.