-- BcdUtilities.mesa
-- Last edited by Satterthwaite on August 1, 1983 11:59 am
-- Last edited by Lewis on 16-Dec-80 10:47:39

DIRECTORY
  Alloc: TYPE USING [AddNotify, DropNotify, Handle, Notifier, Top, Words],
  BcdDefs: TYPE USING [
    CTIndex, CTRecord, cttype, cxtype, EVIndex, EVNull,
    EVRecord, evtype, EXPIndex, EXPRecord, exptype, FPIndex, FPRecord, fptype,
    FTIndex, FTNull, FTRecord, FTSelf, fttype, GFTIndex,
    IMPIndex, IMPNull, IMPRecord, imptype, LFIndex, LFNull, lftype, Link, LinkFrag,
    MTIndex, MTRecord, mttype, Namee, NameRecord, NTIndex, NTRecord, nttype,
    NullLink, NullName, NullVersion, RFIndex, RFNull, rftype, RefLitFrag,
    SGIndex, SGRecord, sgtype, SpaceID, SPIndex, SPRecord, sptype, sttype,
    TFIndex, TFNull, tftype, TMIndex, TMRecord, tmtype, TypeFrag,
    TYPIndex, TYPNull, TYPRecord, typtype, VersionStamp],
  BcdErrorDefs: TYPE USING [Error2Versions],
  BcdUtilDefs: TYPE USING [BcdBasePtr],
  HashOps: TYPE USING [
    EnterString, FindEquivalentString, FindString, SubStringForHash],
  Inline: TYPE USING [LongCOPY],
  Strings: TYPE USING [EquivalentSubString, String, SubString, SubStringDescriptor],
  Symbols: TYPE USING [
    CXIndex, CXRecord, HTIndex, htNull, STIndex, stNull, STRecord],
  Table: TYPE USING [Base],
  Tree: TYPE USING [Link];

BcdUtilities: PROGRAM
    IMPORTS Alloc, BcdErrorDefs, HashOps, Inline, Strings
    EXPORTS BcdUtilDefs = PUBLIC {
  OPEN BcdUtilDefs, BcdDefs;

  Copy: PROC [from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] ~
    Inline.LongCOPY;
    
  STIndex: TYPE ~ Symbols.STIndex;
  stNull: STIndex ~ Symbols.stNull;
  HTIndex: PRIVATE TYPE ~ Symbols.HTIndex;
  htNull: HTIndex ~ Symbols.htNull;
  SubStringDescriptor: TYPE ~ Strings.SubStringDescriptor;
  SubString: TYPE ~ Strings.SubString;

  table: Alloc.Handle;
  
  ctb, mtb, lfb, rfb, tfb: Table.Base;
  sgb, ftb, itb, etb, ntb, stb, cxb, evb, tyb, tmb, spb, fpb: Table.Base;

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

  EnterName: PROC [ss: SubString] RETURNS [NameRecord] ~ {
    lss: SubStringDescriptor;
    hti: HTIndex ~ HashOps.EnterString[ss];
    HashOps.SubStringForHash[@lss, hti];
    RETURN [[lss.offset]]};

  MapName: PROC [bcd: BcdBasePtr, n: NameRecord] RETURNS [NameRecord] ~ {
    ss: SubStringDescriptor ← [
      base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
    RETURN [EnterName[@ss]]};

  MapEquivalentName: PRIVATE PROC [bcd: BcdBasePtr, n: NameRecord]
      RETURNS [NameRecord] ~ {
    ss: SubStringDescriptor ← [base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
    hti: HTIndex;
    hti ← HashOps.FindString[@ss];
    IF hti = htNull THEN hti ← HashOps.FindEquivalentString[@ss];
    RETURN [[IF hti # htNull THEN NameForHti[hti] ELSE EnterName[@ss]]]};

  HtiForName: PROC [bcd: BcdBasePtr, n: NameRecord] RETURNS [HTIndex] ~ {
    ss: SubStringDescriptor ← [base~@bcd.ssb.string, offset~n, length~bcd.ssb.size[n]];
    RETURN [HashOps.EnterString[@ss]]};

  NameForHti: PROC [hti: HTIndex] RETURNS [NameRecord] ~ {
    ss: SubStringDescriptor;
    HashOps.SubStringForHash[@ss, hti];
    RETURN [[ss.offset]]};

  NameForSti: PROC [sti: STIndex] RETURNS [NameRecord] ~ {
    RETURN [NameForHti[stb[sti].hti]]};

  ContextForTree: PROC [t: Tree.Link] RETURNS [Symbols.CXIndex] ~ {
    sti: STIndex ~ NARROW[t, Tree.Link.symbol].index;
    RETURN [NARROW[stb[sti], Symbols.STRecord.local].context]};

  EqVersions: PROC [fti1, fti2: FTIndex] RETURNS [BOOL] ~ {
    RETURN [fti1 = fti2 OR ftb[fti1].version = ftb[fti2].version]};

  EquivalentVersions: PROC [v1, v2: VersionStamp] RETURNS [BOOL] ~ { 
    RETURN [v1 = v2]};

  InsertFile: PRIVATE PROC [
      fn: NameRecord, version: VersionStamp] RETURNS [fti: FTIndex] ~ {
    ftLimit: FTIndex ~ table.Top[fttype];
    mismatched: BOOL ← FALSE;
    otherVersion: VersionStamp;
    FOR fti ← FTIndex.FIRST, fti+FTRecord.SIZE UNTIL fti = ftLimit DO
      IF ftb[fti].name = fn THEN
        SELECT TRUE FROM
          (ftb[fti].version = NullVersion) => {ftb[fti].version ← version; EXIT};
          EquivalentVersions[ftb[fti].version, version],
	   (version = NullVersion) => EXIT;
          ENDCASE => {mismatched ← TRUE;  otherVersion ← ftb[fti].version};
      REPEAT
	FINISHED => {
	  fti ← table.Words[fttype, FTRecord.SIZE];
	  ftb[fti] ← [name~fn, version~version];
	  IF mismatched THEN BcdErrorDefs.Error2Versions[
	    class~$warning, fileName~fn, v1~version, v2~otherVersion]};
      ENDLOOP;
    RETURN};

  MergeFile: PROC [bcd: BcdBasePtr, oldFti: FTIndex] RETURNS [FTIndex] ~ {
    fn: NameRecord;
    IF oldFti = FTSelf OR oldFti = FTNull THEN RETURN [oldFti];
    fn ← MapEquivalentName[bcd, bcd.ftb[oldFti].name];
    RETURN [InsertFile[fn, bcd.ftb[oldFti].version]]};

  EnterFile: PROC [name: Strings.String] RETURNS [FTIndex] ~ {
    ss: SubStringDescriptor ← [base~name, offset~0, length~name.length];
    fn: NameRecord;
    hti: HTIndex;
    nullV: VersionStamp ← NullVersion;
    IF ss.base[ss.offset+ss.length-1] = '. THEN ss.length ← ss.length-1;
    IF ss.length > 4 THEN {
      ext: SubStringDescriptor ← [base~".bcd"L, offset~0, length~4];
      st: SubStringDescriptor ← [base~ss.base, offset~ss.offset+ss.length-4, length~4];
      IF Strings.EquivalentSubString[@st, @ext] THEN ss.length ← ss.length-4};
    hti ← HashOps.FindString[@ss];
    IF hti = htNull THEN hti ← HashOps.FindEquivalentString[@ss];
    fn ← IF hti # htNull THEN NameForHti[hti] ELSE EnterName[@ss];
    RETURN [InsertFile[fn, nullV]]};

  SetFileVersion: PROC [fti: FTIndex, v: VersionStamp] ~ {
    OPEN file~~ftb[fti];
    SELECT TRUE FROM
      (file.version = NullVersion) => file.version ← v;
      EquivalentVersions[file.version, v] => NULL;
      ENDCASE => 
	BcdErrorDefs.Error2Versions[
	  class~$warning, fileName~file.name, v1~v, v2~file.version]};

  FileForVersion: PROC [v: VersionStamp] RETURNS [fti: FTIndex] ~ {
    ftLimit: FTIndex ~ table.Top[fttype];
    FOR fti ← FTIndex.FIRST, fti+FTRecord.SIZE UNTIL fti = ftLimit DO
      IF ftb[fti].version = v THEN EXIT;
      REPEAT
	FINISHED => fti ← FTNull;
      ENDLOOP;
    RETURN};

  nextGfi: CARDINAL;
  nextDummyGfi: CARDINAL;

  GftOverflow: PUBLIC SIGNAL ~ CODE;

  GetGfi: PROC [n: CARDINAL] RETURNS [gfi: GFTIndex] ~ {
    gfi ← nextGfi;
    nextGfi ← nextGfi + n;
    IF nextGfi > GFTIndex.LAST THEN ERROR GftOverflow;
    RETURN};

  GetDummyGfi: PROC [n: CARDINAL] RETURNS [gfi: CARDINAL] ~ {
    gfi ← nextDummyGfi;
    nextDummyGfi ← nextDummyGfi + n;
    RETURN};

  NewContext: PROC RETURNS [ctx: Symbols.CXIndex] ~ {
    ctx ← table.Words[cxtype, Symbols.CXRecord.SIZE];
    cxb[ctx] ← [link~stNull];
    RETURN};

  NewSemanticEntry: PROC [hti: HTIndex] RETURNS [sti: STIndex] ~ {
    sti ← table.Words[sttype, Symbols.STRecord.SIZE];
    stb[sti] ← [
      filename~FALSE, assigned~FALSE,
      imported~FALSE, exported~FALSE,
      hti~htNull,
      link~stNull,
      impi~IMPNull, impgfi~0,
      body~unknown[]];
    stb[sti].hti ← hti;
    RETURN};

  EnterConfig: PROC [bcd: BcdBasePtr, oldCti: CTIndex, name: HTIndex]
      RETURNS [cti: CTIndex] ~ {
    OPEN old~~bcd.ctb[oldCti];
    size: CARDINAL ~ CTRecord.SIZE + old.nControls*Namee.SIZE;
    cti ← table.Words[cttype, size];
    Copy[from~@old, to~@ctb[cti], nwords~size];
    ctb[cti].name ← MapName[bcd, old.name];
    IF name # htNull THEN {
      ctb[cti].namedInstance ← TRUE; CreateInstanceName[name, [config[cti]]]}
    ELSE IF old.namedInstance THEN CopyInstanceName[bcd, [config[oldCti]], [config[cti]]];
    RETURN};

  EnterModule: PROC [bcd: BcdBasePtr, oldMti: MTIndex, name: HTIndex]
      RETURNS [mti: MTIndex] ~ {
    OPEN old~~bcd.mtb[oldMti];
    size: CARDINAL ~ MTRecord.SIZE;
    mti ← table.Words[mttype, size];
    Copy[to~@mtb[mti], from~@old, nwords~size];
    mtb[mti].name ← MapName[bcd, old.name];
    IF name # htNull THEN {
      mtb[mti].namedInstance ← TRUE; CreateInstanceName[name, [module[mti]]]}
    ELSE IF old.namedInstance THEN CopyInstanceName[bcd, [module[oldMti]], [module[mti]]];
    IF old.variables # EVNull THEN mtb[mti].variables ← EnterVariables[bcd, old.variables];
    mtb[mti].links ← EnterLinks[bcd, old.links];
    mtb[mti].refLiterals ← EnterLits[bcd, old.refLiterals];
    mtb[mti].types ← EnterTypes[bcd, old.types];
    RETURN};

  EnterLinks: PRIVATE PROC [bcd: BcdBasePtr, oldLfi: LFIndex] RETURNS [lfi: LFIndex] ~ {
    IF oldLfi = LFNull THEN lfi ← LFNull
    ELSE {
      OPEN old~~bcd.lfb[oldLfi];
      size: CARDINAL ~ LinkFrag[old.length].SIZE;
      lfi ← table.Words[lftype, size];
      Copy[to~@lfb[lfi], from~@old, nwords~size]};
    RETURN};
    
  EnterLits: PRIVATE PROC [bcd: BcdBasePtr, oldRfi: RFIndex] RETURNS [rfi: RFIndex] ~ {
    IF oldRfi = RFNull THEN rfi ← RFNull
    ELSE {
      OPEN old~~bcd.rfb[oldRfi];
      size: CARDINAL ~ RefLitFrag[old.length].SIZE;
      rfi ← table.Words[rftype, size];
      Copy[to~@rfb[rfi], from~@old, nwords~size]};
    RETURN};
    
  EnterTypes: PRIVATE PROC [bcd: BcdBasePtr, oldTfi: TFIndex] RETURNS [tfi: TFIndex] ~ {
    IF oldTfi = TFNull THEN tfi ← TFNull
    ELSE {
      OPEN old~~bcd.tfb[oldTfi];
      size: CARDINAL ~ TypeFrag[old.length].SIZE;
      tfi ← table.Words[tftype, size];
      Copy[to~@tfb[tfi], from~@old, nwords~size]};
    RETURN};
    
  EnterVariables: PRIVATE PROC [bcd: BcdBasePtr, oldEvi: EVIndex]
      RETURNS [evi: EVIndex] ~ {
    OPEN old~~bcd.evb[oldEvi];
    evLimit: EVIndex ~ table.Top[evtype];
    oldLength: CARDINAL ~ old.length;
    FOR evi ← EVIndex.FIRST, evi+EVRecord.SIZE+evb[evi].length UNTIL evi = evLimit DO
      IF evb[evi].length >= oldLength THEN
        FOR i: CARDINAL DECREASING IN [1..oldLength] DO
	  IF evb[evi].offsets[i] # old.offsets[i] THEN EXIT;
	  REPEAT
	    FINISHED => RETURN;
	  ENDLOOP;
      ENDLOOP;
    evi ← table.Words[evtype, EVRecord.SIZE+oldLength];
    Copy[to~@evb[evi], from~@old, nwords~EVRecord.SIZE+oldLength];
    RETURN};

  EnterSegment: PROC [seg: SGRecord] RETURNS [sgi: SGIndex] ~ {
    sgLimit: SGIndex ~ table.Top[sgtype];
    FOR sgi ← SGIndex.FIRST, sgi+SGRecord.SIZE UNTIL sgi = sgLimit DO
      IF sgb[sgi] = seg THEN RETURN ENDLOOP;
    sgi ← table.Words[sgtype, SGRecord.SIZE];
    sgb[sgi] ← seg;
    RETURN};

  EnterImport: PROC [bcd: BcdBasePtr, oldIti: IMPIndex, copyName: BOOL]
      RETURNS [iti: IMPIndex] ~ {
    OPEN old~~bcd.itb[oldIti];
    iti ← table.Words[imptype, IMPRecord.SIZE];
    itb[iti] ← old;
    itb[iti].name ← MapName[bcd, old.name];
    IF copyName AND old.namedInstance THEN
      CopyInstanceName[bcd, [import[oldIti]], [import[iti]]]
    ELSE itb[iti].namedInstance ← FALSE;
    RETURN};

  EnterExport: PROC [bcd: BcdBasePtr, oldEti: EXPIndex, copyName: BOOL]
      RETURNS [eti: EXPIndex] ~ {
    OPEN old~~bcd.etb[oldEti];
    size: CARDINAL ~ old.size + EXPRecord.SIZE;
    eti ← table.Words[exptype, size];
    etb[eti] ← old;
    FOR i: CARDINAL IN [0..etb[eti].size) DO etb[eti].links[i] ← NullLink ENDLOOP;
    etb[eti].name ← MapName[bcd, old.name];
    IF copyName AND old.namedInstance THEN
      CopyInstanceName[bcd, [export[oldEti]], [export[eti]]]
    ELSE etb[eti].namedInstance ← FALSE;
    RETURN};

  EnterType: PROC [bcd: BcdBasePtr, oldTypi: TYPIndex] RETURNS [typi: TYPIndex] ~ {
    OPEN old~~bcd.tyb[oldTypi];
    typLimit: TYPIndex ~ table.Top[typtype];
    FOR typi ← TYPIndex.FIRST, typi +TYPRecord.SIZE UNTIL typi = typLimit DO
      IF tyb[typi] = old THEN EXIT;
      REPEAT FINISHED => {
	typi ← table.Words[typtype, TYPRecord.SIZE]; tyb[typi] ← old};
      ENDLOOP;
    RETURN};

  EnterTypeMap: PROC [bcd: BcdBasePtr, oldTmi: TMIndex] RETURNS [tmi: TMIndex] ~ {
    OPEN old~~bcd.tmb[oldTmi];
    tmLimit: TMIndex ~ table.Top[tmtype];
    FOR tmi ← TMIndex.FIRST, tmi + TMRecord.SIZE UNTIL tmi = tmLimit DO
      IF tmb[tmi].offset = old.offset AND tmb[tmi].version = old.version THEN EXIT;
      REPEAT
	FINISHED => {
	  tmi ← table.Words[tmtype, TMRecord.SIZE];
	  tmb[tmi] ← [version~old.version, offset~old.offset, map~TYPNull]};
      ENDLOOP;
    RETURN};

  EnterSpace: PROC [bcd: BcdBasePtr, oldSpi: SPIndex] RETURNS [spi: SPIndex] ~ {
    OPEN old~~bcd.spb[oldSpi];
    size: CARDINAL ~ SPRecord.SIZE + old.length*SpaceID.SIZE;
    spi ← table.Words[sptype, size];
    Copy[from~@old, to~@spb[spi], nwords~size];
    FOR i: CARDINAL IN [0 .. spb[spi].length) DO
      spb[spi].spaces[i].name ← MapName[bcd, old.spaces[i].name];
      ENDLOOP;
    RETURN};

  EnterFramePack: PROC [bcd: BcdBasePtr, oldFpi: FPIndex] RETURNS [fpi: FPIndex] ~ {
    OPEN old~~bcd.fpb[oldFpi];
    size: CARDINAL ~ FPRecord.SIZE + old.length*MTIndex.SIZE;
    fpi ← table.Words[fptype, size];
    Copy[from~@old, to~@fpb[fpi], nwords~size];
    fpb[fpi].name ← MapName[bcd, old.name];
    RETURN};

  CreateInstanceName: PROC [hti: HTIndex, item: Namee] ~ {
    nti: NTIndex ~ table.Words[nttype, NTRecord.SIZE];
    ntb[nti] ← [item~item, name~NameForHti[hti]]};

  InstanceName: PROC [item: Namee] RETURNS [NameRecord] ~ {
    ntLimit: NTIndex ~ table.Top[nttype];
    FOR nti: NTIndex ← NTIndex.FIRST, nti + NTRecord.SIZE UNTIL nti = ntLimit DO
      IF ntb[nti].item = item THEN RETURN [ntb[nti].name] ENDLOOP;
    RETURN [NullName]};


  CopyInstanceName: PRIVATE PROC [bcd: BcdBasePtr, old, new: Namee] ~ {
    nti: NTIndex = table.Words[nttype, NTRecord.SIZE];
    FOR oldNti: NTIndex ← NTIndex.FIRST, oldNti + NTRecord.SIZE DO
      IF (bcd.ntb[oldNti]).item = old THEN {
        ntb[nti] ← [item~new, name~MapName[bcd, bcd.ntb[oldNti].name]]; RETURN};
      ENDLOOP};

  -- Administrative Procedures

  Init: PROC [ownTable: Alloc.Handle] ~ {
    table ← ownTable;
    table.AddNotify[Notifier]; nextGfi ← nextDummyGfi ← 1};

  Reset: PROC ~ {table.DropNotify[Notifier]; table ← NIL};

  }.