-- file Pass4L.Mesa
-- last modified by Satterthwaite, December 6, 1979 1:09 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [charlength, maxword, wordlength],
ComData: FROM "comdata"
USING [
definitionsOnly, idANY, importCtx, linkBase, linkCount, mainBody,
nBodies, nSigCodes, stopping, switches, textIndex],
CompilerUtil: FROM "compilerutil" USING [AppendBCDWord],
ControlDefs: FROM "controldefs"
USING [EPRange, globalbase, localbase, MaxFrameSize, MaxNGfi],
Log: FROM "log" USING [Error, ErrorN, ErrorSei, WarningSei],
P4: FROM "p4",
Symbols: FROM "symbols"
USING [bodyType, ctxType, seType,
BitAddress, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
BTIndex, CBTIndex,
HTNull, SENull, ISENull, CTXNull, BTNull, lG, lL],
SymbolOps: FROM "symbolops"
USING [
BitsForRange, Cardinality, LinkMode, MakeCtxSe, NextSe,
UnderType, XferMode],
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [treeType, Index, Scan, NullIndex],
TreeOps: FROM "treeops" USING [ScanList];
Pass4L: PROGRAM
IMPORTS
CompilerUtil, Log, SymbolOps, SystemDefs, TreeOps,
dataPtr: ComData
EXPORTS P4 =
BEGIN
OPEN SymbolOps, Symbols;
tb: Table.Base; -- tree base (local copy)
seb: Table.Base; -- se table base (local copy)
ctxb: Table.Base; -- context table base (local copy)
bb: Table.Base; -- body table base (local copy)
LayoutNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType];
END;
-- address assignment (machine sensitive and subject to change)
WordLength: CARDINAL = AltoDefs.wordlength;
WordFill: CARDINAL = WordLength-1;
ByteLength: CARDINAL = AltoDefs.charlength;
BytesPerWord: CARDINAL = WordLength/ByteLength;
LocalOrigin: CARDINAL = ControlDefs.localbase*WordLength;
LocalSlots: CARDINAL = 8;
GlobalOrigin: CARDINAL = ControlDefs.globalbase*WordLength;
FrameLimit: CARDINAL = ControlDefs.MaxFrameSize*WordLength;
EntryLimit: CARDINAL = ControlDefs.MaxNGfi * ControlDefs.EPRange;
BitsForType: PUBLIC PROCEDURE [type: SEIndex] RETURNS [nBits: CARDINAL] =
BEGIN -- assumes (an attempt at) prior processing by P4declitem
b, n, nW: CARDINAL;
sei: CSEIndex ← UnderType[type];
WITH seb[sei] SELECT FROM
basic => nBits ← length;
enumerated => nBits ← BitsForRange[Cardinality[sei]-1];
pointer => nBits ← WordLength;
transfer => nBits ← IF mode = port THEN 2*WordLength ELSE WordLength;
arraydesc => nBits ← 2*WordLength;
relative => nBits ← BitsForType[offsetType];
long =>
BEGIN
nW ← (BitsForType[rangeType] + WordFill)/WordLength;
nBits ← (nW + 1)*WordLength;
END;
real => nBits ← 2*WordLength;
ENDCASE => -- processing of se entry must be complete
BEGIN
IF ~mark4
THEN
BEGIN -- P4declitem has not been able to complete
Log.ErrorSei[typeLength,
IF seb[type].seTag = id
THEN LOOPHOLE[type, ISEIndex]
ELSE ISENull];
RETURN [0]
END;
WITH seb[sei] SELECT FROM
record => BEGIN nBits ← length; lengthUsed ← TRUE END;
array =>
BEGIN
b ← BitsForType[componentType]; n ← Cardinality[indexType];
IF oldPacked AND b <= ByteLength
THEN
nW ← n/BytesPerWord+(IF n MOD BytesPerWord = 0 THEN 0 ELSE 1)
ELSE
BEGIN
b ← ((b + WordFill)/WordLength)*WordLength;
IF n > AltoDefs.maxword/b THEN Log.Error[fieldSize];
nW ← n * (b/WordLength);
END;
nBits ← nW*WordLength; lengthUsed ← TRUE;
END;
subrange =>
nBits ← IF empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1];
ENDCASE => nBits ← 0;
END;
RETURN
END;
-- profile utilities
VarLink: TYPE = RECORD [
SELECT kind: * FROM
symbol => [index: ISEIndex],
body => [index: CBTIndex],
empty => NULL,
ENDCASE];
VarInfo: TYPE = RECORD [link: VarLink, nRefs: CARDINAL];
Profile: TYPE = DESCRIPTOR FOR ARRAY OF VarInfo;
AllocateProfile: PROCEDURE [n: INTEGER] RETURNS [profile: Profile] =
BEGIN
k: INTEGER;
profile ← DESCRIPTOR [SystemDefs.AllocateHeapNode[n*SIZE[VarInfo]], n];
FOR k IN [0 .. n) DO profile[k].link ← [empty[]] ENDLOOP;
RETURN
END;
ReleaseProfile: PROCEDURE [profile: Profile] =
BEGIN SystemDefs.FreeHeapNode[BASE[profile]] END;
SortProfile: PROCEDURE [v: Profile] =
BEGIN -- Shell sort --
h, i, j: INTEGER;
k: CARDINAL;
t: VarInfo;
h ← LENGTH [v];
DO
h ← h/2;
FOR j IN [h .. LENGTH[v])
DO
i ← j-h; k ← v[j].nRefs; t ← v[j];
WHILE k > v[i].nRefs
DO
v[i+h] ← v[i];
IF (i ← i-h) < 0 THEN EXIT;
ENDLOOP;
v[i+h] ← t;
ENDLOOP;
IF h <= 1 THEN EXIT;
ENDLOOP;
END;
-- entry point assignment
GenBodies: PROCEDURE [root: BTIndex, proc: PROCEDURE [CBTIndex]] =
BEGIN
bti, next: BTIndex;
FOR bti ← root, next UNTIL bti = BTNull
DO
WITH bb[bti] SELECT FROM
Callable => proc[LOOPHOLE[bti]];
ENDCASE => NULL;
IF bb[bti].firstSon # BTNull
THEN next ← bb[bti].firstSon
ELSE
DO
next ← bb[bti].link.index;
IF next = BTNull OR bb[bti].link.which # parent THEN EXIT;
bti ← next;
ENDLOOP;
ENDLOOP;
END;
BodyRefs: PROCEDURE [bti: CBTIndex] RETURNS [count: CARDINAL] =
BEGIN
sei: ISEIndex;
node: Tree.Index;
CountRefs: Tree.Scan =
BEGIN
count ← WITH t SELECT FROM
symbol => count + seb[index].idInfo,
ENDCASE => ERROR;
END;
count ← 0;
IF (sei ← bb[bti].id) # SENull
THEN
BEGIN
node ← seb[sei].idValue; TreeOps.ScanList[tb[node].son[1], CountRefs];
END;
RETURN
END;
AssignEntries: PUBLIC PROCEDURE [rootBti: BTIndex] =
BEGIN
i, j, k: INTEGER;
profile: Profile;
bti: CBTIndex;
AssignSlot: PROCEDURE [bti: CBTIndex] =
BEGIN
IF ~bb[bti].inline AND bb[bti].info.mark = Internal
THEN
BEGIN
n: CARDINAL = BodyRefs[bti];
profile[k].link ← [body[index: bti]];
WITH body: bb[bti] SELECT FROM
Inner => BEGIN body.frameOffset ← n; profile[k].nRefs ← 0 END;
ENDCASE => profile[k].nRefs ← n;
k ← k+1;
END;
END;
nEntries: CARDINAL = MAX[dataPtr.nBodies, dataPtr.nSigCodes];
IF nEntries > EntryLimit
THEN Log.ErrorN[bodyEntries, nEntries-EntryLimit];
profile ← AllocateProfile[dataPtr.nBodies];
k ← 0; GenBodies[rootBti, AssignSlot];
IF dataPtr.switches['s] THEN SortProfile[profile];
i ← 1;
FOR j IN [0..LENGTH[profile])
DO
bti ← WITH profile[j].link SELECT FROM body => index, ENDCASE => ERROR;
IF bti = dataPtr.mainBody
THEN bb[bti].entryIndex ← 0
ELSE BEGIN bb[bti].entryIndex ← i; i ← i+1 END;
ENDLOOP;
ReleaseProfile[profile];
END;
-- frame layout
VarScan: TYPE = PROCEDURE [sei: ISEIndex, output: BOOLEAN];
GenCtxVars: PROCEDURE [ctx: CTXIndex, p: VarScan, output: BOOLEAN] =
BEGIN
sei: ISEIndex;
IF ctx # CTXNull THEN
FOR sei ← ctxb[ctx].seList, NextSe[sei] UNTIL sei = SENull
DO
IF ~seb[sei].constant THEN p[sei, output];
ENDLOOP;
END;
GenBodyVars: PROCEDURE [bti: CBTIndex, p: VarScan] =
BEGIN
type: SEIndex = bb[bti].ioType;
WITH se: seb[type] SELECT FROM
cons =>
WITH se SELECT FROM
transfer =>
BEGIN
IF inRecord # SENull
THEN GenCtxVars[seb[inRecord].fieldCtx, p, FALSE];
IF outRecord # SENull
THEN GenCtxVars[seb[outRecord].fieldCtx, p, TRUE];
END;
ENDCASE;
ENDCASE;
GenCtxVars[bb[bti].localCtx, p, FALSE];
END;
GenBodyProcs: PROCEDURE [bti: BTIndex, proc: PROCEDURE [CBTIndex]] =
BEGIN
sonBti: BTIndex;
IF (sonBti ← bb[bti].firstSon) # BTNull
THEN
DO
WITH body: bb[sonBti] SELECT FROM
Callable => IF ~body.inline THEN proc[LOOPHOLE[sonBti]];
ENDCASE => NULL;
IF bb[sonBti].link.which = parent THEN EXIT;
sonBti ← bb[sonBti].link.index;
ENDLOOP;
END;
GenImportedVars: PROCEDURE [p: VarScan] =
BEGIN
sei: ISEIndex;
type: CSEIndex;
ctx: CTXIndex = dataPtr.importCtx;
IF ctx # CTXNull THEN
FOR sei ← ctxb[ctx].seList, NextSe[sei] UNTIL sei = SENull
DO
IF ~seb[sei].constant
THEN p[sei, FALSE]
ELSE
BEGIN type ← UnderType[seb[sei].idType];
WITH seb[type] SELECT FROM
definition => GenCtxVars[defCtx, p, FALSE];
ENDCASE;
END;
ENDLOOP;
END;
MarkArg: VarScan = BEGIN seb[sei].mark4 ← TRUE END;
MarkArgs: PROCEDURE [sei: SEIndex] =
BEGIN
type: CSEIndex = UnderType[sei];
rSei: RecordSEIndex;
WITH seb[type] SELECT FROM
transfer =>
BEGIN
IF (rSei ← inRecord) # SENull THEN
BEGIN
GenCtxVars[seb[rSei].fieldCtx, MarkArg, FALSE];
seb[rSei].length ← LayoutArgs[rSei, 0, TRUE]*WordLength;
seb[rSei].mark4 ← TRUE;
END;
IF (rSei ← outRecord) # SENull THEN
BEGIN
GenCtxVars[seb[rSei].fieldCtx, MarkArg, TRUE];
seb[rSei].length ← LayoutArgs[rSei, 0, TRUE]*WordLength;
seb[rSei].mark4 ← TRUE;
END;
mark4 ← TRUE;
END;
ENDCASE;
END;
LayoutLocals: PUBLIC PROCEDURE [bti: CBTIndex] RETURNS [length: CARDINAL] =
BEGIN
vProfile: Profile;
vI: CARDINAL;
CountVar: VarScan =
BEGIN
IF seb[sei].hash # HTNull OR ~output THEN vI ← vI + 1;
END;
CountProc: PROCEDURE [bti: CBTIndex] =
BEGIN
IF bb[bti].info.mark = Internal THEN vI ← vI + 1;
END;
InsertVar: VarScan =
BEGIN
saveIndex: CARDINAL = dataPtr.textIndex;
node: Tree.Index = LOOPHOLE[seb[sei].idValue];
nW: CARDINAL;
IF node # Tree.NullIndex THEN dataPtr.textIndex ← tb[node].info;
IF seb[sei].hash # HTNull OR ~output
THEN
BEGIN
vProfile[vI] ← [link: [symbol[sei]], nRefs: seb[sei].idInfo];
vI ← vI+1;
END;
IF seb[sei].idInfo = 0 AND seb[sei].hash # HTNull
AND ~output -- suppress message for return record
AND node # Tree.NullIndex
THEN Log.WarningSei[unusedId, sei];
nW ← (BitsForType[seb[sei].idType] + WordFill)/WordLength;
seb[sei].idInfo ← nW*WordLength; seb[sei].idValue ← 0;
dataPtr.textIndex ← saveIndex;
END;
InsertProc: PROCEDURE [bti: CBTIndex] =
BEGIN
IF bb[bti].info.mark = Internal
THEN
BEGIN
vProfile[vI] ← VarInfo[
link: [body[bti]],
nRefs: WITH bb[bti] SELECT FROM Inner=>frameOffset, ENDCASE=>0];
vI ← vI+1;
END;
END;
origin: CARDINAL;
bodyType: SEIndex = bb[bti].ioType;
IF ~seb[bodyType].mark4 THEN MarkArgs[bodyType];
vI ← 0; GenBodyVars[bti, CountVar]; GenBodyProcs[bti, CountProc];
vProfile ← AllocateProfile[vI];
vI ← 0; GenBodyVars[bti, InsertVar]; GenBodyProcs[bti, InsertProc];
SortProfile[vProfile];
origin ← IF bb[bti].level = lL
THEN LocalOrigin
ELSE LocalOrigin + WordLength;
origin ← AssignVars[vProfile, origin, LocalOrigin + LocalSlots*WordLength];
length ← AssignVars[vProfile, origin, FrameLimit];
CheckFrameOverflow[vProfile]; ReleaseProfile[vProfile];
RETURN
END;
LayoutGlobals: PUBLIC PROCEDURE [bti: CBTIndex] RETURNS [length: CARDINAL] =
BEGIN
vProfile, xProfile: Profile;
vI, xI: CARDINAL;
CountVar: VarScan =
BEGIN
ctx: CTXIndex = seb[sei].idCtx;
IF ctxb[ctx].ctxType = imported OR ctx = dataPtr.importCtx
THEN xI ← xI + 1
ELSE IF seb[sei].hash # HTNull OR ~output THEN vI ← vI + 1;
END;
InsertVar: VarScan =
BEGIN
saveIndex: CARDINAL;
ctx: CTXIndex = seb[sei].idCtx;
node: Tree.Index;
nW: CARDINAL;
IF ctxb[ctx].ctxType = imported OR ctx = dataPtr.importCtx
THEN
BEGIN
xProfile[xI] ← [link: [symbol[sei]], nRefs: seb[sei].idInfo];
xI ← xI+1;
IF seb[sei].idInfo = 0 AND ~seb[sei].public
THEN Log.WarningSei[unusedId, sei];
seb[sei].idInfo ←
((BitsForType[seb[sei].idType]+WordFill)/WordLength)*WordLength;
END
ELSE
BEGIN saveIndex ← dataPtr.textIndex;
node ← LOOPHOLE[seb[sei].idValue];
IF node # Tree.NullIndex
THEN dataPtr.textIndex ← tb[node].info;
IF seb[sei].hash # HTNull OR ~output
THEN
BEGIN
vProfile[vI] ← [link: [symbol[sei]], nRefs: seb[sei].idInfo];
vI ← vI + 1;
END;
IF seb[sei].idInfo = 0 AND ~dataPtr.definitionsOnly
AND ~seb[sei].public AND seb[sei].hash # HTNull
AND node # Tree.NullIndex
THEN Log.WarningSei[unusedId, sei];
nW ← (BitsForType[seb[sei].idType] + WordFill)/WordLength;
seb[sei].idInfo ← nW*WordLength; seb[sei].idValue ← 0;
dataPtr.textIndex ← saveIndex;
END;
END;
origin: CARDINAL;
IF ~seb[bb[bti].ioType].mark4 THEN ERROR;
vI ← xI ← 0; GenBodyVars[bti, CountVar]; GenImportedVars[CountVar];
vProfile ← AllocateProfile[vI]; xProfile ← AllocateProfile[xI];
vI ← xI ← 0; GenBodyVars[bti, InsertVar]; GenImportedVars[InsertVar];
IF dataPtr.switches['s]
THEN BEGIN SortProfile[vProfile]; SortProfile[xProfile] END;
origin ← IF dataPtr.stopping THEN GlobalOrigin+WordLength ELSE GlobalOrigin;
AssignImports[xProfile, 0, 256*WordLength];
origin ← AssignVars[vProfile, origin, FrameLimit];
length ← MAX[origin, GlobalOrigin+WordLength];
CheckFrameOverflow[vProfile]; ReleaseProfile[vProfile];
CheckFrameOverflow[xProfile]; ReleaseProfile[xProfile];
RETURN
END;
CheckBlock: PUBLIC PROCEDURE [bti: BTIndex] =
BEGIN
CheckVar: VarScan =
BEGIN
saveIndex: CARDINAL = dataPtr.textIndex;
node: Tree.Index = LOOPHOLE[seb[sei].idValue];
IF node # Tree.NullIndex
THEN
BEGIN
dataPtr.textIndex ← tb[node].info;
IF seb[sei].idInfo = 0 THEN Log.WarningSei[unusedId, sei];
END;
dataPtr.textIndex ← saveIndex;
END;
GenCtxVars[bb[bti].localCtx, CheckVar, FALSE];
END;
LayoutBlock: PUBLIC PROCEDURE [bti: BTIndex, origin: CARDINAL] RETURNS [length: CARDINAL] =
BEGIN
vProfile: Profile;
vI: CARDINAL;
CountVar: VarScan = BEGIN vI ← vI + 1 END;
CountProc: PROCEDURE [bti: CBTIndex] =
BEGIN
IF bb[bti].info.mark = Internal THEN vI ← vI + 1;
END;
InsertVar: VarScan =
BEGIN
nW: CARDINAL;
vProfile[vI] ← [link: [symbol[sei]], nRefs: seb[sei].idInfo]; vI ← vI+1;
nW ← (BitsForType[seb[sei].idType] + WordFill)/WordLength;
seb[sei].idInfo ← nW*WordLength; seb[sei].idValue ← 0;
END;
InsertProc: PROCEDURE [bti: CBTIndex] =
BEGIN
IF bb[bti].info.mark = Internal
THEN
BEGIN
vProfile[vI] ← VarInfo[
link: [body[bti]],
nRefs: WITH bb[bti] SELECT FROM Inner=>frameOffset, ENDCASE=>0];
vI ← vI+1;
END;
END;
vI ← 0; GenCtxVars[bb[bti].localCtx, CountVar, FALSE];
IF bb[bti].level > lG THEN GenBodyProcs[bti, CountProc];
vProfile ← AllocateProfile[vI];
vI ← 0; GenCtxVars[bb[bti].localCtx, InsertVar, FALSE];
IF bb[bti].level > lG THEN GenBodyProcs[bti, InsertProc];
SortProfile[vProfile];
length ← AssignVars[vProfile, origin, FrameLimit];
CheckFrameOverflow[vProfile]; ReleaseProfile[vProfile];
RETURN
END;
LayoutInterface: PUBLIC PROCEDURE [bti: CBTIndex] RETURNS [nEntries: CARDINAL] =
BEGIN
sei: ISEIndex;
epN: CARDINAL;
epN ← 0;
FOR sei ← ctxb[bb[bti].localCtx].seList, NextSe[sei] UNTIL sei = SENull
DO
IF LinkMode[sei] # manifest
THEN
BEGIN
seb[sei].linkSpace ← TRUE;
seb[sei].idValue ← epN; epN ← epN + 1;
END;
ENDLOOP;
IF (nEntries←epN) > EntryLimit
THEN Log.ErrorN[interfaceEntries, nEntries-EntryLimit];
RETURN
END;
CheckFrameOverflow: PROCEDURE [profile: Profile] =
BEGIN
i: INTEGER;
FOR i IN [0 .. LENGTH[profile])
DO
WITH profile[i].link SELECT FROM
symbol => Log.ErrorSei[addressOverflow, index];
body => Log.ErrorSei[addressOverflow, bb[index].id];
ENDCASE;
ENDLOOP;
END;
Align: PROCEDURE [offset: CARDINAL, item: VarLink] RETURNS [CARDINAL] =
BEGIN
RETURN [WITH item SELECT FROM
body =>
(offset+WordLength)/(4*WordLength)*(4*WordLength) + (2*WordLength),
symbol =>
SELECT XferMode[seb[index].idType] FROM
port =>
(offset+WordLength)/(4*WordLength)*(4*WordLength) + (2*WordLength),
ENDCASE => offset,
ENDCASE => offset]
END;
BitWidth: PROCEDURE [item: VarLink] RETURNS [CARDINAL] =
BEGIN
RETURN [WITH item SELECT FROM
symbol => seb[index].idInfo,
body => WordLength,
ENDCASE => 0]
END;
AssignBase: PROCEDURE [item: VarLink, base: CARDINAL] =
BEGIN
WITH item SELECT FROM
symbol =>
BEGIN
sei: ISEIndex = index;
seb[sei].idValue ← BitAddress[wd:base/WordLength, bd:0];
seb[sei].mark4 ← TRUE;
END;
body =>
BEGIN
bti: CBTIndex = index;
WITH bb[bti] SELECT FROM
Inner => frameOffset ← base/WordLength;
ENDCASE => ERROR;
END;
ENDCASE;
END;
AssignVars: PROCEDURE [profile: Profile, origin, limit: CARDINAL] RETURNS [CARDINAL] =
BEGIN
start, base, length, remainder, delta: CARDINAL;
i, j, next: INTEGER;
t: VarLink;
found, skips: BOOLEAN;
next ← 0; start ← origin; remainder ← limit - origin;
WHILE next < LENGTH[profile]
DO
i ← next; found ← skips ← FALSE;
WHILE ~found AND i < LENGTH[profile]
DO
IF (t ← profile[i].link) # [empty[]]
THEN
BEGIN
base ← Align[start, t]; length ← BitWidth[t];
delta ← base - start;
IF length + delta <= remainder
THEN
BEGIN
subBase, subLength, limit: CARDINAL;
nRefs: CARDINAL;
nRefs ← 0; subBase ← start; limit ← base + length;
FOR j ← i+1, j+1 WHILE j < LENGTH[profile] AND subBase < limit
DO
IF profile[j].link # [empty[]]
THEN
BEGIN
subLength ← BitWidth[profile[j].link];
subBase ← Align[subBase, profile[j].link] + subLength;
IF subBase > limit THEN EXIT;
nRefs ← nRefs + profile[j].nRefs;
END;
ENDLOOP;
IF nRefs <= profile[i].nRefs OR ~dataPtr.switches['s]
THEN
BEGIN
found ← TRUE;
AssignBase[t, base]; profile[i].link ← [empty[]];
IF base # start AND dataPtr.switches['s]
THEN [] ← AssignVars[profile, start, base];
start ← limit;
remainder ← remainder - (length+delta);
END
ELSE IF ~skips THEN BEGIN skips ← TRUE; next ← i END;
END;
END;
i ← i+1;
IF ~skips THEN next ← i;
ENDLOOP;
ENDLOOP;
RETURN [start]
END;
AssignImports: PROCEDURE [profile: Profile, origin, limit: CARDINAL] =
BEGIN
nProcs: CARDINAL;
next: CARDINAL;
i, j: CARDINAL;
t: VarLink;
v: VarInfo;
i ← nProcs ← LENGTH[profile];
UNTIL i = 0
DO
i ← i-1; t ← profile[i].link;
WITH t SELECT FROM
symbol =>
IF XferMode[seb[index].idType] # procedure
THEN
BEGIN
nProcs ← nProcs-1; v ← profile[i];
FOR j IN [i..nProcs) DO profile[j] ← profile[j+1] ENDLOOP;
profile[nProcs] ← v;
END;
ENDCASE;
ENDLOOP;
-- the xfer frame fragment begins at origin
dataPtr.linkBase ← origin/WordLength;
CompilerUtil.AppendBCDWord[dataPtr.linkCount ← LENGTH[profile]];
i ← LENGTH[profile];
next ← MIN[origin + LENGTH[profile]*WordLength, limit];
UNTIL i = 0 OR next = origin
DO
i ← i-1; t ← profile[i].link; profile[i].link ← [empty[]];
IF ~dataPtr.definitionsOnly
THEN
WITH t SELECT FROM
symbol =>
BEGIN
sei: ISEIndex = index;
next ← next - seb[sei].idInfo;
CompilerUtil.AppendBCDWord[seb[sei].idValue];
seb[sei].idValue ← BitAddress[wd: next/WordLength, bd: 0];
seb[sei].linkSpace ← TRUE;
END;
ENDCASE;
ENDLOOP;
END;
-- parameter record layout
LayoutArgs: PUBLIC PROCEDURE [argRecord: RecordSEIndex, origin: CARDINAL, body: BOOLEAN]
RETURNS [CARDINAL] =
BEGIN
w, nW: CARDINAL;
ctx: CTXIndex;
sei: ISEIndex;
w ← origin;
IF argRecord # SENull
THEN
BEGIN ctx ← seb[argRecord].fieldCtx;
FOR sei ← ctxb[ctx].seList, NextSe[sei] UNTIL sei = SENull
DO
nW ← (BitsForType[seb[sei].idType] + WordFill)/WordLength;
IF nW = 0 THEN Log.ErrorSei[sizeClash, sei];
IF ~body
THEN
BEGIN
seb[sei].idInfo ← nW*WordLength;
seb[sei].idValue ← BitAddress[wd:w, bd:0];
END;
w ← w + nW;
ENDLOOP;
END;
RETURN [w]
END;
-- record layout
ScanVariants: PROCEDURE
[caseCtx: CTXIndex, proc: PROCEDURE [RecordSEIndex] RETURNS [BOOLEAN]]
RETURNS [BOOLEAN] =
BEGIN
sei: ISEIndex;
rSei: SEIndex;
FOR sei ← ctxb[caseCtx].seList, NextSe[sei] UNTIL sei = SENull
DO
rSei ← seb[sei].idInfo;
WITH variant: seb[rSei] SELECT FROM
cons =>
WITH variant SELECT FROM
record => IF proc[LOOPHOLE[rSei]] THEN RETURN [TRUE];
ENDCASE => ERROR;
ENDCASE => NULL; -- skip multiple identifiers
ENDLOOP;
RETURN [FALSE]
END;
LayoutFields: PUBLIC PROCEDURE [rSei: RecordSEIndex, offset: CARDINAL] =
BEGIN
MaxRecordSize: CARDINAL = LAST[CARDINAL]/WordLength + 1;
w, b: CARDINAL;
lastFillable: BOOLEAN;
lastSei: ISEIndex;
AssignField: PROCEDURE [sei: ISEIndex] =
BEGIN OPEN id: seb[sei];
n, nW, nB: CARDINAL;
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[LOOPHOLE[id.idValue, Tree.Index]].info;
n ← BitsForType[id.idType];
nW ← n/WordLength; nB ← n MOD WordLength;
IF nW > 0 AND nB # 0 THEN BEGIN nW ← nW+1; nB ← 0 END;
IF (nW > 0 OR b+nB > WordLength OR n = 0) AND b # 0
THEN BEGIN w ← w+1; b ← 0 END;
dataPtr.textIndex ← saveIndex;
IF b = 0 AND lastFillable THEN FillWord[lastSei];
IF w >= MaxRecordSize THEN Log.ErrorSei[addressOverflow, sei];
id.idInfo ← nW*WordLength + nB;
id.idValue ← BitAddress[wd:w, bd:b];
lastSei ← sei; lastFillable ← (nW = 0 AND n # 0);
w ← w + nW; b ← b + nB;
IF b >= WordLength THEN BEGIN w ← w+1; b ← b - WordLength END;
-- IF (IF b=0 THEN w ELSE w+1) >= MaxRecordSize
-- THEN Log.ErrorSei[addressOverflow, sei];
END;
FillWord: PROCEDURE [sei: ISEIndex] =
BEGIN
t: BitAddress = seb[sei].idValue;
width: CARDINAL = WordLength - t.bd;
IF seb[rSei].machineDep AND width # seb[sei].idInfo
THEN Log.WarningSei[recordGap, sei];
seb[sei].idInfo ← width;
END;
FindFit: PROCEDURE [vSei: RecordSEIndex] RETURNS [BOOLEAN] =
BEGIN
sei: ISEIndex;
type: CSEIndex;
sei ← ctxb[seb[vSei].fieldCtx].seList;
IF sei = SENull THEN RETURN [FALSE];
type ← UnderType[seb[sei].idType];
WITH seb[type] SELECT FROM
union =>
IF controlled
THEN sei ← tagSei
ELSE RETURN [ScanVariants[caseCtx, FindFit]];
ENDCASE => NULL;
RETURN [BitsForType[seb[sei].idType] + b <= WordLength]
END;
vOrigin: CARDINAL;
maxLength: CARDINAL;
AssignVariant: PROCEDURE [vSei: RecordSEIndex] RETURNS [BOOLEAN] =
BEGIN
LayoutFields[vSei, vOrigin];
maxLength ← MAX[seb[vSei].length, maxLength];
RETURN [FALSE]
END;
eqLengths: BOOLEAN;
padEnd: CARDINAL;
PadVariant: PROCEDURE [vSei: RecordSEIndex] RETURNS [BOOLEAN] =
BEGIN
sei, fillSei: ISEIndex;
type: CSEIndex;
fillOrigin, currentEnd: CARDINAL;
t: BitAddress;
ctx: CTXIndex = seb[vSei].fieldCtx;
fillSei ← ISENull;
FOR sei ← ctxb[ctx].seList, NextSe[sei] UNTIL sei = SENull
DO
IF LOOPHOLE[seb[sei].idValue, BitAddress].wd # w THEN EXIT;
fillSei ← sei;
ENDLOOP;
IF fillSei # SENull
THEN
BEGIN
t ← seb[fillSei].idValue; fillOrigin ← t.wd*WordLength + t.bd;
currentEnd ← fillOrigin + seb[fillSei].idInfo;
IF currentEnd < padEnd AND (currentEnd # 0 OR padEnd < WordLength)
THEN
BEGIN
type ← UnderType[seb[fillSei].idType];
WITH seb[type] SELECT FROM
union =>
BEGIN
saveLastSei: ISEIndex = lastSei;
IF controlled THEN lastSei ← tagSei; -- for messages only
[] ← ScanVariants[caseCtx, PadVariant];
lastSei ← saveLastSei;
END;
ENDCASE =>
IF seb[rSei].machineDep
THEN Log.WarningSei[recordGap, fillSei];
seb[fillSei].idInfo ← padEnd - fillOrigin;
END;
END
ELSE
IF vOrigin < padEnd AND (vOrigin # 0 OR padEnd < WordLength)
THEN
BEGIN
IF seb[rSei].machineDep THEN Log.WarningSei[recordGap, lastSei];
fillSei ← MakeCtxSe[HTNull, CTXNull];
seb[fillSei].public ← TRUE; seb[fillSei].extended ← FALSE;
seb[fillSei].constant ← seb[fillSei].immutable ← FALSE;
seb[fillSei].linkSpace ← FALSE;
seb[fillSei].idType ← dataPtr.idANY;
seb[fillSei].idValue ← BitAddress[wd:w, bd:b];
seb[fillSei].idInfo ← padEnd - vOrigin;
seb[fillSei].mark3 ← seb[fillSei].mark4 ← TRUE;
WITH seb[fillSei] SELECT FROM
linked => link ← ctxb[ctx].seList;
ENDCASE => ERROR;
ctxb[ctx].seList ← fillSei;
END;
seb[vSei].length ← MIN[
maxLength,
(seb[vSei].length + WordFill)/WordLength * WordLength];
IF seb[vSei].length # maxLength THEN eqLengths ← FALSE;
RETURN [FALSE]
END;
sei: ISEIndex;
type: CSEIndex;
ctx: CTXIndex = seb[rSei].fieldCtx;
w ← offset/WordLength; b ← offset MOD WordLength;
lastFillable ← FALSE; lastSei ← ISENull;
FOR sei ← ctxb[ctx].seList, NextSe[sei] UNTIL sei = SENull
DO
IF ~seb[sei].constant
THEN
BEGIN
type ← UnderType[seb[sei].idType];
WITH seb[type] SELECT FROM
union =>
BEGIN
IF ~controlled
THEN seb[sei].idValue ← BitAddress[wd:w, bd:b]
ELSE
BEGIN
AssignField[tagSei];
seb[sei].idValue ← seb[tagSei].idValue;
END;
IF lastFillable AND b # 0 AND ~ScanVariants[caseCtx, FindFit]
THEN BEGIN FillWord[lastSei]; w ← w+1; b ← 0 END;
maxLength ← vOrigin ← w*WordLength + b;
[] ← ScanVariants[caseCtx, AssignVariant];
padEnd ← IF maxLength < WordLength
THEN maxLength
ELSE MAX[(vOrigin + WordFill)/WordLength, 1]*WordLength;
eqLengths ← TRUE;
[] ← ScanVariants[caseCtx, PadVariant];
equalLengths ← eqLengths;
seb[sei].idInfo ←
(maxLength - vOrigin) +
(IF controlled THEN seb[tagSei].idInfo ELSE 0);
w ← maxLength/WordLength; b ← maxLength MOD WordLength;
lastFillable ← FALSE;
END;
ENDCASE => AssignField[sei];
END;
ENDLOOP;
IF lastFillable AND b # 0 AND w > 0
THEN BEGIN FillWord[lastSei]; b ← 0; w ← w + 1 END;
seb[rSei].length ← w*WordLength + b;
END;
END.