-- BcdLoad.mesa
-- Last edited by Satterthwaite on August 1, 1983 12:08 pm
-- Last edited by Lewis on 27-Mar-81  9:49:56

DIRECTORY
  Alloc: TYPE USING [AddNotify, Bounds, DropNotify, Handle, Notifier, Top, Words],
  BcdBindDefs: TYPE USING [Relocations, RelocHandle, RelocType],
  BcdComData: TYPE USING [
    currentName, objectStamp, op, outputFti, table, textIndex, typeExported, zone],
  BcdControlDefs: TYPE USING [],
  BcdDefs: TYPE USING [
    rftype, BCD, CTIndex, CTNull, CTRecord, cttype, cxtype, EPLimit,
    evtype, EXPIndex, EXPNull, EXPRecord, exptype, FPIndex, FPNull, FPRecord, fptype,
    FTIndex, FTNull, FTRecord, FTSelf, fttype, GFTIndex,
    IMPIndex, IMPNull, IMPRecord, imptype, lftype, Link, LinkLocation,
    MTIndex, MTNull, MTRecord, mttype, Namee, NameRecord, nttype, NullLink, NullName,
    SGIndex, SGRecord, sgtype, SpaceID, SPIndex, SPNull, SPRecord,
    sptype, sstype, sttype, tftype, treetype, TMIndex, TMRecord, tmtype, TYPIndex,
    TYPNull, typtype, VersionID],
  BcdErrorDefs: TYPE USING [
    Error, ErrorFile, ErrorHti, ErrorItem, ErrorModule, ErrorName, ErrorSti,
    Error2Files, GetSti],
  BcdFileDefs: TYPE USING [CapabilityForFile, UnknownFile],
  BcdLiterals: TYPE USING [LoadLiterals, MapLitLinks, MapTypeLinks, UnloadLiterals],
  BcdOps: TYPE USING [BcdBase],
  BcdUtilDefs: TYPE USING [
    BcdBasePtr, BcdBases, BcdLimits, ContextForTree,
    CreateInstanceName, EnterConfig, EnterExport, EnterFramePack,
    EnterImport, EnterModule, EnterSegment, EnterSpace, EnterType,
    EnterTypeMap, FileForVersion, EqVersions, GetDummyGfi, GetGfi,
    HtiForName, MergeFile, NameForSti, NewSemanticEntry,
    SetFileVersion],
  File: TYPE USING [Capability, Unknown],
  Inline: TYPE USING [LongCOPY],
  OSMiscOps: TYPE USING [MergeStamps, TimeToStamp],
  Space: TYPE USING [
    Handle, nullHandle, virtualMemory, Create, Delete, Error, LongPointer, Map],
  Symbols: TYPE USING [
    CXIndex, cxNull, HTIndex, htNull, STIndex, STMap, stNull],
  Table: TYPE USING [Base, Index],
  Tree: TYPE USING [Index, Link, NodeName, Scan, null, nullIndex],
  TreeOps: TYPE USING [GetNode, ListLength, ScanList, UpdateList];

BcdLoad: PROGRAM
    IMPORTS
      Alloc, BcdErrorDefs, BcdFileDefs, BcdUtilDefs, BcdLiterals,
      File, Inline, OSMiscOps, Space, TreeOps,
      data: BcdComData
    EXPORTS BcdControlDefs = {
  OPEN BcdDefs, Symbols;

  Zero: PROC [p: LONG POINTER, l: CARDINAL] ~ INLINE {
    IF l # 0 THEN {p^ _ 0; Inline.LongCOPY[from~p, to~(p+1), nwords~(l-1)]}};

  FileMapItem: TYPE ~ RECORD [old, new: FTIndex];
  InterfaceOp: TYPE ~ Tree.NodeName [$plus..$then];
  ExportAssigner: TYPE ~ PROC;

  LoadError: PUBLIC ERROR ~ CODE;

  currentCx, loadCx: CXIndex;
  loadTree: Tree.Index;
  loadExpi: EXPIndex;
  packSti: STIndex;
  currentOp: InterfaceOp;
  table: Alloc.Handle;
  tb, stb, cxb: Table.Base;
  exportsALL: BOOL;

  localBases: BcdUtilDefs.BcdBases;
  limits: BcdUtilDefs.BcdLimits;
  bcd: BcdUtilDefs.BcdBasePtr;

  Notifier: Alloc.Notifier ~ {
    tb _ base[treetype];  stb _ base[sttype];  cxb _ base[cxtype];
    localBases _ [
      ssb: LOOPHOLE[base[sstype]],
      ctb: base[cttype],  mtb: base[mttype],
      lfb: base[lftype],  rfb: base[rftype],  tfb: base[tftype],
      etb: base[exptype], evb: base[evtype],
      itb: base[imptype],
      sgb: base[sgtype],  ftb: base[fttype],
      tyb: base[typtype], tmb: base[tmtype],
      ntb: base[nttype],
      spb: base[sptype],  fpb: base[fptype]]};

  Error: PROC ~ {ERROR LoadError};


  LoadRoot: PUBLIC PROC [root: Tree.Link] RETURNS [BcdBindDefs.RelocHandle] ~ { 
    node: Tree.Index;
    table _ data.table;  table.AddNotify[Notifier];
    bcd _ @localBases;
    currentOp _ $plus;  currentParms _ Tree.null;
    processExports _ VerifyExports;
    relocationHead _ NIL;
    loadExpi _ EXPNull;  loadTree _ Tree.nullIndex;  loadCx _ cxNull;
    exportsALL _ FALSE;
    data.typeExported _ FALSE;
    node _ TreeOps.GetNode[root];
    SELECT tb[node].name FROM
      $source => {
	packSti _ FindSti[tb[node].son[2]];
	[] _ LoadLocalConfig[TreeOps.GetNode[tb[node].son[3]], $outer, htNull]};
      ENDCASE => Error[];
    table.DropNotify[Notifier];  table _ NIL;
    RETURN [relocationHead]};
    
  FindSti: PROC [t: Tree.Link] RETURNS [STIndex] ~ {
    RETURN [IF t = Tree.null
      THEN stNull
      ELSE
	WITH t SELECT FROM
	  symbol => index,
	  subtree => FindSti[tb[index].son[1]],
	  ENDCASE => ERROR LoadError]};

  currentParms: Tree.Link;

  BodyWalk: Tree.Scan ~ {
    WITH t SELECT FROM
      symbol => LoadSti[index, htNull];
      subtree => {
	node: Tree.Index ~ index;
	saveIndex: CARDINAL ~ data.textIndex;
	data.textIndex _ tb[node].info;
	SELECT tb[node].name FROM
	  $list   => TreeOps.ScanList[t, BodyWalk];
	  $item   => LoadItem[t];
	  $config => NULL;
	  $assign => LoadAssign[t];
	  $module => { 
	    currentParms _ tb[node].son[2];  LoadItem[tb[node].son[1]]};
	  ENDCASE => Error[];
        data.textIndex _ saveIndex};
      ENDCASE => Error[]};

  LoadLocalConfig: PROC [
        node: Tree.Index, level: BcdBindDefs.RelocType, name: HTIndex]
      RETURNS [Symbols.STMap] ~ {
    saveCx: CXIndex ~ currentCx;
    saveLhs: Tree.Link ~ lhs;
    saveAssigner: ExportAssigner ~ processExports;
    saveName: NameRecord ~ data.currentName;
    saveIndex: CARDINAL ~ data.textIndex;

    currentCti: CTIndex;
    firstConfig: CTIndex ~ table.Top[cttype];
    firstModule: MTIndex ~ table.Top[mttype];
    localRel: BcdBindDefs.RelocHandle;
    firstImport: IMPIndex ~ table.Top[imptype];
    data.textIndex _ tb[node].info;
    lhs _ Tree.null;  processExports _ NormalExports;
    currentCx _ BcdUtilDefs.ContextForTree[tb[node].son[4]];
    AllocateRelocations[level];
    localRel _ rel;  localRel.parentcx _ saveCx;
    BodyWalk[tb[node].son[5]];  -- process body of config
    IF data.op = $bind THEN {
      nControls: CARDINAL _ 0;
      
      CountControl: PROC [item: Namee, sti: STIndex] ~ {
        nControls _ nControls + 1;
	IF item = [module[MTNull]] AND sti # stNull THEN
	  BcdErrorDefs.ErrorHti[$error,
	    "is not valid as a CONTROL module"L, stb[sti].hti]};
	
      EnumerateControls[tb[node].son[3], CountControl];
      currentCti _ table.Words[cttype, CTRecord.SIZE + nControls*Namee.SIZE];
	BEGIN  OPEN newConfig~~localBases.ctb[currentCti];
	i: CARDINAL _ 0;

	AssignControl: PROC [item: Namee, sti: STIndex] ~ {
	  newConfig.controls[i] _ item;  i _ i+1};

	data.currentName _ newConfig.name _ NameForLink[tb[node].son[4]];
	IF name = htNull THEN newConfig.namedInstance _ FALSE
	ELSE {
	  newConfig.namedInstance _ TRUE;
	  BcdUtilDefs.CreateInstanceName[name, [config[currentCti]]]};
	newConfig.file _ FTSelf;  newConfig.config _ CTNull;
	UpdateConfigParent[currentCti, firstConfig, currentCti];
	UpdateModuleParent[currentCti, firstModule, table.Top[mttype]];
	newConfig.nControls _ nControls;
	EnumerateControls[tb[node].son[3], AssignControl];
	END};
    lhs _ saveLhs;  processExports _ saveAssigner;
    loadTree _ node;  loadCx _ currentCx;  currentCx _ saveCx;
    exportsALL _ tb[node].attrs[$exportsALL]; 
    processExports[];
    currentCx _ loadCx;
    localRel.import _ table.Bounds[imptype].size;
    localRel.dummygfi _ BcdUtilDefs.GetDummyGfi[0];
    ProcessLocalImports[firstImport];
    localRel.importLimit _ table.Top[imptype];
    loadTree _ Tree.nullIndex;  loadCx _ cxNull;
    currentCx _ saveCx;  
    data.currentName _ saveName;
    data.textIndex _ saveIndex;
    RETURN [[config[currentCti]]]};


  EnumerateControls: PROC [t: Tree.Link, proc: PROC [Namee, STIndex]] ~ {
  
    Item: Tree.Scan ~ {
      sti: STIndex ~ NARROW[t, Tree.Link.symbol].index;
      BEGIN
      WITH s~~stb[sti] SELECT FROM
	external =>
	  WITH m~~s.map SELECT FROM
	    module => proc[[module[m.mti]], sti];
	    interface =>
	      IF localBases.etb[m.expi].port = $module THEN {
		gfi: GFTIndex ~ localBases.etb[m.expi].links[0].gfi;

		FindModule: PROC [mti: MTIndex] RETURNS [stop: BOOL] ~ {
		  RETURN [localBases.mtb[mti].gfi = gfi]};

		limits.mt _ table.Top[mttype];
		proc[[module[EnumerateModules[FindModule]]], sti]}
	      ELSE GOTO notvalid;
	    config => proc[[config[m.cti]], sti];
--+	    config =>
--+	      FOR i: CARDINAL IN [0 .. localBases.ctb[m.cti].nControls) DO
--+		proc[localBases.ctb[m.cti].controls[i], stNull];
--+		ENDLOOP;
	    ENDCASE => GOTO notvalid;
	local =>
	  WITH m~~s.map SELECT FROM
	    config => proc[[config[m.cti]], sti];
--+	    config =>
--+	      FOR i: CARDINAL IN [0 .. localBases.ctb[m.cti].nControls) DO
--+		proc[localBases.ctb[m.cti].controls[i], stNull];
--+		ENDLOOP;
	    ENDCASE => GOTO notvalid;
	ENDCASE => GOTO notvalid;
      EXITS
	notvalid => proc[[module[MTNull]], sti]
      END};
    
    TreeOps.ScanList[t, Item]};
    
  NameForLink: PROC [t: Tree.Link] RETURNS [NameRecord] ~ {
    RETURN [WITH t SELECT FROM
      symbol => BcdUtilDefs.NameForSti[index],
      ENDCASE => NullName]};


  LoadSti: PROC [sti: STIndex, name: HTIndex] ~ {
    ENABLE BcdErrorDefs.GetSti => {RESUME [sti]};
    WITH s~~stb[sti] SELECT FROM
      external =>
        WITH p~~s SELECT FROM
          file => s.map _ Load[sti, name];
          instance => s.map _ Load[p.sti, name];
          ENDCASE => Error[];
      local => s.map _ LoadLocalConfig[s.info, $inner, name];
      ENDCASE => NotLoadable[sti]};

  NotLoadable: PROC [sti: STIndex] ~ {
    BcdErrorDefs.ErrorSti[$error, "is not loadable (probably needs ""[]"")"L, sti]};

  FileForSti: PROC [sti: STIndex] RETURNS [FTIndex] ~ {
    RETURN [
      IF sti = stNull THEN FTNull
      ELSE
	WITH s~~stb[sti] SELECT FROM
	  unknown => FTNull,
	  external =>
	    WITH p~~s SELECT FROM
	      file => p.fti,
	      instance => FileForSti[p.sti],
	      ENDCASE => ERROR LoadError,
	  ENDCASE => ERROR LoadError]};

  FileForPortableItem: PROC [p: PortableItem] RETURNS [FTIndex] ~ {
    RETURN [WITH p SELECT FROM
      interface => MapFile[bcd.etb[expi].file],
      module    => MapFile[bcd.mtb[mti].file],
      ENDCASE => ERROR LoadError]};

  DeclarePortableItem: PROC [sti: STIndex, p: PortableItem] ~ {
    WITH p SELECT FROM
      interface => DeclareInterface[sti, expi, TRUE];
      module    => DeclareModule[sti, mti, TRUE];
      ENDCASE => Error[]};

  DeclareInterface: PROC [sti: STIndex, eti: EXPIndex, setMap: BOOL] ~ {
    fti: FTIndex ~ MapFile[bcd.etb[eti].file];
    WITH s~~stb[sti] SELECT FROM
      external => {
        IF setMap THEN s.map _ [interface[EXPNull]];
        WITH p~~s SELECT FROM
          instance =>
            IF p.sti = stNull THEN s.pointer _ file[fti]
	    ELSE DeclareInterface[p.sti, eti, FALSE];
          file => p.fti _ fti;
          ENDCASE => Error[]};
      unknown =>
        stb[sti].body _ external[
		pointer~file[fti],
		map~(IF setMap THEN [interface[EXPNull]] ELSE [unknown[]])];
      ENDCASE => Error[]};

  DeclareModule: PROC [sti: STIndex, mti: MTIndex, setMap: BOOL] ~ {
    WITH s~~stb[sti] SELECT FROM
      external => {
        IF setMap THEN s.map _ [module[MTNull]];
        WITH p~~s SELECT FROM
          instance => DeclareModule[p.sti, mti, FALSE];
          file => p.fti _ MapFile[bcd.mtb[mti].file];
          ENDCASE => Error[]};
      unknown => {
        fti: FTIndex ~ MapFile[bcd.mtb[mti].file];
        stb[sti].body _ external[
		pointer~file[fti],
		map~(IF setMap THEN [module[MTNull]] ELSE [unknown[]])]};
      ENDCASE => Error[]};

  currentLinkLoc: LinkLocation _ $frame;
  explicitLinkLoc: BOOL _ FALSE;

  LoadItem: PROC [t: Tree.Link] ~ {
    node: Tree.Index ~ TreeOps.GetNode[t];
    sti: STIndex ~ NARROW[tb[node].son[1], Tree.Link.symbol].index;
    IF tb[node].name # $item THEN Error[];
    currentLinkLoc _ IF tb[node].attrs[$codeLinks] THEN $code ELSE $frame;
    explicitLinkLoc _ tb[node].attrs[$explicitLinkLoc];
    LoadSti[sti, (IF tb[node].son[2] = Tree.null THEN htNull ELSE stb[sti].hti)]};

  BcdRelocations: TYPE ~ BcdBindDefs.Relocations;

  relocationHead: BcdBindDefs.RelocHandle;
  rel: BcdBindDefs.RelocHandle;

  FileMap: TYPE ~ RECORD [SEQUENCE length: CARDINAL OF FTIndex];
  fileMap: LONG POINTER TO FileMap _ NIL;

  MapFile: PROC [fti: FTIndex] RETURNS [FTIndex] ~ {
    SELECT TRUE FROM
      (bcd = @localBases) => RETURN [fti];
      (fti = FTSelf) => RETURN [bcdFti];
      (fti = FTNull) => RETURN [FTNull];
      ENDCASE => {
	fileIndex: CARDINAL ~ LOOPHOLE[fti, CARDINAL]/FTRecord.SIZE;
	IF fileMap[fileIndex] = FTNull THEN fileMap[fileIndex] _ bcd.MergeFile[fti];
	RETURN [fileMap[fileIndex]]}};

  AllocateRelocations: PROC [type: BcdBindDefs.RelocType] ~ {
    p: BcdBindDefs.RelocHandle ~ (data.zone).NEW[BcdRelocations];
    Zero[p, BcdRelocations.SIZE];
    p.link _ NIL;
    IF relocationHead = NIL THEN relocationHead _ rel _ p
    ELSE {rel.link _ p; rel _ p};
    IF (rel.type _ type) = $file THEN {
      rel.firstgfi _ rel.lastgfi _ BcdUtilDefs.GetGfi[0];
      rel.dummygfi _ BcdUtilDefs.GetDummyGfi[0];
      rel.import _ table.Bounds[imptype].size;
      rel.importLimit _ LOOPHOLE[rel.import];
      rel.module _ table.Bounds[mttype].size;
      rel.config _ table.Bounds[cttype].size;
      rel.parentcx _ cxNull}
    ELSE rel.originalfirstdummy _ 1;
    rel.textIndex _ data.textIndex;
    rel.context _ currentCx;
    rel.parameters _ currentParms;  currentParms _ Tree.null};

  processExports: ExportAssigner;

  Load: PROC [sti: STIndex, name: HTIndex] RETURNS [map: Symbols.STMap] ~ {
    fti: FTIndex ~ FileForSti[sti];
    nFiles: CARDINAL;
      BEGIN
      IF fti = FTNull THEN { 
	NotLoadable[SIGNAL BcdErrorDefs.GetSti];  GOTO fail};
      IF fti = data.outputFti THEN 
	BcdErrorDefs.Error[$error, "Output file referenced as input"L];
      LoadBcd[fti
	! BcdFileDefs.UnknownFile => {
	    BcdErrorDefs.ErrorFile[$error, "cannot be opened"L, fti]; GOTO fail};
          EmptyBcdFile => {
            BcdErrorDefs.ErrorFile[$error, "is empty"L, fti]; GOTO fail};
	  DefsFile => {
	    BcdErrorDefs.ErrorFile[$error, "is a definitions file"L, fti]; GOTO fail};
	  NonDefsFile => {
	    BcdErrorDefs.ErrorFile[$error, "is not a definitions file"L, fti]; GOTO fail};
	  IncompatibleVersion => {
	    BcdErrorDefs.ErrorFile[$error, "has an incompatible version"L, fti]; GOTO fail}];
      EXITS fail => RETURN [[unknown[]]];
      END;

    nFiles _ LOOPHOLE[limits.ft, CARDINAL]/FTRecord.SIZE;
    fileMap _ (data.zone).NEW[FileMap[nFiles]];
    FOR i: CARDINAL IN [0..fileMap.length) DO fileMap[i] _ FTNull ENDLOOP;

    BcdLiterals.LoadLiterals[fti, bHeader, MapFile, MapSegment];

    IF limits.ct # CTIndex.FIRST THEN {   -- configuration
      map _ LoadConfigs[name, sti];  [] _ LoadModules[htNull, sti]}
    ELSE map _ LoadModules[name, sti];
    ProcessTypeMap[];
    processExports[];
    ProcessImports[];
    LoadSpaces[];
    LoadFramePacks[];
    rel.lastgfi _ BcdUtilDefs.GetGfi[0]-1;
    rel.importLimit _ LOOPHOLE[table.Bounds[imptype].size];
    IF bHeader.typeExported THEN data.typeExported _ TRUE;
    
    BcdLiterals.UnloadLiterals[];

    UnloadBcd[];
    (data.zone).FREE[@fileMap]};

  CheckInternalName: PROC [name: NameRecord, sti: STIndex] ~ { 
    IF name # BcdUtilDefs.NameForSti[sti] THEN 
      BcdErrorDefs.ErrorSti[$error,
        "does not match the module or configuration name in the Bcd"L, sti]};

  bcdFile: File.Capability;
  bcdSpace: Space.Handle _ Space.nullHandle;
  bcdFti: FTIndex;
  bHeader: BcdOps.BcdBase;

  EmptyBcdFile: ERROR ~ CODE;
  DefsFile: ERROR ~ CODE;
  NonDefsFile: ERROR ~ CODE;
  IncompatibleVersion: ERROR ~ CODE;

  LoadBcd: PROC [fti: FTIndex] ~ {
    bcdPages: CARDINAL _ 8;
    
    DeleteHeader: PROC ~ {
      IF bcdSpace # Space.nullHandle THEN {
	Space.Delete[bcdSpace];  bcdSpace _ Space.nullHandle}};

      
    bcdSpace _ Space.nullHandle;
    bcdFile _ BcdFileDefs.CapabilityForFile[fti];
    DO
      bcdSpace _ Space.Create[size~bcdPages, parent~Space.virtualMemory];
      bcdSpace.Map[window~[file~bcdFile, base~1]
        ! Space.Error, File.Unknown => {GO TO fail}];
      bHeader _ bcdSpace.LongPointer[];
      IF bHeader.versionIdent # BcdDefs.VersionID THEN {
        DeleteHeader[];  ERROR IncompatibleVersion};
      SELECT data.op FROM
        $bind => IF bHeader.definitions THEN {DeleteHeader[]; ERROR DefsFile};
	$conc => IF ~bHeader.definitions THEN {DeleteHeader[]; ERROR NonDefsFile};
	ENDCASE;
      IF bcdPages >= bHeader.nPages THEN EXIT;
      bcdPages _ bHeader.nPages;
      Space.Delete[bcdSpace];  bcdSpace _ Space.nullHandle;
      REPEAT
        fail => {DeleteHeader[]; ERROR BcdFileDefs.UnknownFile[fti]};
      ENDLOOP;
    bcdFti _ fti;
    BcdUtilDefs.SetFileVersion[fti, bHeader.version];
    data.objectStamp _ OSMiscOps.MergeStamps[
      data.objectStamp, OSMiscOps.TimeToStamp[bHeader.version]];
    bcd _ (data.zone).NEW[BcdUtilDefs.BcdBases _ [
	ctb~LOOPHOLE[bHeader + bHeader.ctOffset],
	mtb~LOOPHOLE[bHeader + bHeader.mtOffset],
	lfb~LOOPHOLE[bHeader + bHeader.lfOffset],
	rfb~LOOPHOLE[bHeader + bHeader.rfOffset],
	tfb~LOOPHOLE[bHeader + bHeader.tfOffset],
	etb~LOOPHOLE[bHeader + bHeader.expOffset],
	itb~LOOPHOLE[bHeader + bHeader.impOffset],
	sgb~LOOPHOLE[bHeader + bHeader.sgOffset],
	ftb~LOOPHOLE[bHeader + bHeader.ftOffset],
	ssb~LOOPHOLE[bHeader + bHeader.ssOffset],
	evb~LOOPHOLE[bHeader + bHeader.evOffset],
	tyb~LOOPHOLE[bHeader + bHeader.typOffset],
	tmb~LOOPHOLE[bHeader + bHeader.tmOffset],
	ntb~LOOPHOLE[bHeader + bHeader.ntOffset],
	spb~LOOPHOLE[bHeader + bHeader.spOffset],
	fpb~LOOPHOLE[bHeader + bHeader.fpOffset] ]];
    limits _ [
	ct~bHeader.ctLimit,  mt~bHeader.mtLimit,
	et~bHeader.expLimit,
	it~bHeader.impLimit,
	sg~bHeader.sgLimit,  ft~bHeader.ftLimit,
	tm~bHeader.tmLimit,
	nt~bHeader.ntLimit,
	sp~bHeader.spLimit,  fp~bHeader.fpLimit];
    AllocateRelocations[$file];
    rel.originalfirstdummy _ bHeader.firstdummy};

  UnloadBcd: PROC ~ {
    Space.Delete[bcdSpace]; bcdSpace _ Space.nullHandle;
    (data.zone).FREE[@bcd];
    bcd _ @localBases};


  CTRecordSize: PROC [base: BcdUtilDefs.BcdBasePtr, cti: CTIndex] RETURNS [NAT] ~ INLINE {
    RETURN [CTRecord.SIZE + base.ctb[cti].nControls*Namee.SIZE]};
    
  EnumerateConfigurations: PROC [proc: PROC [CTIndex]] ~ {
    cti: CTIndex _ CTIndex.FIRST;
    UNTIL cti = limits.ct DO
      proc[cti];
      cti _ cti + CTRecordSize[bcd, cti];
      ENDLOOP};

  LoadConfigs: PROC [name: HTIndex, sti: STIndex] RETURNS [Symbols.STMap] ~ {
    rootCti: CTIndex _ CTNull;
        
    LoadConfig: PROC [cti: CTIndex] ~ {
      root: BOOL ~ bcd.ctb[cti].config = CTNull;
      newCti: CTIndex ~ bcd.EnterConfig[cti, IF root THEN name ELSE htNull];
        BEGIN OPEN new~~localBases.ctb[newCti];
        IF ~root THEN new.config _ new.config + rel.config
	ELSE {
	  CheckInternalName[new.name, sti];
	  IF rootCti # CTNull THEN
	    BcdErrorDefs.ErrorSti[$warning, "contains multiple root configs"L, sti];
	  rootCti _ newCti;  new.config _ CTNull};
        new.file _ MapFile[new.file];
	FOR i: CARDINAL IN [0 .. new.nControls) DO
	  WITH c~~new.controls[i] SELECT FROM
	    module => c.mti _ c.mti + rel.module;
	    config => c.cti _ c.cti + rel.config;
	    ENDCASE => ERROR;
	  ENDLOOP;
        END};

    EnumerateConfigurations[LoadConfig];
    RETURN [[config[rootCti]]]};

  UpdateConfigParent: PROC [parent: CTIndex, first, limit: CTIndex] ~ {
    FOR cti: CTIndex _ first, cti + CTRecordSize[@localBases, cti] UNTIL cti = limit DO
      OPEN new~~localBases.ctb[cti];
      IF new.config = CTNull THEN new.config _ parent;
      ENDLOOP};
      
      
  MTRecordSize: PROC [base: BcdUtilDefs.BcdBasePtr, mti: MTIndex] RETURNS [NAT] ~ INLINE {
    RETURN [MTRecord.SIZE]};
    
  EnumerateModules: PROC [
      proc: PROC [MTIndex] RETURNS [BOOL]] RETURNS [mti: MTIndex] ~ {
    mti _ MTIndex.FIRST;
    UNTIL mti = limits.mt DO
      IF proc[mti] THEN RETURN;
      mti _ mti + MTRecordSize[bcd, mti];
      ENDLOOP;
    RETURN [MTNull]};

  CheckPacking: PROC [mti: MTIndex] ~ {
    name: NameRecord ~ localBases.mtb[mti].name;
    FOR sti: STIndex _ packSti, stb[sti].link UNTIL sti = stNull DO
      IF BcdUtilDefs.NameForSti[sti] = name THEN {
	  stb[sti].body _ external[
	    map~[module[mti]], pointer~file[localBases.mtb[mti].file]];
	  EXIT};
      ENDLOOP};

  MapSegment: PROC [oldSgi: SGIndex] RETURNS [SGIndex] ~ {
    seg: SGRecord _ bcd.sgb[oldSgi];
    seg.file _ MapFile[seg.file];
    RETURN [BcdUtilDefs.EnterSegment[seg]]};

  LoadModules: PROC [name: HTIndex, sti: STIndex] RETURNS [Symbols.STMap] ~ {
    rootMti: MTIndex _ MTNull;
    
    LoadModule: PROC [mti: MTIndex] RETURNS [BOOL _ FALSE] ~ {
      root: BOOL ~ bcd.mtb[mti].config = CTNull;
      newMti: MTIndex = bcd.EnterModule[mti, IF root THEN name ELSE htNull];
        BEGIN OPEN new~~localBases.mtb[newMti];
        name _ htNull;
        IF ~root THEN new.config _ new.config + rel.config
	ELSE {
	  CheckInternalName[new.name, sti];
	  IF rootMti # MTNull THEN
	    BcdErrorDefs.ErrorSti[$warning, "contains multiple modules"L, sti];
	  rootMti _ newMti; new.config _ CTNull};
        new.gfi _ BcdUtilDefs.GetGfi[new.ngfi];
        new.file _ MapFile[new.file];
        new.code.sgi _ MapSegment[new.code.sgi];
        new.sseg _ MapSegment[new.sseg];
	CheckPacking[newMti];
        IF root THEN new.linkLoc _ currentLinkLoc
	ELSE IF explicitLinkLoc AND currentLinkLoc # new.linkLoc THEN
	  NULL;
--	  BcdErrorDefs.ErrorModule[
--	    warning,
--	    "has already been bound with a different link location"L,
--	    newMti];
	SELECT TRUE FROM
	  new.tableCompiled => NULL; 
	  (~bHeader.spare1) => BcdErrorDefs.ErrorModule[$error, " has obsolete format"L, mti];
	  ENDCASE;
	BcdLiterals.MapTypeLinks[new.types];
	BcdLiterals.MapLitLinks[new.refLiterals];
	END;
      RETURN};

    [] _ EnumerateModules[LoadModule];
    RETURN [[module[rootMti]]]};

  UpdateModuleParent: PROC [parent: CTIndex, first, limit: MTIndex] ~ {
    FOR mti: MTIndex _ first, mti + MTRecordSize[@localBases, mti] UNTIL mti = limit DO
      OPEN new~~localBases.mtb[mti];
      IF new.config = CTNull THEN new.config _ parent;
      ENDLOOP};
      

  ProcessTypeMap: PROC ~ {
    FOR tmi: TMIndex _ TMIndex.FIRST, tmi + TMRecord.SIZE UNTIL tmi = limits.tm DO
      newTypi: TYPIndex ~ bcd.EnterType[bcd.tmb[tmi].map];
      newTmi: TMIndex ~ bcd.EnterTypeMap[tmi];
	BEGIN OPEN new~~localBases.tmb[newTmi];
	SELECT new.map FROM
	  TYPNull => new.map _ newTypi;
	  newTypi => NULL;
	  ENDCASE => {
	    fti: FTIndex ~ BcdUtilDefs.FileForVersion[new.version];
	    BcdErrorDefs.ErrorItem[$error,
	      "is an exported type with clashing definitions"L, [NullName, fti], new.offset]};
	END;
      ENDLOOP};


  EnumerateSpaces: PROC [proc: PROC [SPIndex] RETURNS [BOOL]]
      RETURNS [spi: SPIndex] ~ {
    spi _ SPIndex.FIRST;
    UNTIL spi = limits.sp DO
      IF proc[spi] THEN RETURN;
      spi _ spi + SPRecord.SIZE + bcd.spb[spi].length*SpaceID.SIZE;
      ENDLOOP;
    RETURN [SPNull]};

  LoadSpaces: PROC ~ {

    LoadSpace: PROC [spi: SPIndex] RETURNS [BOOL _ FALSE] ~ {
      newSpi: SPIndex ~ bcd.EnterSpace[spi];
      localBases.spb[newSpi].seg _ MapSegment[bcd.spb[spi].seg];
      RETURN};

    [] _ EnumerateSpaces[LoadSpace]};

  EnumerateFramePacks: PROC [proc: PROC [FPIndex] RETURNS [BOOL]]
      RETURNS [fpi: FPIndex] ~ {
    fpi _ FPIndex.FIRST;
    UNTIL fpi = limits.fp DO
      IF proc[fpi] THEN RETURN;
      fpi _ fpi + FPRecord.SIZE + bcd.fpb[fpi].length*MTIndex.SIZE;
      ENDLOOP;
    RETURN [FPNull]};

  LoadFramePacks: PROC ~ {

    LoadFramePack: PROC [fpi: FPIndex] RETURNS [BOOL _ FALSE] ~ {
      newFpi: FPIndex ~ bcd.EnterFramePack[fpi];
      FOR i: CARDINAL IN [0 .. localBases.fpb[newFpi].length) DO
	localBases.fpb[newFpi].modules[i] _ localBases.fpb[newFpi].modules[i] + rel.module;
	ENDLOOP;
      RETURN};

    [] _ EnumerateFramePacks[LoadFramePack]};


  ProcessImports: PROC ~ {
    FOR impi: IMPIndex _ FirstImport[], NextImport[impi] UNTIL impi = IMPNull DO
      newImpi: IMPIndex ~ bcd.EnterImport[impi, TRUE];
      localBases.itb[newImpi].file _ MapFile[localBases.itb[newImpi].file];
      [] _ BcdUtilDefs.GetDummyGfi[localBases.itb[newImpi].ngfi];
      ENDLOOP};

  FirstImport: PROC RETURNS [IMPIndex] ~ INLINE {
    OPEN localBases;
    RETURN [IF limits.it = IMPIndex.FIRST THEN IMPNull ELSE IMPIndex.FIRST]};

  NextImport: PROC [impi: IMPIndex] RETURNS [IMPIndex] ~ INLINE {
    OPEN localBases;
    IF impi = IMPNull THEN RETURN [IMPNull];
    impi _ impi + IMPRecord.SIZE;
    RETURN [IF impi = limits.it THEN IMPNull ELSE impi]};

  nextLocalGfi: CARDINAL;

  GetLocalGfi: PROC [n: CARDINAL] RETURNS [gfi: GFTIndex] ~ {
    gfi _ nextLocalGfi;
    nextLocalGfi _ nextLocalGfi + n;  [] _ BcdUtilDefs.GetDummyGfi[n]};

  ProcessLocalImports: PROC [start: IMPIndex] ~ {
    nextLocalGfi _ 1;
    FOR sti: STIndex _ FirstLocalImport[], NextLocalImport[sti] UNTIL sti = stNull DO
      WITH s~~stb[sti] SELECT FROM
        unknown => DeclareImportByName[sti, start];
        external =>
          WITH m~~s.map SELECT FROM
            interface => DeclareImport[sti, m.expi];
            unknown => DeclareImportByName[sti, start];
            config, module => BcdErrorDefs.ErrorSti[$error,
	      "is both a component and an import of the config"L, sti];
            ENDCASE => Error[];
        ENDCASE => Error[];
      ENDLOOP};

  FirstLocalImport: PROC RETURNS [STIndex] ~ {
    OPEN localBases;
    FOR sti: STIndex _ cxb[loadCx].link, stb[sti].link UNTIL sti = stNull DO
      IF stb[sti].imported THEN RETURN [sti] ENDLOOP;
    RETURN [stNull]};

  NextLocalImport: PROC [sti: STIndex] RETURNS [STIndex] ~ {
    OPEN localBases;
    IF sti = stNull THEN RETURN [stNull];
    UNTIL (sti _ stb[sti].link) = stNull DO
      IF stb[sti].imported THEN RETURN [sti] ENDLOOP;
    RETURN [stNull]};

  DeclareImportByName: PROC [sti: STIndex, start: IMPIndex] ~ {
    impi: IMPIndex;
    maxNgfi: [1..4] _ 1;
    firstImpi: IMPIndex _ IMPNull;
    impLimit: IMPIndex ~ LOOPHOLE[table.Bounds[imptype].size];
    name: NameRecord ~ WITH s~~stb[sti] SELECT FROM
      external =>
        WITH p~~s SELECT FROM
          file => BcdUtilDefs.NameForSti[sti],
          instance => BcdUtilDefs.NameForSti[p.sti],
          ENDCASE => ERROR LoadError,
      unknown => BcdUtilDefs.NameForSti[sti],
      ENDCASE => ERROR LoadError;
    FOR impi _ start, impi+IMPRecord.SIZE UNTIL impi = impLimit DO
      IF localBases.itb[impi].name = name THEN {
	IF firstImpi = IMPNull THEN firstImpi _ impi;
	maxNgfi _ MAX[maxNgfi, localBases.itb[impi].ngfi]};
      ENDLOOP;
    IF firstImpi = IMPNull THEN {
      BcdErrorDefs.ErrorName[$warning, "is not IMPORTed by any modules"L, name];
      stb[sti].imported _ FALSE;
      RETURN};
    stb[sti].impi _ impi _ (@localBases).EnterImport[firstImpi, FALSE];
    WITH s~~stb[sti] SELECT FROM
      external =>
	IF s.ptype = $instance THEN {
	  BcdUtilDefs.CreateInstanceName[s.hti, [import[impi]]];
	  localBases.itb[impi].namedInstance _ TRUE};
      ENDCASE;
    localBases.itb[impi].ngfi _ maxNgfi;
    localBases.itb[impi].gfi _ GetLocalGfi[maxNgfi];
    IF stb[sti].type = $unknown THEN 
      stb[sti].body _ external[
	map~[unknown[]], pointer~file[localBases.itb[impi].file]]};

  DeclareImport: PROC [sti: STIndex, expi: EXPIndex] ~ {
    OPEN localBases, exp~~localBases.etb[expi];
    impi: IMPIndex ~ table.Words[imptype, IMPRecord.SIZE];
    ngfi: [0..4) ~ (exp.size + (EPLimit-1))/EPLimit;
    itb[impi] _ [
      port~$interface, namedInstance~FALSE, file~exp.file, ngfi~ngfi,
      name~BcdUtilDefs.NameForSti[sti], gfi~GetLocalGfi[ngfi]];
    stb[sti].impi _ impi;
    IF stb[sti].type = $unknown THEN 
      stb[sti].body _ external[map~[unknown[]], pointer~file[exp.file]]};

  Lookup: PROC [hti: HTIndex] RETURNS [sti: STIndex] ~ {
    last: STIndex;
    IF hti = htNull THEN RETURN [stNull];
    FOR sti _ cxb[currentCx].link, stb[sti].link UNTIL sti = stNull DO
      IF stb[sti].hti = hti THEN EXIT;  
      last _ sti;
      REPEAT
	FINISHED => {
	  sti _ BcdUtilDefs.NewSemanticEntry[hti];
	  stb[sti].hti _ hti;  stb[last].link _ sti};
      ENDLOOP;
    RETURN};

  PortableItem: TYPE ~ RECORD [
    SELECT type: * FROM
      interface => [expi: EXPIndex],
      module => [mti: MTIndex],
      unknown => [name: HTIndex],
      null => NULL,
      ENDCASE];

  PortNull: PortableItem ~ [null[]];

  HtiForPortable: PROC [p: PortableItem] RETURNS [HTIndex] ~ {
    RETURN [
      WITH p SELECT FROM
       interface => bcd.HtiForName[bcd.etb[expi].name],
       module    => bcd.HtiForName[bcd.mtb[mti].name],
       ENDCASE => htNull]};

  EnumerateExports: PROC [proc: PROC [PortableItem]] RETURNS [PortableItem] ~ {
    OPEN localBases;

    FindItem: Tree.Scan ~ {
      sti: STIndex ~ FindSti[t];
      IF stb[sti].exported THEN
	WITH s~~stb[sti] SELECT FROM
	  external =>
	    WITH m~~s.map SELECT FROM
	      interface => proc[[interface[m.expi]]];
	      module => proc[[module[m.mti]]];
	      ENDCASE => proc[[unknown[s.hti]]];
	  ENDCASE => proc[[unknown[s.hti]]]};

    SELECT TRUE FROM
      (loadExpi # EXPNull) => proc[[interface[loadExpi]]];
      (loadTree = Tree.nullIndex) =>
        FOR eti: EXPIndex _ EXPIndex.FIRST, eti+EXPRecord.SIZE+bcd.etb[eti].size
         UNTIL eti = limits.et DO
	  proc[[interface[eti]]] ENDLOOP;
      ENDCASE => {
	IF exportsALL THEN {
	  FOR sti: STIndex _ cxb[loadCx].link, stb[sti].link UNTIL sti = stNull DO
            IF ~stb[sti].filename THEN 
              WITH s~~stb[sti] SELECT FROM
                external =>
                  WITH m~~s.map SELECT FROM
                    interface => {s.exported _ TRUE;  proc[[interface[m.expi]]]};
                   ENDCASE;
                ENDCASE
            ENDLOOP};
	TreeOps.ScanList[tb[loadTree].son[2], FindItem]};
    RETURN [PortNull]};

  VerifyExports: ExportAssigner ~ {

    VerifyExport: PROC [p: PortableItem] ~ {
      WITH p SELECT FROM
        unknown => BcdErrorDefs.ErrorHti[$warning, "is not EXPORTed by any modules"L, name];
        ENDCASE};

    [] _ EnumerateExports[VerifyExport]};

  NormalExports: ExportAssigner ~ {
  
    NormalExport: PROC [p: PortableItem] ~ {
      CombineExport[Lookup[HtiForPortable[p]], p, currentOp]};
      
    [] _ EnumerateExports[NormalExport]};

  lhs: Tree.Link;

  AssignedExports: ExportAssigner ~ {
    port: TYPE ~ MACHINE DEPENDENT RECORD[in, out: UNSPECIFIED];
    left: PORT [Tree.Link] RETURNS [Tree.Link];
    right: PORT RETURNS [PortableItem];
    t: Tree.Link;
    p: PortableItem;
    nExports: CARDINAL _ 0;
    LOOPHOLE[left,port].out _ TreeOps.UpdateList;
    LOOPHOLE[right,port].out _ EnumerateExports;
    t _ LOOPHOLE[left,PORT[Tree.Link,POINTER] RETURNS [Tree.Link]][lhs, @left];
    p _ LOOPHOLE[right,PORT[POINTER] RETURNS [PortableItem]][@right];
    UNTIL p = PortNull DO
      nExports _ nExports+1;
      WITH t SELECT FROM
        symbol => CombineExport[index, p, currentOp];
        subtree => {
          OPEN tb[index];
          IF name # $item THEN Error[];
          WITH son[1] SELECT FROM
            symbol => CombineExport[index, p, currentOp];
            ENDCASE => Error[]};
        ENDCASE => Error[];
      t _ left[t];  p _ right[];
      IF t = lhs THEN EXIT;
      ENDLOOP;
    UNTIL p = PortNull DO nExports _ nExports+1; p _ right[] ENDLOOP;
    UNTIL t = lhs DO t _ left[t] ENDLOOP;
    SELECT TreeOps.ListLength[lhs] FROM
      < nExports =>
	BcdErrorDefs.Error[$error, "The right hand side exports more interfaces than required by the left hand side"L];
      > nExports =>
	BcdErrorDefs.Error[$error, "The left hand side requires more interfaces than exported by the right hand side"L];
      ENDCASE};

  LoadAssign: PROC [t: Tree.Link] ~ {
    node: Tree.Index ~ TreeOps.GetNode[t];
    saveAssigner: ExportAssigner ~ processExports;
    processExports _ AssignedExports;
    lhs _ tb[node].son[1];  LoadRhs[tb[node].son[2]];
    processExports _ saveAssigner};

  NewExport: PROC [expi: EXPIndex] RETURNS [newExpi: EXPIndex] ~ {
    newExpi _ bcd.EnterExport[expi, TRUE];
    localBases.etb[newExpi].file _ MapFile[localBases.etb[newExpi].file]};

  CombineExport: PROC [sti: STIndex, p: PortableItem, op: InterfaceOp] ~ {
    target: FTIndex ~ FileForSti[sti];
    WITH p SELECT FROM
      unknown => {
        BcdErrorDefs.ErrorHti[$warning, "is not EXPORTed by any modules"L, name];
        RETURN};
      ENDCASE;
    IF target = FTNull THEN DeclarePortableItem[sti, p]
    ELSE {
      source: FTIndex ~ FileForPortableItem[p];
      IF ~BcdUtilDefs.EqVersions[source, target] THEN
        BcdErrorDefs.Error2Files[
	  class~$error,
	  s~"is being exported, but required version is"L,
	  ft1~source, ft2~target]};
    WITH p SELECT FROM
      interface => CombineInterface[sti, expi, op];
      module    => CombineModule[sti, mti, op];
      ENDCASE};

  CombineModule: PROC [sti: STIndex, mti: MTIndex, op: InterfaceOp] ~ {
    WITH s~~stb[sti] SELECT FROM
      external =>
        WITH m~~s.map SELECT FROM
          module =>
	    IF m.mti = MTNull THEN m.mti _ mti
	    ELSE IF op = $plus THEN 
	      BcdErrorDefs.ErrorModule[$warning, "is a duplicate export"L, m.mti];
          unknown => s.map _ [module[bcd.EnterModule[mti, htNull]]];
          ENDCASE => Error[];
      ENDCASE => Error[]};


  CombineInterface: PROC [sti: STIndex, eti: EXPIndex, op: InterfaceOp] ~ {
    newEti: EXPIndex;
    WITH s~~stb[sti] SELECT FROM
      external =>
        WITH m~~s.map SELECT FROM
          interface => {
            IF m.expi = EXPNull THEN m.expi _ NewExport[eti];
            newEti _ m.expi};
          unknown => {
            newEti _ NewExport[eti]; s.map _ [interface[newEti]]};
          ENDCASE => NotOperand[sti];
      ENDCASE => Error[];
    BEGIN OPEN old~~bcd.etb[eti], new~~localBases.etb[newEti];
    FOR i: CARDINAL IN [0..old.size) DO
      IF old.links[i] # NullLink THEN
        SELECT TRUE FROM
	  (old.links[i].vtag = $type) => {
	    cl: BcdDefs.Link ~ [type[
		  typeID~bcd.EnterType[old.links[i].typeID],
		  type~TRUE, proc~FALSE]];
	    IF new.links[i] # NullLink AND new.links[i] # cl THEN
	      BcdErrorDefs.ErrorItem[$error,
		"is an incompatible type definition"L,
		[name~localBases.etb[newEti].name, fti~localBases.etb[newEti].file], i];
	    new.links[i] _ cl};
	  (new.links[i] = NullLink) =>
	    new.links[i] _ RelocateExportLink[old.links[i]];
	  (op = $plus) =>
	    BcdErrorDefs.ErrorItem[$warning, "is a duplicate export"L,
	      [name~localBases.etb[newEti].name, fti~localBases.etb[newEti].file], i];
	  ENDCASE;
      ENDLOOP;
    END};


  RelocateExportLink: PROC [cl: BcdDefs.Link] RETURNS [BcdDefs.Link] ~ {
    IF loadExpi = EXPNull AND loadCx = cxNull THEN
      SELECT cl.vtag FROM
	$var =>		cl.vgfi _ cl.vgfi + rel.firstgfi-1;
	$proc0, $proc1 => cl.gfi _ cl.gfi + rel.firstgfi-1;
	$type =>		ERROR;
	ENDCASE;
    RETURN [cl]};


  LoadRhs: PROC [exp: Tree.Link] ~ {
    WITH exp SELECT FROM
      subtree =>
        SELECT tb[index].name FROM
          $module => {currentParms _ tb[index].son[2];  LoadItem[tb[index].son[1]]};
          ENDCASE => LoadOperand[exp];
      ENDCASE => LoadOperand[exp]};

  LoadOperand: PROC [exp: Tree.Link] ~ {
    WITH exp SELECT FROM
      symbol => LoadOperandSti[index];
      subtree =>
        SELECT tb[index].name FROM
          $item =>
	    LoadOperandSti[NARROW[tb[index].son[1], Tree.Link.symbol].index];
          $module => {
            BcdErrorDefs.ErrorSti[$error,
	      "must name an interface (no ""[]"")"L,
	      FindSti[tb[index].son[1]]];
            currentParms _ tb[index].son[2];  LoadItem[tb[index].son[1]]};
          $plus, $then => {
            LoadOperand[tb[index].son[1]];
            currentOp _ tb[index].name;
            LoadOperand[tb[index].son[2]];
            currentOp _ $plus};
          ENDCASE => Error[];
      ENDCASE => Error[]};

  NotOperand: PROC [sti: STIndex] ~ {
    BcdErrorDefs.ErrorSti[$error, "must name an interface"L, sti];
    LoadSti[sti, htNull]};

  LoadOperandSti: PROC [sti: STIndex] ~ {
    WITH s~~stb[sti] SELECT FROM
      external =>
        WITH m~~s.map SELECT FROM
          interface => {
            IF m.expi = EXPNull THEN Error[];
            loadExpi _ m.expi;  processExports[];  loadExpi _ EXPNull};
	  unknown => BcdErrorDefs.ErrorSti[$error, "cannot be an operand"L, sti];
          ENDCASE => NotOperand[sti];
      unknown =>
	IF s.imported THEN 
	  BcdErrorDefs.ErrorSti[$error, "is imported and cannot be an operand"L, sti]
	ELSE NotOperand[sti];
      ENDCASE => NotOperand[sti]};

  }.