-- file Pass4L.Mesa
-- last modified by Satterthwaite, May 10, 1983 4:12 pm

DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [
idANY, importCtx, interface, linkCount, nBodies, nSigCodes, switches,
textIndex, zone],
CompilerUtil: TYPE USING [AppendBCDWord],
Log: TYPE USING [Error, ErrorN, ErrorSei, WarningSei],
P4: TYPE USING [],
PrincOps: TYPE USING [
EPRange, globalbase, localbase, LocalOverhead, MaxFrameSize, MaxNGfi],
Symbols: TYPE USING [
Base, BitAddress, BitCount, FieldBitCount, PackedBitCount, WordCount,
Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex,
nullName, ISENull, RecordSENull, CTXNull, BTNull, lL, RootBti, WordLength,
bodyType, ctxType, seType],
SymbolOps: TYPE USING [
ArgCtx, ArgRecord, BitsForRange, Cardinality, FirstCtxSe, LinkMode,
MakeCtxSe, NextSe, PackedSize, TypeForm, UnderType, XferMode],
Tree: TYPE USING [Base, Index, Link, Scan, NullIndex, treeType],
TreeOps: TYPE USING [ScanList];

Pass4L: PROGRAM
IMPORTS
CompilerUtil, Log, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS P4 = {
OPEN SymbolOps, Symbols;

tb: Tree.Base; -- tree base (local copy)
seb: Symbols.Base; -- se table base (local copy)
ctxb: Symbols.Base; -- context table base (local copy)
bb: Symbols.Base; -- body table base (local copy)

LayoutNotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType]};


-- address assignment (machine sensitive and subject to change)

wordFill: CARDINAL = WordLength-1;

localOrigin: CARDINAL = PrincOps.localbase*WordLength;
localSlots: CARDINAL = 8;
globalOrigin: CARDINAL = PrincOps.globalbase*WordLength;
frameLimit: CARDINAL = (PrincOps.MaxFrameSize-PrincOps.LocalOverhead.SIZE)*WordLength;

entryLimit: CARDINAL = PrincOps.MaxNGfi*PrincOps.EPRange;


BitsForType: PUBLIC PROC [type: Type] RETURNS [nBits: BitCount] = {
-- assumes (an attempt at) prior processing by P4.DeclItem
sei: CSEIndex = UnderType[type];
WITH seb[sei] SELECT FROM
basic => nBits ← length;
enumerated => nBits ← BitsForRange[Cardinality[sei]-1];
ref => nBits ← WordLength;
transfer => nBits ← IF mode = port THEN 2*WordLength ELSE WordLength;
arraydesc => nBits ← 2*WordLength;
relative => nBits ← BitsForType[offsetType];
zone => nBits ← (IF mds THEN 1 ELSE 2)*WordLength;
long => nBits ← ((BitsForType[rangeType] + wordFill)/WordLength + 1)*WordLength;
real => nBits ← 2*WordLength;
ENDCASE => { -- processing of se entry must be complete
 IF ~mark4 THEN { -- P4declitem has not been able to complete
  Log.ErrorSei[typeLength,
  IF seb[type].seTag = id THEN LOOPHOLE[type, ISEIndex] ELSE ISENull];
  RETURN [0]};
 WITH seb[sei] SELECT FROM
  record => nBits ← length;
  array => {
  n: LONG CARDINAL = Cardinality[indexType];
  b: BitCount ← BitsForType[componentType];
  IF packed AND (b#0 AND b<=PackedBitCount.LAST) THEN { -- b IN PackedBitCount
  itemsPerWord: CARDINAL = WordLength/PackedSize[b];
  nBits ← IF n <= itemsPerWord
   THEN n*PackedSize[b]
   ELSE ((n+(itemsPerWord-1))/itemsPerWord)*WordLength}
  ELSE {
  b ← ((b + wordFill)/WordLength)*WordLength;
  IF n > CARDINAL.LAST/b THEN Log.Error[fieldSize];
  nBits ← n*b}};
  opaque => nBits ← length;
  subrange => nBits ← IF empty THEN 0 ELSE BitsForRange[Cardinality[sei]-1];
  ENDCASE => nBits ← 0};
RETURN};


-- profile utilities

VarLink: TYPE = RECORD [
SELECT kind: * FROM
symbol => [index: ISEIndex],
body => [index: CBTIndex],
empty => NULL,
ENDCASE];

VarInfo: TYPE = RECORD [link: VarLink, key: CARDINAL];
VarInfoList: TYPE = RECORD [SEQUENCE length: NAT OF VarInfo];
Profile: TYPE = LONG POINTER TO VarInfoList;

AllocateProfile: PROC [n: CARDINAL] RETURNS [profile: Profile] = {
profile ← (dataPtr.zone).NEW[VarInfoList[n]];
FOR k: CARDINAL IN [0 .. n) DO profile[k].link ← [empty[]] ENDLOOP;
RETURN};

ReleaseProfile: PROC [profile: Profile] = {(dataPtr.zone).FREE[@profile]};

SortProfile: PROC [v: Profile] = { -- Shell sort --
h, i, j: INTEGER;
k: CARDINAL;
t: VarInfo;
h ← v.length;
DO
h ← h/2;
FOR j IN [h .. v.length) DO
 i ← j-h; k ← v[j].key; t ← v[j];
 WHILE k > v[i].key 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};


-- entry point assignment

GenBodies: PROC [root: BTIndex, proc: PROC [CBTIndex]] = {
bti, next: BTIndex;
FOR bti ← root, next UNTIL bti = BTNull DO
WITH bb[bti] SELECT FROM
 Callable => IF nesting # Catch THEN 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};


BodyRefs: PROC [bti: CBTIndex] RETURNS [count: CARDINAL𡤀] = {
sei: ISEIndex = bb[bti].id;

CountRefs: Tree.Scan = {
count ← count + seb[NARROW[t, Tree.Link.symbol].index].idInfo};

IF sei # ISENull THEN {
node: Tree.Index = seb[sei].idValue;
TreeOps.ScanList[tb[node].son[1], CountRefs]};
RETURN};


AssignEntries: PUBLIC PROC [rootBti: BTIndex] = {
i, k: INTEGER;
profile: Profile;
bti: CBTIndex;

AssignSlot: PROC [bti: CBTIndex] = {
IF ~bb[bti].inline AND bb[bti].info.mark = Internal THEN {
 n: CARDINAL = BodyRefs[bti];
 profile[k].link ← [body[index: bti]];
 WITH body: bb[bti] SELECT FROM
  Inner => {body.frameOffset ← n; profile[k].key ← 0};
  ENDCASE => profile[k].key ← n;
 k ← k+1}};

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: INTEGER IN [0..profile.length) DO
bti ← NARROW[profile[j].link, VarLink.body].index;
IF bti = RootBti THEN bb[bti].entryIndex ← 0
ELSE {bb[bti].entryIndex ← i; i ← i+1};
ENDLOOP;
ReleaseProfile[profile]};


-- frame layout

FieldWordCount: TYPE = [0..FieldBitCount.LAST/WordLength];

WordsForField: PROC [sei: ISEIndex] RETURNS [nW: FieldWordCount] = {
nBits: BitCount = BitsForType[seb[sei].idType] + wordFill;
IF nBits > FieldBitCount.LAST THEN {
Log.ErrorSei[addressOverflow, sei]; nW ← FieldWordCount.LAST}
ELSE nW ← FieldBitCount[nBits]/WordLength;
RETURN};

VarScan: TYPE = PROC [sei: ISEIndex, output: BOOL];

GenCtxVars: PROC [ctx: CTXIndex, p: VarScan, output: BOOL] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF ~seb[sei].constant THEN p[sei, output] ENDLOOP};

GenBodyVars: PROC [bti: CBTIndex, p: VarScan] = {
type: Type = bb[bti].ioType;
WITH se: seb[type] SELECT FROM
cons =>
 WITH t: se SELECT FROM
  transfer => {
  GenCtxVars[ArgCtx[t.typeIn], p, FALSE];
  GenCtxVars[ArgCtx[t.typeOut], p, TRUE]};
  ENDCASE;
ENDCASE;
GenCtxVars[bb[bti].localCtx, p, FALSE]};

GenBodyProcs: PROC [bti: BTIndex, proc: PROC [CBTIndex]] = {
sonBti: BTIndex;
IF (sonBti ← bb[bti].firstSon) # BTNull THEN
DO
 WITH body: bb[sonBti] SELECT FROM
  Callable =>
  IF ~body.inline AND body.nesting # Catch THEN proc[LOOPHOLE[sonBti]];
  ENDCASE => NULL;
 IF bb[sonBti].link.which = parent THEN EXIT;
 sonBti ← bb[sonBti].link.index;
 ENDLOOP};

GenImportedVars: PROC [p: VarScan] = {
ctx: CTXIndex = dataPtr.importCtx;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF ~seb[sei].constant THEN p[sei, FALSE]
ELSE {
 type: CSEIndex = UnderType[seb[sei].idType];
 WITH seb[type] SELECT FROM definition => GenCtxVars[defCtx, p, FALSE] ENDCASE};
ENDLOOP};


MarkArg: VarScan = {seb[sei].mark4 ← TRUE};

MarkArgs: PROC [sei: Type] = {
type: CSEIndex = UnderType[sei];
rSei: RecordSEIndex;
WITH t: seb[type] SELECT FROM
transfer => {
 IF (rSei ← ArgRecord[t.typeIn]) # RecordSENull THEN {
  GenCtxVars[seb[rSei].fieldCtx, MarkArg, FALSE];
  seb[rSei].length ← LayoutArgs[rSei, 0, TRUE]*WordLength;
  seb[rSei].mark4 ← TRUE};
 IF (rSei ← ArgRecord[t.typeOut]) # RecordSENull THEN {
  GenCtxVars[seb[rSei].fieldCtx, MarkArg, TRUE];
  seb[rSei].length ← LayoutArgs[rSei, 0, TRUE]*WordLength;
  seb[rSei].mark4 ← TRUE};
 t.mark4 ← TRUE};
ENDCASE};


LayoutLocals: PUBLIC PROC [bti: CBTIndex] RETURNS [length: CARDINAL] = {
vProfile: Profile;
vI: CARDINAL;

CountVar: VarScan = {
IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN vI ← vI + 1};

CountProc: PROC [bti: CBTIndex] = {
IF bb[bti].info.mark = Internal THEN vI ← vI + 1};

InsertVar: VarScan = {
saveIndex: CARDINAL = dataPtr.textIndex;
node: Tree.Index = LOOPHOLE[seb[sei].idValue];
IF node # Tree.NullIndex THEN dataPtr.textIndex ← tb[node].info;
IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN {
vProfile[vI] ← [link: [symbol[sei]], key: seb[sei].idInfo]; vI ← vI+1};
IF seb[sei].idInfo = 0 AND seb[sei].hash # nullName
AND ~output -- suppress message for return record
AND node # Tree.NullIndex THEN Log.WarningSei[unusedId, sei];
seb[sei].idInfo ← WordsForField[sei]*WordLength;
seb[sei].idValue ← 0;
dataPtr.textIndex ← saveIndex};

InsertProc: PROC [bti: CBTIndex] = {
IF bb[bti].info.mark = Internal THEN {
 vProfile[vI] ← VarInfo[
  link: [body[bti]],
  key: WITH bb[bti] SELECT FROM Inner=>frameOffset, ENDCASE=>0];
 vI ← vI+1}};

bodyType: Type = bb[bti].ioType;
origin: CARDINAL ← IF bb[bti].level = lL THEN localOrigin ELSE localOrigin+WordLength;
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 ← AssignVars[vProfile, origin, localOrigin + localSlots*WordLength];
length ← AssignVars[vProfile, origin, frameLimit];
CheckFrameOverflow[vProfile]; ReleaseProfile[vProfile];
RETURN};


LayoutGlobals: PUBLIC PROC [bti: CBTIndex, stopping, fragments: BOOL]
RETURNS [length: CARDINAL] = {
vProfile, xProfile: Profile;
vI, xI: CARDINAL;

CountVar: VarScan = {
ctx: CTXIndex = seb[sei].idCtx;
IF ctxb[ctx].ctxType = imported OR ctx = dataPtr.importCtx THEN xI ← xI + 1
ELSE IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN vI ← vI + 1};

InsertVar: VarScan = {
ctx: CTXIndex = seb[sei].idCtx;
IF ctxb[ctx].ctxType = imported OR ctx = dataPtr.importCtx THEN {
 xProfile[xI] ← [link: [symbol[sei]], key: seb[sei].idInfo];
 xI ← xI+1;
 IF seb[sei].idInfo = 0 AND ~seb[sei].public THEN Log.WarningSei[unusedId, sei];
 seb[sei].idInfo ← WordsForField[sei]*WordLength}
ELSE {
 saveIndex: CARDINAL = dataPtr.textIndex;
 node: Tree.Index = LOOPHOLE[seb[sei].idValue];
 IF node # Tree.NullIndex THEN dataPtr.textIndex ← tb[node].info;
 IF seb[sei].hash # nullName OR seb[sei].extended OR ~output THEN {
  vProfile[vI] ← [link: [symbol[sei]], key: seb[sei].idInfo]; vI ← vI + 1};
 IF seb[sei].idInfo = 0 AND ~dataPtr.interface
  AND ~seb[sei].public AND seb[sei].hash # nullName
  AND node # Tree.NullIndex THEN Log.WarningSei[unusedId, sei];
 seb[sei].idInfo ← WordsForField[sei]*WordLength;
 seb[sei].idValue ← 0;
 dataPtr.textIndex ← saveIndex}};

origin: CARDINAL ← globalOrigin;
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 {SortProfile[vProfile]; SortProfile[xProfile]};
AssignImports[xProfile, 0, 256*WordLength];
SELECT TRUE FROM -- adjust for system uses of global 0
stopping => origin ← origin + WordLength;
fragments =>
 -- avoid fragment (length >= 2*WordLength) overlay of global 0 (used for start traps)
 origin ← MAX[
  AssignVars[vProfile, origin, globalOrigin+WordLength],
  globalOrigin+WordLength];
ENDCASE;
origin ← AssignVars[vProfile, origin, frameLimit];
length ← MAX[origin, globalOrigin+WordLength];
CheckFrameOverflow[vProfile]; ReleaseProfile[vProfile];
CheckFrameOverflow[xProfile]; ReleaseProfile[xProfile];
RETURN};


CheckBlock: PUBLIC PROC [bti: BTIndex] = {

CheckVar: VarScan = {
saveIndex: CARDINAL = dataPtr.textIndex;
node: Tree.Index = LOOPHOLE[seb[sei].idValue];
IF node # Tree.NullIndex THEN {
 dataPtr.textIndex ← tb[node].info;
 IF seb[sei].idInfo = 0 THEN Log.WarningSei[unusedId, sei]};
dataPtr.textIndex ← saveIndex};

GenCtxVars[bb[bti].localCtx, CheckVar, FALSE]};

LayoutBlock: PUBLIC PROC [bti: BTIndex, origin: CARDINAL]
RETURNS [length: CARDINAL] = {
vProfile: Profile;
vI: CARDINAL;

CountVar: VarScan = {vI ← vI + 1};

CountProc: PROC [bti: CBTIndex] = {
IF bb[bti].info.mark = Internal THEN vI ← vI + 1};

InsertVar: VarScan = {
vProfile[vI] ← [link: [symbol[sei]], key: seb[sei].idInfo]; vI ← vI+1;
seb[sei].idInfo ← WordsForField[sei]*WordLength;
seb[sei].idValue ← 0};

InsertProc: PROC [bti: CBTIndex] = {
IF bb[bti].info.mark = Internal THEN {
 vProfile[vI] ← VarInfo[
  link: [body[bti]],
  key: WITH bb[bti] SELECT FROM Inner=>frameOffset, ENDCASE=>0];
 vI ← vI+1}};

vI ← 0; GenCtxVars[bb[bti].localCtx, CountVar, FALSE]; GenBodyProcs[bti, CountProc];
vProfile ← AllocateProfile[vI];
vI ← 0; GenCtxVars[bb[bti].localCtx, InsertVar, FALSE]; GenBodyProcs[bti, InsertProc];
SortProfile[vProfile];
length ← AssignVars[vProfile, origin, frameLimit];
CheckFrameOverflow[vProfile]; ReleaseProfile[vProfile];
RETURN};


LayoutInterface: PUBLIC PROC [bti: CBTIndex] RETURNS [nEntries: CARDINAL] = {
epN: CARDINAL ← 0;
FOR sei: ISEIndex ← FirstCtxSe[bb[bti].localCtx], NextSe[sei] UNTIL sei = ISENull DO
SELECT LinkMode[sei] FROM
 val, ref => {seb[sei].linkSpace ← TRUE; seb[sei].idValue ← epN; epN ← epN + 1};
 type => {seb[sei].idValue ← epN; epN ← epN + 1};
 ENDCASE;
ENDLOOP;
IF (nEntries𡤎pN) > entryLimit THEN Log.ErrorN[interfaceEntries, nEntries-entryLimit];
RETURN};


CheckFrameOverflow: PROC [profile: Profile] = {
FOR i: INTEGER IN [0 .. profile.length) DO
WITH profile[i].link SELECT FROM
 symbol => Log.ErrorSei[addressOverflow, index];
 body => Log.ErrorSei[addressOverflow, bb[index].id];
 ENDCASE;
ENDLOOP};


Align: PROC [offset: CARDINAL, item: VarLink] RETURNS [CARDINAL] = {
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]};

BitWidth: PROC [item: VarLink] RETURNS [CARDINAL] = {
RETURN [WITH item SELECT FROM
symbol => seb[index].idInfo,
body => WordLength,
ENDCASE => 0]};

AssignBase: PROC [item: VarLink, base: CARDINAL] = {
WITH item SELECT FROM
symbol => {
 sei: ISEIndex = index;
seb[sei].idValue ← BitAddress[wd:base/WordLength, bd:0];
seb[sei].mark4 ← TRUE};
body => {
 bti: CBTIndex = index;
 WITH bb[bti] SELECT FROM Inner => frameOffset ← base/WordLength ENDCASE => ERROR};
ENDCASE};

AssignVars: PROC [profile: Profile, origin, limit: CARDINAL] RETURNS [CARDINAL] = {
start, base, length, remainder, delta: CARDINAL;
i, j, next: INTEGER;
t: VarLink;
found, skips: BOOL;
next ← 0; start ← origin;
remainder ← IF origin < limit THEN limit - origin ELSE 0;
WHILE next < profile.length DO
i ← next; found ← skips ← FALSE;
WHILE ~found AND i < profile.length DO
 IF (t ← profile[i].link) # [empty[]] THEN {
  base ← Align[start, t]; length ← BitWidth[t];
  delta ← base - start;
  IF length + delta <= remainder THEN {
  limit: CARDINAL = base + length;
  subBase: CARDINAL ← start;
  nRefs: CARDINAL ← 0;
  FOR j ← i+1, j+1 WHILE j < profile.length AND subBase < limit DO
  IF profile[j].link # [empty[]] THEN {
  subLength: CARDINAL = BitWidth[profile[j].link];
  subDelta: CARDINAL = Align[subBase, profile[j].link] - subBase;
  IF (subDelta + subLength) > (limit - subBase) THEN EXIT;
  subBase ← subBase + (subDelta + subLength);
  nRefs ← nRefs + profile[j].key};
  ENDLOOP;
  IF nRefs <= profile[i].key OR ~dataPtr.switches['s] THEN {
  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)}
  ELSE IF ~skips THEN {skips ← TRUE; next ← i}}};
 i ← i+1;
 IF ~skips THEN next ← i;
 ENDLOOP;
ENDLOOP;
RETURN [start]};

AssignImports: PROC [profile: Profile, origin, limit: CARDINAL] = {
i, nProcs: CARDINAL ← profile.length;
next: CARDINAL;
t: VarLink;
v: VarInfo;
UNTIL i = 0 DO
i ← i-1; t ← profile[i].link;
WITH t SELECT FROM
 symbol =>
  IF XferMode[seb[index].idType] # proc THEN {
  nProcs ← nProcs-1; v ← profile[i];
  FOR j: CARDINAL IN [i..nProcs) DO profile[j] ← profile[j+1] ENDLOOP;
  profile[nProcs] ← v};
 ENDCASE;
ENDLOOP;
-- the frame link fragment begins at origin
dataPtr.linkCount ← profile.length;
IF ~dataPtr.interface THEN CompilerUtil.AppendBCDWord[profile.length];
i ← profile.length;
next ← MIN[origin + profile.length*WordLength, limit];
UNTIL i = 0 OR next = origin DO
i ← i-1; t ← profile[i].link; profile[i].link ← [empty[]];
IF ~dataPtr.interface THEN
 WITH t SELECT FROM
  symbol => {
  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};
  ENDCASE;
ENDLOOP};


-- parameter record layout

LayoutArgs: PUBLIC PROC [argRecord: RecordSEIndex, origin: CARDINAL, body: BOOL]
RETURNS [CARDINAL] = {
w: CARDINAL ← origin;
IF argRecord # RecordSENull THEN {
ctx: CTXIndex = seb[argRecord].fieldCtx;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
 nW: FieldWordCount = WordsForField[sei];
 IF nW = 0 THEN Log.ErrorSei[sizeClash, sei];
 IF ~body THEN {
  seb[sei].idInfo ← nW*WordLength;
  seb[sei].idValue ← BitAddress[wd:w, bd:0]};
 w ← w + nW;
 ENDLOOP};
RETURN [w]};


-- record layout

BitOffset: PROC [sei: ISEIndex] RETURNS [CARDINAL] = {
t: BitAddress = seb[sei].idValue; RETURN [t.wd*WordLength + t.bd]};

BitsForField: PROC [sei: ISEIndex] RETURNS [nB: FieldBitCount] = {
nBits: BitCount = BitsForType[seb[sei].idType];
IF nBits > FieldBitCount.LAST THEN {
Log.ErrorSei[addressOverflow, sei]; nB ← 0}
ELSE nB ← FieldBitCount[nBits];
RETURN};

ScanVariants: PROC [caseCtx: CTXIndex, proc: PROC [RecordSEIndex] RETURNS [BOOL]]
RETURNS [BOOL] = {
FOR sei: ISEIndex ← FirstCtxSe[caseCtx], NextSe[sei] UNTIL sei = ISENull DO
rSei: Type = 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]};

LayoutFields: PUBLIC PROC [rSei: RecordSEIndex, offset: CARDINAL] = {
maxRecordSize: CARDINAL = CARDINAL.LAST/WordLength + 1;
w: WordCount;
b: CARDINAL;
lastFillable: BOOL;
lastSei: ISEIndex;

AssignField: PROC [sei: ISEIndex] = {
OPEN id: seb[sei];
n: FieldBitCount;
nW, nB: CARDINAL;
saveIndex: CARDINAL = dataPtr.textIndex;
dataPtr.textIndex ← tb[LOOPHOLE[id.idValue, Tree.Index]].info;
n ← BitsForField[sei];
nW ← n/WordLength; nB ← n MOD WordLength;
IF nW > 0 AND nB # 0 THEN {nW ← nW+1; nB ← 0};
IF (nW > 0 OR b+nB > WordLength OR n = 0) AND b # 0 THEN {w ← w+1; b ← 0};
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 {w ← w+1; b ← b - WordLength};
IF (IF b=0 THEN w ELSE w+1) >= maxRecordSize THEN
 Log.ErrorSei[addressOverflow, sei]};

FillWord: PROC [sei: ISEIndex] = {
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};

FindFit: PROC [vSei: RecordSEIndex] RETURNS [BOOL] = {
sei: ISEIndex ← FirstCtxSe[seb[vSei].fieldCtx];
type: CSEIndex;
IF sei = ISENull THEN RETURN [FALSE];
type ← UnderType[seb[sei].idType];
WITH seb[type] SELECT FROM
 union =>
  IF controlled THEN sei ← tagSei
  ELSE RETURN [ScanVariants[caseCtx, FindFit]];
 sequence => IF controlled THEN sei ← tagSei ELSE RETURN [FALSE];
 ENDCASE => NULL;
RETURN [BitsForType[seb[sei].idType] + b <= WordLength]};

vOrigin: CARDINAL;
maxLength: CARDINAL;

AssignVariant: PROC [vSei: RecordSEIndex] RETURNS [BOOL] = {
LayoutFields[vSei, vOrigin];
maxLength ← MAX[seb[vSei].length, maxLength];
RETURN [FALSE]};

eqLengths: BOOL;
padEnd: CARDINAL;

PadVariant: PROC [vSei: RecordSEIndex] RETURNS [BOOL] = {
fillSei: ISEIndex ← ISENull;
type: CSEIndex;
fillOrigin, currentEnd: CARDINAL;
ctx: CTXIndex = seb[vSei].fieldCtx;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
 IF LOOPHOLE[seb[sei].idValue, BitAddress].wd # w THEN EXIT;
 fillSei ← sei;
 ENDLOOP;
IF fillSei # ISENull THEN {
 fillOrigin ← BitOffset[fillSei];
 currentEnd ← fillOrigin + seb[fillSei].idInfo;
 IF currentEnd < padEnd AND (currentEnd # 0 OR padEnd < WordLength) THEN {
  type ← UnderType[seb[fillSei].idType];
  WITH seb[type] SELECT FROM
  union => {
  saveLastSei: ISEIndex = lastSei;
  IF controlled THEN lastSei ← tagSei; -- for messages only
  [] ← ScanVariants[caseCtx, PadVariant];
  lastSei ← saveLastSei};
  ENDCASE => IF seb[rSei].machineDep THEN Log.WarningSei[recordGap, fillSei];
  seb[fillSei].idInfo ← padEnd - fillOrigin}}
ELSE IF vOrigin < padEnd AND (vOrigin # 0 OR padEnd < WordLength) THEN {
 IF seb[rSei].machineDep THEN Log.WarningSei[recordGap, lastSei];
 fillSei ← MakeCtxSe[nullName, 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};
seb[vSei].length ← MIN[
  maxLength,
  (seb[vSei].length + wordFill)/WordLength * WordLength];
IF seb[vSei].length # maxLength THEN eqLengths ← FALSE;
RETURN [FALSE]};

type: CSEIndex;
ctx: CTXIndex = seb[rSei].fieldCtx;
w ← offset/WordLength; b ← offset MOD WordLength;
lastFillable ← FALSE; lastSei ← ISENull;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
IF ~seb[sei].constant THEN {
 type ← UnderType[seb[sei].idType];
 WITH seb[type] SELECT FROM
  union => {
  IF ~controlled THEN seb[sei].idValue ← BitAddress[wd:w, bd:b]
  ELSE {AssignField[tagSei]; seb[sei].idValue ← seb[tagSei].idValue};
  IF lastFillable AND b # 0 AND ~ScanVariants[caseCtx, FindFit] THEN {
  FillWord[lastSei]; w ← w+1; b ← 0};
  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];
  hints.equalLengths ← eqLengths;
  seb[sei].idInfo ←
  (maxLength - vOrigin) + (IF controlled THEN seb[tagSei].idInfo ELSE 0);
  w ← maxLength/WordLength; b ← maxLength MOD WordLength;
  lastFillable ← FALSE};
  sequence => {
  IF ~controlled THEN seb[sei].idValue ← BitAddress[wd:w, bd:b]
  ELSE {AssignField[tagSei]; seb[sei].idValue ← seb[tagSei].idValue};
  IF lastFillable AND b # 0 THEN {FillWord[lastSei]; w ← w+1; b ← 0};
  seb[sei].idInfo ← (CARDINAL[w]*WordLength+b) - BitOffset[sei];
  lastFillable ← FALSE};
  ENDCASE => AssignField[sei]};
ENDLOOP;
IF lastFillable AND b # 0 AND w > 0 THEN {FillWord[lastSei]; b ← 0; w ← w+1};
seb[rSei].length ← w*WordLength + b};


CheckFields: PUBLIC PROC [rSei: RecordSEIndex, origin: CARDINAL] = {
vProfile: Profile;
vI: CARDINAL;

CountVar: VarScan = {vI ← vI + 1};

InsertVar: VarScan = {
vProfile[vI] ← [link:[symbol[sei]], key:BitOffset[sei]]; vI ← vI+1};

b, newB: CARDINAL;
sei, lastSei: ISEIndex;
vI ← 0; GenCtxVars[seb[rSei].fieldCtx, CountVar, FALSE];
vProfile ← AllocateProfile[vI];
vI ← 0; GenCtxVars[seb[rSei].fieldCtx, InsertVar, FALSE];
SortProfile[vProfile];
b ← origin; lastSei ← ISENull;
FOR vI DECREASING IN [0 .. vProfile.length) DO
sei ← NARROW[vProfile[vI].link, VarLink.symbol].index;
SELECT TypeForm[seb[sei].idType] FROM
 union => CheckVariants[sei];
 sequence => {
  IF vI # 0 THEN Log.ErrorSei[recordOverlap, sei];
  CheckSequence[sei]};
 ENDCASE;
SELECT (newB ← vProfile[vI].key) FROM
 > b => Log.ErrorSei[recordGap, lastSei];
 < b => Log.ErrorSei[recordOverlap, sei];
 ENDCASE;
b ← newB + seb[sei].idInfo; lastSei ← sei;
ENDLOOP;
ReleaseProfile[vProfile];
IF b > WordLength AND b MOD WordLength # 0
THEN {
 Log.ErrorSei[recordGap, lastSei];
 b ← ((b+wordFill)/WordLength) * WordLength};
seb[rSei].length ← b};

CheckVariants: PROC [sei: ISEIndex] = {
type: CSEIndex = UnderType[seb[sei].idType];
started: BOOL ← FALSE;
eqLengths: BOOL ← TRUE;
gaps: BOOL ← FALSE;
origin, maxLength, size: CARDINAL;

CheckVariant: PROC [rSei: RecordSEIndex] RETURNS [BOOL] = {
length: CARDINAL;
CheckFields[rSei, origin]; length ← seb[rSei].length;
IF ~started THEN {maxLength ← length; started ← TRUE}
ELSE {
 IF length MOD WordLength # 0 OR maxLength MOD WordLength # 0 THEN gaps ← TRUE;
 IF length # maxLength THEN {maxLength ← MAX[length, maxLength]; eqLengths ← FALSE}};
RETURN [FALSE]};

origin ← BitOffset[sei];
WITH union: seb[type] SELECT FROM
union => {
 IF union.controlled THEN {
  newOrigin: CARDINAL = BitOffset[union.tagSei];
  IF origin # newOrigin THEN Log.ErrorSei[fieldPosition, union.tagSei];
  origin ← newOrigin + seb[union.tagSei].idInfo};
 [] ← ScanVariants[union.caseCtx, CheckVariant];
 size ← maxLength - BitOffset[sei]; union.hints.equalLengths ← eqLengths;
 IF gaps THEN Log.ErrorSei[recordGap, sei];
 SELECT TRUE FROM
  (seb[sei].idInfo = 0) => seb[sei].idInfo ← size;
  (size # seb[sei].idInfo) => Log.ErrorSei[fieldPosition, sei];
  ENDCASE};
ENDCASE => ERROR};

CheckSequence: PROC [sei: ISEIndex] = {
type: CSEIndex = UnderType[seb[sei].idType];
origin, length: CARDINAL;
origin ← BitOffset[sei];
WITH seq: seb[type] SELECT FROM
sequence => {
 IF seq.controlled THEN {
  newOrigin: CARDINAL = BitOffset[seq.tagSei];
  IF origin # newOrigin THEN Log.ErrorSei[fieldPosition, seq.tagSei];
  origin ← newOrigin + seb[seq.tagSei].idInfo};
 IF origin MOD WordLength # 0 THEN Log.ErrorSei[fieldPosition, sei];
 length ← origin - BitOffset[sei];
 SELECT seb[sei].idInfo FROM
  0 => seb[sei].idInfo ← length;
  length => NULL;
  ENDCASE => Log.ErrorSei[fieldPosition, sei]};
ENDCASE => ERROR};

}.