-- file Pass4B.Mesa
-- last modified by Satterthwaite, July 27, 1983 4:23 pm
-- last modified by Sweet, Jan 20, 1981 12:32 PM

DIRECTORY
  Alloc: TYPE USING [Notifier, Top],
  BcdDefs: TYPE USING [
    BCD, CodeDesc, EPIndex, EVIndex, EVRecord, EXPRecord, FTIndex, FTRecord,
    GFTIndex, IMPIndex, IMPRecord, Link, LFIndex, MTRecord, Namee, NameRecord,
    NTRecord, PackedString, RefLitIndex, RFIndex, SGIndex, SGRecord, TFIndex, TMRecord,
    TypeIndex, TYPIndex, TYPRecord, VarIndex, VersionID,
    CTNull, EVNull, FTSelf, LFNull, RFNull, TFNull, NullLink, NullName],
  BcdOps: TYPE USING [BcdBase, EVHandle, NameString],
  ComData: TYPE USING [
    bcdSeg, codeSeg, compilerVersion, fixupLoc, importCtx, interface, linkCount,
    mainCtx, moduleCtx, mtRoot, mtRootSize, nBodies, nSigCodes, objectVersion,
    ownSymbols, pattern, source, switches, symSeg, table, textIndex],
  CompilerUtil: TYPE USING [
    AppendBCDString, AppendBCDWord, AppendBCDWords, EndBCD, FillBCDPage,
    ReadBCDIndex, ReadBCDOffset, RTTableOut, StartBCD, UpdateBCDWords],
  Copier: TYPE USING [FreeSymbolTable, GetSymbolTable, MapSymbols, UnmapSymbols],
  Environment: TYPE USING [wordsPerPage],
  Log: TYPE USING [ErrorN, ErrorSei, WarningSei, WarningSubString],
  P4: TYPE USING [ownGfi, DefaultBasicOps, OperandType],
  Pass4: TYPE USING [resident],
  PrincOps: TYPE USING [MaxNGfi],
  ReplOps: TYPE USING [MatchedBodies, Unmatched],
  Strings: TYPE USING [
    SubString, SubStringDescriptor,
    AppendChar, AppendString, AppendSubString, EqualSubStrings, EquivalentSubStrings],
  Symbols: TYPE USING [
    bodyType, ctxType, mdType, seType,
    Base, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
    IncludedCTXIndex, BitAddress, Linkage, MDRecord, MDIndex, BTIndex,
    nullName, ISENull, CTXNull, MDNull, BTNull, nullFileIndex,
    OwnMdi, RootBti, typeTYPE],
  SymbolOps: TYPE USING [
    FindString, FirstCtxSe, NextSe, SearchContext, SubStringForName,
    TypeForm, UnderType, XferMode],
  SymbolTable: TYPE USING [Base],
  SymLiteralOps: TYPE USING [
    RefLitItem,
    DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes,
    UTypeId, TypeIndex],
  Tree: TYPE USING [Base, Index, Link, Map, Scan, NullIndex, treeType],
  TreeOps: TYPE USING [GetNode, GetSe, ListLength, ScanList],
  Types: TYPE USING [SymbolTableBase, Assignable, Equivalent];
  
Pass4B: PROGRAM
    IMPORTS
      Alloc, CompilerUtil, Copier, Log, P4, ReplOps, Strings,
      SymbolOps, SymLiteralOps, TreeOps, Types,
      dataPtr: ComData, passPtr: Pass4
    EXPORTS P4 = {
  OPEN SymbolOps, Symbols;
  
  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;	-- body table base address (local copy)
  bb: Symbols.Base;	-- body table base address (local copy)
  
  zone: UNCOUNTED ZONE ← NIL;
  
  ZoneWords: PROC [n: CARDINAL] RETURNS [LONG POINTER] = {
    WordSeq: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF WORD];
    RETURN [zone.NEW[WordSeq[n]]]};
    
  FreeZoneWords: PROC [p: LONG POINTER] = INLINE {zone.FREE[@p]};
  

  BCDNotify: PUBLIC 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]};
    
    
-- shared variables

  bcdHeader: BcdOps.BcdBase;
  BcdHeaderPage: CARDINAL = 1;		-- page 0 is reserved
  bcdOffset, mtOffset: CARDINAL;
  
  nString: BcdOps.NameString;
  
  firstPorted: MDIndex = MDIndex.FIRST + MDRecord.SIZE;
  lastPorted: MDIndex;	-- im/exported files in [firstPorted..lastPorted)
  
-- service routines

  GFTIndex: TYPE = BcdDefs.GFTIndex;
  EPIndex: TYPE = BcdDefs.EPIndex;
  EPLimit: CARDINAL = EPIndex.LAST+1;
  VarLimit: CARDINAL = BcdDefs.VarIndex.LAST+1;
  BcdLink: TYPE = BcdDefs.Link;
  
  ownGfi: GFTIndex = P4.ownGfi;
  
  
  GFSlots: PROC [epMax: EPIndex] RETURNS [nGfi: [1..4]] = {
    nGfi ← epMax/EPLimit + 1; RETURN};
    
  MakeEPLink: PUBLIC PROC [ep: CARDINAL, gfi: GFTIndex] RETURNS [BcdLink] = {
    RETURN [[procedure[tag: TRUE, ep: ep MOD EPLimit, gfi: gfi + ep/EPLimit]]]};
    
  MakeFrameLink: PROC [ep: CARDINAL, gfi: GFTIndex] RETURNS [BcdLink] = {
    RETURN [[variable[vtag: var, var: ep MOD VarLimit, vgfi: gfi + ep/VarLimit]]]};
    
  MakeTypeLink: PROC [index: BcdDefs.TYPIndex] RETURNS [BcdLink] = INLINE {
    RETURN [[type[typeID: index, type: TRUE, proc: FALSE]]]};
    
    
  MdiForCtx: PROC [ctx: CTXIndex] RETURNS [MDIndex] = {
    RETURN [WITH c: ctxb[ctx] SELECT FROM
      included => c.module,
      imported => ctxb[c.includeLink].module,
      ENDCASE => OwnMdi]};
      
  PortedCtx: PROC [ctx: CTXIndex] RETURNS [BcdDefs.FTIndex] = {
    RETURN [PortedFile[MdiForCtx[ctx]]]};
      
  PortedFile: PROC [mdi: MDIndex] RETURNS [fti: BcdDefs.FTIndex] = {
    n: CARDINAL;
    IF mdi = OwnMdi THEN fti ← BcdDefs.FTSelf
    ELSE {
      IF mdi IN [firstPorted .. lastPorted) THEN
        n ← LOOPHOLE[mdi-firstPorted, CARDINAL]/MDRecord.SIZE
      ELSE {
	n ← LOOPHOLE[lastPorted-firstPorted, CARDINAL]/MDRecord.SIZE;
	SwapMdi[mdi, lastPorted];
	lastPorted ← lastPorted + MDRecord.SIZE};
      fti ← LOOPHOLE[n*BcdDefs.FTRecord.SIZE]};
    RETURN};
    
  SwapMdi: PROC [mdi1, mdi2: MDIndex] = {
    IF mdi1 # mdi2 THEN {
      ctx: IncludedCTXIndex;
      t: MDRecord;
      FOR ctx ← mdb[mdi1].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
	ctxb[ctx].module ← mdi2 ENDLOOP;
      FOR ctx ← mdb[mdi2].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
	ctxb[ctx].module ← mdi1 ENDLOOP;
      t ← mdb[mdi1];  mdb[mdi1] ← mdb[mdi2];  mdb[mdi2] ← t}};
	
	
  SubString: TYPE = Strings.SubString;
  SubStringDescriptor: TYPE = Strings.SubStringDescriptor;
  
  EnterId: PROC [id: SubString, ignoreCase: BOOL] RETURNS [BcdDefs.NameRecord] = {
    i: CARDINAL;
    desc: SubStringDescriptor;
    s: SubString = @desc;
    i ← 0;  s.base ← @nString.string;
    UNTIL i = nString.string.length DO
      s.offset ← i ← i+1;  s.length ← nString.size[i];
      IF (IF ignoreCase
	    THEN Strings.EquivalentSubStrings[id, s]
	    ELSE Strings.EqualSubStrings[id, s]) THEN EXIT;
      i ← i + s.length;
      REPEAT
	FINISHED => {
	  IF nString.string.length + (id.length+1) > nString.string.maxlength THEN {
	    -- rewrite if nString is in table area
	    t: BcdOps.NameString ← LOOPHOLE[
	      zone.NEW[StringBody[nString.string.maxlength + MAX[(id.length+1), 32]]]];
	    Strings.AppendString[@t.string, @nString.string];
	    zone.FREE[@nString];  nString ← t};
	  i ← nString.string.length ← nString.string.length + 1;
	  nString.size[i] ← id.length;
	  FOR j: CARDINAL IN [0..id.length) DO
	    Strings.AppendChar[@nString.string, id.base[id.offset+j]] ENDLOOP};
      ENDLOOP;
    RETURN [[i]]};
    
  EnterSymbolId: PROC [sei: ISEIndex] RETURNS [BcdDefs.NameRecord] = {
    s: Strings.SubStringDescriptor;
    SubStringForName[@s, seb[sei].hash];
    RETURN [EnterId[@s, FALSE]]};
    
  EnterFileId: PROC [mdi: MDIndex] RETURNS [BcdDefs.NameRecord] = {
    s: Strings.SubStringDescriptor;
    extLength: CARDINAL = (".bcd"L).length;
    SubStringForName[@s, mdb[mdi].fileId];
    IF s.base[s.offset+s.length-1] = '. THEN s.length ← s.length - 1;
    IF s.length > extLength THEN {
      t: Strings.SubStringDescriptor ← [
        base: s.base, offset: s.offset+s.length-extLength, length: extLength];
      ext: Strings.SubStringDescriptor ← [base:".bcd"L, offset:0, length:extLength];
      IF Strings.EquivalentSubStrings[@t, @ext] THEN s.length ← s.length - extLength};
    RETURN [EnterId[@s, TRUE]]};
    
    
-- processing directory entries (to file table)

  ProcessDirectory: PUBLIC Tree.Scan = {

    DirectoryItem: Tree.Scan = {
      node: Tree.Index = TreeOps.GetNode[t];
      sei: ISEIndex = TreeOps.GetSe[tb[node].son[1]];
      type: CSEIndex = UnderType[seb[sei].idType];
      WITH t: seb[type] SELECT FROM
	definition => [] ← PortedCtx[t.defCtx];
	transfer => {
	  bti: BTIndex = seb[sei].idInfo;
	  IF bti # BTNull THEN [] ← PortedCtx[bb[bti].localCtx]};
	ENDCASE};
    
    TreeOps.ScanList[t, DirectoryItem]};
    
    
-- relocating imported control links

  ScanImports: PROC [action: PROC [ISEIndex]] = {
    FOR sei: ISEIndex ← FirstCtxSe[dataPtr.importCtx], NextSe[sei] UNTIL sei = ISENull DO
      action[sei] ENDLOOP};
      
  RelocateImports: PROC [ctx: CTXIndex, gfi: GFTIndex] RETURNS [epMax: EPIndex ← 0] = {
    FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
      IF ~seb[sei].constant THEN {
	epN: CARDINAL = seb[sei].idValue;
	seb[sei].idValue ← MakeEPLink[epN, gfi];  epMax ← MAX[epN, epMax]};
      ENDLOOP;
    RETURN};
    
  AssignImports: PUBLIC Tree.Scan = {
    gfi: GFTIndex;
    saveIndex: CARDINAL = dataPtr.textIndex;
    
    ImportItem: PROC [sei: ISEIndex] = {
      node: Tree.Index = seb[sei].idValue;
      type: CSEIndex = UnderType[seb[sei].idType];
      epMax: EPIndex;
      IF node # Tree.NullIndex THEN dataPtr.textIndex ← tb[node].info;
      WITH t: seb[type] SELECT FROM
	definition => {
	  IF ctxb[t.defCtx].seList = ISENull THEN Log.WarningSei[unusedImport, sei];
	  epMax ← IF dataPtr.interface THEN 0 ELSE RelocateImports[t.defCtx, gfi];
	  gfi ← gfi + (seb[sei].idInfo ← t.nGfi)};
	ref => {
	  IF ~dataPtr.interface THEN seb[sei].idValue ← MakeEPLink[ep:0, gfi:gfi];
	  gfi ← gfi + 1};
	ENDCASE;
      seb[sei].mark4 ← TRUE};
      
    dataPtr.mtRoot.gfi ← ownGfi;
    dataPtr.mtRoot.ngfi ← GFSlots[MAX[dataPtr.nBodies, dataPtr.nSigCodes]-1];
    gfi ← bcdHeader.firstdummy ← ownGfi + PrincOps.MaxNGfi;
    ScanImports[ImportItem];
    bcdHeader.nDummies ← gfi - bcdHeader.firstdummy;
    dataPtr.textIndex ← saveIndex};
    
    
-- writing frame fragments (link fragment written by Pass4L)

  ProcessSymLiterals: PUBLIC PROC = {
    offset, length: CARDINAL;
    bcdHeader.rfOffset ← CompilerUtil.ReadBCDOffset[];
    bcdHeader.lfLimit ← LOOPHOLE[bcdHeader.rfOffset - bcdHeader.lfOffset];
    IF ~dataPtr.interface THEN {
      rfi: BcdDefs.RefLitIndex ← [0];
      
      AppendLitItem: PROC [SymLiteralOps.RefLitItem] = {
        CompilerUtil.AppendBCDWords[@rfi, BcdDefs.RefLitIndex.SIZE];
	rfi ← [rfi + 1]};
	
      [offset, length] ← SymLiteralOps.DescribeRefLits[];
      IF length # 0 THEN {
	dataPtr.mtRoot.refLiterals ← BcdDefs.RFIndex.FIRST;
	CompilerUtil.AppendBCDWord[offset];  CompilerUtil.AppendBCDWord[length];
	SymLiteralOps.EnumerateRefLits[AppendLitItem]}};
    bcdHeader.tfOffset ← CompilerUtil.ReadBCDOffset[];
    bcdHeader.rfLimit ← LOOPHOLE[bcdHeader.tfOffset - bcdHeader.rfOffset];
    IF ~dataPtr.interface THEN {
      tfi: BcdDefs.TypeIndex ← [0];

      AppendTypeIndex: PROC [canonical: BOOL, type: Type] = {
        CompilerUtil.AppendBCDWords[@tfi, BcdDefs.TypeIndex.SIZE];
	tfi ← [tfi + 1]};
	
      [offset, length] ← SymLiteralOps.DescribeTypes[];
      IF length # 0 THEN {
   	dataPtr.mtRoot.types ← BcdDefs.TFIndex.FIRST;
	CompilerUtil.AppendBCDWord[offset];  CompilerUtil.AppendBCDWord[length];
	SymLiteralOps.EnumerateTypes[AppendTypeIndex]}};
    bcdHeader.tfLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[] - bcdHeader.tfOffset]};
  
  
-- writing import records

  ProcessImports: PUBLIC Tree.Scan = {
    -- N.B. nextGfi must be regenerated to match AssignImports
    nImports: CARDINAL;
    impi: BcdDefs.IMPIndex;
    nextGfi: GFTIndex;
    anyNamed: BOOL;
    
    ProcessSei: PROC [sei, tSei: ISEIndex, implicit: BOOL] = {
      type: CSEIndex = UnderType[seb[sei].idType];
      entry: BcdDefs.IMPRecord ← [
		name: EnterSymbolId[tSei],
		port: interface,
		namedInstance: seb[sei].hash # seb[tSei].hash,
		file: ,
		gfi: nextGfi, ngfi: ];
      WITH t: seb[type] SELECT FROM
	definition => {
	  entry.file ← PortedCtx[t.defCtx];  entry.ngfi ← seb[sei].idInfo;
	  nextGfi ← (seb[sei].idValue ← nextGfi) + seb[sei].idInfo};
	ref => {
	  rType: RecordSEIndex = LOOPHOLE[UnderType[t.refType]];
	  entry.port ← module;
	  entry.file ← PortedCtx[seb[rType].fieldCtx];  entry.ngfi ← 1;
	  nextGfi ← nextGfi + 1};
	ENDCASE;
      nImports ← nImports + 1;
      IF entry.namedInstance THEN anyNamed ← TRUE;
      CompilerUtil.AppendBCDWords[@entry, BcdDefs.IMPRecord.SIZE]};
      
    sei: ISEIndex;	-- updated by ImportItem
    
    ImportItem: Tree.Scan = {
      node: Tree.Index = TreeOps.GetNode[t];
      ProcessSei[sei, TreeOps.GetSe[tb[node].son[2]], FALSE];
      sei ← NextSe[sei]};
      
    NameItem: Tree.Scan = {
      node: Tree.Index = TreeOps.GetNode[t];
      sei: ISEIndex = TreeOps.GetSe[tb[node].son[1]];
      tSei: ISEIndex = TreeOps.GetSe[tb[node].son[2]];
      entry: BcdDefs.NTRecord;
      IF  seb[sei].hash # seb[tSei].hash THEN {
	entry ← [name: EnterSymbolId[sei], item: BcdDefs.Namee[import[impi]]];
	CompilerUtil.AppendBCDWords[@entry, BcdDefs.NTRecord.SIZE]};
      impi ← impi + BcdDefs.IMPRecord.SIZE};
      
    offset: CARDINAL;
    bcdHeader.impOffset ← offset ← CompilerUtil.ReadBCDOffset[];
    nImports ← 0;  impi ← BcdDefs.IMPIndex.FIRST;
    nextGfi ← bcdHeader.firstdummy;  anyNamed ← FALSE;
    sei ← FirstCtxSe[dataPtr.importCtx];
    TreeOps.ScanList[t, ImportItem];
    UNTIL sei = ISENull DO ProcessSei[sei, sei, TRUE]; sei ← NextSe[sei] ENDLOOP;
    bcdHeader.nImports ← nImports;
    bcdHeader.impLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
    bcdHeader.ntOffset ← offset ← CompilerUtil.ReadBCDOffset[];
    IF anyNamed THEN TreeOps.ScanList[t, NameItem];	-- matches importCtx prefix
    bcdHeader.ntLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset]};
    
    
-- writing export records

  maxEVLength: CARDINAL;
  evList: BcdOps.EVHandle;
  
  EnterEVOffset: PROC [offset: CARDINAL] RETURNS [index: CARDINAL] = {
    IF offset = 0 THEN index ← 0
    ELSE
      FOR index IN [1 .. evList.length] DO
	IF offset = evList.offsets[index] THEN EXIT;
	REPEAT
	  FINISHED => {
	    index ← evList.length ← evList.length + 1;
	    IF index <= maxEVLength THEN evList.offsets[index] ← offset};
	ENDLOOP;
    RETURN};
    
    
  TypeMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF
    RECORD [opaque: BcdDefs.TMRecord, concrete: BcdDefs.TYPRecord]];
  typeMap: LONG POINTER TO TypeMap;
  mapIndex: CARDINAL;
  typeIndex: BcdDefs.TYPIndex;
  
  EnterType: PROC [mdi: MDIndex, offset: CARDINAL, sei: ISEIndex]
      RETURNS [typeId: BcdDefs.TYPIndex] = {
    entry: BcdDefs.TYPRecord = MakeTypeId[sei];
    IF typeMap = NIL OR mapIndex >= typeMap.length THEN AdjustTypeMap[8];
    FOR i: CARDINAL IN [0..mapIndex) DO
      IF typeMap[i].concrete = entry THEN GO TO matched;
      REPEAT
	matched => typeId ← typeMap[i].opaque.map;
	FINISHED => {typeId ← typeIndex; typeIndex ← typeIndex + BcdDefs.TYPRecord.SIZE};
      ENDLOOP;
    typeMap[mapIndex] ← [
	opaque: [version: mdb[mdi].stamp, offset: offset, map: typeId],
	concrete: entry];
    mapIndex ← mapIndex + 1;
    RETURN};
    
  MakeTypeId: PROC [id: ISEIndex] RETURNS [BcdDefs.TYPRecord] = {
    sei: ISEIndex ← id;
    next: Type;
    mdi: MDIndex;
    DO
      next ← seb[sei].idInfo;
      WITH seb[next] SELECT FROM
	id => sei ← LOOPHOLE[next];
	ENDCASE => EXIT;
      ENDLOOP;
    mdi ← MdiForCtx[seb[sei].idCtx];
    RETURN [[id: [seb[sei].idValue], version: mdb[mdi].stamp]]};
    
  AdjustTypeMap: PROC [delta: CARDINAL] = {
    oldN: CARDINAL = IF typeMap = NIL THEN 0 ELSE typeMap.length;
    newMap: LONG POINTER TO TypeMap = zone.NEW[TypeMap[oldN+delta]];
    FOR i: CARDINAL IN [0 .. oldN) DO newMap[i] ← typeMap[i] ENDLOOP;
    IF typeMap # NIL THEN zone.FREE[@typeMap];
    typeMap ← newMap};
    
  WriteTypeTable: PROC = {
    i, offset: CARDINAL;
    next: BcdDefs.TYPIndex ← BcdDefs.TYPIndex.FIRST;
    bcdHeader.typOffset ← offset ← CompilerUtil.ReadBCDOffset[];
    FOR i IN [0 .. mapIndex) DO
      FOR j: CARDINAL IN [0..i) DO
	IF typeMap[i].opaque.map = typeMap[j].opaque.map THEN EXIT
	REPEAT
	  FINISHED => {
	    CompilerUtil.AppendBCDWords[@typeMap[i].concrete, BcdDefs.TYPRecord.SIZE];
	    next ← next + BcdDefs.TYPRecord.SIZE};
	ENDLOOP;
      ENDLOOP;
    bcdHeader.typLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
    bcdHeader.tmOffset ← offset ← CompilerUtil.ReadBCDOffset[];
    FOR i IN [0 .. mapIndex) DO
      CompilerUtil.AppendBCDWords[@typeMap[i].opaque, BcdDefs.TMRecord.SIZE];
      ENDLOOP;
    bcdHeader.tmLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset]};
    
    
  ExportId: Tree.Map = {
    expType: CSEIndex = P4.OperandType[t];
    ctx: IncludedCTXIndex;
    iBase: Types.SymbolTableBase;
    id, sei, iSei: ISEIndex;
    epN: CARDINAL;
    used: BOOL;
    id ← TreeOps.GetSe[t];
    WITH v: seb[expType] SELECT FROM
      definition => {
	ctx ← LOOPHOLE[v.defCtx];
	iBase ← Copier.GetSymbolTable[ctxb[ctx].module];
	IF iBase # NIL THEN {
	  BEGIN
	  header: BcdDefs.EXPRecord ← [
		  name: EnterSymbolId[id],
		  size: 0,
		  port: interface,
		  namedInstance: FALSE,
		  typeExported: FALSE,
		  file: PortedCtx[v.defCtx],
		  links: ];
	  FOR iSei ← iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = ISENull DO
	    SELECT iBase.LinkMode[iSei] FROM
	      val, ref => header.size ← header.size + 1;
	      type => {header.typeExported ← TRUE; header.size ← header.size + 1};
	      ENDCASE;
	    ENDLOOP;
	  CompilerUtil.AppendBCDWords[@header, BcdDefs.EXPRecord.SIZE];
	  END;
	  used ← FALSE;  epN ← 0;
	  FOR iSei ← iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = ISENull DO
	    mode: Linkage = iBase.LinkMode[iSei];
	    link: BcdLink ← BcdDefs.NullLink;
	      BEGIN
	      ss: SubStringDescriptor;
	      name: Name;
	      iBase.SubStringForName[@ss, iBase.seb[iSei].hash];
	      name ← FindString[@ss];
	      IF name = nullName THEN sei ← ISENull
	      ELSE {
		sei ← SearchContext[name, dataPtr.mainCtx];
		IF sei = ISENull THEN sei ← SearchContext[name, dataPtr.moduleCtx]};
	      END;
	    IF sei # ISENull THEN {
	      public: BOOL = seb[sei].public;
	      iType: CSEIndex = iBase.UnderType[iBase.seb[iSei].idType];
	      SELECT mode FROM
		val => {
		  IF ~Types.Assignable[
			[iBase, iType], [dataPtr.ownSymbols, UnderType[seb[sei].idType]]] THEN {
		    IF public THEN Log.ErrorSei[exportClash,sei]}
		  ELSE IF ~public AND seb[sei].idCtx = dataPtr.mainCtx THEN
		    Log.WarningSei[privateExport, sei];
		  IF public THEN {
		    IF ~seb[sei].constant OR seb[sei].extended THEN Log.ErrorSei[varExport, sei];
		    link ← IF XferMode[seb[sei].idType] = program
				THEN MakeFrameLink[ep:EnterEVOffset[0], gfi:ownGfi]
				ELSE seb[sei].idValue}};
		ref => {
		  iTarget: CSEIndex ← iType;
		  iConst: BOOL ← iBase.seb[iSei].immutable;
		  WITH t: iBase.seb[iType] SELECT FROM
		    ref =>
		      IF t.var THEN {iTarget ← iBase.UnderType[t.refType]; iConst ← t.readOnly}; 
		    ENDCASE;
		  IF ~Types.Equivalent[
			[iBase, iTarget], [dataPtr.ownSymbols, UnderType[seb[sei].idType]]] THEN {
		    IF public THEN Log.ErrorSei[exportClash,sei]}
		  ELSE IF ~public AND seb[sei].idCtx = dataPtr.mainCtx THEN
		    Log.WarningSei[privateExport, sei];
		  IF public THEN {
		    SELECT TRUE FROM
		      seb[sei].constant => Log.ErrorSei[varExport, sei];
		      seb[sei].immutable AND ~iConst => Log.ErrorSei[exportClash, sei];
		      ENDCASE;
		  link ← MakeFrameLink[
			   ep: EnterEVOffset[LOOPHOLE[seb[sei].idValue, BitAddress].wd],
			   gfi: ownGfi]}};
		type =>
		  IF seb[sei].idType # typeTYPE OR TypeForm[sei] = opaque THEN {
		    IF public THEN Log.ErrorSei[exportClash, sei]}
		  ELSE {
		    iValue: CSEIndex = iBase.UnderType[iSei];
		    IF (~public AND seb[sei].idCtx = dataPtr.mainCtx) THEN
		      Log.WarningSei[privateExport, sei]
		    ELSE
		      WITH it: iBase.seb[iValue] SELECT FROM
			opaque =>
			  IF it.lengthKnown AND ~P4.DefaultBasicOps[sei, it.length] THEN
			    Log.ErrorSei[exportAttr, sei];
			ENDCASE => ERROR;
		    IF public THEN {
		      link ← MakeTypeLink[EnterType[ctxb[ctx].module, epN, sei]];
		      bcdHeader.typeExported ← TRUE}};
		manifest =>
		  IF public
		    AND (seb[sei].idType # typeTYPE OR iBase.seb[iSei].idType # typeTYPE) THEN
		     Log.WarningSei[voidExport, sei];
		ENDCASE};
	    IF link # BcdDefs.NullLink THEN used ← TRUE;
	    IF mode # manifest THEN {CompilerUtil.AppendBCDWord[link]; epN ← epN + 1};
	    ENDLOOP;
	Copier.FreeSymbolTable[iBase];
	IF ~used THEN Log.WarningSei[unusedExport, id]}};
      ENDCASE;
    RETURN [t]};
    
  ExportItem: Tree.Scan = {
    node: Tree.Index = TreeOps.GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex ← tb[node].info;
    tb[node].son[2] ← ExportId[tb[node].son[2]];
    dataPtr.textIndex ← saveIndex};
    
  ProcessExports: PUBLIC Tree.Map = {
    offset: CARDINAL;
    bcdHeader.nExports ← TreeOps.ListLength[t];
    bcdHeader.expOffset ← offset ← CompilerUtil.ReadBCDOffset[];
    maxEVLength ← PrincOps.MaxNGfi*VarLimit - 1;
    evList ← ZoneWords[BcdDefs.EVRecord.SIZE+maxEVLength];
    evList↑ ← [length:0, offsets:];
    typeIndex ← BcdDefs.TYPIndex.FIRST;  mapIndex ← 0;  typeMap ← NIL;
    TreeOps.ScanList[t, ExportItem];
    bcdHeader.expLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
    bcdHeader.evOffset ← offset ← CompilerUtil.ReadBCDOffset[];
    IF evList.length > maxEVLength THEN Log.ErrorN[exportedVars, evList.length-maxEVLength];
    IF evList.length = 0 THEN dataPtr.mtRoot.variables ← BcdDefs.EVNull
    ELSE {
      dataPtr.mtRoot.ngfi ← MAX[dataPtr.mtRoot.ngfi, evList.length/VarLimit+1];
      dataPtr.mtRoot.variables ← BcdDefs.EVIndex.FIRST;
      CompilerUtil.AppendBCDWords[evList,
	  BcdDefs.EVRecord.SIZE + MIN[evList.length, maxEVLength]]};
    bcdHeader.evLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-offset];
    FreeZoneWords[evList];
    WriteTypeTable[];
    IF typeMap # NIL THEN zone.FREE[@typeMap];
    RETURN [t]};
    

-- initialization/finalization

  ProcessFiles: PROC = {
    ftEntry: BcdDefs.FTRecord;
    mdi: MDIndex;
    limit: MDIndex = (dataPtr.table).Top[mdType];

    EnterCanonicalFile: PROC [canonical: BOOL, type: Type] = {
      IF ~canonical THEN {
        mdi: MDIndex;
	[mdi, ] ←  SymLiteralOps.UTypeId[type];
	IF mdi # MDNull THEN [] ← PortedFile[mdi]}};
	
    offset: CARDINAL = CompilerUtil.ReadBCDOffset[];
    FOR mdi ← lastPorted, mdi + MDRecord.SIZE UNTIL mdi = limit DO
      IF mdb[mdi].file # nullFileIndex THEN
        [] ← PortedFile[mdi];	-- add any files opened during compilation
      ENDLOOP;
    bcdHeader.ftOffset ← offset;
    SymLiteralOps.EnumerateTypes[EnterCanonicalFile];
    FOR mdi ← firstPorted, mdi + MDRecord.SIZE UNTIL mdi = lastPorted DO
      ftEntry ← [name: EnterFileId[mdi], version: mdb[mdi].stamp];
      CompilerUtil.AppendBCDWords[@ftEntry, BcdDefs.FTRecord.SIZE];
      ENDLOOP;
    bcdHeader.ftLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[] - offset]};
    
    
  InitBCD: PUBLIC PROC [ids: Tree.Link, scratchZone: UNCOUNTED ZONE] = {
    OPEN BcdDefs;
    nIds: CARDINAL;
    zone ← scratchZone;
    nIds ← TreeOps.ListLength[ids];
    IF nIds > 1 AND ~dataPtr.interface THEN {Log.ErrorN[listLong, nIds-1]; nIds ← 1};
    lastPorted ← firstPorted;
    nString ← LOOPHOLE[zone.NEW[StringBody[64]]];
    -- allocate the null name
      nString.string.length ← BcdDefs.NullName;
      nString.size[BcdDefs.NullName] ← 0;
    mdb[OwnMdi].stamp ← dataPtr.objectVersion;	-- update from DIRECTORY processing
    CompilerUtil.StartBCD[];
    bcdHeader ← zone.NEW[BCD];
      bcdHeader.versionIdent ← VersionID;
      bcdHeader.version ← dataPtr.objectVersion;
      bcdHeader.creator ← dataPtr.compilerVersion;
      bcdHeader.sourceVersion ← dataPtr.source.version;
      bcdHeader.nConfigs ← 0;
      bcdHeader.nModules ← nIds;
      bcdHeader.nImports ← bcdHeader.nExports ← 0;
      bcdHeader.definitions ← dataPtr.interface;
      bcdHeader.typeExported ← FALSE;
      bcdHeader.repackaged ← bcdHeader.tableCompiled ← FALSE;
      bcdHeader.versions ← FALSE;
      bcdHeader.spare1 ← bcdHeader.spare2 ← bcdHeader.spare3 ← FALSE;
      bcdHeader.ctOffset ← 0;  bcdHeader.ctLimit ← LOOPHOLE[0];
      bcdHeader.spOffset ← 0;  bcdHeader.spLimit ← LOOPHOLE[0];
      bcdHeader.fpOffset ← 0;  bcdHeader.fpLimit ← LOOPHOLE[0];
      nString.string.length ← nString.string.length + 1;
      bcdHeader.source ← NameRecord[nString.string.length];
	nString.size[bcdHeader.source] ← dataPtr.source.locator.length;
	Strings.AppendSubString[@nString.string, @dataPtr.source.locator];
    bcdOffset ← CompilerUtil.ReadBCDOffset[];
    CompilerUtil.AppendBCDWords[bcdHeader, BCD.SIZE];
    dataPtr.fixupLoc ← CompilerUtil.ReadBCDIndex[];
    bcdHeader.sgOffset ← CompilerUtil.ReadBCDOffset[];
    CompilerUtil.AppendBCDWords[@dataPtr.codeSeg, SGRecord.SIZE];
    CompilerUtil.AppendBCDWords[@dataPtr.symSeg, SGRecord.SIZE];
    bcdHeader.mtOffset ← mtOffset ← CompilerUtil.ReadBCDOffset[];
    bcdHeader.sgLimit ← LOOPHOLE[mtOffset - bcdHeader.sgOffset];
    dataPtr.mtRootSize ← BcdDefs.MTRecord.SIZE;
    dataPtr.mtRoot ← zone.NEW[BcdDefs.MTRecord];
    dataPtr.mtRoot.links ←
        IF dataPtr.interface THEN BcdDefs.LFNull ELSE BcdDefs.LFIndex.FIRST;
    dataPtr.mtRoot.refLiterals ← BcdDefs.RFNull;
    dataPtr.mtRoot.types ← BcdDefs.TFNull;
    FOR i: CARDINAL IN [0..nIds) DO
      CompilerUtil.AppendBCDWords[dataPtr.mtRoot, dataPtr.mtRootSize]
      ENDLOOP;
    bcdHeader.lfOffset ← CompilerUtil.ReadBCDOffset[];
    bcdHeader.mtLimit ← LOOPHOLE[bcdHeader.lfOffset-bcdHeader.mtOffset]};
      
  FinishBCD: PUBLIC PROC [ids: Tree.Link] = {
    OPEN BcdDefs;
    PageSize: CARDINAL = Environment.wordsPerPage;
    Alignment: CARDINAL = 4;  -- Code Segments must start at 0 MOD Alignment
    nLinks: CARDINAL = dataPtr.linkCount;
    codeLinks: BOOL = dataPtr.switches['l];
    gfType: RecordSEIndex = bb[RootBti].type;
    -- fill MTRecord
      IF TreeOps.ListLength[ids] > 1 THEN {	-- complete nString now

	EnterId: Tree.Scan = {[] ← EnterSymbolId[TreeOps.GetSe[t]]};

	TreeOps.ScanList[ids, EnterId]};
      dataPtr.mtRoot.name ← EnterSymbolId[bb[RootBti].id];
      dataPtr.mtRoot.namedInstance ← FALSE;
      dataPtr.mtRoot.initial ← ~dataPtr.switches['s];
      dataPtr.mtRoot.file ← dataPtr.bcdSeg.file ← dataPtr.codeSeg.file ← dataPtr.symSeg.file ← 
        PortedCtx[dataPtr.mainCtx];
      dataPtr.bcdSeg.base ← 0;
      dataPtr.mtRoot.linkLoc ← IF codeLinks THEN code ELSE frame;
      dataPtr.mtRoot.config ← CTNull;
      dataPtr.mtRoot.code ← CodeDesc[
		sgi: SGIndex.FIRST,
		packed: FALSE, linkspace: codeLinks,
		offset: IF codeLinks AND nLinks # 0
		  THEN (nLinks+1) + (Alignment-1 - (nLinks MOD Alignment))
		  ELSE 0,
		length: 0];	-- will be updated
      dataPtr.mtRoot.sseg ← SGIndex.FIRST + SGRecord.SIZE;
      dataPtr.mtRoot.frameRefs ← seb[gfType].hints.refField;
      dataPtr.mtRoot.frameType ←
         IF seb[gfType].hints.refField THEN SymLiteralOps.TypeIndex[gfType] ELSE 0;
      dataPtr.mtRoot.spare ←  FALSE;
      dataPtr.mtRoot.framesize ← 0;	-- will be updated
      dataPtr.mtRoot.tableCompiled ← FALSE;
      dataPtr.mtRoot.residentFrame ← passPtr.resident;
      dataPtr.mtRoot.boundsChecks ← dataPtr.switches['b];
      dataPtr.mtRoot.nilChecks ← dataPtr.switches['n];
      dataPtr.mtRoot.long ← dataPtr.switches['c];	-- compiled for Cedar
      dataPtr.mtRoot.crossJumped ← dataPtr.switches['j];
      dataPtr.mtRoot.packageable ← TRUE;
    ProcessFiles[];
    bcdHeader.ssOffset ← CompilerUtil.ReadBCDOffset[];
    CompilerUtil.AppendBCDString[@nString.string];
    bcdHeader.ssLimit ← LOOPHOLE[CompilerUtil.ReadBCDOffset[]-bcdHeader.ssOffset];
    IF dataPtr.interface THEN bcdHeader.rtPages.relPageBase ← 0
    ELSE {
      CompilerUtil.FillBCDPage[];
      bcdHeader.rtPages.relPageBase ← CompilerUtil.ReadBCDOffset[]/PageSize;
      CompilerUtil.RTTableOut[dataPtr.table]};
    bcdHeader.nPages ← (CompilerUtil.ReadBCDOffset[] + (PageSize-1))/PageSize;
    bcdHeader.rtPages.pages ← bcdHeader.nPages - bcdHeader.rtPages.relPageBase;
    CompilerUtil.UpdateBCDWords[bcdOffset, bcdHeader, BCD.SIZE];
    dataPtr.bcdSeg.base ← 0; dataPtr.bcdSeg.pages ← bcdHeader.nPages;
    IF dataPtr.interface AND TreeOps.ListLength[ids] > 1 THEN {
      offset: CARDINAL ← mtOffset;
      saveName: BcdDefs.NameRecord = dataPtr.mtRoot.name;
	
      UpdateMDEntry: Tree.Scan = {
	dataPtr.mtRoot.name ← EnterSymbolId[TreeOps.GetSe[t]];
	CompilerUtil.UpdateBCDWords[offset, dataPtr.mtRoot, dataPtr.mtRootSize];
	offset ← offset + dataPtr.mtRootSize};
	  
      offset ← mtOffset;  TreeOps.ScanList[ids, UpdateMDEntry];
      dataPtr.mtRoot.name ← saveName};
    CompilerUtil.EndBCD[];
    zone.FREE[@nString]; zone.FREE[@bcdHeader]; zone ← NIL};
    

  MatchBCD: PUBLIC PROC RETURNS [matched: BOOL ← FALSE] = {
    oldSymbols: SymbolTable.Base ← Copier.MapSymbols[dataPtr.pattern];
    IF oldSymbols = NIL THEN
      Log.WarningSubString[fileName, @dataPtr.pattern.locator]
    ELSE {
      matched ← ReplOps.MatchedBodies[
	    [oldSymbols, RootBti], [dataPtr.ownSymbols, RootBti]
	! ReplOps.Unmatched => {
	    d: Strings.SubStringDescriptor;
	    id.stb.SubStringForName[@d, id.stb.NameForSe[id.sei]];
	    SELECT attr FROM
	      strings => Log.WarningSubString[replString, @d];
	      id => Log.WarningSubString[replId, @d];
	      ENDCASE;
	    RESUME}];
      Copier.UnmapSymbols[oldSymbols]}};

  }.