-- file Pass3B.mesa
-- last modified by Satterthwaite, September 14, 1982 1:37 pm

DIRECTORY
  Alloc: TYPE USING [Notifier, AddNotify, DropNotify, Words],
  ComData: TYPE USING [
    definitionsOnly, importCtx, moduleCtx, objectStamp, outerCtx, table, textIndex, zone],
  Copier: TYPE USING [
    CreateFileTable, EnterFile, FillModule, SearchFileCtx, UnknownModule],
  LiteralOps: TYPE USING [StringValue],
  Log: TYPE USING [ErrorHti, ErrorSei, ErrorTree],
  OSMiscOps: TYPE USING [MergeStamps, TimeToStamp],
  P3: TYPE USING [
    Mark,
    EnterIdList, Exp, MakeIdTable, MakeFrameRecord, MakeRefType, 
    PopCtx, PushCtx, RAttr, RPop, RType, Shared],
  Strings: TYPE USING [String, SubString, SubStringDescriptor],
  Symbols: TYPE USING [
    Base, SERecord, CTXRecord, 
    HTIndex, ISEIndex, CSEIndex, CTXIndex, IncludedCTXIndex, MDIndex, CBTIndex,
    HTNull, ISENull, CTXNull, RootBti, BTNull, lG, OwnMdi, typeANY,
    seType, ctxType, mdType, bodyType],
  SymbolOps: TYPE USING [
    FillCtxSe, FirstCtxSe, LinkMode, MakeCtxSe, MakeNonCtxSe, NameClash,
    NewCtx, NextSe, SearchContext, UnderType],
  Tree: TYPE USING [Base, Index, Link, Map, Scan, Test, Null, NullIndex, treeType],
  TreeOps: TYPE USING [GetHash, GetNode, ListLength, ScanList, SearchList, UpdateList];

Pass3B: PROGRAM
    IMPORTS
      Alloc, Copier, LiteralOps, Log, OSMiscOps, P3, SymbolOps, TreeOps,
      dataPtr: ComData
    EXPORTS P3 = {
  OPEN TreeOps, SymbolOps, Symbols, P3;

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

  BCDNotify: Alloc.Notifier = {
    -- called by allocator whenever table area is repacked
    tb ← base[Tree.treeType];
    seb ← base[seType];  ctxb ← base[ctxType];  mdb ← base[mdType];
    bb ← base[bodyType]};

  GetSe: PROC [t: Tree.Link] RETURNS [ISEIndex] = {
    RETURN [WITH t SELECT FROM
      symbol => index,
      subtree => GetSe[tb[index].son[1]],
      ENDCASE => ERROR]};

  ItemLabel: PROC [node: Tree.Index] RETURNS [ISEIndex] = INLINE {
    RETURN [GetSe[tb[node].son[1]]]};

  MemberId: PROC [hti: HTIndex, list: Tree.Link] RETURNS [found: BOOLEAN ← FALSE] = {
  
    TestItem: Tree.Test = {
      RETURN [WITH t SELECT FROM
        hash => IF index = hti THEN (found ← TRUE) ELSE FALSE,
	subtree => TestItem[tb[index].son[1]],
	ENDCASE => FALSE]};
	
    SearchList[list, TestItem];
    RETURN};
    

 -- module header

   HashTest: TYPE = PROC [hti: HTIndex] RETURNS [BOOLEAN];
   
   
   Header: PUBLIC PROC [node: Tree.Index] = {
    
    TestShared: HashTest = {
      RETURN [MemberId[hti, tb[node].son[3]] OR MemberId[hti, tb[node].son[4]]]};
      
    (dataPtr.table).AddNotify[BCDNotify];
    Directory[directory: tb[node].son[1], shared: TestShared];
    ScanList[tb[node].son[4], Sharing];
    PushCtx[dataPtr.outerCtx];  PushCtx[dataPtr.moduleCtx];
    Interfaces[imports: tb[node].son[2], exports: tb[node].son[3]];
    PopCtx[];  PopCtx[];
    (dataPtr.table).DropNotify[BCDNotify]};


 -- directory processing

  Directory: PROC [directory: Tree.Link, shared: HashTest] = {
    nIdLists: CARDINAL;
    mdb[OwnMdi].moduleId ← seb[bb[RootBti].id].hash;
    nIdLists ← DirectoryScan[directory];
    MakeIdTable[nIdLists];
    DirectoryDecls[directory, shared]};


  MdiMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF MDIndex];
  mdiMap: LONG POINTER TO MdiMap;
  
  DirectoryScan: PROC [t: Tree.Link] RETURNS [nLists: CARDINAL ← 0] = {
    i: CARDINAL ← 0;
    
    FileEntry: Tree.Scan = {
      ss: Strings.SubStringDescriptor;
      s: Strings.SubString = @ss;
      node: Tree.Index = GetNode[t];
      formalId: HTIndex = seb[ItemLabel[node]].hash;
      typeId: HTIndex = WITH tb[node].son[2] SELECT FROM
	hash => index,
	ENDCASE => formalId;
      mdiMap[i] ← Copier.EnterFile[formalId, typeId, TreeStringValue[tb[node].son[2]]];
      i ← i + 1;
      IF tb[node].son[3] # Tree.Null THEN nLists ← nLists+1};

    n: CARDINAL = ListLength[t];
    Copier.CreateFileTable[n];
    mdiMap ← (dataPtr.zone).NEW[MdiMap[n]];
    ScanList[t, FileEntry];
    RETURN};

  TreeStringValue: PROC [t: Tree.Link] RETURNS [s: Strings.String] = {
    RETURN [WITH e:t SELECT FROM
      literal =>
	WITH e.info SELECT FROM
	  string => LiteralOps.StringValue[index],
	  ENDCASE => NIL,
      ENDCASE => NIL]};


  DirectoryDecls: PROC [directory: Tree.Link, shared: HashTest] = {
    i: CARDINAL ← 0;
    
    DirectoryItem: Tree.Scan = {
      node: Tree.Index = GetNode[t];
      sei: ISEIndex = ItemLabel[node];
      key: HTIndex = WITH tb[node].son[2] SELECT FROM
	hash => index,
	ENDCASE => seb[sei].hash;
      type: CSEIndex;
      ctx: CTXIndex;
      bti: CBTIndex;
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex ← tb[node].info;
      tb[node].attr2 ← tb[node].attr3 ← P3.Mark;
      Copier.FillModule[sei, key, mdiMap[i]
	  ! Copier.UnknownModule => {Log.ErrorHti[moduleId, hti]; RESUME}];
      type ← UnderType[seb[sei].idType];
      ctx ← WITH t: seb[type] SELECT FROM
	definition => t.defCtx,
	transfer => IF (bti←seb[sei].idInfo) # BTNull THEN bb[bti].localCtx ELSE CTXNull,
	ENDCASE => CTXNull;
      IF ctx # CTXNull THEN {
	WITH c: ctxb[ctx] SELECT FROM
	  included => {
	    dataPtr.objectStamp ← OSMiscOps.MergeStamps[
	      dataPtr.objectStamp, OSMiscOps.TimeToStamp[mdb[c.module].stamp]];
	    mdb[c.module].shared ← shared[seb[sei].hash]};
	  ENDCASE;
	tb[node].son[3] ← IncludedIds[ctx, tb[node].son[3]]};
      i ← i + 1;
      dataPtr.textIndex ← saveIndex};
    
    ScanList[directory, DirectoryItem];
    (dataPtr.zone).FREE[@mdiMap]};


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

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

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

	  sei ← SearchContext[hti, ctx];
	  IF sei = ISENull THEN {
	    [found, sei] ← Copier.SearchFileCtx[hti, includedCtx]; update ← found}
	  ELSE {
	    found ← TRUE;  update ← LinkMode[sei] = manifest;
	    duplicate ← FALSE;  SearchList[list, CheckDuplicate];
	    IF duplicate THEN Log.ErrorHti[duplicateId, hti]};
	  IF found THEN {
	    IF ~seb[sei].public AND ~Shared[includedCtx] THEN {
	      Log.ErrorHti[noAccess, hti];  seb[sei].public ← TRUE};
	    IF update THEN seb[sei].idCtx ← CTXNull;
	    v ← [symbol[index: sei]]}
	  ELSE {Log.ErrorHti[unknownId, hti]; v ← t}};
	ENDCASE => ERROR;
      RETURN};

    WITH c: ctxb[ctx] SELECT FROM
      included =>
	IF list # Tree.Null THEN {
	  includedCtx ← LOOPHOLE[ctx];
	  c.restricted ← TRUE;
	  val ← UpdateList[list, IncludedId];
	  EnterIdList[includedCtx, val]}
	ELSE val ← Tree.Null;
      ENDCASE => ERROR;
    RETURN};


  Sharing: Tree.Scan = {
    hti: HTIndex = GetHash[t];
    sei: ISEIndex = SearchContext[hti, dataPtr.moduleCtx];
    IF sei = ISENull THEN Log.ErrorHti[unknownId, hti]
    ELSE {
      type: CSEIndex = UnderType[seb[sei].idType];
      ctx: CTXIndex ← CTXNull;
      WITH seb[type] SELECT FROM
	definition => ctx ← defCtx;
	transfer =>
	  IF seb[sei].mark4 AND seb[sei].constant AND mode = program THEN
	    ctx ← bb[LOOPHOLE[seb[sei].idInfo, CBTIndex]].localCtx;
	ENDCASE;
      IF ctx = CTXNull AND type # typeANY THEN Log.ErrorHti[typeClash, hti]}};


  ImportType: PROC [mdi: MDIndex] RETURNS [CSEIndex] = {
    sei: ISEIndex;
    type: CSEIndex;
    FOR sei ← FirstCtxSe[dataPtr.moduleCtx], NextSe[sei] UNTIL sei = ISENull DO
      type ← UnderType[seb[sei].idType];
      WITH t: seb[type] SELECT FROM
	definition =>
	  WITH c: ctxb[t.defCtx] SELECT FROM
	    imported => IF ctxb[c.includeLink].module = mdi THEN GO TO Found;
	    ENDCASE;
	ENDCASE;
      REPEAT
	Found => NULL;
	FINISHED => {
	  sei ← MakeCtxSe[mdb[mdi].moduleId, CTXNull];
	  Copier.FillModule[sei, seb[sei].hash, mdi]};
      ENDLOOP;
    RETURN [UnderType[seb[sei].idType]]};


 -- import/export processing

  Interfaces: PROC [imports, exports: Tree.Link] = INLINE {
    ScanList[imports, ImportItem];
    ScanList[exports, ExportItem]};


  ImportItem: Tree.Scan = {
    node: Tree.Index = GetNode[t];
    sei: ISEIndex = ItemLabel[node];
    type, vType: CSEIndex;
    const: BOOLEAN;
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex ← tb[node].info;
    tb[node].attr2 ← tb[node].attr3 ← P3.Mark;
    tb[node].son[2] ← Exp[tb[node].son[2], typeANY];
    vType ← RType[];  const ← RAttr[].const;  RPop[];
    WITH v: seb[vType] SELECT FROM
      definition =>
	SELECT ctxb[v.defCtx].ctxType FROM
	  included => {
	    type ← ImportInstance[iType: vType, named: tb[node].attr1];
	    IF tb[node].attr1 AND dataPtr.definitionsOnly THEN Log.ErrorSei[nonDefinition, sei]};
	  ENDCASE => {type ← typeANY; Log.ErrorTree[notPortable, tb[node].son[2]]};
      transfer => {
	IF v.mode # program OR dataPtr.definitionsOnly THEN
	  Log.ErrorTree[notPortable, tb[node].son[2]];
	seb[sei].immutable ← TRUE;
	type ← MakeRefType[MakeFrameRecord[tb[node].son[2]], typeANY];
	const ← FALSE};
      ENDCASE => {
	IF vType # typeANY THEN Log.ErrorTree[typeClash, tb[node].son[2]];
	type ← typeANY};
    seb[sei].idType ← type;
    seb[sei].immutable ← TRUE; seb[sei].constant ← const; seb[sei].idInfo ← 1;
    seb[sei].mark3 ← TRUE;
    dataPtr.textIndex ← saveIndex};

  ImportInstance: PROC [iType: CSEIndex, named: BOOLEAN] RETURNS [type: CSEIndex] = {
    WITH t: seb[iType] SELECT FROM
      definition =>
	WITH c: ctxb[t.defCtx] SELECT FROM
	  included => {
	    ctx: CTXIndex = NewImportedCtx[LOOPHOLE[t.defCtx]];
	    type ← MakeNonCtxSe[SIZE[definition cons SERecord]];
	    seb[type] ← SERecord[mark3: TRUE, mark4: TRUE,
			    body: cons[definition[
			      nGfi: t.nGfi, named: named, defCtx: ctx]]];
	    IF ~named THEN mdb[c.module].defaultImport ← ctx};
	  ENDCASE => ERROR;
      ENDCASE => type ← typeANY;
    RETURN};

  NewImportedCtx: PROC [link: IncludedCTXIndex] RETURNS [ctx: CTXIndex] = {
    ctx ← (dataPtr.table).Words[ctxType, SIZE[imported CTXRecord]];
    ctxb[ctx] ← CTXRecord[
		    mark: FALSE,  varUpdated: FALSE,
		    seList: ISENull,
		    level: ctxb[link].level,
		    extension: imported[includeLink: link]];
    RETURN};


  ExportItem: Tree.Scan = {
    node: Tree.Index = GetNode[t];
    type: CSEIndex;
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex ← tb[node].info;
    tb[node].son[2] ← Exp[tb[node].son[2], typeANY];  type ← RType[];  RPop[];
    WITH d: seb[type] SELECT FROM
      definition => {
	WITH ctxb[d.defCtx] SELECT FROM
	  included => mdb[module].exported ← TRUE;
	  ENDCASE => Log.ErrorTree[notPortable, tb[node].son[2]]};
      ENDCASE => IF type # typeANY THEN Log.ErrorTree[typeClash, tb[node].son[2]];
    dataPtr.textIndex ← saveIndex};


  SetDefaultImport: PUBLIC PROC [iCtx: IncludedCTXIndex, implicitOK: BOOLEAN] = {
    mdi: MDIndex;
    (dataPtr.table).AddNotify[BCDNotify];
    mdi ← ctxb[iCtx].module;
    IF mdb[mdi].defaultImport = CTXNull THEN {
      sei: ISEIndex;
      type: CSEIndex;
      n: CARDINAL ← 0;
      IF dataPtr.importCtx = CTXNull THEN dataPtr.importCtx ← NewCtx[lG];
      FOR sei ← FirstCtxSe[dataPtr.importCtx], NextSe[sei] UNTIL sei = ISENull DO
	type ← UnderType[seb[sei].idType];
	WITH t: seb[type] SELECT FROM
	  definition =>
	    WITH c: ctxb[t.defCtx] SELECT FROM
	      imported =>
		IF ctxb[c.includeLink].module = mdi THEN {
		  mdb[mdi].defaultImport ← t.defCtx; n ← n+1};
	      ENDCASE;
	  ENDCASE;
	ENDLOOP;
      SELECT n FROM
	0 => {
	  IF ~implicitOK THEN Log.ErrorHti[missingImport, mdb[mdi].moduleId];
	  sei ← MakeCtxSe[HTNull, dataPtr.importCtx];
	  FillCtxSe[sei, mdb[mdi].moduleId, FALSE
		! NameClash => {Log.ErrorHti[missingImport, hti]; RESUME}];
	  seb[sei].immutable ← seb[sei].constant ← TRUE;
	  seb[sei].linkSpace ← seb[sei].extended ← FALSE;
	  seb[sei].idType ← ImportInstance[iType: ImportType[mdi], named:FALSE];
	  seb[sei].idInfo ← 1;  seb[sei].idValue ← Tree.NullIndex;
	  seb[sei].mark3 ← TRUE;  seb[sei].mark4 ← FALSE};
	1 => NULL;
	ENDCASE => Log.ErrorHti[missingImport, mdb[mdi].moduleId];
      IF mdb[mdi].defaultImport = CTXNull THEN mdb[mdi].defaultImport ← NewImportedCtx[iCtx]};
    (dataPtr.table).DropNotify[BCDNotify]};

  }.