-- file Pass4L.Mesa
-- last modified by Satterthwaite, February 22, 1983 4:09 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, 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*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 => 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_0] = {
    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 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_epN) > 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};

  }.