-- 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.