-- file Pass3B.Mesa
-- last modified by Satterthwaite, October 7, 1979  2:57 PM

DIRECTORY
  ComData: FROM "comdata" USING [definitionsOnly, textIndex],
  Copier: FROM "copier"
    USING [
      CreateFileTable, EnterFile, FillModule, LocateTables, SearchFileCtx,
      UnknownModule],
  LiteralOps: FROM "literalops" USING [StringValue],
  Log: FROM "log" USING [ErrorHti, ErrorSei, ErrorTree],
  P3: FROM "p3"
    USING [
      Mark,
      EnterIdList, Exp, MakeIdTable, MakeFrameRecord,
      MakePointerType, RAttr, RPop, RType],
  Symbols: FROM "symbols"
    USING [seType, ctxType, mdType, bodyType,
      SERecord, CTXRecord, 
      HTIndex, ISEIndex, CSEIndex, CTXIndex, IncludedCTXIndex, CBTIndex,
      ISENull, CTXNull, BTNull, OwnMdi, typeANY],
  SymbolOps: FROM "symbolops"
    USING [LinkMode, MakeNonCtxSe, SearchContext, UnderType],
  SymbolTable: FROM "symboltable" USING [SetCacheSize, CacheSize],
  Table: FROM "table" USING [Base, Notifier, AddNotify, Allocate, DropNotify],
  Tree: FROM "tree" USING [Index, Link, Map, Null, Scan, Test, treeType],
  TreeOps: FROM "treeops"
    USING [GetNode, ListLength, ScanList, SearchList, UpdateList];

Pass3B: PROGRAM
    IMPORTS
	Copier, LiteralOps, Log, P3, SymbolTable, SymbolOps, Table, TreeOps,
	dataPtr: ComData
    EXPORTS P3 =
  BEGIN
  OPEN TreeOps, SymbolOps, Symbols, P3;

  tb: Table.Base;	-- tree base address (local copy)
  seb: Table.Base;	-- se table base address (local copy)
  ctxb: Table.Base;	-- context table base address (local copy)
  mdb: Table.Base;	-- module table base address (local copy)
  bb: Table.Base;	-- body table base address (local copy)

  BCDNotify: Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    tb _ base[Tree.treeType];
    seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
    bb _ base[bodyType];
    END;


 -- directory processing

  Directory: PUBLIC Tree.Scan =
    BEGIN
    nIdLists: CARDINAL;
    Table.AddNotify[BCDNotify];
    nIdLists _ DirectoryScan[t];
    MakeIdTable[nIdLists];
    ScanList[t, DirectoryItem];
    Table.DropNotify[BCDNotify];
    END;


  DirectoryScan: PROCEDURE [t: Tree.Link] RETURNS [nLists: CARDINAL] =
    BEGIN

    FileEntry: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      id: HTIndex = WITH tb[node].son[1] SELECT FROM
	symbol =>  seb[index].hash,
	ENDCASE => ERROR;
      [] _ Copier.EnterFile[id, TreeStringValue[tb[node].son[2]]];
      IF tb[node].son[3] # Tree.Null THEN  nLists _ nLists+1;
      END;

    n: CARDINAL = ListLength[t];
    nLists _ 0;
    Copier.CreateFileTable[n];
    IF n # 0 THEN BEGIN ScanList[t, FileEntry]; Copier.LocateTables[n] END;
    RETURN
    END;

  TreeStringValue: PROCEDURE [t: Tree.Link] RETURNS [STRING] =
    BEGIN
    WITH e:t SELECT FROM
      literal =>
	WITH e.info SELECT FROM
	  string => RETURN [LiteralOps.StringValue[index]];
	  ENDCASE;
      ENDCASE;
    ERROR
    END;


  DirectoryItem: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveSize: CARDINAL = SymbolTable.CacheSize[];
    dataPtr.textIndex _ tb[node].info;
    -- clear the symbol cache
      SymbolTable.SetCacheSize[0];
      SymbolTable.SetCacheSize[256];
    tb[node].attr2 _ tb[node].attr3 _ P3.Mark;
    WITH id: tb[node].son[1] SELECT FROM
      symbol =>
	BEGIN
	sei: ISEIndex = id.index;
	type: CSEIndex;
	bti: CBTIndex;
	Copier.FillModule[sei
		! Copier.UnknownModule =>
		   BEGIN  Log.ErrorHti[moduleId, hti];  RESUME  END];
	type _ UnderType[seb[sei].idType];
	WITH seb[type] SELECT FROM
	  definition =>
	    tb[node].son[3] _ IncludedIds[defCtx, tb[node].son[3]];
	  transfer =>
	    IF (bti _ seb[sei].idInfo) # BTNull THEN
	      tb[node].son[3] _IncludedIds[bb[bti].localCtx, tb[node].son[3]];
	  ENDCASE => NULL;
	END;
      ENDCASE => ERROR;
    -- restore symbol caching
      SymbolTable.SetCacheSize[saveSize];
    dataPtr.textIndex _ saveIndex;
    END;


  IncludedIds: PROCEDURE [ctx: CTXIndex, list: Tree.Link] RETURNS [val: Tree.Link] =
    BEGIN
    includedCtx: IncludedCTXIndex;

    IncludedId: Tree.Map =
      BEGIN
      WITH t SELECT FROM
	hash =>
	  BEGIN
	  hti: HTIndex = index;
	  sei: ISEIndex;
	  found, duplicate, update: BOOLEAN;

	  CheckDuplicate: Tree.Test =
	    BEGIN
	    RETURN [WITH t SELECT FROM
	      symbol => IF index = sei THEN ~(duplicate _ TRUE) ELSE TRUE,
	      ENDCASE => FALSE];
	    END;

	  sei _ SearchContext[hti, ctx];
	  IF sei = ISENull
	    THEN
	      BEGIN
	      [found, sei] _ Copier.SearchFileCtx[hti, includedCtx];
	      update _ found;
	      END
	    ELSE
	      BEGIN
	      found _ TRUE;  update _ LinkMode[sei] = manifest;
	      duplicate _ FALSE;  SearchList[list, CheckDuplicate];
	      IF duplicate THEN Log.ErrorHti[duplicateId, hti]
	      END;
	  IF found
	    THEN
	      BEGIN
	      IF update THEN seb[sei].idCtx _ CTXNull;
	      v _ [symbol[index: sei]];
	      END
	    ELSE  BEGIN Log.ErrorHti[unknownId, hti]; v _ t END;
	  END;
	ENDCASE => ERROR;
      RETURN
      END;

    WITH c: ctxb[ctx] SELECT FROM
      included =>
	IF list # Tree.Null
	  THEN
	    BEGIN  includedCtx _ LOOPHOLE[ctx];
	    c.restricted _ TRUE;
	    mdb[c.module].shared _ TRUE;
	    val _ UpdateList[list, IncludedId];
	    mdb[c.module].shared _ FALSE;
	    EnterIdList[includedCtx, val];
	    END
	  ELSE  val _ Tree.Null;
      ENDCASE => ERROR;
    RETURN
    END;


 -- import/export processing

  ModulePrefix: PUBLIC Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    Table.AddNotify[BCDNotify];
    ScanList[tb[node].son[1], ImportItem];
    tb[node].son[2] _ UpdateList[tb[node].son[2], ExportId];
    ScanList[tb[node].son[3], Sharing];
      BEGIN  -- fix up OwnMdi entry
      subNode: Tree.Index = GetNode[tb[node].son[5]];
      mdb[OwnMdi].moduleId _ WITH tb[subNode].son[1] SELECT FROM
	symbol =>  seb[index].hash,
	ENDCASE => ERROR;
      END;
    Table.DropNotify[BCDNotify];
    END;


  ImportItem: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    sei: ISEIndex;
    type, vType: CSEIndex;
    ctx: CTXIndex;
    includedCtx: IncludedCTXIndex;
    const: BOOLEAN;
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex _ tb[node].info;
    tb[node].attr2 _ tb[node].attr3 _ P3.Mark;
    sei _ WITH tb[node].son[1] SELECT FROM symbol => index, ENDCASE => ERROR;
    tb[node].son[2] _ Exp[tb[node].son[2], typeANY];
    vType _ RType[];  const _ RAttr[].const;  RPop[];
    WITH v: seb[vType] SELECT FROM
      definition =>
	WITH c: ctxb[v.defCtx] SELECT FROM
	  included =>
	    BEGIN
	    includedCtx _ LOOPHOLE[v.defCtx];
	    ctx _ Table.Allocate[ctxType, SIZE[imported CTXRecord]];
	    ctxb[ctx] _ CTXRecord[
			    mark: FALSE,
			    varUpdated: FALSE,
			    seList: ISENull,
			    level: c.level,
			    extension: imported[includeLink: includedCtx]];
	    type _ MakeNonCtxSe[SIZE[definition cons SERecord]];
	    seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
			    body: cons[definition[
			      nGfi: v.nGfi,
			      named: tb[node].attr1,
			      defCtx: ctx]]];
	    IF ~tb[node].attr1
	      THEN mdb[c.module].defaultImport _ ctx
	      ELSE
		IF dataPtr.definitionsOnly
		  THEN Log.ErrorSei[nonDefinition, sei];
	    END;
	  ENDCASE => 
	    BEGIN
	    type _ typeANY;  Log.ErrorTree[notPortable, tb[node].son[2]];
	    END;
      transfer => 
	BEGIN
	IF v.mode # program OR dataPtr.definitionsOnly
	  THEN Log.ErrorTree[notPortable, tb[node].son[2]];
	seb[sei].immutable _ TRUE;
	type _ MakePointerType[MakeFrameRecord[tb[node].son[2]], typeANY];
	const _ FALSE;
	END;
      ENDCASE =>
	BEGIN
	IF vType # typeANY THEN Log.ErrorTree[typeClash, tb[node].son[2]];
	type _ typeANY;
	END;
    seb[sei].idType _ type;
    seb[sei].immutable _ TRUE; seb[sei].constant _ const; seb[sei].idInfo _ 1;
    seb[sei].mark3 _ TRUE;
    dataPtr.textIndex _ saveIndex;
    END;

  ExportId: Tree.Map =
    BEGIN
    type: CSEIndex;
    v _ Exp[t, typeANY];  type _ RType[];  RPop[];
    WITH d: seb[type] SELECT FROM
      definition =>
	BEGIN
	WITH ctxb[d.defCtx] SELECT FROM
	  included => mdb[module].exported _ TRUE;
	  ENDCASE => Log.ErrorTree[notPortable, v];
	END;
      ENDCASE =>  IF type # typeANY THEN Log.ErrorTree[typeClash, v];
    RETURN
    END;


  Sharing: Tree.Scan =
    BEGIN
    v: Tree.Link = Exp[t, typeANY];
    type: CSEIndex = RType[];
    ctx: CTXIndex;
    sei: ISEIndex;
    ctx _ CTXNull;
    WITH seb[type] SELECT FROM
      definition =>  ctx _ defCtx;
      transfer =>
	WITH v SELECT FROM
	  symbol =>
	    BEGIN  sei _ index;
	    IF seb[sei].mark4 AND seb[sei].constant AND mode = program
	      THEN ctx _ bb[LOOPHOLE[seb[sei].idInfo, CBTIndex]].localCtx;
	    END;
	  ENDCASE;
      ENDCASE;
    IF ctx # CTXNull
      THEN
	WITH ctxb[ctx] SELECT FROM
	  included => mdb[module].shared _ TRUE;
	  ENDCASE
      ELSE IF type # typeANY THEN Log.ErrorTree[typeClash, v];
    RPop[];
    END;

  END.