DIRECTORY
Alloc: TYPE USING [Notifier],
CodeDefs:
TYPE
USING [
Base, BoVarIndex, codeType, JumpType, LabelCCIndex, Lexeme, NullLex,
StoreOptions, VarComponent, VarIndex, VarNull],
ComData: TYPE USING [switches, typeRefANY],
Counting: TYPE USING [],
FOpCodes:
TYPE
USING [
qBLTL, qBLZL, qDUP, qICDL, qKFCB, qLP, qPUSH, qNILCKL, qRL, qRD,
qSFC, qSUB, qWCDL, qWL],
P5: TYPE USING [CallCatch, Exp, GenTempLex, PushLex, PushRhs, SAssign, SysCall],
P5L:
TYPE
USING [
AllLoaded, CopyToTemp, CopyVarItem, EasilyLoadable, InCode, GenAdd, LoadAddress,
LoadComponent, LoadVar, MakeBo, OVarItem, ReleaseVarItem, ReusableCopies,
StoreVar, TOSAddrLex, VarAlignment, VarVarAssign, VarForLex, Words],
P5U:
TYPE
USING [
InsertLabel, LabelAlloc, Out0, Out1, OutJump, PushLitVal, TreeLiteral, WordsForSei],
PrincOps: TYPE USING [SD],
RTSD: TYPE USING [sAssignComposite, sAssignCompositeNew, sSystemZone],
Stack: TYPE USING [Decr, DeleteToMark, Dump, Incr, Load, Mark, TempStore, Top],
SymbolOps:
TYPE
USING [
FirstCtxSe, NextSe, RCType, TypeRoot, UnderType, WordsForType],
Symbols:
TYPE
USING [
Base, CSEIndex, ISEIndex, lZ, RecordSEIndex, RefClass, SEIndex, seType],
SymLiteralOps: TYPE USING [TypeRef],
Tree: TYPE USING [Link, Null],
TreeOps: TYPE USING [FreeTree, ScanList];
CountingImpl:
PROGRAM
IMPORTS MPtr: ComData, P5, P5L, P5U, Stack, SymbolOps, SymLiteralOps, TreeOps
EXPORTS Counting, CodeDefs = {
OPEN CodeDefs, Counting, Symbols;
seb: Symbols.Base; -- se base (local copy)
cb: CodeDefs.Base; -- code base (local copy)
CountingNotify:
PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
seb ← base[seType]; cb ← base[codeType]};
CheckArgRefs:
PUBLIC
PROC [t: Tree.Link, rsei: RecordSEIndex]
RETURNS [safe:
BOOL←
TRUE] =
BEGIN
IF seb[rsei].hints.refField
THEN
BEGIN
sei: ISEIndex ← SymbolOps.FirstCtxSe[seb[rsei].fieldCtx];
TestField:
PROC [t: Tree.Link] =
BEGIN
IF SymbolOps.RCType[SymbolOps.UnderType[seb[sei].idType]] # none
AND ~P5U.TreeLiteral[t]
THEN
safe ← FALSE;
sei ← SymbolOps.NextSe[sei];
END;
TreeOps.ScanList[t, TestField];
END;
RETURN
END;
Allocate:
PUBLIC
PROC [
zone: Tree.Link, type: SEIndex, catch: Tree.Link, pushSize: PROC] = {
Allocate generates code for space allocation from counted zones
first, generate code to perform the allocation
nwords: CARDINAL = SymbolOps.WordsForType[type];
sizeVar: VarIndex ← VarNull;
zoneVar, copyVar: VarIndex;
topVar: VarIndex ← VarNull;
initRC: RefClass = SymbolOps.RCType[SymbolOps.UnderType[type]];
typeTree: Tree.Link ← SymLiteralOps.TypeRef[SymbolOps.TypeRoot[type], FALSE];
Stack.Dump[]; Stack.Mark[];
IF zone = Tree.Null THEN LoadSystemZone[]
ELSE {
zoneVar ← P5L.VarForLex[P5.Exp[zone]];
[first: zoneVar, next: copyVar] ← P5L.ReusableCopies[zoneVar, load, FALSE];
P5L.LoadVar[zoneVar]};
IF pushSize #
NIL
THEN {
pushSize[]; -- (must save it for later)
P5U.Out0[FOpCodes.qDUP]; sizeVar ← StackTemp[1]}
ELSE P5U.PushLitVal[nwords];
P5.PushRhs[typeTree]; typeTree ← TreeOps.FreeTree[typeTree];
IF zone = Tree.Null THEN LoadSystemZone[]
ELSE {
P5L.LoadVar[copyVar];
IF ~MPtr.switches['a] THEN P5U.Out0[FOpCodes.qNILCKL]};
P5U.Out1[FOpCodes.qRL, 0];
Stack.DeleteToMark[]; Stack.Incr[1]; P5U.Out0[FOpCodes.qSFC];
P5.CallCatch[catch];
Stack.Incr[2];
if size is in a variable and we are RC, then clear the world to NIL
IF initRC # none
AND pushSize #
NIL
THEN {
IF nwords = 0 OR sizeVar = VarNull THEN ERROR;
IF MPtr.switches['m] THEN {CopyLoad[sizeVar]; P5U.Out0[FOpCodes.qBLZL]}
ELSE {
topVar ← StackTemp[2];
P5U.PushLitVal[0]; CopyLoad[topVar]; P5U.Out1[FOpCodes.qWL, 0];
CopyLoad[topVar];
CopyLoad[sizeVar]; P5U.PushLitVal[1]; P5U.Out0[FOpCodes.qSUB];
DoubleIncr[topVar, 1];
P5U.Out0[FOpCodes.qBLTL];
CopyLoad[topVar]}}};
Free:
PUBLIC
PROC [var: VarIndex, counted:
BOOL, zone, catch: Tree.Link] = {
emit code for zone.FREE[@ var ! catch]
c0: VarIndex ← P5L.OVarItem[[wSize: 2, space: const[d1:0, d2:0]]];
bor: BoVarIndex ← P5L.MakeBo[var];
r, rr, zoneVar, copyVar: VarIndex;
cb[bor].base ← P5L.EasilyLoadable[cb[bor].base, load];
rr ← P5L.CopyVarItem[bor];
r ← P5L.OVarItem[P5L.CopyToTemp[bor].var];
IF counted THEN [] ← VarVarAssignCounted[rr, c0, [counted: TRUE], MPtr.typeRefANY]
ELSE [] ← P5L.VarVarAssign[rr, c0, FALSE];
Stack.Dump[]; Stack.Mark[];
IF zone = Tree.Null THEN LoadSystemZone[]
ELSE {
zoneVar ← P5L.VarForLex[P5.Exp[zone]];
[first: zoneVar, next: copyVar] ← P5L.ReusableCopies[zoneVar, load, FALSE];
P5L.LoadVar[zoneVar]};
P5L.LoadVar[r]; -- reload the REF
IF zone = Tree.Null THEN LoadSystemZone[]
ELSE {
P5L.LoadVar[copyVar];
IF ~MPtr.switches['a] THEN P5U.Out0[FOpCodes.qNILCKL]};
P5U.Out1[FOpCodes.qRL, 1];
Stack.DeleteToMark[]; Stack.Incr[1]; P5U.Out0[FOpCodes.qSFC];
P5.CallCatch[catch]};
VarVarAssignCounted:
PUBLIC
PROC [
to, from: VarIndex, options: StoreOptions, type: SEIndex]
RETURNS [l: Lexeme ← NullLex] = {
nWords: CARDINAL = P5U.WordsForSei[type];
IF options.composite
THEN {
typeTree: Tree.Link ← SymLiteralOps.TypeRef[SymbolOps.UnderType[type]];
tempVar: VarIndex;
LoadLongVarAddress[from];
IF options.expr THEN CopyLoad[tempVar ← StackTemp[2]];
LoadLongAddress[to];
P5.PushRhs[typeTree]; typeTree ← TreeOps.FreeTree[typeTree];
P5U.PushLitVal[nWords];
Stack.Load[Stack.Top[6], 6]; Stack.Decr[6]; -- Stack.LoadToDepth[6];
P5U.Out1[FOpCodes.qKFCB, IF options.init THEN RTSD.sAssignCompositeNew ELSE RTSD.sAssignComposite];
IF options.expr THEN l ← AddrVarToLex[tempVar, nWords]}
ELSE {
IF nWords # 2 THEN ERROR; -- somebody goofed!
IF options.expr
THEN {
v: VarIndex;
P5L.LoadVar[from];
v ← StackTemp[2]; CopyLoad[v];
l ← [bdo[v]]}
ELSE {
IF ~StackVar[from, nWords]
OR ~P5L.AllLoaded[from] THEN P5L.LoadVar[from]}; -- anything above it is part of "to"
StoreVarCounted[to, options]};
RETURN};
StoreVarCounted:
PROC [r: VarIndex, options: StoreOptions] = {
WCDOp:
ARRAY
BOOL
OF [0..256) = [
FALSE: FOpCodes.qWCDL, TRUE: FOpCodes.qICDL];
alpha: CARDINAL ← 0;
WITH cc: cb[r]
SELECT
FROM
bo => {
offset: VarComponent = cc.offset;
WITH oo: offset
SELECT
FROM
frame =>
IF oo.level = Symbols.lZ
AND oo.wSize = 2
AND oo.bSize = 0
AND oo.bd = 0
THEN {
P5L.LoadComponent[cc.base];
SELECT P5L.Words[cc.base.wSize, cc.base.bSize]
FROM
1 => P5U.Out0[FOpCodes.qLP];
2 => NULL;
ENDCASE => ERROR;
alpha ← oo.wd;
P5L.ReleaseVarItem[r]}
ELSE LoadLongAddress[r];
ENDCASE => LoadLongAddress[r]};
ENDCASE => LoadLongAddress[r];
Stack.Load[Stack.Top[4], 4]; -- REF + nWords
P5U.Out1[WCDOp[options.init], alpha]};
FillCounted:
PUBLIC
PROC [
space, source: VarIndex, options: StoreOptions, type: Symbols.SEIndex] = {
subType: CSEIndex = SymbolOps.UnderType[type];
wordsPerItem: CARDINAL = SymbolOps.WordsForType[subType];
nItems: CARDINAL = P5L.VarAlignment[space, load].wSize/wordsPerItem;
countLex: se Lexeme = P5.GenTempLex[1];
ptrTemp: VarIndex;
loopLabel: CodeDefs.LabelCCIndex = P5U.LabelAlloc[];
testLabel: LabelCCIndex = P5U.LabelAlloc[];
LoadLongAddress[space]; ptrTemp ← StackTemp[2];
Stack.Dump[];
P5U.PushLitVal[nItems]; Stack.Decr[1];
P5U.OutJump[Jump, testLabel];
P5U.InsertLabel[loopLabel]; -- top of the assignment loop
IF SymbolOps.RCType[subType] = composite
THEN {
typeTree: Tree.Link ← SymLiteralOps.TypeRef[subType];
Stack.Mark[];
LoadLongVarAddress[source];
CopyLoad[ptrTemp];
P5.PushRhs[typeTree]; typeTree ← TreeOps.FreeTree[typeTree];
P5U.PushLitVal[wordsPerItem];
P5.SysCall[IF options.init THEN RTSD.sAssignCompositeNew ELSE RTSD.sAssignComposite]}
ELSE {
WCDOp: ARRAY BOOL OF [0..256) = [FALSE: FOpCodes.qWCDL, TRUE: FOpCodes.qICDL];
P5L.LoadVar[source];
CopyLoad[ptrTemp];
P5U.Out1[WCDOp[options.init], 0]};
DoubleIncr[ptrTemp, wordsPerItem]; -- update pointer
P5L.StoreVar[ptrTemp];
P5.PushLex[countLex];
P5U.PushLitVal[1];
P5U.Out0[FOpCodes.qSUB];
P5U.InsertLabel[testLabel];
P5.SAssign[countLex.lexsei];
P5U.Out0[FOpCodes.qPUSH];
P5U.PushLitVal[0];
P5U.OutJump[JumpG, loopLabel]};
LoadLongAddress:
PUBLIC
PROC [v: VarIndex] = {
Push a LONG address for the variable
NOTE: clobbers the VarItem
IF ~P5L.LoadAddress[v] THEN P5U.Out0[FOpCodes.qLP]};
LoadLongVarAddress:
PROC [var: VarIndex] =
INLINE {
Push a LONG address for the var
IF P5L.InCode[var] THEN var ← P5L.OVarItem[P5L.CopyToTemp[var].var];
LoadLongAddress[var]};
LoadSystemZone:
PROC = {
P5U.PushLitVal[LOOPHOLE[PrincOps.SD, CARDINAL] + RTSD.sSystemZone];
P5U.Out1[FOpCodes.qRD, 0]};
AddrVarToLex:
PROC [var: VarIndex, nwords:
CARDINAL, pushOK:
BOOL ←
TRUE]
RETURNS [Lexeme] = {
CopyLoad[var];
RETURN [P5L.TOSAddrLex[nwords, TRUE]]};
DoubleIncr:
PROC [var: VarIndex, n:
CARDINAL] = {
load the LONG variable and increment it by n
NOTE: does not clobber the var
P5L.LoadVar[P5L.CopyVarItem[var]];
P5L.GenAdd[n, TRUE]};
CopyLoad:
PROC [var: VarIndex] = {
load the variable
NOTE: does not clobber the var
P5L.LoadVar[P5L.CopyVarItem[var]]};
StackTemp:
PROC [nwords:
CARDINAL]
RETURNS [VarIndex] = {
make a new temporary from the top nwords of the stack
RETURN [P5L.OVarItem[Stack.TempStore[nwords]]]};
StackVar:
PROC [var: VarIndex, nWords:
CARDINAL]
RETURNS [
BOOL] = {
RETURN [
WITH cc: cb[var]
SELECT
FROM
o =>
WITH vv: cc.var
SELECT
FROM
stack => (vv.wd = 0 AND vv.wSize = nWords),
ENDCASE => FALSE,
ENDCASE => FALSE]};
}.