-- file Pass3B.mesa
-- last modified by Satterthwaite, February 24, 1983 1:04 pm

DIRECTORY
  Alloc: TYPE USING [Notifier, AddNotify, DropNotify, Words],
  ComData: TYPE USING [
    importCtx, interface, moduleCtx, objectStamp, outerCtx, table, textIndex, zone],
  Copier: TYPE USING [
    CreateFileTable, EnterFile, FillModule, SearchFileCtx, UnknownModule],
  LiteralOps: TYPE USING [StringIndex, 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, 
    Name, ISEIndex, CSEIndex, CTXIndex, IncludedCTXIndex, MDIndex, CBTIndex,
    nullName, 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 [name: Name, list: Tree.Link] RETURNS [found: BOOL_FALSE] = {
  
    TestItem: Tree.Test = {
      RETURN [WITH t SELECT FROM
        hash => IF index = name THEN (found _ TRUE) ELSE FALSE,
	subtree => TestItem[tb[index].son[1]],
	ENDCASE => FALSE]};
	
    SearchList[list, TestItem];
    RETURN};
    

 -- module header

   HashTest: TYPE = PROC [name: Name] RETURNS [BOOL];
   
   
   Header: PUBLIC PROC [node: Tree.Index] = {
    
    TestShared: HashTest = {
      RETURN [MemberId[name, tb[node].son[3]] OR MemberId[name, 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: Name = seb[ItemLabel[node]].hash;
      typeId: Name = 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 [Strings.String] = {
    RETURN [WITH t SELECT FROM
      s: Tree.Link.literal => LiteralOps.StringValue[LiteralOps.StringIndex[s.index]],
      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: Name = 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, name]; 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 => {
	  name: Name = index;
	  sei: ISEIndex;
	  found, duplicate, update: BOOL;

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

	  sei _ SearchContext[name, ctx];
	  IF sei = ISENull THEN {
	    [found, sei] _ Copier.SearchFileCtx[name, includedCtx]; update _ found}
	  ELSE {
	    found _ TRUE;  update _ LinkMode[sei] = manifest;
	    duplicate _ FALSE;  SearchList[list, CheckDuplicate];
	    IF duplicate THEN Log.ErrorHti[duplicateId, name]};
	  IF found THEN {
	    IF ~seb[sei].public AND ~Shared[includedCtx] THEN {
	      Log.ErrorHti[noAccess, name];  seb[sei].public _ TRUE};
	    IF update THEN seb[sei].idCtx _ CTXNull;
	    v _ [symbol[index: sei]]}
	  ELSE {Log.ErrorHti[unknownId, name]; 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 = {
    name: Name = GetHash[t];
    sei: ISEIndex = SearchContext[name, dataPtr.moduleCtx];
    IF sei = ISENull THEN Log.ErrorHti[unknownId, name]
    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, name]}};


  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: BOOL;
    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 _ UnderType[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.interface THEN Log.ErrorSei[nonDefinition, sei]};
	  ENDCASE => {type _ typeANY; Log.ErrorTree[notPortable, tb[node].son[2]]};
      transfer => {
	IF v.mode # program OR dataPtr.interface 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: BOOL] 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[SERecord.cons.definition.SIZE];
	    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, CTXRecord.imported.SIZE];
    ctxb[ctx] _ CTXRecord[
		    rePainted: 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 _ UnderType[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: BOOL] = {
    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[nullName, dataPtr.importCtx];
	  FillCtxSe[sei, mdb[mdi].moduleId, FALSE
		! NameClash => {Log.ErrorHti[missingImport, name]; 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]};

  }.