-- CodePackProcsImpl.Mesa  
--  Last edited by Lewis on  2-Apr-81 10:27:23
--  Last edited by Sweet on September 16, 1980  12:46 PM
--  Last edited by Levin on July 6, 1982 3:31 pm

DIRECTORY
  Alloc USING [AddNotify, DropNotify, Handle, Notifier, Words],
  BcdDefs USING [MTIndex, MTNull, NameRecord],
  CodePackProcs,
  Error USING [
    Error, ErrorName, ModuleAlreadyPacked, NoProcFromModuleInCP,
    NotProcInModule, ProcNotPlaced, ProcPlacedTwice,
    TableCompModuleNotIncAsUnit],
  Inline USING [BITAND, BITXOR],
  ModuleSymbols USING [
    InvalidSymbols, Load, Unload, outerPackArray, FindProc],
  PackagerDefs USING [
    packtreetype, packsttype, packctreetype, packpotype, packmdtype,
    globalData],
  PackageSymbols USING [OPIndex, OPNull, MaxEntries],
  ProcessingOrder USING [Enumerate, IsEmpty],
  SemanticEntry USING [STIndex],
  SourceBcd USING [
    bcdBases, configTreeRoot, EnumerateModulesInConfig, IsTableCompiled],
  Strings USING [String, SubString, SubStringDescriptor],
  Symbols USING [HTIndex, HTNull],
  SymbolOps USING [SubStringForHash],
  SymTabDefs USING [HTIndex],
  SymTabOps USING [SubStringForHash],
  Table USING [Base],
  Tree: FROM "PackTree" USING [Index, NullIndex, Link, root, Scan, Test],
  TreeOps: FROM "PackTreeOps" USING [ListHead, ListLength, ScanList, SearchList];
 
CodePackProcsImpl: PROGRAM
    IMPORTS 
      Alloc, Error, Inline, ModuleSymbols, PackagerDefs, ProcessingOrder,
      SymbolOps, SymTabOps, SourceBcd, Tree, TreeOps
    EXPORTS CodePackProcs = 
  BEGIN  OPEN PackagerDefs, CodePackProcs;

  CPerror: PROC = {ERROR CodePackProcsError};
  CodePackProcsError: ERROR = CODE;


 -- Parse tree, semantic entry, config tree, processing order, 
 -- and code pack module allocator table bases
 
  table: Alloc.Handle ← NIL;
  tb, stb, ctreeb, pob, mdb: Table.Base;

  UpdateBases: Alloc.Notifier =
    BEGIN
    tb     ← base[PackagerDefs.packtreetype];  
    stb    ← base[PackagerDefs.packsttype];
    ctreeb ← base[PackagerDefs.packctreetype];
    pob    ← base[PackagerDefs.packpotype];
    mdb    ← base[PackagerDefs.packmdtype];
    END;


 -- ***************** Module Record Location and Creation *****************

  MRecHVSize: CARDINAL = 71;
  MRecHash: TYPE = [0..MRecHVSize);
  mRecHashVec: ARRAY MRecHash OF ModuleIndex;

  InitModuleHashVector: PROC =
    BEGIN
    i: MRecHash;
    FOR i IN MRecHash DO mRecHashVec[i] ← NullModuleIndex ENDLOOP;
    END;

  HashForModule: PROC [module: BcdDefs.MTIndex] RETURNS [MRecHash] =
    BEGIN
    moduleName: BcdDefs.NameRecord = SourceBcd.bcdBases.mtb[module].name;
    moduleSS: Strings.SubString ← @moduleSSDesc;
      moduleSSDesc: Strings.SubStringDescriptor ← [
        base:   @SourceBcd.bcdBases.ssb.string, 
        offset: moduleName, 
	length: SourceBcd.bcdBases.ssb.size[moduleName]];
    RETURN[HashValue[moduleSS]];
    END;

  HashValue: PROC [ss: Strings.SubString] RETURNS [MRecHash] =
    BEGIN  -- computes the hash index for substring ss
    CharMask: PROC [CHARACTER, WORD] RETURNS [CARDINAL] =
      LOOPHOLE[Inline.BITAND];
    mask: WORD = 137B;                -- masks out ASCII case shifts
    n: CARDINAL = ss.length;
    b: Strings.String = ss.base;
    v: WORD;
    v ← CharMask[b[ss.offset], mask]*177B + CharMask[b[ss.offset+(n-1)], mask];
    RETURN[Inline.BITXOR[v, n*17B] MOD MRecHVSize]
    END;


 -- one element cache for <MTIndex, cpNode> -> <ModuleIndex> mapping
  lastModule: BcdDefs.MTIndex ← BcdDefs.MTNull;
  lastCpNode: Tree.Index ← Tree.NullIndex;
  lastModuleIndex: ModuleIndex ← NullModuleIndex;

  moduleRecKind: TYPE = {all, some};

  EnterModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index, procs: moduleRecKind] 
      RETURNS [existingRec: ModuleIndex] =
    BEGIN
    existingRec ← FindModuleRec[module, cpNode, procs, create].m;
    END;

  LocateExistingModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index] 
      RETURNS [existingRec: ModuleIndex, found: BOOLEAN] =
    BEGIN
    [existingRec, found] ← FindModuleRec[module, cpNode, some, noCreate];
    END;

  FindModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index, procs: moduleRecKind,
        createNewRec: {create, noCreate}] 
      RETURNS [m: ModuleIndex, found: BOOLEAN] =
    BEGIN 
    mHash: MRecHash;
    hashChainHead: ModuleIndex;
    IF cpNode = lastCpNode AND module = lastModule THEN
      RETURN[lastModuleIndex, TRUE];            -- found in cache
    mHash ← HashForModule[module];
    hashChainHead ← mRecHashVec[mHash];
    FOR m ← hashChainHead, mdb[m].link UNTIL m = NullModuleIndex DO
      IF mdb[m].mti = module AND mdb[m].cp = cpNode THEN 
	BEGIN  -- set up new cache entry
	lastModule ← module;  lastCpNode ← cpNode;  lastModuleIndex ← m;  
	RETURN[m, TRUE];
	END; 
      ENDLOOP;
    IF createNewRec = noCreate THEN RETURN[NullModuleIndex, FALSE];
    m ← IF procs = all 
      THEN NewAllProcsModuleRec[module, cpNode, hashChainHead]
      ELSE NewSomeProcsModuleRec[module, cpNode, hashChainHead];
    mRecHashVec[mHash] ← m;             -- add to hash chain 
    WITH tb[cpNode].son[3] SELECT FROM  -- add to code pack's module rec chain
      procs => 
        BEGIN moduleChainHead: ModuleIndex = index;
	IF moduleChainHead # NullModuleIndex THEN
	  mdb[m].next ← moduleChainHead;  
	tb[cpNode].son[3] ← Tree.Link[procs[m]];
        END;
      ENDCASE => CPerror[];
    lastModule ← module;  lastCpNode ← cpNode;  lastModuleIndex ← m;
    RETURN[m, FALSE];
    END;

  NewAllProcsModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index, chainHead: ModuleIndex] 
      RETURNS [newRec: ModuleIndex] =
    BEGIN
    newRec ← table.Words[PackagerDefs.packmdtype, SIZE[allProcs ModuleRecord]];
    mdb[newRec] ← ModuleRecord[
      mti:    module, 
      unused: 0,
      cp:     cpNode, 
      numWordPairsInProcArray: 1,  -- (irrelevant for allProcs variant) 
      next:   NullModuleIndex, 
      fill:   0,
      link:   chainHead, 
      procDescription: allProcs[includeMAIN: FALSE]];
    END;

  NewSomeProcsModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index, chainHead: ModuleIndex] 
      RETURNS [newRec: ModuleIndex] =
    BEGIN
    numWordPairsInProcArray: [1..4];
    i: CARDINAL;
    numWordPairsInProcArray ← SourceBcd.bcdBases.mtb[module].ngfi;
    newRec ← table.Words[PackagerDefs.packmdtype, 
      SIZE[someProcs ModuleRecord] + (2*numWordPairsInProcArray)];
    mdb[newRec] ← ModuleRecord[
      mti:    module, 
      unused: 0,
      cp:     cpNode, 
      numWordPairsInProcArray: numWordPairsInProcArray, 
      next:   NullModuleIndex, 
      fill:   0,
      link:   chainHead, 
      procDescription: someProcs[
        unused: 0,
        procIncluded: ]];
    WITH mdb[newRec] SELECT FROM
      someProcs =>
        FOR i IN [0..(32*numWordPairsInProcArray)) DO 
          procIncluded[i] ← FALSE;  
          ENDLOOP;
      ENDCASE; 
    END;


 -- ************************* Procedure Insertion *************************

  MAINProc: PackageSymbols.OPIndex = 0;

  -- records code pack in which each procedure is placed for error reporting
  procsCodePack: ARRAY [0..PackageSymbols.MaxEntries) OF Tree.Index;

  InsertProc: PROC [opi: PackageSymbols.OPIndex, m: ModuleIndex] =
    BEGIN
    WITH mdb[m] SELECT FROM
      allProcs =>
	IF opi # MAINProc OR includeMAIN --main already included-- THEN
          ReportProcIncludedTwice[opi, mti, procsCodePack[MAINProc], cp]
	ELSE
          BEGIN
	  ModuleSymbols.outerPackArray[MAINProc].placed ← includeMAIN ← TRUE;
	  procsCodePack[MAINProc] ← cp;
	  END;
      someProcs =>
	BEGIN
	IF opi = PackageSymbols.OPNull 
          OR opi >= LENGTH[ModuleSymbols.outerPackArray] THEN CPerror[];
	IF ModuleSymbols.outerPackArray[opi].placed THEN
	  ReportProcIncludedTwice[opi, mti, procsCodePack[opi], cp]
	ELSE 
          BEGIN
	  ModuleSymbols.outerPackArray[opi].placed ← procIncluded[opi] ← TRUE;
	  procsCodePack[opi] ← cp;
	  END;
	END;
      ENDCASE;
    END;

  ReportProcIncludedTwice: PROC [
      opi: PackageSymbols.OPIndex, mti: BcdDefs.MTIndex, 
      cpNode1, cpNode2: Tree.Index] =
    BEGIN
    procIdSS: Strings.SubString ← @procIdSSDesc;
      procIdSSDesc: Strings.SubStringDescriptor;
    cpId1, cpId2: SymTabDefs.HTIndex;
    SubStringForOPIndex[procIdSS, opi];
    WITH tb[cpNode1].son[1] SELECT FROM
      hash => cpId1 ← index;
      ENDCASE => CPerror[];
    WITH tb[cpNode2].son[1] SELECT FROM
      hash => cpId2 ← index;
      ENDCASE => CPerror[];
    Error.ProcPlacedTwice[error, procIdSS, mti, cpId1, cpId2];
    END;

  SubStringForOPIndex: PUBLIC PROC [
      ss: Strings.SubString, opi: PackageSymbols.OPIndex] =
    BEGIN
    hti: Symbols.HTIndex;
    IF opi = MAINProc THEN 
      {ss.base ← "MAIN";  ss.offset ← 0;  ss.length ← 4}
    ELSE
      BEGIN
      hti ← ModuleSymbols.outerPackArray[opi].hti;
      IF hti = Symbols.HTNull THEN
	{ss.base ← "(unknown)";  ss.offset ← 0;  ss.length ← 9}
      ELSE SymbolOps.SubStringForHash[ss, hti];
      END;
    END;


 -- ******************* Code Pack Procedure Determination ********************

  codePackProcsDetermined: BOOLEAN ← FALSE;

  Determine: PUBLIC PROC =
    BEGIN
    IF codePackProcsDetermined THEN CPerror[];
    table ← globalData.ownTable;
    table.AddNotify[UpdateBases];
    InitModuleHashVector[];
    PlaceProcedures[];
    VerifyProcsFromEachModuleInCodePacks[];
    codePackProcsDetermined ← TRUE;
    END;
  
  Destroy: PUBLIC PROC = 
    BEGIN
    IF ~codePackProcsDetermined THEN CPerror[];
    IF table # NIL THEN {table.DropNotify[UpdateBases]; table ← NIL};
    codePackProcsDetermined ← FALSE;
    END;

  
  PlaceProcedures: PROC = 
    {SourceBcd.EnumerateModulesInConfig[
      kind: prototype,
      configTreeNode: SourceBcd.configTreeRoot,
      userProc: PlaceOneModulesProcs]};
  
  PlaceOneModulesProcs: PROC [
      module: BcdDefs.MTIndex] RETURNS [stop: BOOLEAN] = 
    BEGIN

    PlaceOneCDNodesProcs: PROC [cdNode: Tree.Index] RETURNS [stop: BOOLEAN] =
      {PlaceModulesProcsForOneCDNode[module, cdNode];  RETURN[FALSE]};
  
    IF ProcessingOrder.IsEmpty[module] THEN 
      BEGIN
      name: BcdDefs.NameRecord = SourceBcd.bcdBases.mtb[module].name;
      Error.ErrorName[error, "was never placed in a code segment"L, name];
      RETURN[FALSE];
      END;
    IF ~SourceBcd.IsTableCompiled[module] THEN   -- load module's symbol table
      BEGIN
      ModuleSymbols.Load[module
        ! ModuleSymbols.InvalidSymbols => GO TO badSymbols];
      MarkProcsUnplaced[];
      ProcessingOrder.Enumerate[module, PlaceOneCDNodesProcs
        ! UNWIND => ModuleSymbols.Unload[]];
      VerifyProcsAllPlaced[module];
      ModuleSymbols.Unload[];
      END
    ELSE  -- table compiled: don't load symbols
      ProcessingOrder.Enumerate[module, PlaceOneCDNodesProcs]; 
    RETURN[FALSE];
    EXITS
      badSymbols =>
	BEGIN
	name: BcdDefs.NameRecord = SourceBcd.bcdBases.mtb[module].name;
	Error.ErrorName[error, "has invalid symbols"L, name];
	RETURN[FALSE];
        END;
    END;
  
  MarkProcsUnplaced: PROC = 
    BEGIN
    opi: PackageSymbols.OPIndex;
    FOR opi IN [MAINProc..LENGTH[ModuleSymbols.outerPackArray]) DO
      ModuleSymbols.outerPackArray[opi].placed ← FALSE;
      procsCodePack[opi] ← Tree.NullIndex;
      ENDLOOP;
    END;
  
  VerifyProcsAllPlaced: PROC [module: BcdDefs.MTIndex] = 
    BEGIN
    opi: PackageSymbols.OPIndex;
    procIdSS: Strings.SubString ← @procIdSSDesc;
      procIdSSDesc: Strings.SubStringDescriptor;
    FOR opi IN [MAINProc..LENGTH[ModuleSymbols.outerPackArray]) DO
      IF ~(ModuleSymbols.outerPackArray[opi].placed) THEN
	BEGIN
        SubStringForOPIndex[procIdSS, opi];
	Error.ProcNotPlaced[error, procIdSS, module]; 
	END;
      ENDLOOP;
    END;
  
  PlaceModulesProcsForOneCDNode: PROC [
      module: BcdDefs.MTIndex, cdNode: Tree.Index] = 
    BEGIN
    saveIndex: CARDINAL = globalData.textIndex;
    globalData.textIndex ← tb[cdNode].info;
    SELECT tb[cdNode].name FROM
      allComp          => PlaceAllCompCDProcs[module, cdNode];
      compItems        => PlaceCompItemsCDProcs[module, cdNode];
      exceptItems      => PlaceExceptItemsCDProcs[module, cdNode];
      exceptPacks      => PlaceExceptPacksCDProcs[module, cdNode];
      itemsExceptPacks => PlaceItemsExceptPacksCDProcs[module, cdNode];
      exceptPacksItems => PlaceExceptPacksItemsCDProcs[module, cdNode];
      mainProcs        => PlaceMainOfCDProcs[module, cdNode];
      ENDCASE => CPerror[];
    globalData.textIndex ← saveIndex;
    END;


--****** Place Module's Procedures For Explicit Component Descriptions ******

  PlaceAllCompCDProcs: PROC [module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= Component 
    InsertWholeModule[module: module, cpNode: tb[cdNode].cp];
    END;

  InsertWholeModule: PROC [module: BcdDefs.MTIndex, cpNode: Tree.Index] =
    BEGIN 
    m: ModuleIndex;
    opi: PackageSymbols.OPIndex;
    IF LocateExistingModuleRec[module, cpNode].found THEN
      BEGIN
      Error.ModuleAlreadyPacked[error, module];
      RETURN;
      END;
    m ← EnterModuleRec[module: module, cpNode: cpNode, procs: all];
    IF ~SourceBcd.IsTableCompiled[module] THEN
      BEGIN
      IF ~MainIsExcluded[cpNode] THEN InsertProc[MAINProc, m];
      FOR opi IN [1..LENGTH[ModuleSymbols.outerPackArray]) DO
        ModuleSymbols.outerPackArray[opi].placed ← TRUE;
        procsCodePack[opi] ← cpNode;
        ENDLOOP;
      END;
    END;

  MainIsExcluded: PROC [cpNode: Tree.Index] RETURNS [reply: BOOLEAN] =
    INLINE {RETURN[ tb[cpNode].attr1 ]};


  PlaceCompItemsCDProcs: PROC [module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= Component [ItemList]
    WITH tb[cdNode].son[1] SELECT FROM
      symbol => 
        BEGIN componentSE: SemanticEntry.STIndex = index;
	WITH stb[componentSE] SELECT FROM
          module => 
	    BEGIN
	    IF mti # module THEN CPerror[];
	    InsertNamedProcsFromModule[
	      module: module, cpNode: tb[cdNode].cp, 
	      itemList: tb[cdNode].son[2]];
	    END; 
          config =>  -- ProcessingOrderImpl found module should be processed 
	    InsertWholeModule[module: module, cpNode: tb[cdNode].cp];
          ENDCASE;
        END;
      ENDCASE => CPerror[];
    END;

  InsertNamedProcsFromModule: PROC [
      module: BcdDefs.MTIndex, cpNode: Tree.Index, itemList: Tree.Link] =
    BEGIN
    procSS: Strings.SubString ← @procSSDesc;
      procSSDesc: Strings.SubStringDescriptor;
    opi: PackageSymbols.OPIndex;
    m: ModuleIndex;

    InsertOneProc: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
        hash =>
          BEGIN procId: SymTabDefs.HTIndex = index;
          SymTabOps.SubStringForHash[procSS, procId];
          opi ← ModuleSymbols.FindProc[procSS];
	  IF opi = PackageSymbols.OPNull THEN
	    Error.NotProcInModule[error, procId, module]
	  ELSE InsertProc[opi, m];
          END;
        subtree =>
          BEGIN itemNode: Tree.Index = index;
  	  IF tb[itemNode].name # main THEN CPerror[];
  	  IF MainIsExcluded[cpNode] THEN 
	    Error.Error[warning, "Main procedure is included in a code pack for which EXCEPT [MAIN] was specified"];
	  InsertProc[MAINProc, m];
          END;
        ENDCASE => CPerror[];
      END;
  
    m ← EnterModuleRec[module: module, cpNode: cpNode, procs: some];
    TreeOps.ScanList[itemList, InsertOneProc];
    END;


  PlaceExceptItemsCDProcs: PROC [module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= Component EXCEPT [ItemList]
    WITH tb[cdNode].son[1] SELECT FROM
      symbol => 
        BEGIN componentSE: SemanticEntry.STIndex = index;
	WITH stb[componentSE] SELECT FROM
          module => 
	    BEGIN
	    IF mti # module THEN CPerror[];
	    ExcludeNamedProcsFromModule[
	      module: module, cpNode: tb[cdNode].cp, 
	      itemList: tb[cdNode].son[2]];
	    END; 
          config =>  -- ProcessingOrderImpl found module should be output 
	    InsertWholeModule[module: module, cpNode: tb[cdNode].cp];
          ENDCASE;
        END;
      ENDCASE => CPerror[];
    END;

  ExcludeNamedProcsFromModule: PROC [
      module: BcdDefs.MTIndex, cpNode: Tree.Index, itemList: Tree.Link] =
    BEGIN
    procSS: Strings.SubString ← @procSSDesc;
      procSSDesc: Strings.SubStringDescriptor;
    opi: PackageSymbols.OPIndex;
    m: ModuleIndex;

    RemoveMarkOfOneProc: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
        hash =>
          BEGIN procId: SymTabDefs.HTIndex = index;
          SymTabOps.SubStringForHash[procSS, procId];
          opi ← ModuleSymbols.FindProc[procSS];
	  IF opi = PackageSymbols.OPNull THEN
	    Error.NotProcInModule[error, procId, module]
	  ELSE WITH mdb[m] SELECT FROM
            someProcs => ModuleSymbols.outerPackArray[opi].attr1 ← FALSE;
            ENDCASE;
          END;
        subtree =>
          BEGIN itemNode: Tree.Index = index;
  	  IF tb[itemNode].name # main THEN CPerror[];
	  WITH mdb[m] SELECT FROM
            someProcs => ModuleSymbols.outerPackArray[MAINProc].attr1 ← FALSE;
            ENDCASE;
          END;
        ENDCASE => CPerror[];
      END;
  
    m ← EnterModuleRec[module: module, cpNode: cpNode, procs: some];
    MarkAllProcs[m];  -- then remove marks for those procs to exclude 
    IF MainIsExcluded[cpNode] THEN
      ModuleSymbols.outerPackArray[MAINProc].attr1 ← FALSE;
    TreeOps.ScanList[itemList, RemoveMarkOfOneProc];
    InsertRemainingMarkedProcs[m]; 
    END;

  MarkAllProcs: PROC [m: ModuleIndex] =
    BEGIN
    opi: PackageSymbols.OPIndex;
    WITH mdb[m] SELECT FROM
      allProcs =>
	Error.ModuleAlreadyPacked[error, mdb[m].mti];
      someProcs =>
        FOR opi IN [0..LENGTH[ModuleSymbols.outerPackArray]) DO
          ModuleSymbols.outerPackArray[opi].attr1 ← TRUE;
          ENDLOOP;
      ENDCASE;
    END;

  InsertRemainingMarkedProcs: PROC [m: ModuleIndex] =
    BEGIN
    opi: PackageSymbols.OPIndex;
    WITH mdb[m] SELECT FROM
      someProcs =>
        FOR opi IN [MAINProc..LENGTH[ModuleSymbols.outerPackArray]) DO
          IF ModuleSymbols.outerPackArray[opi].attr1 THEN  -- wasn't excluded 
	    BEGIN
	    IF ModuleSymbols.outerPackArray[opi].placed THEN
	      ReportProcIncludedTwice[opi, mti, procsCodePack[opi], cp]
	    ELSE 
              BEGIN
	      ModuleSymbols.outerPackArray[opi].placed ← procIncluded[opi] ← TRUE;
	      procsCodePack[opi] ← cp;
	      END;
	    END;
          ENDLOOP;
      ENDCASE;
    END;


--****** Place Module's Procedures For Implicit Component Descriptions ******

  PlaceExceptPacksCDProcs: PROC [module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= Component EXCEPT PackList
    WITH tb[cdNode].son[1] SELECT FROM
      symbol => 
        BEGIN componentSE: SemanticEntry.STIndex = index;
	WITH stb[componentSE] SELECT FROM
          module =>  
	    BEGIN
	    IF mti # module THEN CPerror[];
	    IncludeAllProcsNotInAnyPack[
	      module: module, cpNode: tb[cdNode].cp, 
	      packList: tb[cdNode].son[2]];
	    END; 
          config =>  -- ProcessingOrderImpl found module should be processed 
	    IncludeAllProcsNotInAnyPack[
	      module: module, cpNode: tb[cdNode].cp, 
	      packList: tb[cdNode].son[2]]; 
          ENDCASE;
        END;
      ENDCASE => CPerror[];
    END;

  IncludeAllProcsNotInAnyPack: PROC [
      module: BcdDefs.MTIndex, cpNode: Tree.Index, packList: Tree.Link] =
    BEGIN  -- include all procs not already in a code pack of packList
    m, oldMRec: ModuleIndex;
    found: BOOLEAN;

    RemoveMarksOfProcsInOnePack: Tree.Scan =
      BEGIN
      RemoveMarkOfOneProc: PROC [
	  opi: PackageSymbols.OPIndex] RETURNS [stop: BOOLEAN] =
	BEGIN
	WITH mdb[m] SELECT FROM
          someProcs => ModuleSymbols.outerPackArray[opi].attr1 ← FALSE;
          ENDCASE;
	RETURN[FALSE];
	END;

      WITH t SELECT FROM
        symbol =>
          BEGIN cpSE: SemanticEntry.STIndex = index;
	  WITH stb[cpSE] SELECT FROM
	    codePack =>
	      BEGIN
              [oldMRec, found] ← LocateExistingModuleRec[
                module: module, cpNode: treeNode];
              IF found THEN  -- procs from module in old cp
                EnumerateProcs[oldMRec, RemoveMarkOfOneProc];
	      END;
            ENDCASE;
          END;
        ENDCASE => CPerror[];
      END;
  
    IF SourceBcd.IsTableCompiled[module] THEN
      BEGIN
      [m, found] ← LocateExistingModuleRec[module: module, cpNode: cpNode];
      IF ~found THEN InsertWholeModule[module: module, cpNode: cpNode]
      ELSE Error.TableCompModuleNotIncAsUnit[error, module];
      END
    ELSE
      BEGIN 
      m ← EnterModuleRec[module: module, cpNode: cpNode, procs: some];
      MarkAllProcs[m];  -- then remove marks for those procs to exclude 
      IF MainIsExcluded[cpNode] THEN
        ModuleSymbols.outerPackArray[MAINProc].attr1 ← FALSE;
      TreeOps.ScanList[packList, RemoveMarksOfProcsInOnePack];
      InsertRemainingMarkedProcs[m]; 
      END; 
    END;


  PlaceItemsExceptPacksCDProcs: PROC [
      module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= Component [ItemList] EXCEPT PackList
    WITH tb[cdNode].son[1] SELECT FROM
      symbol => 
        BEGIN componentSE: SemanticEntry.STIndex = index;
	WITH stb[componentSE] SELECT FROM  -- component must not be a module
          config =>  -- ProcessingOrderImpl found module should be processed 
	    IncludeAllProcsNotInAnyPack[
	      module: module, cpNode: tb[cdNode].cp, 
	      packList: tb[cdNode].son[3]]; 
          ENDCASE;
        END;
      ENDCASE => CPerror[];
    END;


  PlaceExceptPacksItemsCDProcs: PROC [
      module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= Component EXCEPT PackList, [ItemList]
    WITH tb[cdNode].son[1] SELECT FROM
      symbol => 
        BEGIN componentSE: SemanticEntry.STIndex = index;
	WITH stb[componentSE] SELECT FROM
          module =>  
	    BEGIN
	    IF mti # module THEN CPerror[];
	    IncludeProcsNotInPackNorItemLists[
	      module: module, cpNode: tb[cdNode].cp,
	      packList: tb[cdNode].son[2], itemList: tb[cdNode].son[3]];
	    END; 
          config =>  -- ProcessingOrderImpl found module should be processed 
	    IncludeAllProcsNotInAnyPack[
	      module: module, cpNode: tb[cdNode].cp, 
	      packList: tb[cdNode].son[2]]; 
          ENDCASE;
        END;
      ENDCASE => CPerror[];
    END;

  IncludeProcsNotInPackNorItemLists: PROC [
      module: BcdDefs.MTIndex, cpNode: Tree.Index, 
      packList: Tree.Link, itemList: Tree.Link] =
    BEGIN  -- include all procs not already in a code pack or in item list
    procSS: Strings.SubString ← @procSSDesc;
      procSSDesc: Strings.SubStringDescriptor;
    opi: PackageSymbols.OPIndex;
    m, oldMRec: ModuleIndex;
    found: BOOLEAN;

    RemoveMarksOfProcsInOnePack: Tree.Scan =
      BEGIN
      RemoveMarkOfOneProcInPack: PROC [
	  opi: PackageSymbols.OPIndex] RETURNS [stop: BOOLEAN] =
	BEGIN
	WITH mdb[m] SELECT FROM
          someProcs => ModuleSymbols.outerPackArray[opi].attr1 ← FALSE;
          ENDCASE;
	RETURN[FALSE];
	END;

      WITH t SELECT FROM
        symbol =>
          BEGIN cpSE: SemanticEntry.STIndex = index;
	  WITH stb[cpSE] SELECT FROM
	    codePack =>
	      BEGIN
              [oldMRec, found] ← LocateExistingModuleRec[
                module: module, cpNode: treeNode];
              IF found THEN  -- procs from module in old cp
                EnumerateProcs[oldMRec, RemoveMarkOfOneProcInPack];
	      END;
            ENDCASE;
          END;
        ENDCASE => CPerror[];
      END;

    RemoveMarkOfOneProc: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
        hash =>
          BEGIN procId: SymTabDefs.HTIndex = index;
          SymTabOps.SubStringForHash[procSS, procId];
          opi ← ModuleSymbols.FindProc[procSS];
	  IF opi = PackageSymbols.OPNull THEN
	    Error.NotProcInModule[error, procId, module]
	  ELSE WITH mdb[m] SELECT FROM
            someProcs => ModuleSymbols.outerPackArray[opi].attr1 ← FALSE;
            ENDCASE;
          END;
        subtree =>
          BEGIN itemNode: Tree.Index = index;
  	  IF tb[itemNode].name # main THEN CPerror[];
	  WITH mdb[m] SELECT FROM
            someProcs => ModuleSymbols.outerPackArray[MAINProc].attr1 ← FALSE;
            ENDCASE;
          END;
        ENDCASE => CPerror[];
      END;
  
    m ← EnterModuleRec[module: module, cpNode: cpNode, procs: some];
    MarkAllProcs[m];  -- then remove marks for those procs to exclude 
    IF MainIsExcluded[cpNode] THEN
      ModuleSymbols.outerPackArray[MAINProc].attr1 ← FALSE;
    TreeOps.ScanList[packList, RemoveMarksOfProcsInOnePack];
    TreeOps.ScanList[itemList, RemoveMarkOfOneProc];
    InsertRemainingMarkedProcs[m]; 
    END;


--***** Place Module's Procedures For the MAIN OF Component Description *****

  PlaceMainOfCDProcs: PROC [module: BcdDefs.MTIndex, cdNode: Tree.Index] =
    BEGIN  -- ComponentDesc ::= MAIN OF PackList
    -- insert module's main proc if any of its other procs are in packlist 
    packList: Tree.Link = tb[cdNode].son[1];
    firstInList: Tree.Link;

    EnterMainIfOtherProcsInASegmentsPack: Tree.Test =
      BEGIN
      inserted: BOOLEAN;
      WITH t SELECT FROM
        subtree =>
          BEGIN segsCpNode: Tree.Index = index;
	  inserted ← InsertMainProcIfOtherProcsInPack[
	        module: module, cpNode: tb[cdNode].cp, 
	        existingCpNode: segsCpNode];
	  RETURN[inserted];  -- stop enumeration if main was inserted
          END;
        ENDCASE => CPerror[];
      RETURN[FALSE];
      END;

    EnterMainIfOtherProcsInOnePack: Tree.Test =
      BEGIN
      inserted: BOOLEAN;
      WITH t SELECT FROM
        symbol =>
          BEGIN cpSE: SemanticEntry.STIndex = index;
	  WITH stb[cpSE] SELECT FROM
            codePack => 
              BEGIN
	      inserted ← InsertMainProcIfOtherProcsInPack[
		    module: module, cpNode: tb[cdNode].cp, 
		    existingCpNode: treeNode];
	      RETURN[inserted];  -- stop enumeration if main was inserted
              END;
            ENDCASE;
          END;
        ENDCASE => CPerror[];
      RETURN[FALSE];
      END;

    IF SourceBcd.IsTableCompiled[module] THEN RETURN;
    IF TreeOps.ListLength[packList] = 1 THEN
      BEGIN  -- packlist might only be name of current code segment
      firstInList ← TreeOps.ListHead[packList];
      WITH firstInList SELECT FROM
        symbol => 
          BEGIN firstSE: SemanticEntry.STIndex = index;
	  WITH stb[firstSE] SELECT FROM
	    segment =>
	      BEGIN segNode: Tree.Index = treeNode;  -- the current segment
	      TreeOps.SearchList[
	        tb[segNode].son[2], EnterMainIfOtherProcsInASegmentsPack];
	      RETURN;
	      END;
	    ENDCASE;
          END;
        ENDCASE => CPerror[]; 
      END;
    TreeOps.SearchList[packList, EnterMainIfOtherProcsInOnePack];
    END;

  InsertMainProcIfOtherProcsInPack: PROC [
        module: BcdDefs.MTIndex, cpNode, existingCpNode: Tree.Index] 
      RETURNS [inserted: BOOLEAN] =
    BEGIN  
    -- insert module's main proc if it has other procs in existingCpNode
    existingMRec, newMRec: ModuleIndex;
    found: BOOLEAN;
    [existingMRec, found] ← LocateExistingModuleRec[
      module: module, cpNode: existingCpNode];
    IF found THEN  
      BEGIN
      newMRec ← EnterModuleRec[module: module, cpNode: cpNode, procs: some]; 
      InsertProc[MAINProc, newMRec];
      RETURN[TRUE];
      END
    ELSE RETURN[FALSE];
    END;


 --*** For each code pack, check that procs were included from each module ***

  VerifyProcsFromEachModuleInCodePacks: PROC [] =
    {EnumerateSegments[CheckOneCodeSegment]};

  CheckOneCodeSegment: PROC [segNode: Tree.Index] RETURNS [stop: BOOLEAN] =
    BEGIN
    IF segNode # Tree.NullIndex THEN 
      EnumerateCodePacks[segNode, CheckOneCodePack];
    RETURN[FALSE]; 
    END;
  
  currentCPId: SymTabDefs.HTIndex;

  CheckOneCodePack: PROC [cpNode: Tree.Index] RETURNS [stop: BOOLEAN] =
    BEGIN
    IF cpNode # Tree.NullIndex THEN  
      BEGIN
      WITH tb[cpNode].son[1] SELECT FROM
	hash => currentCPId ← index;
	ENDCASE;
      EnumerateModules[cpNode, CheckOneCodePackModule];
      END;  
    RETURN[FALSE]; 
    END; 

  CheckOneCodePackModule: PROC [
        mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex] 
      RETURNS [stop: BOOLEAN] =
    BEGIN
    IF ~SourceBcd.IsTableCompiled[mti] THEN
      IF ~AnyProcs[module] THEN
        Error.NoProcFromModuleInCP[warning, mti, currentCPId];
    RETURN[FALSE]; 
    END; 


 --******************** Code Pack Procedure Enumeration **********************
  
  EnumerateSegments: PUBLIC PROC [
      userProc: PROC [segNode: Tree.Index] RETURNS [stop: BOOLEAN]] = 
    BEGIN

    OutputOneCodeSegment: Tree.Test =
      BEGIN
      WITH t SELECT FROM
        subtree =>
          BEGIN treeNode: Tree.Index = index;
          SELECT tb[treeNode].name FROM
	    codeSeg, merge =>
	      IF ~tb[treeNode].attr2 THEN                  -- not superceded 
	        {IF userProc[treeNode] THEN RETURN[TRUE]}; -- stop enumeration
	    ENDCASE;
          END;
        ENDCASE => CPerror[];
      RETURN[FALSE];
      END;
  
    TreeOps.SearchList[Tree.root, OutputOneCodeSegment];
    END;

  SubStringForSegmentNode: PUBLIC PROC [
      ss: Strings.SubString, segNode: Tree.Index] =
    BEGIN
    WITH tb[segNode].son[1] SELECT FROM
      hash =>
	BEGIN segmentHti: SymTabDefs.HTIndex = index;
	SymTabOps.SubStringForHash[ss, segmentHti];
        END;
      ENDCASE => CPerror[];
    END;


  EnumerateCodePacks: PUBLIC PROC [
      segNode: Tree.Index, 
      userProc: PROC [cpNode: Tree.Index] RETURNS [stop: BOOLEAN]] =
    BEGIN
    saveIndex: CARDINAL = globalData.textIndex;

    OutputOneCodePack: Tree.Test =
      BEGIN
      WITH t SELECT FROM
        subtree =>
          BEGIN cpNode: Tree.Index = index;
          SELECT tb[cpNode].name FROM
	    codePack, unnamedCodePack, discardCodePack =>
	      BEGIN
	      IF tb[cpNode].attr2 THEN CPerror[];    -- superceded 
	      IF userProc[cpNode] THEN RETURN[TRUE]; -- stop enumeration
	      END;
	    ENDCASE => CPerror[];
          END;
        ENDCASE => CPerror[];
      RETURN[FALSE];
      END;
  
    globalData.textIndex ← tb[segNode].info;
    IF tb[segNode].attr2 THEN CPerror[];  -- segment has been superceded
    TreeOps.SearchList[tb[segNode].son[2], OutputOneCodePack];
    globalData.textIndex ← saveIndex;
    END;


  SubStringForCodePackNode: PUBLIC PROC [
      ss: Strings.SubString, cpNode: Tree.Index] =
    BEGIN
    WITH tb[cpNode].son[1] SELECT FROM
      hash =>
	BEGIN codePackHti: SymTabDefs.HTIndex = index;
	SymTabOps.SubStringForHash[ss, codePackHti];
        END;
      ENDCASE => CPerror[];
    END;


  IsDiscardCodePack: PUBLIC PROC [cpNode: Tree.Index] RETURNS [yes: BOOLEAN] =
    BEGIN
    IF cpNode = Tree.NullIndex THEN CPerror[];
    RETURN[ tb[cpNode].name = discardCodePack ];
    END;


  DoneEnumeratingModules: SIGNAL = CODE;

  EnumerateModules: PUBLIC PROC [
      cpNode: Tree.Index, 
      userProc: PROC [
        mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOLEAN]] =
    BEGIN
    saveIndex: CARDINAL = globalData.textIndex;
    globalData.textIndex ← tb[cpNode].info;
    IF tb[cpNode].attr2 THEN CPerror[]; -- code pack has been superceded
    OutputModules[
      cpNode: cpNode, userProc: userProc ! DoneEnumeratingModules => CONTINUE];
    globalData.textIndex ← saveIndex;
    END;

  OutputModules: PROC [  -- called recursively when multiple layers of merging
      cpNode: Tree.Index, 
      userProc: PROC [
        mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOLEAN]] =
    BEGIN
    SELECT tb[cpNode].name FROM
      codePack, unnamedCodePack, discardCodePack =>
	BEGIN
	cdList: Tree.Link = tb[cpNode].son[2];
	firstCdLink: Tree.Link = TreeOps.ListHead[cdList];
        WITH firstCdLink SELECT FROM
          symbol =>  -- cpNode is a code pack in a merged code segment
    	    OutputModulesOfMergedOldCodePacks[
	      oldCpList: cdList, userProc: userProc];
          ENDCASE =>  -- cpNode is a "normal" code pack 
	    OutputCodePackModules[
	      moduleList: tb[cpNode].son[3], userProc: userProc];
	END;
      ENDCASE => CPerror[];
    END;

  OutputModulesOfMergedOldCodePacks: PROC [
      oldCpList: Tree.Link, 
      userProc: PROC [
        mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOLEAN]] =
    BEGIN

    OutputModulesOfOneOldCodePack: Tree.Scan =
      BEGIN
      WITH t SELECT FROM
        symbol =>
          BEGIN oldCpSE: SemanticEntry.STIndex = index;
          WITH stb[oldCpSE] SELECT FROM
	    codePack =>
	      BEGIN oldCpNode: Tree.Index = treeNode;
	      OutputModules[cpNode: oldCpNode, userProc: userProc]
	      END;
	    ENDCASE;
          END;
        ENDCASE => CPerror[];
      END;
  
    TreeOps.ScanList[oldCpList, OutputModulesOfOneOldCodePack];
    END;

  OutputCodePackModules: PROC [
      moduleList: Tree.Link, 
      userProc: PROC [
        mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOLEAN]] =
    BEGIN
    m: ModuleIndex;
    mti: BcdDefs.MTIndex;
    stopEnumeration: BOOLEAN;
    WITH moduleList SELECT FROM
      procs => 
	BEGIN moduleChainHead: ModuleIndex = index;
	FOR m ← moduleChainHead, mdb[m].next UNTIL m = NullModuleIndex DO
	  mti ← mdb[m].mti;
          IF ~SourceBcd.IsTableCompiled[mti] THEN
	    BEGIN
	    ModuleSymbols.Load[mti ! ModuleSymbols.InvalidSymbols => LOOP];
	    stopEnumeration ← userProc[mti, m 
	      ! UNWIND => ModuleSymbols.Unload[]];
	    ModuleSymbols.Unload[];
	    IF stopEnumeration THEN SIGNAL DoneEnumeratingModules;
	    END
	  ELSE  -- table compiled: don't load symbol table 
	    IF userProc[mti, m] THEN SIGNAL DoneEnumeratingModules;
	  ENDLOOP;
	END;
      ENDCASE => CPerror[];
    END;

  AnyProcs: PUBLIC PROC [module: ModuleIndex] RETURNS [reply: BOOLEAN] =
    BEGIN  -- return TRUE if any procedures are specified by a ModuleRecord
    p: PackageSymbols.OPIndex;
    lastProc: PackageSymbols.OPIndex;
    reply ← FALSE;
    IF SourceBcd.IsTableCompiled[mdb[module].mti] THEN RETURN[FALSE];
    lastProc ← (LENGTH[ModuleSymbols.outerPackArray] - 1);
    WITH mdb[module] SELECT FROM
      allProcs => reply ← TRUE;
      someProcs => 
	FOR p IN [MAINProc..lastProc] DO
	  IF procIncluded[p] THEN {reply ← TRUE;  EXIT};
	  ENDLOOP;
      ENDCASE => CPerror[];
    RETURN[reply];
    END;

  EnumerateProcs: PUBLIC PROC [
      module: ModuleIndex, 
      userProc: PROC [proc: PackageSymbols.OPIndex] RETURNS [stop: BOOLEAN]] =
    BEGIN
    p: PackageSymbols.OPIndex;
    lastProc: PackageSymbols.OPIndex;
    IF SourceBcd.IsTableCompiled[mdb[module].mti] THEN RETURN;
    lastProc ← (LENGTH[ModuleSymbols.outerPackArray] - 1);
    WITH mdb[module] SELECT FROM
      allProcs => 
	BEGIN 
	IF includeMAIN THEN 
	  IF userProc[MAINProc] THEN RETURN;
	FOR p IN [(MAINProc+1)..lastProc] DO
	  IF userProc[p] THEN RETURN;
	  ENDLOOP;
	END;
      someProcs => 
	BEGIN
	FOR p IN [MAINProc..lastProc] DO
	  IF procIncluded[p] THEN
	    IF userProc[p] THEN RETURN;
	  ENDLOOP;
	END;
      ENDCASE => CPerror[];
    END;

  END.