DIRECTORY
Alloc USING [FreeChunk, GetChunk, Handle, Notifier, Words],
Code USING [bodyStartLoc, codeptr, fileLoc, xtracting, xtractsei, ZEROlexeme],
CodeDefs USING [Base, Byte, CCIndex, CCItem, CCNull, ChunkIndex, CodeCCIndex, CodeChunkType, codeType, JumpCCIndex, JumpCCNull, JumpType, LabelCCIndex, LabelCCNull, Lexeme, OpWordCount, RelSourceLoc],
ComData USING [typeSTRING],
FOpCodes USING [qJ, qJREL, qLI],
LiteralOps USING [Find, FindDescriptor, Value],
OpTableDefs USING [InstLength],
P5 USING [NumberOfParams, P5Error, PushEffect],
P5U USING [],
PackageSymbols USING [ConstRecord, constType, WordIndex],
PrincOps USING [FrameVec],
SourceMap USING [Loc, nullLoc, Cons, Delta, Val],
Stack USING [Check],
SymbolOps USING [FirstCtxSe, NextSe, NormalType, RecordRoot, TypeRoot, UnderType, WordsForType],
Symbols USING [Base, BitAddress, CSEIndex, CTXIndex, ISEIndex, ISENull, RecordSEIndex, SEIndex, SENull, seType, typeANY, typeTYPE, WordLength],
Table USING [Base, Limit],
Tree USING [Base, Index, Link, Null, NullIndex, treeType],
TreeOps USING [PopTree, PushNode, PushTree, ScanList, SetInfo];
CgenUtil:
PROGRAM
IMPORTS Alloc, MPtr: ComData, CPtr: Code, LiteralOps, OpTableDefs, P5, SourceMap, Stack, SymbolOps, TreeOps
EXPORTS P5U = BEGIN OPEN SymbolOps, CodeDefs;
imported definitions
BitAddress: TYPE = Symbols.BitAddress;
CSEIndex: TYPE = Symbols.CSEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
SEIndex: TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
WordLength: CARDINAL = Symbols.WordLength;
table: Alloc.Handle ← NIL;
tb: Tree.Base; -- tree base (local copy)
seb: Symbols.Base; -- semantic entry base (local copy)
cb: CodeDefs.Base; -- code base (local copy)
cstb: Table.Base; -- constant table base (local copy)
CgenUtilNotify:
PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
tb ← base[Tree.treeType];
cb ← base[codeType];
cstb ← base[PackageSymbols.constType];
END;
AllocCodeCCItem:
PUBLIC
PROC [n: [0..3]]
RETURNS [c: CodeCCIndex] =
BEGIN
c ← GetChunk[CCItem.code.SIZE + n];
cb[c] ← CCItem[free:
FALSE, flink: CCNull, blink: CCNull, ccvalue:
code[inst: 0, realinst: FALSE, isize: 0, fill: 0, parameters: ]];
LinkCCItem[c];
RETURN
END;
BitsForOperand:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
CARDINAL] =
BEGIN
RETURN [
WITH t
SELECT
FROM
literal => WordLength, -- not always TRUE, but good enough
ENDCASE => BitsForType[OperandType[t]]]
END;
BitsForType:
PUBLIC
PROC [sei: SEIndex]
RETURNS [
CARDINAL] =
BEGIN
csei: CSEIndex = UnderType[sei];
RETURN [
WITH seb[csei]
SELECT
FROM
record => length,
ENDCASE => CARDINAL[WordsForType[csei]]*WordLength]
END;
CCellAlloc:
PUBLIC
PROC [t: CodeChunkType] =
BEGIN -- allocates a cell for other than code or label
c: CCIndex;
nwords: CARDINAL;
SELECT t
FROM
code => P5.P5Error[262];
label => P5.P5Error[263];
jump => nwords ← CCItem.jump.SIZE;
other => nwords ← CCItem.other.SIZE; -- NB: not relSource OR absSource
ENDCASE;
c ← GetChunk[nwords];
SELECT t
FROM
jump => cb[c] ← CCItem[free: FALSE, flink: , blink: , ccvalue: jump[,,,,,,,]];
other => cb[c] ← CCItem[free: FALSE, flink: , blink: , ccvalue: other[obody: ]];
ENDCASE;
LinkCCItem[c];
END;
CgenUtilInit:
PUBLIC
PROC [ownTable: Alloc.Handle] =
BEGIN
table ← ownTable;
CPtr.ZEROlexeme ← Lexeme[literal[word[LiteralOps.Find[0].lti]]];
CPtr.fileLoc ← SourceMap.Cons[0];
END;
ComputeFrameSize:
PUBLIC
PROC [fs:
CARDINAL]
RETURNS [
CARDINAL] =
BEGIN -- finds alloc-vector index for frame of size fs
OPEN PrincOps;
FOR fx:
CARDINAL
IN [0..FrameVec.
LENGTH)
DO
IF fs <= FrameVec[fx] THEN RETURN [fx] ENDLOOP;
ERROR
END;
CreateLabel:
PUBLIC
PROC
RETURNS [c: LabelCCIndex] =
BEGIN -- allocates and inserts a label at codeptr
c ← LabelAlloc[];
InsertLabel[c];
END;
DeleteCell:
PUBLIC
PROC [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;
nwords ←
WITH cc: cb[c]
SELECT
FROM
code => ParamCount[LOOPHOLE[c]] + CCItem.code.SIZE,
label => CCItem.label.SIZE,
jump => CCItem.jump.SIZE,
other =>
WITH cc
SELECT
FROM
absSource => CCItem.other.absSource.SIZE,
relSource => CCItem.other.relSource.SIZE,
ENDCASE => CCItem.other.SIZE, -- NB: see CCellAllocate
ENDCASE => ERROR;
FreeChunk[c, nwords];
END;
EnumerateCaseArms:
PUBLIC
PROC [node: Tree.Index, action:
PROC [t: Tree.Link]] =
BEGIN
ProcessItem:
PROC [t: Tree.Link] =
BEGIN
inode: Tree.Index;
WITH t
SELECT
FROM
subtree => inode ← index;
ENDCASE;
SELECT tb[inode].name
FROM
item, casetest => 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;
FreeChunk:
PUBLIC
PROC [i: CodeDefs.ChunkIndex, size:
CARDINAL] =
BEGIN
FOR p:
LIST
OF MonitorRecord ← monList, p.rest
WHILE p #
NIL
DO
IF p.first.cell = i AND p.first.action = free THEN ERROR;
ENDLOOP;
table.FreeChunk[LOOPHOLE[i], size, codeType];
END;
FullWordBits:
PUBLIC
PROC [bits:
CARDINAL]
RETURNS [
CARDINAL] =
BEGIN
RETURN [((bits+WordLength-1)/WordLength) * WordLength]
END;
GetChunk:
PUBLIC
PROC [size:
CARDINAL]
RETURNS [c: CodeDefs.ChunkIndex] =
BEGIN
c ← LOOPHOLE[table.GetChunk[size, codeType]];
FOR p:
LIST
OF MonitorRecord ← monList, p.rest
WHILE p #
NIL
DO
IF p.first.cell = c AND p.first.action = allocate THEN ERROR;
ENDLOOP;
RETURN [c]
END;
InsertLabel: PUBLIC PROC [c: LabelCCIndex] = LinkCCItem;
LabelAlloc:
PUBLIC
PROC
RETURNS [c: LabelCCIndex] =
BEGIN -- gets a chunk for a label but does not insert it in stream
c ← GetChunk[CCItem.label.SIZE];
cb[c] ← CCItem[free:
FALSE, flink: , blink: , ccvalue:
label[labelseen: FALSE, labelinfo: generating[fillword: , jumplist: JumpCCNull]]];
RETURN
END;
LinkCCItem:
PROC[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;
END;
LongTreeAddress:
PUBLIC
PROC [t: Tree.Link]
RETURNS [long:
BOOL ←
FALSE] =
BEGIN
node: Tree.Index;
WITH t
SELECT
FROM
subtree =>
BEGIN node ← index;
IF node # Tree.NullIndex
THEN
SELECT tb[node].name
FROM
loophole, cast, openx, pad, chop =>
long ← LongTreeAddress[tb[node].son[1]];
dot, uparrow, dindex, seqindex, dollar, index, new, 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: PROC [t: Tree.Link] = {long ← long OR LongTreeAddress[t]};
EnumerateCaseArms[node, LongArm];
END;
ENDCASE => NULL;
END;
ENDCASE => NULL;
RETURN
END;
MakeLongTreeLiteral:
PUBLIC
PROC [d:
DESCRIPTOR
FOR
ARRAY
OF
WORD, type: CSEIndex]
RETURNS [Tree.Link] =
BEGIN
TreeOps.PushTree[[literal[LiteralOps.FindDescriptor[d]]]];
TreeOps.PushNode[mwconst, 1]; TreeOps.SetInfo[type];
RETURN [TreeOps.PopTree[]]
END;
MakeTreeLiteral:
PUBLIC
PROC [val:
WORD]
RETURNS [Tree.Link] =
BEGIN
RETURN [[literal[LiteralOps.Find[val]]]]
END;
MarkedType:
PUBLIC
PROC [type: SEIndex]
RETURNS [CSEIndex] =
BEGIN
subType: CSEIndex = NormalType[UnderType[type]];
RETURN [
WITH t: seb[subType]
SELECT
FROM
ref => UnderType[TypeRoot[t.refType]],
transfer => subType,
ENDCASE => Symbols.typeANY]
END;
MonitorAction: TYPE = {allocate, free};
MonitorRecord: TYPE = RECORD [cell: CCIndex, action: MonitorAction];
monList: LIST OF MonitorRecord ← NIL;
Monitor:
PROC [cell: CCIndex, action: MonitorAction] =
BEGIN
monList ← CONS[[cell, action], monList];
END;
NextVar:
PUBLIC
PROC [sei: ISEIndex]
RETURNS [ISEIndex] =
BEGIN -- starting at sei returns first variable on ctx-list
RETURN [
SELECT
TRUE
FROM
(sei = ISENull) => ISENull,
(seb[sei].idType # Symbols.typeTYPE) => sei,
ENDCASE => NextVar[NextSe[sei]]]
END;
NilTree:
PUBLIC
PROC [type: CSEIndex]
RETURNS [Tree.Link] =
BEGIN
SELECT SymbolOps.WordsForType[type]
FROM
1 => RETURN[MakeTreeLiteral[0]];
2 =>
BEGIN
zeros: ARRAY [0..2) OF WORD ← [0, 0];
RETURN[MakeLongTreeLiteral[DESCRIPTOR[zeros], type]];
END;
ENDCASE => ERROR;
END;
OperandType:
PUBLIC
PROC [t: Tree.Link]
RETURNS [sei: CSEIndex] =
BEGIN -- compute type of tree
RETURN [
WITH e:t
SELECT
FROM
symbol => UnderType[seb[e.index].idType],
literal => IF e.index.litTag = string THEN MPtr.typeSTRING ELSE ERROR,
subtree =>
IF e = Tree.Null
THEN
IF CPtr.xtracting THEN UnderType[seb[CPtr.xtractsei].idType] ELSE ERROR
ELSE UnderType[tb[e.index].info],
ENDCASE => ERROR]
END;
Out0:
PUBLIC
PROC [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];
c ← AllocCodeCCItem[0];
cb[c].inst ← i;
END;
Out1:
PUBLIC
PROC [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];
c ← AllocCodeCCItem[1];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
END;
Out2:
PUBLIC
PROC [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];
c ← AllocCodeCCItem[2];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].parameters[2] ← p2;
END;
Out3:
PUBLIC
PROC [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];
c ← AllocCodeCCItem[3];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].parameters[2] ← p2;
cb[c].parameters[3] ← p3;
END;
OutJump:
PUBLIC
PROC [jt: JumpType, l: LabelCCIndex] =
BEGIN -- outputs a jump-type code ceel into the code stream
Stack.Check[
SELECT jt
FROM
Jump, JumpA, JumpC, JumpCA, JumpRet => FOpCodes.qJ,
ENDCASE => 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;
END;
ENDCASE
END;
OutSource:
PUBLIC
PROC [index: SourceMap.Loc] =
BEGIN
c: CCIndex;
relIndex: CARDINAL;
IF index # SourceMap.nullLoc
AND index.Val[] >= CPtr.bodyStartLoc.Val[]
AND (relIndex ← index.Delta[CPtr.bodyStartLoc])
IN RelSourceLoc
THEN
BEGIN
c ← GetChunk[CCItem.other.relSource.SIZE];
cb[c] ← [free:
FALSE, flink: , blink: ,
ccvalue: other[relSource[relLoc: relIndex]]];
END
ELSE
BEGIN
c ← GetChunk[CCItem.other.absSource.SIZE];
cb[c] ← [free:
FALSE, flink: , blink: ,
ccvalue: other[absSource[loc: index]]];
END;
LinkCCItem[c];
END;
ParamCount:
PUBLIC
PROC [c: CodeCCIndex]
RETURNS [
CARDINAL] =
BEGIN
RETURN [
SELECT
TRUE
FROM
(cb[c].isize # 0) => cb[c].isize-1,
cb[c].realinst => OpTableDefs.InstLength[cb[c].inst]-1,
ENDCASE => P5.NumberOfParams[cb[c].inst]]
END;
PrevVar:
PUBLIC
PROC [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[NextSe[psei]] ENDLOOP;
RETURN [rsei];
END;
PushLitVal:
PUBLIC
PROC [v:
UNSPECIFIED] =
BEGIN -- forces a constant onto the stack
Out1[FOpCodes.qLI, v];
END;
RecordConstant:
PUBLIC
PROC [offset: PackageSymbols.WordIndex, length:
CARDINAL] =
BEGIN OPEN PackageSymbols;
csti: Table.Base
RELATIVE
POINTER [0..Table.Limit)
TO ConstRecord =
table.Words[constType, ConstRecord.SIZE];
cstb[csti] ← [offset: offset, length: length];
END;
ReferentType:
PUBLIC
PROC [type: SEIndex]
RETURNS [SEIndex] =
BEGIN
subType: CSEIndex = NormalType[UnderType[type]];
RETURN [
WITH t: seb[subType]
SELECT
FROM
ref => t.refType,
ENDCASE => Symbols.typeANY]
END;
TreeLiteral:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
BOOL] =
BEGIN
RETURN [
WITH t
SELECT
FROM
literal => index.litTag = word,
subtree =>
SELECT tb[index].name
FROM
cast => TreeLiteral[tb[index].son[1]],
mwconst => TRUE,
ENDCASE => FALSE,
ENDCASE => FALSE]
END;
TreeLiteralValue:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
WORD] =
BEGIN
RETURN [
WITH e:t
SELECT
FROM
literal =>
WITH e.index
SELECT
FROM
word => LiteralOps.Value[lti],
ENDCASE => ERROR,
subtree =>
SELECT tb[e.index].name
FROM
cast, mwconst => TreeLiteralValue[tb[e.index].son[1]],
ENDCASE => ERROR,
ENDCASE => ERROR]
END;
TypeForTree:
PUBLIC
PROC [t: Tree.Link]
RETURNS [SEIndex] =
BEGIN
RETURN [
WITH t
SELECT
FROM
subtree => tb[index].info,
symbol => index,
ENDCASE => ERROR]
END;
UnMonitor:
PROC [cell: CCIndex, action: MonitorAction] =
BEGIN
IF monList = NIL THEN RETURN;
IF monList.first.cell = cell
AND monList.first.action = action
THEN {monList ← monList.rest; RETURN};
FOR p:
LIST
OF MonitorRecord ← monList, p.rest
UNTIL p.rest =
NIL
DO
IF p.rest.first.cell = cell
AND p.rest.first.action = action
THEN {p.rest ← p.rest.rest; RETURN};
ENDLOOP;
END;
VariantTag:
PUBLIC
PROC [type: SEIndex, ctx: Symbols.CTXIndex]
RETURNS [
WORD] =
BEGIN
next: SEIndex;
FOR sei: SEIndex ← type, next
UNTIL sei = SENull
DO
WITH se: seb[sei]
SELECT
FROM
id =>
BEGIN
IF se.idCtx = ctx THEN RETURN [se.idValue];
next ← se.idInfo;
END;
ENDCASE => EXIT;
ENDLOOP;
ERROR
END;
WordAligned:
PUBLIC
PROC [tsei: RecordSEIndex]
RETURNS [
BOOL] =
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[FirstCtxSe[seb[tsei].fieldCtx]];
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
PROC [t: Tree.Link]
RETURNS [OpWordCount] =
BEGIN -- compute number of words for storing value of tree
RETURN [
WITH t
SELECT
FROM
literal => 1, -- multiwords will be subtrees
symbol => WordsForSei[seb[index].idType],
ENDCASE => OpWordCount[WordsForType[OperandType[t]]]]
END;
WordsForSei:
PUBLIC
PROC [sei: SEIndex]
RETURNS [OpWordCount] =
BEGIN
RETURN [IF sei # SENull THEN OpWordCount[WordsForType[UnderType[sei]]] ELSE 0]
END;
WordsForString:
PUBLIC
PROC [nChars:
CARDINAL]
RETURNS [
CARDINAL] =
BEGIN -- computed for the object machine
RETURN [(nChars+1)/2 + 2]
END;
END.