-- CodePackProcsImpl.mesa  
--  Last edited by Lewis on  1-Mar-82 23:55:08
--  Last edited by Satterthwaite, January 12, 1983 11:46 am

DIRECTORY
  Alloc USING [AddNotify, DropNotify, Handle, Notifier, Words],
  BcdDefs USING [MTIndex, MTNull, NameRecord],
  CodePackProcs,
  Error USING [
    EmptyCodePack, Error, ErrorName, EVInDiscardCodePack, EVNotFirst,
    ModuleAlreadyPacked, NoProcFromModuleInCP, NotProcInModule,
    ProcNotPlaced, ProcPlacedTwice, TableCompModuleNotIncAsUnit],
  HashOps USING [HTIndex, SubStringForHash],
  Inline USING [BITAND, BITXOR],
  ModuleSymbols USING [InvalidSymbols, Load, Unload, outerPackArray, FindProc],
  PackagerDefs USING [
    globalData, GlobalData, packtreetype, packsttype, packmdtype],
  PackageSymbols USING [OPCatch, OPEntry, OPIndex, OPMain, OPNull],
  ProcessingOrder USING [Enumerate, IsEmpty],
  SemanticEntry USING [STIndex],
  SourceBcd USING [
    bcdBases, CTreeIndex, EnumerateModulesInConfig, IsTableCompiled,
    moduleCount, ModuleNum, ModuleNumForMti],
  String USING [SubString, SubStringDescriptor],
  Symbols USING [HTIndex, HTNull],
  SymbolOps USING [SubStringForHash],
  Table USING [Base, Index, Limit],
  Tree: FROM "PackTree" USING [Index, Link, ProcsLink, Scan, Test, nullIndex],
  TreeOps: FROM "PackTreeOps" USING [ListHead, ListLength, ScanList, SearchList];
 
CodePackProcsImpl: PROGRAM
    IMPORTS 
      Alloc, Error, HashOps, Inline, ModuleSymbols, PackagerDefs,
      ProcessingOrder, SymbolOps, SourceBcd, TreeOps
    EXPORTS CodePackProcs = 
  BEGIN  OPEN PackageSymbols, CodePackProcs;

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


  gd: PackagerDefs.GlobalData _ NIL;  -- set by Determine
  table: Alloc.Handle _ NIL;

  tb, stb, mdb: Table.Base;

  UpdateBases: Alloc.Notifier = {
    tb     _ base[PackagerDefs.packtreetype];  
    stb    _ base[PackagerDefs.packsttype];
    mdb    _ base[PackagerDefs.packmdtype]};

 -- *****************      Exported Types      *****************

  ModuleIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO ModuleRecord;
  nullModuleIndex: ModuleIndex = ModuleIndex.LAST;

  ModuleRecord: PUBLIC TYPE = MACHINE DEPENDENT RECORD [
    mti: BcdDefs.MTIndex,
    includeMAIN: BOOL,
    unused: [0..2),
    cp: Tree.Index,         -- code pack's parse tree node
    numWordPairsInProcArray: [1..4],  -- if someProcs variant
    next: ModuleIndex,     -- next module record in code pack's chain
    includeEV: BOOL,
    includeCatch: BOOL,
    link: ModuleIndex,     -- links module records with same id hash values
    unused2: [0..2),
    procDescription: SELECT kind: * FROM
      allProcs  => [],
      someProcs => [       -- up to PackageSymbols.MaxEntries procedures
        procIncluded: PACKED ARRAY [1..1) OF BOOL], 
      ENDCASE];

  MakeProcsLink: PROC [m: ModuleIndex] RETURNS [Tree.ProcsLink] = INLINE {
    RETURN [[literal[m]]]};
    
    
 -- ***************** Module Record Location and Creation *****************

  MRecHVSize: CARDINAL = 71;
  MRecHash: TYPE = [0..MRecHVSize);
  
  mRecHashVec: LONG POINTER TO MRecMap _ NIL;  -- MRecHash -> ModuleIndex
  MRecMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF ModuleIndex];

  InitModuleHashVector: PROC = {
    mRecHashVec _ gd.zone.NEW[MRecMap[MRecHVSize]];
    FOR i: MRecHash IN MRecHash DO mRecHashVec[i] _ nullModuleIndex ENDLOOP};

  ReleaseModuleHashVector: PROC = {
    IF mRecHashVec # NIL THEN gd.zone.FREE[@mRecHashVec]};

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

  HashValue: PROC [ss: String.SubString] RETURNS [MRecHash] = {
    CharMask: PROC [CHARACTER, WORD] RETURNS [CARDINAL] = LOOPHOLE[Inline.BITAND];
    mask: WORD = 137B;                -- masks out ASCII case shifts
    n: CARDINAL = ss.length;
    b: LONG 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]};


 -- 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] = {
    existingRec _ FindModuleRec[
      module: module, cpNode: cpNode, procs: procs, create: TRUE].m};

  LocateExistingModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index] 
      RETURNS [existingRec: ModuleIndex, found: BOOL] = {
    [existingRec, found] _ FindModuleRec[
      module: module, cpNode: cpNode, procs: some, create: FALSE]};

  FindModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index, procs: moduleRecKind,
        create: BOOL] 
      RETURNS [m: ModuleIndex, found: BOOL] = {
    mHash: MRecHash;
    hashChainHead, moduleChainHead: 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 { 
	-- set up new cache entry
	lastModule _ module;  lastCpNode _ cpNode;  lastModuleIndex _ m;  
	RETURN[m, TRUE]}; 
      ENDLOOP;
    IF ~create 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 
    -- add to code pack's module rec chain
        moduleChainHead _ NARROW[tb[cpNode].son[3], Tree.ProcsLink].index;
	IF moduleChainHead # nullModuleIndex THEN
	  mdb[m].next _ moduleChainHead;  
	tb[cpNode].son[3] _ MakeProcsLink[m];
    lastModule _ module;  lastCpNode _ cpNode;  lastModuleIndex _ m;
    RETURN[m, FALSE]};

  NewAllProcsModuleRec: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index, chainHead: ModuleIndex] 
      RETURNS [newRec: ModuleIndex] = {
    newRec _ table.Words[PackagerDefs.packmdtype, SIZE[allProcs ModuleRecord]];
    mdb[newRec] _ ModuleRecord[
      mti:          module, 
      includeMAIN:  FALSE, 
      unused:       0,
      cp:           cpNode, 
      numWordPairsInProcArray: 1,  -- (irrelevant for allProcs variant) 
      next:         nullModuleIndex, 
      includeEV:    FALSE, 
      includeCatch: FALSE, 
      link:         chainHead,
      unused2:      0, 
      procDescription: allProcs[]]};

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


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

  -- information about each procedure, and MAIN, ENTRY VECTOR, and CATCH CODE
  proc: LONG POINTER TO ProcMap _ NIL;
  ProcMap: TYPE = ARRAY PackageSymbols.OPIndex OF ProcData;
  ProcData: TYPE = RECORD [
    codePack: Tree.Index,  -- proc was placed if (containing) codePack # nullIndex
    mark: BOOL];        -- used during EXCEPT processing

  InitProcMap: PROC = {proc _ gd.zone.NEW[ProcMap]};

  ReleaseProcMap: PROC = {
    IF proc # NIL THEN gd.zone.FREE[@proc]};
    
  InsertProc: PROC [opi: PackageSymbols.OPIndex, m: ModuleIndex] = {
    SELECT opi FROM
      OPMain => 
        IF proc[OPMain].codePack # Tree.nullIndex --main already included-- THEN
          ReportProcIncludedTwice[
	    opi, mdb[m].mti, proc[OPMain].codePack, mdb[m].cp]
	ELSE {mdb[m].includeMAIN _ TRUE;  proc[OPMain].codePack _ mdb[m].cp};
      OPEntry => 
	IF proc[OPEntry].codePack # Tree.nullIndex THEN
	  ReportProcIncludedTwice[
	    opi, mdb[m].mti, proc[OPEntry].codePack, mdb[m].cp]
	ELSE {mdb[m].includeEV _ TRUE;  proc[OPEntry].codePack _ mdb[m].cp};
      OPCatch => 
	IF proc[OPCatch].codePack # Tree.nullIndex THEN
	  ReportProcIncludedTwice[
	    opi, mdb[m].mti, proc[OPCatch].codePack, mdb[m].cp]
	ELSE {mdb[m].includeCatch _ TRUE;  proc[OPCatch].codePack _ mdb[m].cp};
      ENDCASE => {
        IF opi = PackageSymbols.OPNull OR opi > lastOpi THEN CPerror[];
        WITH mdb[m] SELECT FROM
	  allProcs => 
	    ReportProcIncludedTwice[
	      opi, mdb[m].mti, proc[opi].codePack, mdb[m].cp];
	  someProcs => 
	    IF proc[opi].codePack # Tree.nullIndex THEN
	      ReportProcIncludedTwice[
	        opi, mdb[m].mti, proc[opi].codePack, mdb[m].cp]
	    ELSE {procIncluded[opi] _ TRUE;  proc[opi].codePack _ mdb[m].cp};
	  ENDCASE}};

  ReportProcIncludedTwice: PROC [
      opi: PackageSymbols.OPIndex, mti: BcdDefs.MTIndex,
      cpNode1, cpNode2: Tree.Index] = {
    procIdSS: String.SubString _ @procIdSSDesc;
    procIdSSDesc: String.SubStringDescriptor;
    cpId1, cpId2: HashOps.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]};

  SubStringForOPIndex: PUBLIC PROC [
      ss: String.SubString, opi: PackageSymbols.OPIndex] = {
    SELECT opi FROM
      OPMain  => {ss.base _ "MAIN";  ss.offset _ 0;  ss.length _ 4};
      OPEntry => {ss.base _ "ENTRY VECTOR";  ss.offset _ 0;  ss.length _ 12};
      OPCatch => {ss.base _ "CATCH CODE";  ss.offset _ 0;  ss.length _ 10};
      ENDCASE => {
        hti: Symbols.HTIndex = ModuleSymbols.outerPackArray[opi].hti;
        IF hti = Symbols.HTNull THEN {
	  ss.base _ "(unknown)";  ss.offset _ 0;  ss.length _ 9}
        ELSE SymbolOps.SubStringForHash[ss, hti]}};


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

  codePackProcsDetermined: BOOL _ FALSE;

  Determine: PUBLIC PROC [configTreeRoot: SourceBcd.CTreeIndex] = {
    ENABLE UNWIND => Destroy[];
    IF codePackProcsDetermined THEN CPerror[];
    gd _ PackagerDefs.globalData;
    table _ gd.ownTable;
    table.AddNotify[UpdateBases];
    InitModuleHashVector[];  InitProcMap[];
    PlaceProcedures[configTreeRoot];
    ValidatePackagingDesc[];
    codePackProcsDetermined _ TRUE};
  
  Destroy: PUBLIC PROC =  {
    ReleaseModuleHashVector[];  ReleaseProcMap[];
    IF table # NIL THEN {table.DropNotify[UpdateBases];  table _ NIL};
    gd _ NIL;
    codePackProcsDetermined _ FALSE};

  
  PlaceProcedures: PROC [configTreeRoot: SourceBcd.CTreeIndex] = INLINE { 
    SourceBcd.EnumerateModulesInConfig[
      kind: prototype,
      configTreeNode: configTreeRoot,
      userProc: PlaceOneModulesProcs]};
      
  lastOpi: PackageSymbols.OPIndex _ 0;
  hasCatchCode: BOOL _ TRUE;
  
  PlaceOneModulesProcs: PROC [module: BcdDefs.MTIndex] RETURNS [stop: BOOL] = { 

    PlaceOneCDNodesProcs: PROC [cdNode: Tree.Index] RETURNS [stop: BOOL] = {
      PlaceModulesProcsForOneCDNode[module, cdNode];  RETURN[FALSE]};
  
    IF ProcessingOrder.IsEmpty[module] THEN {
      name: BcdDefs.NameRecord = SourceBcd.bcdBases.mtb[module].name;
      Error.ErrorName[error, "was never placed in a code segment"L, name];
      RETURN[FALSE]};
    IF ~SourceBcd.IsTableCompiled[module] THEN {   -- load module's symbol table
      ModuleSymbols.Load[module
        ! ModuleSymbols.InvalidSymbols => GO TO badSymbols];
      BEGIN ENABLE UNWIND => ModuleSymbols.Unload[];
      lastOpi _ (LENGTH[ModuleSymbols.outerPackArray] - 2);
      hasCatchCode _ (ModuleSymbols.outerPackArray[lastOpi+1].length # 0);
      MarkProcsUnplaced[];
      ProcessingOrder.Enumerate[module, PlaceOneCDNodesProcs];
      VerifyProcsAllPlaced[module];
      ModuleSymbols.Unload[];
      END}
    ELSE {  -- table compiled: don't load symbols
      hasCatchCode _ FALSE;
      ProcessingOrder.Enumerate[module, PlaceOneCDNodesProcs]}; 
    RETURN[FALSE];
    EXITS
      badSymbols => {
	name: BcdDefs.NameRecord = SourceBcd.bcdBases.mtb[module].name;
	Error.ErrorName[error, "has invalid symbols"L, name];
	RETURN[FALSE]}};
  
  MarkProcsUnplaced: PROC =  {
    FOR opi: PackageSymbols.OPIndex IN PackageSymbols.OPIndex DO
      proc[opi] _ [codePack: Tree.nullIndex, mark: FALSE];
      ENDLOOP};
  
  VerifyProcsAllPlaced: PROC [module: BcdDefs.MTIndex] =  {

    NotPlaced: PROC [opi: PackageSymbols.OPIndex] = { 
      procIdSS: String.SubStringDescriptor;
      SubStringForOPIndex[@procIdSS, opi];
      Error.ProcNotPlaced[error, @procIdSS, module]};

    IF proc[OPMain].codePack = Tree.nullIndex THEN NotPlaced[OPMain];
    IF proc[OPEntry].codePack = Tree.nullIndex THEN NotPlaced[OPEntry];
    IF proc[OPCatch].codePack = Tree.nullIndex AND hasCatchCode THEN
      NotPlaced[OPCatch];
    FOR opi: PackageSymbols.OPIndex IN [1..lastOpi] DO
      IF proc[opi].codePack = Tree.nullIndex THEN NotPlaced[opi];
      ENDLOOP};
     
  PlaceModulesProcsForOneCDNode: PROC [
      module: BcdDefs.MTIndex, cdNode: Tree.Index] =  {
    saveIndex: CARDINAL = gd.textIndex;
    gd.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];
      mainOfPL, evOfPL, catchOfPL => PlaceMiscCodeForCD[module, cdNode];
      ENDCASE => CPerror[];
    gd.textIndex _ saveIndex};


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

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

  InsertWholeModule: PROC [module: BcdDefs.MTIndex, cpNode: Tree.Index] = {
    m: ModuleIndex;
    IF LocateExistingModuleRec[module, cpNode].found THEN {
      Error.ModuleAlreadyPacked[error, module];  
      RETURN};
    m _ EnterModuleRec[module: module, cpNode: cpNode, procs: all];
    IF ~SourceBcd.IsTableCompiled[module] THEN {
      IF ~tb[cpNode].attrs[$exceptMAIN] THEN InsertProc[OPMain, m];
      IF ~tb[cpNode].attrs[$exceptEV] THEN InsertProc[OPEntry, m];
      IF ~tb[cpNode].attrs[$exceptCatch] THEN InsertProc[OPCatch, m];
      FOR opi: PackageSymbols.OPIndex IN [1..lastOpi] DO
        proc[opi].codePack _ cpNode;
        ENDLOOP}};

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

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

    InsertOneProc: Tree.Scan = {
      WITH t SELECT FROM
        hash => {
          procId: HashOps.HTIndex = index;
          HashOps.SubStringForHash[procSS, procId];
          opi _ ModuleSymbols.FindProc[procSS];
	  IF opi = PackageSymbols.OPNull THEN
	    Error.NotProcInModule[error, procId, module]
	  ELSE InsertProc[opi, m]};
        subtree => {
          itemNode: Tree.Index = index;
	  SELECT tb[itemNode].name FROM
	    main => {
	      IF tb[cpNode].attrs[$exceptMAIN] THEN {
	        Error.Error[warning, "MAIN is included in a code pack for which EXCEPT[MAIN] was specified"L];
	        RETURN};
	      InsertProc[OPMain, m]};
	    ev => {
	      IF tb[cpNode].attrs[$exceptEV] THEN {
	        Error.Error[warning, "ENTRY VECTOR is included in a code pack for which EXCEPT[ENTRY VECTOR] was specified"L];
	        RETURN};
	      InsertProc[OPEntry, m]};
	    catch => {
	      IF tb[cpNode].attrs[$exceptCatch] THEN {
	        Error.Error[warning, "CATCH CODE is included in a code pack for which EXCEPT[CATCH CODE] was specified"L];
	        RETURN};
	      InsertProc[OPCatch, m]};
	    ENDCASE => CPerror[]};
        ENDCASE => CPerror[]};
  
    m _ EnterModuleRec[module: module, cpNode: cpNode, procs: some];
    TreeOps.ScanList[itemList, InsertOneProc]};


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

  ExcludeNamedProcsFromModule: PROC [
      module: BcdDefs.MTIndex, cpNode: Tree.Index, itemList: Tree.Link] = {
    m: ModuleIndex = EnterModuleRec[module: module, cpNode: cpNode, procs: some];

    RemoveMarkOfNamedProc: Tree.Scan = {
      WITH t SELECT FROM
        hash => {
          procId: HashOps.HTIndex = index;
          procSS: String.SubString _ @procSSDesc;
          procSSDesc: String.SubStringDescriptor;
          opi: PackageSymbols.OPIndex;
          HashOps.SubStringForHash[procSS, procId];
          opi _ ModuleSymbols.FindProc[procSS];
	  IF opi = PackageSymbols.OPNull THEN 
	    Error.NotProcInModule[error, procId, module]
	  ELSE WITH mdb[m] SELECT FROM
            someProcs => proc[opi].mark _ FALSE;
            ENDCASE};
        subtree => {
          itemNode: Tree.Index = index;
	  SELECT tb[itemNode].name FROM
	    main  => proc[OPMain].mark _ FALSE;
	    ev    => proc[OPEntry].mark _ FALSE;
	    catch => proc[OPCatch].mark _ FALSE;
	    ENDCASE => CPerror[]};
        ENDCASE => CPerror[]};
  
    MarkAllProcs[m];  -- then remove marks for those procs to exclude 
    IF tb[cpNode].attrs[$exceptMAIN] THEN proc[OPMain].mark _ FALSE;
    IF tb[cpNode].attrs[$exceptEV] THEN proc[OPEntry].mark _ FALSE;
    IF tb[cpNode].attrs[$exceptCatch] THEN proc[OPCatch].mark _ FALSE;
    TreeOps.ScanList[itemList, RemoveMarkOfNamedProc];
    InsertRemainingMarkedProcs[m]};

  MarkAllProcs: PROC [m: ModuleIndex] = {
    WITH mdb[m] SELECT FROM
      allProcs => Error.ModuleAlreadyPacked[error, mdb[m].mti];
      someProcs => {
        proc[OPMain].mark _ TRUE;
        proc[OPEntry].mark _ TRUE;
        proc[OPCatch].mark _ TRUE;
        FOR opi: PackageSymbols.OPIndex IN [1..lastOpi] DO
	  proc[opi].mark _ TRUE;
	  ENDLOOP};
      ENDCASE};

  InsertRemainingMarkedProcs: PROC [m: ModuleIndex] = {
    IF proc[OPMain].mark THEN InsertProc[OPMain, m];  -- wasn't excluded
    IF proc[OPEntry].mark THEN InsertProc[OPEntry, m];
    IF proc[OPCatch].mark THEN InsertProc[OPCatch, m];
    FOR opi: PackageSymbols.OPIndex IN [1..lastOpi] DO
      IF proc[opi].mark THEN InsertProc[opi, m];
      ENDLOOP};


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

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

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

    RemoveMarksOfProcsInOnePack: Tree.Scan = {
    
      RemoveMarkOfOneProc: PROC [opi: PackageSymbols.OPIndex] RETURNS [BOOL] = {
        proc[opi].mark _ FALSE;  RETURN[FALSE]};

      WITH t SELECT FROM
        symbol => {
          cpSE: SemanticEntry.STIndex = index;
	  oldMRec: ModuleIndex;
	  WITH stb[cpSE] SELECT FROM
	    codePack => {
              [oldMRec, found] _ LocateExistingModuleRec[
                module: module, cpNode: treeNode];
              IF found THEN  -- procs from module in old cp
                EnumerateProcs[oldMRec, RemoveMarkOfOneProc]};
            ENDCASE};
        ENDCASE => CPerror[]};
  
    IF SourceBcd.IsTableCompiled[module] THEN {
      [m, found] _ LocateExistingModuleRec[module: module, cpNode: cpNode];
      IF ~found THEN InsertWholeModule[module: module, cpNode: cpNode]
      ELSE Error.TableCompModuleNotIncAsUnit[error, module]}
    ELSE {
      m _ EnterModuleRec[module: module, cpNode: cpNode, procs: some];
      MarkAllProcs[m];  -- then remove marks for those procs to exclude 
      IF tb[cpNode].attrs[$exceptMAIN] THEN proc[OPMain].mark _ FALSE;
      IF tb[cpNode].attrs[$exceptEV] THEN proc[OPEntry].mark _ FALSE;
      IF tb[cpNode].attrs[$exceptCatch] THEN proc[OPCatch].mark _ FALSE;
      TreeOps.ScanList[packList, RemoveMarksOfProcsInOnePack];
      InsertRemainingMarkedProcs[m]}};


  PlaceItemsExceptPacksCDProcs: PROC [
      module: BcdDefs.MTIndex, cdNode: Tree.Index] = {
    -- ComponentDesc ::= Component [ItemList] EXCEPT PackList
    WITH tb[cdNode].son[1] SELECT FROM
      symbol => {
        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};
      ENDCASE => CPerror[]};


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

  IncludeProcsNotInPackNorItemLists: PROC [
      module: BcdDefs.MTIndex, cpNode: Tree.Index, 
      packList: Tree.Link, itemList: Tree.Link] = {
    -- include all procs not already in a code pack or in item list
    m: ModuleIndex = EnterModuleRec[module: module, cpNode: cpNode, procs: some];
    found: BOOL;

    RemoveMarksOfProcsInOnePack: Tree.Scan = {
    
      RemoveMarkOfOneProcInPack: PROC [
	  opi: PackageSymbols.OPIndex] RETURNS [stop: BOOL] = {
        proc[opi].mark _ FALSE;  RETURN[FALSE]};

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

    RemoveMarkOfOneProc: Tree.Scan = {
      WITH t SELECT FROM
        hash => {
          procId: HashOps.HTIndex = index;
	  procSS: String.SubString _ @procSSDesc;
	  procSSDesc: String.SubStringDescriptor;
	  opi: PackageSymbols.OPIndex;
          HashOps.SubStringForHash[procSS, procId];
          opi _ ModuleSymbols.FindProc[procSS];
	  IF opi = PackageSymbols.OPNull THEN
	    Error.NotProcInModule[error, procId, module]
	  ELSE proc[opi].mark _ FALSE};
        subtree => {
          itemNode: Tree.Index = index;
	  SELECT tb[itemNode].name FROM
	    main  => proc[OPMain].mark _ FALSE;
	    ev    => proc[OPEntry].mark _ FALSE;
	    catch => proc[OPCatch].mark _ FALSE;
	    ENDCASE => CPerror[]};
        ENDCASE => CPerror[]};
  
    MarkAllProcs[m];  -- then remove marks for those procs to exclude 
    IF tb[cpNode].attrs[$exceptMAIN] THEN proc[OPMain].mark _ FALSE;
    IF tb[cpNode].attrs[$exceptEV] THEN proc[OPEntry].mark _ FALSE;
    IF tb[cpNode].attrs[$exceptCatch] THEN proc[OPCatch].mark _ FALSE;
    TreeOps.ScanList[packList, RemoveMarksOfProcsInOnePack];
    TreeOps.ScanList[itemList, RemoveMarkOfOneProc];
    InsertRemainingMarkedProcs[m]};


--**** Place Module's Procedures For MAIN/ENTRY VECTOR/CATCH CODE OF CDs ****

  PlaceMiscCodeForCD: PROC [module: BcdDefs.MTIndex, cdNode: Tree.Index] = {
    -- ComponentDesc ::= MAIN OF PackList
    -- ComponentDesc ::= ENTRY VECTOR OF PackList
    -- ComponentDesc ::= CATCH CODE OF PackList
    -- add module's main proc/ev/catch code if any of its other procs in packlist 
    packList: Tree.Link = tb[cdNode].son[1];
    firstInList: Tree.Link;
    miscCodeOpi: PackageSymbols.OPIndex = 
      (SELECT tb[cdNode].name FROM
         mainOfPL => OPMain,
	 evOfPL   => OPEntry,
	 ENDCASE --catchOfPL-- => OPCatch);

    EnterMiscCodeIfOtherProcsInASegmentsPack: Tree.Test = {
      WITH t SELECT FROM
        subtree => {
          segsCpNode: Tree.Index = index;
	  inserted: BOOL = 
	    InsertMiscCodeIfOtherProcsInPack[
	      module: module, cpNode: tb[cdNode].cp, miscCodeOpi: miscCodeOpi,
	      existingCpNode: segsCpNode];
	  RETURN[inserted]};  -- stop enumeration if main/ev/catch code inserted
        ENDCASE => CPerror[];
      RETURN[FALSE]};

    EnterMiscCodeIfOtherProcsInOnePack: Tree.Test = {
      WITH t SELECT FROM
        symbol => {
          cpSE: SemanticEntry.STIndex = index;
	  WITH stb[cpSE] SELECT FROM
            codePack => { 
	      inserted: BOOL =
	        InsertMiscCodeIfOtherProcsInPack[
		  module: module, cpNode: tb[cdNode].cp, miscCodeOpi: miscCodeOpi, 
		  existingCpNode: treeNode];
	      RETURN[inserted]};  -- stop if main/ev/catch code inserted
            ENDCASE};
        ENDCASE => CPerror[];
      RETURN[FALSE]};

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

  InsertMiscCodeIfOtherProcsInPack: PROC [
        module: BcdDefs.MTIndex, cpNode: Tree.Index,
	miscCodeOpi: PackageSymbols.OPIndex, existingCpNode: Tree.Index] 
      RETURNS [inserted: BOOL] = {
    -- insert module's main/ev/catch code if it has other procs in existingCpNode
    existingMRec, newMRec: ModuleIndex;
    found: BOOL;
    [existingMRec, found] _ LocateExistingModuleRec[
      module: module, cpNode: existingCpNode];
    IF found THEN {
      newMRec _ EnterModuleRec[module: module, cpNode: cpNode, procs: some]; 
      InsertProc[miscCodeOpi, newMRec];
      RETURN[TRUE]}
    ELSE RETURN[FALSE]};


 --********* Validate packaging description ********* 
 --        For each code pack, check that
 --          (1) it is nonempty, and  
 --          (2) procedures were included from each module, and  
 --        For each module, check that
 --          (1) the entry vector precedes any procedure and catch code

  evPlaced: LONG POINTER TO EVPlacedMap _ NIL;  -- SourceBcd.ModuleNum -> BOOL
  EVPlacedMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF BOOL];

  ValidatePackagingDesc: PROC [] = {
    ENABLE UNWIND => ReleaseEVPlacedArray[];
    InitEVPlacedArray[];
    EnumerateSegments[CheckOneCodeSegment];
    ReleaseEVPlacedArray[]};
    
  InitEVPlacedArray: PROC = {
    evPlaced _ gd.zone.NEW[EVPlacedMap[SourceBcd.moduleCount]];
    FOR i: SourceBcd.ModuleNum IN [0..SourceBcd.moduleCount) DO
      evPlaced[i] _ FALSE;
      ENDLOOP};

  ReleaseEVPlacedArray: PROC = {
    IF evPlaced # NIL THEN gd.zone.FREE[@evPlaced]};

  CheckOneCodeSegment: PROC [segNode: Tree.Index] RETURNS [stop: BOOL] = {
    IF segNode # Tree.nullIndex THEN EnumerateCodePacks[segNode, CheckOneCodePack];
    RETURN[FALSE]};
  
  currentCPId: HashOps.HTIndex;
  cpEmpty, discardCP: BOOL;

  CheckOneCodePack: PROC [cpNode: Tree.Index] RETURNS [stop: BOOL] = {
    IF cpNode # Tree.nullIndex THEN {
      WITH tb[cpNode].son[1] SELECT FROM
	hash => currentCPId _ index;
	ENDCASE; 
      discardCP _ IsDiscardCodePack[cpNode];
      cpEmpty _ TRUE;
      EnumerateModules[cpNode, CheckOneCodePackModule];
      IF cpEmpty THEN Error.EmptyCodePack[error, currentCPId]};  
    RETURN[FALSE]}; 

  currentMti: BcdDefs.MTIndex;
  currentModuleNum: SourceBcd.ModuleNum;

  CheckOneCodePackModule: PROC [
        mti: BcdDefs.MTIndex, module: CodePackProcs.ModuleIndex] 
      RETURNS [stop: BOOL] = {
    IF SourceBcd.IsTableCompiled[mti] THEN cpEmpty _ FALSE
    ELSE
      IF AnyProcs[module] THEN {
        cpEmpty _ FALSE;
	currentMti _ mti;  currentModuleNum _ SourceBcd.ModuleNumForMti[mti];
	EnumerateProcs[module, CheckOneProc]}
      ELSE Error.NoProcFromModuleInCP[warning, mti, currentCPId];
    RETURN[FALSE]}; 

  CheckOneProc: PROC [opi: PackageSymbols.OPIndex] RETURNS [stop: BOOL] = {
    SELECT opi FROM
      OPEntry => {
        IF discardCP THEN {
	  Error.EVInDiscardCodePack[error, currentMti];
	  RETURN[TRUE]};
	evPlaced[currentModuleNum] _ TRUE};
      OPCatch =>
        IF hasCatchCode AND ~evPlaced[currentModuleNum] THEN {
	  Error.EVNotFirst[error, currentMti];
	  RETURN[TRUE]}; 
      ENDCASE =>
        IF ~evPlaced[currentModuleNum] THEN {
	  Error.EVNotFirst[error, currentMti];
	  RETURN[TRUE]}; 
    RETURN[FALSE]}; 


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

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

  SubStringForSegmentNode: PUBLIC PROC [
      ss: String.SubString, segNode: Tree.Index] = {
    WITH tb[segNode].son[1] SELECT FROM
      hash => {
	segmentHti: HashOps.HTIndex = index;
	HashOps.SubStringForHash[ss, segmentHti]};
      ENDCASE => CPerror[]};


  EnumerateCodePacks: PUBLIC PROC [
      segNode: Tree.Index, 
      userProc: PROC [cpNode: Tree.Index] RETURNS [stop: BOOL]] = {
    saveIndex: CARDINAL = gd.textIndex;

    OutputOneCodePack: Tree.Test = {
      WITH t SELECT FROM
        subtree => {
          cpNode: Tree.Index = index;
          SELECT tb[cpNode].name FROM
	    codePack, unnamedCodePack, discardCodePack => {
	      IF tb[cpNode].attrs[$superceded] THEN CPerror[]; 
	      IF userProc[cpNode] THEN RETURN[TRUE]}; -- stop enumeration
	    ENDCASE => CPerror[]};
        ENDCASE => CPerror[];
      RETURN[FALSE]};
  
    gd.textIndex _ tb[segNode].info;
    IF tb[segNode].attrs[$superceded] THEN CPerror[];
    TreeOps.SearchList[tb[segNode].son[2], OutputOneCodePack];
    gd.textIndex _ saveIndex};


  SubStringForCodePackNode: PUBLIC PROC [
      ss: String.SubString, cpNode: Tree.Index] = {
    WITH tb[cpNode].son[1] SELECT FROM
      hash => {
	codePackHti: HashOps.HTIndex = index;
	HashOps.SubStringForHash[ss, codePackHti]};
      ENDCASE => CPerror[]};

  HtiForCodePackNode: PUBLIC PROC [
      cpNode: Tree.Index] RETURNS [hti: HashOps.HTIndex] = {
    WITH tb[cpNode].son[1] SELECT FROM
      hash => {hti _ index; RETURN[hti]};
      ENDCASE => CPerror[]};

  IsDiscardCodePack: PUBLIC PROC [cpNode: Tree.Index] RETURNS [yes: BOOL] = {
    IF cpNode = Tree.nullIndex THEN CPerror[];
    RETURN[ tb[cpNode].name = discardCodePack ]};


  DoneEnumeratingModules: SIGNAL = CODE;

  EnumerateModules: PUBLIC PROC [
      cpNode: Tree.Index, 
      userProc: PROC [
        mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOL]] = {
    saveIndex: CARDINAL = gd.textIndex;
    gd.textIndex _ tb[cpNode].info;
    IF tb[cpNode].attrs[$superceded] THEN CPerror[]; -- code pack has been superceded
    OutputModules[
      cpNode: cpNode, userProc: userProc ! DoneEnumeratingModules => CONTINUE];
    gd.textIndex _ saveIndex};

  OutputModules: PROC [  -- called recursively when multiple layers of merging
      cpNode: Tree.Index, 
      userProc: PROC [
        mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOL]] = {
    SELECT tb[cpNode].name FROM
      codePack, unnamedCodePack, discardCodePack => {
        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]};
      ENDCASE => CPerror[]};

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

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

  OutputCodePackModules: PROC [
      moduleList: Tree.Link, 
      userProc: PROC [
      mti: BcdDefs.MTIndex, module: ModuleIndex] RETURNS [stop: BOOL]] = {
    moduleChainHead: ModuleIndex = NARROW[moduleList, Tree.ProcsLink].index;
    FOR m: ModuleIndex _ moduleChainHead, mdb[m].next UNTIL m = nullModuleIndex DO
      mti: BcdDefs.MTIndex = mdb[m].mti;
      stopEnumeration: BOOL;
      IF ~SourceBcd.IsTableCompiled[mti] THEN {
	ModuleSymbols.Load[mti ! ModuleSymbols.InvalidSymbols => LOOP];
	lastOpi _ (LENGTH[ModuleSymbols.outerPackArray] - 2);
	hasCatchCode _ (ModuleSymbols.outerPackArray[lastOpi+1].length # 0);
	stopEnumeration _ userProc[mti, m 
	      ! UNWIND => ModuleSymbols.Unload[]];
	ModuleSymbols.Unload[];
	IF stopEnumeration THEN SIGNAL DoneEnumeratingModules}
      ELSE {  -- table compiled: don't load symbol table 
	hasCatchCode _ FALSE;
	IF userProc[mti, m] THEN SIGNAL DoneEnumeratingModules};
      ENDLOOP};

  AnyProcs: PUBLIC PROC [module: ModuleIndex] RETURNS [reply: BOOL] = {
    -- return TRUE if any procedures are specified by a ModuleRecord
    IF SourceBcd.IsTableCompiled[mdb[module].mti] THEN RETURN[FALSE];
    IF mdb[module].includeMAIN THEN RETURN[TRUE];
    IF mdb[module].includeEV THEN RETURN[TRUE];
    IF mdb[module].includeCatch THEN RETURN[TRUE];
    WITH mdb[module] SELECT FROM
      allProcs => RETURN[TRUE];
      someProcs => 
	FOR p: PackageSymbols.OPIndex IN [1..lastOpi] DO
	  IF procIncluded[p] THEN RETURN[TRUE];
	  ENDLOOP;
      ENDCASE => CPerror[];
    RETURN[FALSE]};

  EnumerateProcs: PUBLIC PROC [
      module: ModuleIndex, 
      userProc: PROC [proc: PackageSymbols.OPIndex] RETURNS [stop: BOOL]] = {
    IF SourceBcd.IsTableCompiled[mdb[module].mti] THEN RETURN;
    IF mdb[module].includeEV THEN IF userProc[OPEntry] THEN RETURN;
    IF mdb[module].includeMAIN THEN IF userProc[OPMain] THEN RETURN;
    WITH mdb[module] SELECT FROM
      allProcs => { 
	FOR p: PackageSymbols.OPIndex IN [1..lastOpi] DO
	  IF userProc[p] THEN RETURN;
	  ENDLOOP};
      someProcs => {
        FOR p: PackageSymbols.OPIndex IN [1..lastOpi] DO
	  IF procIncluded[p] THEN IF userProc[p] THEN RETURN;
	  ENDLOOP};
      ENDCASE => CPerror[];
    IF mdb[module].includeCatch THEN [] _ userProc[OPCatch]};

  END.