
    <<Pass4L.Mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, May 1, 1986 12:50:11 pm PDT>>
        <<Paul Rovner, September 7, 1983 4:54 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:52:03 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier],
        BcdDefs: TYPE USING [EPLimit, IRLinkLimit],
        ComData: TYPE USING [idANY, importCtx, interface, linkCount, nBodies, nSigCodes, switches, textIndex],
        CompilerUtil: TYPE USING [AppendBCDWord],
        Log: TYPE USING [Error, ErrorN, ErrorSei, WarningSei],
        P4: TYPE USING [],
        PrincOps: TYPE USING [ControlLink, EPRange, globalbase, localbase, LocalOverhead, MaxFrameSize, MaxNGfi, Port, PsbIndex],
        SourceMap: TYPE USING [Loc],
        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 = MIN[BcdDefs.EPLimit, 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 _ WordLength * (SELECT mode FROM
                    proc => PrincOps.ControlLink.SIZE,
                    port => PrincOps.Port.SIZE,
                    signal, error => PrincOps.ControlLink.SIZE,
                    process => PrincOps.PsbIndex.SIZE,
                    program => PrincOps.ControlLink.SIZE,
                    ENDCASE => ERROR);
                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[arraySize];
                                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 => [],
                ENDCASE];

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

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

        SortProfile: PROC[v: Profile] = {  -- Shell sort --
            i, j: INTEGER;
            k: CARDINAL;
            t: VarInfo;
            h: NAT _ 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};

        MergeProfiles: PROC[profile1, profile2: Profile] RETURNS[profile: Profile] = {
            i, i1, i2: CARDINAL _ 0;
            profile _ NEW[VarInfoList[profile1.length+profile2.length]];
            WHILE i1 < profile1.length AND i2 < profile2.length DO
                IF profile1[i1].key > profile2[i2].key THEN {profile[i] _ profile1[i1];  i1 _ i1+1}
                ELSE {profile[i] _ profile2[i2];  i2 _ i2+1};
                i _ i + 1
                ENDLOOP;
            WHILE i1 < profile1.length DO
                profile[i] _ profile1[i1];  i1 _ i1+1;  i _ i + 1
                ENDLOOP;
            WHILE i2 < profile2.length DO
                profile[i] _ profile2[i2];  i2 _ i2+1;  i _ i + 1
                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_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;
            profile _ NIL};


    <<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: SourceMap.Loc = 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];  vProfile _ NIL;
            RETURN};


        LayoutGlobals: PUBLIC PROC[bti: CBTIndex, stopping, fragments: BOOL]
              RETURNS[length: CARDINAL] = {
            vProfile, pProfile, xProfile: Profile;
            vI, pI, 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 {
                    IF seb[sei].public THEN pI _ pI + 1 ELSE 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: SourceMap.Loc = 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 {
                        IF seb[sei].public THEN {
                            pProfile[pI] _ [link: [symbol[sei]], key: seb[sei].idInfo]; pI _ pI + 1}
                        ELSE {
                            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 _ pI _ xI _ 0;  GenBodyVars[bti, CountVar];  GenImportedVars[CountVar];
            vProfile _ AllocateProfile[vI];
            pProfile _ AllocateProfile[pI];
            xProfile _ AllocateProfile[xI];
            vI _ xI _ 0;  GenBodyVars[bti, InsertVar];  GenImportedVars[InsertVar];
            IF dataPtr.switches['s] THEN {
                SortProfile[vProfile]; SortProfile[pProfile]; SortProfile[xProfile]};
            AssignImports[xProfile, 0, 256*PrincOps.ControlLink.SIZE*WordLength];
            SELECT TRUE FROM    -- adjust for system uses of global 0
                stopping => origin _ origin + WordLength;
                fragments OR pProfile.length # 0 =>
                    <<avoid overlay of global 0 (used for start traps).>>
                    <<note that fragment length >= 2*WordLength>>
                    origin _ MAX[
                        AssignVars[vProfile, origin, globalOrigin+WordLength],
                        globalOrigin+WordLength];
                ENDCASE;
            IF pProfile.length # 0 THEN {
                vProfile _ MergeProfiles[vProfile, pProfile];  pProfile _ NIL};
            origin _ AssignVars[vProfile, origin, frameLimit];
            length _ MAX[origin, globalOrigin+WordLength];
            CheckFrameOverflow[vProfile];  vProfile _ NIL;
            CheckFrameOverflow[xProfile];  xProfile _ NIL;
            RETURN};


        CheckBlock: PUBLIC PROC[bti: BTIndex] = {

            CheckVar: VarScan = {
                saveIndex: SourceMap.Loc = 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];  vProfile _ NIL;
            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) > BcdDefs.IRLinkLimit THEN
                Log.ErrorN[interfaceEntries, nEntries-BcdDefs.IRLinkLimit];
            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 => PrincOps.ControlLink.SIZE*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*PrincOps.ControlLink.SIZE*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: SourceMap.Loc = 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[paddedField, 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[paddedField, fillSei];
                        seb[fillSei].idInfo _  padEnd - fillOrigin}}
                ELSE IF vOrigin < padEnd AND (vOrigin # 0 OR padEnd < WordLength) THEN {
                    IF seb[rSei].machineDep THEN Log.WarningSei[paddedField, 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;
            vProfile _ NIL;
            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};

        }.

