-- SymsMed.Mesa  Edited by:
  -- Bruce Oct 9, 1980 7:45 PM
  -- Sandman July 17, 1980  11:10 AM
  -- Johnsson July 21, 1980  5:19 PM
  
DIRECTORY
  BcdDefs USING [
    Base, BCD, FTNull, FTSelf, GFTIndex, MTIndex, NameRecord, NullVersion, SGIndex,
    SGNull, VersionID, VersionStamp],
  BcdOps USING [BcdBase, FTHandle, MTHandle, NameString, ProcessModules, SGHandle],
  DebugOps USING [CacheNewFile, InvalidateFileCache, UserAborted],
  DLoadState USING [Acquire, AcquireBcd, Invalid, MapRealToConfig, Release, ReleaseBcd],
  DOutput USING [Blanks, Char, Text],
  DSymOps USING [CacheItem, DeleteItem, StripExtension, SymHandle, SymRec],
  DSyms USING [FindFrame, Item],
  Frames USING [Invalid],
  Gf USING [File, GFI, Original],
  Lookup USING [Fail],
  MachineDefs USING [
    ConfigIndex, CoPilot, FileHandle, FSHandle, GFHandle, GFTIndex, NullConfig],
  Segments USING [
    DefaultAccess, DeleteSegment, FileProblem, FileNameProblem, SegmentAddress,
    MoveSegment, NewFile, NewSegment, OldFileOnly, PageNumber, Read, SwapIn,
    SwapOut, Unlock, VMtoSegment, FileFromSegment],
  String USING [AppendString],
  Strings USING [AppendSubString, EquivalentSubString, SubStringDescriptor],
  SymbolOps USING [EnterString],
  Symbols USING [HTIndex, HTNull],
  SymbolTable USING [Missing],
  Table USING [Base],
  UserInput USING [userAbort];
  
SymsMed: PROGRAM
  IMPORTS BcdOps, DLoadState, Strings, 
    DSymOps, DSyms, DebugOps, DOutput, Frames, Gf, 
    Lookup, Segments, String, SymbolOps, SymbolTable, UserInput
  EXPORTS DSymOps =
  BEGIN OPEN DSymOps, DSyms, MachineDefs;
  
  CantAttach: ERROR = CODE;
  WrongVersion: ERROR = CODE;
  SymbolTableProblem: ERROR = CODE;
  
  ssb: BcdOps.NameString;
  bcd: BcdOps.BcdBase _ NIL;
  sgb: BcdDefs.Base _ NIL;
  sgh: BcdOps.SGHandle;
  
  SymbolSegForFrame: PUBLIC PROCEDURE [h: SymHandle] =
    BEGIN
    cgfi: GFTIndex;
    config: ConfigIndex;
    tryBcd: BOOLEAN _ FALSE;
    name: BcdDefs.NameRecord;
    saveMth: BcdOps.MTHandle;
    
    FindModule: PROCEDURE [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS [BOOLEAN] =
      BEGIN
      ssd: Strings.SubStringDescriptor;
      IF cgfi IN [mth.gfi..mth.gfi+mth.ngfi) THEN
	BEGIN
	saveMth _ mth;
	sgh _ @sgb[mth.sseg];
	IF h.hti = Symbols.HTNull THEN {
	  ssd _ [base: @ssb.string, offset: mth.name, length: ssb.size[mth.name]];
	  h.hti _ SymbolOps.EnterString[@ssd]};
	h.jumped _ mth.crossJumped;
	SELECT mth.file FROM
	  BcdDefs.FTNull, BcdDefs.FTSelf => NULL;
	  ENDCASE => {
	    f: BcdOps.FTHandle = @LOOPHOLE[bcd+bcd.ftOffset, BcdDefs.Base][mth.file];
	    IF sgh.file # sgb[mth.code.sgi].file THEN {
	      name _ f.name; h.version _ f.version; tryBcd _ TRUE}  };
	RETURN[TRUE];
	END;
      IF UserInput.userAbort THEN SIGNAL DebugOps.UserAborted;
      RETURN[FALSE];
      END;
      
    [] _ DLoadState.Acquire[ ! DLoadState.Invalid => GOTO nil];
    [cgfi,config] _ DLoadState.MapRealToConfig[Gf.GFI[Gf.Original[h.gf]]];
    IF config = NullConfig THEN {
      DLoadState.Release[]; ERROR Frames.Invalid[h.gf]};
    bcd _ DLoadState.AcquireBcd[config];
    ssb _ LOOPHOLE[bcd+bcd.ssOffset];
    sgb _ LOOPHOLE[bcd+bcd.sgOffset];
    [] _ BcdOps.ProcessModules[bcd, FindModule ! UNWIND => Cleanup[]];
    IF tryBcd THEN LookForBcd[h, name !
	Segments.FileNameProblem[], Segments.FileProblem[] => CONTINUE;
	UNWIND => Cleanup[]];
    IF h.seg = NIL THEN FindSeg[h, saveMth !
	Segments.FileNameProblem[], Segments.FileProblem[] => {Cleanup[]; GOTO nil};
	UNWIND => Cleanup[]];
    Cleanup[];
    IF h.hti = Symbols.HTNull THEN ERROR Frames.Invalid[h.gf];
    EXITS nil => RETURN;
    END;
    
  LookForBcd: PROCEDURE [h: SymHandle, name: BcdDefs.NameRecord] =
    BEGIN OPEN Segments;
    file: FileHandle;
    filename: STRING _ [40];
    MakeName[filename, name, TRUE];
    file _ DebugOps.CacheNewFile[filename, Segments.DefaultAccess];
    CompilerSeg[h, file ! WrongVersion => {IncorrectVersion[filename]; CONTINUE}];
    END;
    
  FindSeg: PROCEDURE [h: SymHandle, mth: BcdOps.MTHandle] =
    BEGIN OPEN Segments;
    file: FileHandle _ NIL;
    f: BcdOps.FTHandle = @LOOPHOLE[bcd+bcd.ftOffset, BcdDefs.Base][sgh.file];
    name: BcdDefs.NameRecord;
    SELECT sgh.file FROM
      BcdDefs.FTNull => RETURN;
      BcdDefs.FTSelf => IF MachineDefs.CoPilot THEN {
	  name _ bcd.source; h.version _ bcd.version;
	  IF ~EquivalentNames[bcd, mth.name, name] THEN {
	    TryName[h, mth.name, TRUE !
	      Segments.FileNameProblem[], Segments.FileProblem[] => CONTINUE];
	    IF h.seg # NIL THEN RETURN}  }
	ELSE {
	  bcdseg: FSHandle _ VMtoSegment[bcd];
	  h.seg _ NewSegment[FileFromSegment[bcdseg], sgh.base, sgh.pages+sgh.extraPages];
	  h.fgt _ sgh.extraPages # 0;
	  h.version _ f.version;
	  RETURN};
      sgb[mth.code.sgi].file => {
	IF ~MachineDefs.CoPilot THEN file _ Gf.File[h.gf];
	name _ f.name; h.version _ f.version}
      ENDCASE => {name _ f.name; h.version _ f.version};
    TryName[h, name, sgh.file = BcdDefs.FTSelf, file];
    RETURN;
    END;
    
  TryName: PROCEDURE [
      h: SymHandle, name: BcdDefs.NameRecord, force: BOOLEAN, file: FileHandle _ NIL] =
    BEGIN OPEN Segments;
    filename: STRING _ [40];
    symsbcd: BcdOps.BcdBase;
    IF file = NIL THEN {
      MakeName[filename, name, force];
      file _ DebugOps.CacheNewFile[filename, Segments.DefaultAccess]};
    h.seg _ NewSegment[file, 1, 1];
    SwapIn[h.seg];
    symsbcd _ SegmentAddress[h.seg];
    IF symsbcd.version # h.version THEN {
      Unlock[h.seg]; DeleteSegment[h.seg]; h.seg _ NIL;
      IncorrectVersion[filename];
      RETURN};
    Unlock[h.seg];
    MoveSegment[h.seg, sgh.base, sgh.pages+sgh.extraPages];
    h.fgt _ sgh.extraPages # 0;
    RETURN;
    END;
    
  MakeName: PROC [
      fileName: STRING, name: BcdDefs.NameRecord, force: BOOLEAN] = {
    ss: Strings.SubStringDescriptor _ [@ssb.string, name, ssb.size[name]];
    Strings.AppendSubString[fileName, @ss];
    CheckForExtension[fileName, ".bcd"L, force]};
    
  EquivalentNames: PROC [ bcd: BcdOps.BcdBase, n1, n2: BcdDefs.NameRecord] 
    RETURNS [BOOLEAN] = {
    ssb: BcdOps.NameString = LOOPHOLE[bcd+bcd.ssOffset];
    ss1: Strings.SubStringDescriptor _ [@ssb.string, n1, ssb.size[n1]];
    ss2: Strings.SubStringDescriptor _ [@ssb.string, n2, ssb.size[n2]];
    RETURN[Strings.EquivalentSubString[@ss1, @ss2]]};
    
  Cleanup: PROC [] = {
    DLoadState.ReleaseBcd[bcd]; DLoadState.Release[]};
    
  IncorrectVersion: PROC [name: STRING] =
    BEGIN OPEN DOutput;
    Char[' ]; Text[name]; Text[" referenced in different versions! "L];
    END;
    
  CheckForExtension: PROCEDURE [name, ext: STRING, force: BOOLEAN _ FALSE] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..name.length) DO
      IF name[i] = '. THEN IF force THEN {name.length _ i; EXIT} ELSE RETURN;
      ENDLOOP;
    String.AppendString[name, ext];
    RETURN
    END;
    
  AttachSyms: PUBLIC PROC [gf: GFHandle, file: STRING] =
    BEGIN
    syms: Item;
    mod: STRING _ [40];
    rec: SymRec _ [gf: gf, hti: Symbols.HTNull];
    fh: FileHandle;
    String.AppendString[mod,file]; DSymOps.StripExtension[mod];
    String.AppendString[mod,".bcd"L];
    fh _ Segments.NewFile[mod,Segments.Read,Segments.OldFileOnly !
      Segments.FileNameProblem[] => {SIGNAL Lookup.Fail[mod]; CONTINUE}];
    IF gf # NIL AND (syms _ FindFrame[gf]) # NIL THEN
      DSymOps.DeleteItem[syms];
    CompilerSeg[@rec,fh ! CantAttach =>
	BEGIN OPEN DOutput;
	Blanks[1]; Text[mod]; Text[" is a definitions file!"L];
	GOTO bad
	END];
    [] _ CacheItem[@rec ! SymbolTable.Missing =>
	  BEGIN OPEN DOutput;
	  Blanks[1]; Text[mod]; Text[" does not have a valid symbol table!"L];
	  CONTINUE
	  END];
    DebugOps.InvalidateFileCache[];
    EXITS bad => NULL
    END;
    
  CompilerSeg: PROC [h: SymHandle, file: FileHandle] =
    BEGIN OPEN Segments;
    sgh: BcdOps.SGHandle;
    mth: BcdOps.MTHandle;
    ssb: BcdOps.NameString;
    sSeg: BcdDefs.SGIndex;
    bcdPages: CARDINAL _ 1;
    bcd: BcdOps.BcdBase;
    headerSeg: FSHandle _ NewSegment[file, 1, bcdPages];
    ssd: Strings.SubStringDescriptor;
    BEGIN
    DO
      SwapIn[headerSeg];  bcd _ SegmentAddress[headerSeg];
      IF bcd.versionIdent # BcdDefs.VersionID THEN GOTO nogood;
      IF bcdPages = bcd.nPages THEN EXIT;
      bcdPages _ bcd.nPages;
      Unlock[headerSeg];  SwapOut[headerSeg];
      MoveSegment[headerSeg, 1, bcdPages];
      ENDLOOP;
    IF h.version # BcdDefs.NullVersion AND bcd.version # h.version THEN {
      CleanupSeg[headerSeg]; ERROR WrongVersion};
    IF bcd.nConfigs # 0 THEN GOTO nogood;
    IF bcd.definitions AND h.gf # NIL THEN {CleanupSeg[headerSeg]; ERROR CantAttach};
    mth _ @LOOPHOLE[bcd+bcd.mtOffset,Table.Base][FIRST[BcdDefs.MTIndex]];
    sSeg _ mth.sseg; h.jumped _ mth.crossJumped;
    sgh _ @LOOPHOLE[bcd+bcd.sgOffset,Table.Base][sSeg];
    IF sSeg=BcdDefs.SGNull OR sgh.pages = 0 OR sgh.file # BcdDefs.FTSelf THEN
      GOTO nogood;
    ssb _ LOOPHOLE[bcd+bcd.ssOffset];
    ssd _ [base: @ssb.string, offset: mth.name, length: ssb.size[mth.name]];
    h.hti _ SymbolOps.EnterString[@ssd];
    h.version _ bcd.version;
    h.seg _ NewSegment[file, sgh.base, sgh.pages+sgh.extraPages];
    h.fgt _ sgh.extraPages # 0;
    CleanupSeg[headerSeg];
    EXITS nogood => CleanupSeg[headerSeg];
    END;
    END;
    
  CleanupSeg: PROCEDURE [seg: FSHandle] =
    BEGIN
    Segments.Unlock[seg];
    Segments.DeleteSegment[seg];
    END;
    
  END...