-- CgenUtil.mesa, last modified by Sweet, November 28, 1979 10:04 AM
DIRECTORY
AltoDefs: FROM "altodefs" USING [Address, BYTE, wordlength],
Code: FROM "code" USING [
CodePassInconsistency, codeptr, fileindex, stking, xtracting,
xtractsei, ZEROlexeme],
CodeDefs: FROM "codedefs" USING [
CCIndex, CCItem, CCNull, ChunkIndex, CodeCCIndex, CodeChunkType,
JumpCCIndex, JumpCCNull, JumpType, LabelCCIndex, LabelCCNull, Lexeme,
NULLfileindex],
ComData: FROM "comdata" USING [typeSTRING],
ControlDefs: FROM "controldefs" USING [FrameVec],
FOpCodes: FROM "fopcodes" USING [qJ, qJREL, qLI],
LiteralOps: FROM "literalops" USING [Find, Value],
MiscDefs: FROM "miscdefs" USING [CallDebugger],
OpTableDefs: FROM "optabledefs" USING [instlength],
P5: FROM "p5" USING [NumberOfParams, P5Error, PushEffect],
P5U: FROM "p5u",
Stack: FROM "stack" USING [Check, Depth],
SymbolOps: FROM "symbolops" USING [
NextSe, RecordRoot, UnderType, WordsForType],
Symbols: FROM "symbols" USING [
BitAddress, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex,
CSENull, CTXIndex, ctxType, HTIndex, HTNull, ISEIndex, ISENull, lG, lL,
MDIndex, RecordSEIndex, RecordSENull, SEIndex, SENull, seType, typeTYPE],
SymbolSegment: FROM "symbolsegment" USING [ByteIndex],
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
Table: FROM "table" USING [Base, FreeChunk, GetChunk, Notifier],
Tree: FROM "tree" USING [Index, Link, Null, NullIndex, treeType],
TreeOps: FROM "treeops" USING [ScanList];
CgenUtil: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, LiteralOps, MiscDefs, OpTableDefs, P5, Stack, SymbolOps, SystemDefs, Table, TreeOps
EXPORTS CodeDefs, P5U =
BEGIN
OPEN SymbolOps, CodeDefs;
-- imported definitions
Address: TYPE = AltoDefs.Address;
BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;
BitAddress: TYPE = Symbols.BitAddress;
BTIndex: TYPE = Symbols.BTIndex;
CBTIndex: TYPE = Symbols.CBTIndex;
BTNull: BTIndex = Symbols.BTNull;
ContextLevel: TYPE = Symbols.ContextLevel;
CSEIndex: TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
CTXIndex: TYPE = Symbols.CTXIndex;
HTIndex: TYPE = Symbols.HTIndex;
HTNull: HTIndex = Symbols.HTNull;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
lG: ContextLevel = Symbols.lG;
lL: ContextLevel = Symbols.lL;
MDIndex: TYPE = Symbols.MDIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
SEIndex: TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
typeTYPE: CSEIndex = Symbols.typeTYPE;
tb: Table.Base; -- tree base (local copy)
seb: Table.Base; -- semantic entry base (local copy)
ctxb: Table.Base; -- context entry base (local copy)
bb: Table.Base; -- body entry base (local copy)
cb: Table.Base; -- code base (local copy)
CgenUtilNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
bb ← base[Symbols.bodyType];
cb ← tb ← base[Tree.treeType];
RETURN
END;
codeindex: SymbolSegment.ByteIndex;
AllocCodeCCItem: PUBLIC PROCEDURE [n: [0..3]] RETURNS [c: CodeCCIndex] =
BEGIN
c ← GetChunk[SIZE[code CCItem] + n];
cb[c] ←
CCItem[free: FALSE, pad:0, flink: CCNull, blink: CCNull, ccvalue:
code[inst: 0, realinst: FALSE, minimalStack: FALSE,
sourcefileindex: NULLfileindex,
isize: 0, aligned: FALSE, fill: 0, parameters: ]];
IF CPtr.stking THEN cb[c].sourcefileindex ← codeindex;
linkCCItem[c];
RETURN
END;
BitsForOperand: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [CARDINAL] =
BEGIN
WITH t SELECT FROM
literal => RETURN [wordlength]; -- not always TRUE, but good enough
ENDCASE;
RETURN[BitsForType[OperandType[t]]]
END;
BitsForType: PUBLIC PROCEDURE [sei: SEIndex] RETURNS [CARDINAL] =
BEGIN
csei: CSEIndex ← UnderType[sei];
WITH seb[csei] SELECT FROM
record => RETURN[length];
ENDCASE => RETURN[SymbolOps.WordsForType[csei]*wordlength]
END;
CCellAlloc: PUBLIC PROCEDURE [t: CodeChunkType] =
BEGIN -- allocates a cell for other than code or label
c: CCIndex;
nwords: CARDINAL;
codeindex ← MAX[CPtr.fileindex, codeindex];
SELECT t FROM
code => P5.P5Error[262];
label => P5.P5Error[263];
jump => nwords ← SIZE[jump CCItem];
other => nwords ← SIZE[other CCItem];
ENDCASE;
c ← GetChunk[nwords];
SELECT t FROM
jump =>
cb[c] ←
CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: jump[,,,,,,,]];
other =>
cb[c] ←
CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: other[obody: ]];
ENDCASE;
linkCCItem[c];
RETURN
END;
CgenUtilInit: PUBLIC PROCEDURE =
BEGIN
CPtr.ZEROlexeme ← Lexeme[literal[word[LiteralOps.Find[0]]]];
codeindex ← CPtr.fileindex ← 0;
END;
ComputeFrameSize: PUBLIC PROCEDURE [fs: CARDINAL] RETURNS [CARDINAL] =
BEGIN -- finds alloc-vector index for frame of size fs
OPEN ControlDefs;
fx: CARDINAL;
FOR fx IN [0..LENGTH[FrameVec]) DO
IF fs <= FrameVec[fx] THEN RETURN [fx] ENDLOOP;
ERROR;
END;
CreateLabel: PUBLIC PROCEDURE RETURNS [c: LabelCCIndex] =
BEGIN -- allocates and inserts a label at codeptr
c ← LabelAlloc[];
InsertLabel[c];
RETURN
END;
DeleteCell: PUBLIC PROCEDURE [c: CCIndex] =
BEGIN -- deletes cell from code stream
nwords: CARDINAL;
IF cb[c].blink # CCNull THEN
cb[cb[c].blink].flink ← cb[c].flink;
IF cb[c].flink # CCNull THEN
cb[cb[c].flink].blink ← cb[c].blink;
WITH cb[c] SELECT FROM
code => nwords ← ParamCount[LOOPHOLE[c]] + SIZE[code CCItem];
label => nwords ← SIZE[label CCItem];
jump => nwords ← SIZE[jump CCItem];
other => nwords ← SIZE[other CCItem];
ENDCASE;
FreeChunk[c, nwords];
RETURN
END;
EnumerateCaseArms: PUBLIC PROCEDURE [node: Tree.Index,
action: PROCEDURE [t: Tree.Link]] =
BEGIN
ProcessItem: PROCEDURE [t: Tree.Link] =
BEGIN
inode: Tree.Index;
WITH t SELECT FROM
subtree => inode ← index;
ENDCASE;
SELECT tb[inode].name FROM
item => action[tb[inode].son[2]];
caseswitch => TreeOps.ScanList[tb[inode].son[3], ProcessItem];
ENDCASE;
END;
TreeOps.ScanList[tb[node].son[2], ProcessItem];
IF tb[node].son[3] # Tree.Null THEN action[tb[node].son[3]];
END;
FieldAddress: PUBLIC PROCEDURE [sei: ISEIndex] RETURNS [BitAddress, CARDINAL] =
BEGIN
RETURN [seb[sei].idValue, seb[sei].idInfo]
END;
FreeChunk: PUBLIC PROCEDURE [i: CodeDefs.ChunkIndex, size: CARDINAL] =
BEGIN
p: POINTER TO MonitorRecord;
FOR p ← monList, p.next WHILE p # NIL DO
IF p.cell = i AND p.action = free THEN MiscDefs.CallDebugger["From FreeChunk"L];
ENDLOOP;
Table.FreeChunk[LOOPHOLE[i],size];
END;
FullWordBits: PUBLIC PROCEDURE [bits: CARDINAL] RETURNS [CARDINAL] =
BEGIN
RETURN[((bits+wordlength-1)/wordlength) * wordlength]
END;
GetChunk: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [c: CodeDefs.ChunkIndex] =
BEGIN
p: POINTER TO MonitorRecord;
c ← LOOPHOLE[Table.GetChunk[size]];
FOR p ← monList, p.next WHILE p # NIL DO
IF p.cell = c AND p.action = allocate THEN MiscDefs.CallDebugger["From GetChunk"L];
ENDLOOP;
RETURN [c];
END;
InsertLabel: PUBLIC PROCEDURE [c: LabelCCIndex] =
BEGIN -- puts a label chunk in the code stream
IF CPtr.codeptr # CCNull THEN
BEGIN
cb[c].flink ← cb[CPtr.codeptr].flink;
IF cb[CPtr.codeptr].flink # CCNull THEN
cb[cb[CPtr.codeptr].flink].blink ← c;
cb[CPtr.codeptr].flink ← c;
END
ELSE cb[c].flink ← CCNull;
cb[c].blink ← CPtr.codeptr;
CPtr.codeptr ← c;
RETURN
END;
LabelAlloc: PUBLIC PROCEDURE RETURNS [c: LabelCCIndex] =
BEGIN -- gets a chunk for a label but does not insert it in stream
c ← GetChunk[SIZE[label CCItem]];
cb[c] ←
CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: label[labelseen: FALSE, labelinfo: generating[filltoword: , jumplist: JumpCCNull]]];
RETURN
END;
linkCCItem: PROCEDURE[c: CCIndex] =
BEGIN -- inserts a CCItem in list @ codeptr
IF CPtr.codeptr # CCNull THEN
BEGIN
cb[c].flink ← cb[CPtr.codeptr].flink;
IF cb[CPtr.codeptr].flink # CCNull THEN
cb[cb[CPtr.codeptr].flink].blink ← c;
cb[CPtr.codeptr].flink ← c;
END
ELSE cb[c].flink ← CCNull;
cb[c].blink ← CPtr.codeptr;
CPtr.codeptr ← c;
RETURN
END;
LongTreeAddress: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [long: BOOLEAN] =
BEGIN
node: Tree.Index;
WITH t SELECT FROM
subtree =>
BEGIN node ← index;
IF node = Tree.NullIndex
THEN long ← FALSE
ELSE SELECT tb[node].name FROM
loophole, cast, openx, pad, chop =>
long ← LongTreeAddress[tb[node].son[1]];
dot, uparrow, dindex, seqindex, dollar, index, reloc =>
long ← tb[node].attr2;
assignx => WITH tb[node].son[2] SELECT FROM
subtree => IF tb[index].name = mwconst THEN
long ← LongTreeAddress[tb[node].son[1]]
ELSE long ← LongTreeAddress[tb[node].son[2]];
ENDCASE => long ← LongTreeAddress[tb[node].son[2]];
ifx => long ← LongTreeAddress[tb[node].son[2]] OR
LongTreeAddress[tb[node].son[3]];
casex =>
BEGIN
LongArm: PROCEDURE [t: Tree.Link] =
BEGIN
long ← long OR LongTreeAddress[t];
END;
long ← FALSE;
EnumerateCaseArms[node, LongArm];
END;
ENDCASE => long ← FALSE;
END;
ENDCASE => long ← FALSE;
RETURN
END;
MakeTreeLiteral: PUBLIC PROCEDURE [val: WORD] RETURNS [Tree.Link] =
BEGIN
RETURN [Tree.Link[literal[[word[index: LiteralOps.Find[val]]]]]]
END;
MonitorAction: TYPE = {allocate, free};
MonitorRecord: TYPE = RECORD [next: POINTER TO MonitorRecord, cell: CCIndex, action: MonitorAction];
monList: POINTER TO MonitorRecord ← NIL;
Monitor: PROCEDURE [cell: CCIndex, action: MonitorAction] =
BEGIN
p: POINTER TO MonitorRecord;
p ← SystemDefs.AllocateHeapNode[SIZE[MonitorRecord]];
p↑ ← [monList, cell, action];
monList ← p;
END;
NextVar: PUBLIC PROCEDURE [sei: ISEIndex] RETURNS [ISEIndex] =
BEGIN -- starting at sei returns first variable on ctx-list
IF sei = ISENull THEN RETURN [ISENull];
DO
IF seb[sei].idType # typeTYPE THEN RETURN [sei];
IF (sei ← SymbolOps.NextSe[sei]) = ISENull THEN EXIT;
ENDLOOP;
RETURN [ISENull];
END;
OperandType: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [sei: CSEIndex] =
BEGIN -- compute number of words for storing value of tree
WITH e:t SELECT FROM
literal =>
WITH e.info SELECT FROM
string => sei ← MPtr.typeSTRING;
ENDCASE => SIGNAL CPtr.CodePassInconsistency;
symbol => sei ← UnderType[seb[e.index].idType];
subtree =>
IF e = Tree.Null THEN
IF CPtr.xtracting THEN
sei ← UnderType[seb[CPtr.xtractsei].idType]
ELSE ERROR
ELSE sei ← tb[e.index].info;
ENDCASE;
RETURN
END;
Out0: PUBLIC PROCEDURE [i: BYTE] =
BEGIN -- outputs an parameter-less instruction
c: CodeCCIndex;
pusheffect: CARDINAL = P5.PushEffect[i];
Stack.Check[i];
IF P5.NumberOfParams[i] # 0 THEN P5.P5Error[257];
codeindex ← MAX[CPtr.fileindex, codeindex];
c ← AllocCodeCCItem[0];
cb[c].inst ← i;
cb[c].minimalStack ← Stack.Depth[] = pusheffect;
RETURN
END;
Out1: PUBLIC PROCEDURE [i: BYTE, p1: WORD] =
BEGIN -- outputs an one-parameter instruction
c: CodeCCIndex;
pusheffect: CARDINAL = P5.PushEffect[i];
Stack.Check[i];
IF P5.NumberOfParams[i] # 1 THEN P5.P5Error[258];
codeindex ← MAX[CPtr.fileindex, codeindex];
c ← AllocCodeCCItem[1];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].minimalStack ← Stack.Depth[] = pusheffect;
RETURN
END;
Out2: PUBLIC PROCEDURE [i: BYTE, p1, p2: WORD] =
BEGIN -- outputs an two-parameter instruction
c: CodeCCIndex;
pusheffect: CARDINAL = P5.PushEffect[i];
Stack.Check[i];
IF P5.NumberOfParams[i] # 2 THEN P5.P5Error[259];
codeindex ← MAX[CPtr.fileindex, codeindex];
c ← AllocCodeCCItem[2];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].parameters[2] ← p2;
cb[c].minimalStack ← Stack.Depth[] = pusheffect;
RETURN
END;
Out3: PUBLIC PROCEDURE [i: BYTE, p1, p2, p3: WORD] =
BEGIN -- outputs an three-parameter instruction
c: CodeCCIndex;
pusheffect: CARDINAL = P5.PushEffect[i];
Stack.Check[i];
IF P5.NumberOfParams[i] # 3 THEN P5.P5Error[260];
codeindex ← MAX[CPtr.fileindex, codeindex];
c ← AllocCodeCCItem[3];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].parameters[2] ← p2;
cb[c].parameters[3] ← p3;
cb[c].minimalStack ← Stack.Depth[] = pusheffect;
RETURN
END;
OutJump: PUBLIC PROCEDURE [jt: JumpType, l: LabelCCIndex] =
BEGIN -- outputs a jump-type code ceel into the code stream
SELECT jt FROM
Jump, JumpA, JumpC, JumpCA, JumpRet => Stack.Check[FOpCodes.qJ];
ENDCASE => Stack.Check[FOpCodes.qJREL];
CCellAlloc[jump];
WITH cb[CPtr.codeptr] SELECT FROM
jump =>
BEGIN
fixedup ← FALSE;
completed ← FALSE;
jtype ← jt;
destlabel ← l;
IF l # LabelCCNull THEN
BEGIN
thread ← cb[l].jumplist;
cb[l].jumplist ← LOOPHOLE[CPtr.codeptr, JumpCCIndex];
END
ELSE thread ← JumpCCNull;
RETURN
END;
ENDCASE
END;
ParamCount: PUBLIC PROCEDURE [c: CodeCCIndex] RETURNS [CARDINAL] =
BEGIN
RETURN[IF cb[c].isize # 0 THEN cb[c].isize-1
ELSE IF cb[c].realinst THEN OpTableDefs.instlength[cb[c].inst]-1
ELSE P5.NumberOfParams[cb[c].inst]]
END;
PrevVar: PUBLIC PROCEDURE [ssei, sei : ISEIndex] RETURNS [ISEIndex] =
BEGIN -- returns vars in reverse order as those returned by nextvar
psei: ISEIndex ← NextVar[ssei];
rsei: ISEIndex;
IF psei = sei THEN RETURN [psei];
UNTIL psei = sei DO
rsei ← psei; psei ← NextVar[SymbolOps.NextSe[psei]]; ENDLOOP;
RETURN [rsei];
END;
PushLitVal: PUBLIC PROCEDURE [v: UNSPECIFIED] =
BEGIN -- forces a constant onto the stack
Out1[FOpCodes.qLI, v];
RETURN
END;
SetCodeIndex: PUBLIC PROCEDURE [i: SymbolSegment.ByteIndex] =
BEGIN
codeindex ← i;
END;
TreeLiteral: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
BEGIN
node: Tree.Index;
DO
WITH t SELECT FROM
literal => RETURN[info.litTag = word];
subtree =>
BEGIN node ← index;
SELECT tb[node].name FROM
cast, mwconst => t ← tb[node].son[1];
ENDCASE => RETURN [FALSE];
END;
ENDCASE => RETURN[FALSE]
ENDLOOP
END;
TreeLiteralValue: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [WORD] =
BEGIN
node: Tree.Index;
DO
WITH e:t SELECT FROM
literal =>
WITH e.info SELECT FROM
word => RETURN [LiteralOps.Value[index]];
ENDCASE => EXIT;
subtree =>
BEGIN node ← e.index;
SELECT tb[node].name FROM
cast, mwconst => t ← tb[node].son[1];
ENDCASE => EXIT;
END;
ENDCASE => EXIT
ENDLOOP;
P5.P5Error[261]; -- never comes back
RETURN[0]
END;
UnMonitor: PROCEDURE [cell: CCIndex, action: MonitorAction] =
BEGIN
p, q: POINTER TO MonitorRecord;
IF monList = NIL THEN RETURN;
IF monList.cell = cell AND monList.action = action THEN
BEGIN p ← monList.next; SystemDefs.FreeHeapNode[monList];
monList ← p;
END;
FOR p ← monList, p.next UNTIL p.next = NIL DO
IF p.next.cell = cell AND p.next.action = action THEN
BEGIN
q ← p.next.next;
SystemDefs.FreeHeapNode[p.next];
p.next ← q;
RETURN;
END;
ENDLOOP;
END;
WordAligned: PUBLIC PROCEDURE [tsei: RecordSEIndex] RETURNS [BOOLEAN] =
BEGIN -- sees if a word-aligned record (never TRUE for a variant record)
-- always true for an argument record
sei: ISEIndex;
wa: INTEGER ← 0;
a: BitAddress;
tsei ← RecordRoot[tsei];
IF seb[tsei].hints.variant THEN RETURN[FALSE];
IF seb[tsei].argument THEN RETURN[TRUE];
sei ← NextVar[ctxb[seb[tsei].fieldCtx].seList];
UNTIL sei = ISENull DO
a ← seb[sei].idValue;
IF a.bd # 0 THEN RETURN[FALSE];
IF a.wd < wa THEN RETURN [FALSE];
wa ← a.wd;
sei ← NextVar[NextSe[sei]];
ENDLOOP;
RETURN[TRUE]
END;
WordsForOperand: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [n: CARDINAL] =
BEGIN -- compute number of words for storing value of tree
WITH t SELECT FROM
literal => n ← 1; -- multiwords will be subtrees
symbol => n ← WordsForSei[seb[index].idType];
subtree => n ← WordsForType[OperandType[t]];
ENDCASE;
RETURN
END;
WordsForSei: PUBLIC PROCEDURE [sei: SEIndex] RETURNS [CARDINAL] =
BEGIN
RETURN [IF sei = SENull THEN 0
ELSE SymbolOps.WordsForType[UnderType[sei]]];
END;
END.