-- File BcdSymbolPack.mesa
-- Last edited by Satterthwaite on August 1, 1983 11:26 am
-- Last edited by Lewis on 27-Mar-81 10:04:27

DIRECTORY
  Alloc: TYPE USING [AddNotify, DropNotify, Handle, Notifier],
  BcdComData: TYPE USING [table],
  BcdDefs: TYPE USING [
    Base, fttype, FTIndex, FTNull, FTSelf, lftype, Link,
    mttype, MTIndex, MTNull, MTRecord, NameRecord,
    sgtype, SGIndex, SGNull, sstype, VersionID, VersionStamp],
  BcdErrorDefs: TYPE USING [InterfaceId],
  BcdFileDefs: TYPE USING [CapabilityForFile, UnknownFile],
  BcdOps: TYPE USING [BcdBase, NameString],
  File: TYPE USING [Capability, nullCapability],
  FileSegment: TYPE USING [Pages],
  OSMiscOps: TYPE USING [FindFile, FileError],
  Space: TYPE USING [
    Handle, nullHandle, virtualMemory,
    Create, Delete, LongPointer, Map],
  Strings: TYPE USING [
    AppendString, AppendSubString, EqualSubStrings,
    String, SubString, SubStringDescriptor],
  Symbols: TYPE USING [
    ISEIndex, CSEIndex, CTXIndex, BitAddress, ISENull],
  SymbolTable: TYPE USING [
    Base, Handle, nullHandle, Acquire, Missing, Release];

BcdSymbolPack: PROGRAM
    IMPORTS
      Alloc, BcdFileDefs, data: BcdComData, OSMiscOps, Space, Strings,
      SymbolTable
    EXPORTS BcdErrorDefs = {
  OPEN BcdDefs;

  InterfaceId: TYPE ~ BcdErrorDefs.InterfaceId;
  
  mtb, lfb, sgb, ftb: BcdDefs.Base;
  ssb: BcdOps.NameString;

  Notifier: Alloc.Notifier ~ {
    mtb _ base[mttype]; lfb _ base[lftype];
    sgb _ base[sgtype]; ftb _ base[fttype];
    ssb _ base[sstype]};


  nullPages: SymbolTable.Handle ~ SymbolTable.nullHandle;

  initialized: BOOL _ FALSE;
  
  Initialize: PUBLIC PROC ~ {
    IF initialized THEN Finalize[];
    initialized _ TRUE};
    
  Finalize:  PUBLIC PROC ~ {initialized _ FALSE};
    

  ExportItemName: PUBLIC PROC [
      export: InterfaceId, ep: CARDINAL,
      userProc: PROC [Strings.SubString]] ~ { 
    symbolPages: SymbolTable.Handle;
    (data.table).AddNotify[Notifier];
    symbolPages _ InterfaceSymbols[export];
    IF symbolPages # nullPages THEN
      PrintNameFromInterface[symbolPages, ep, userProc];
    (data.table).DropNotify[Notifier]};

  ImportItemName: PUBLIC PROC [
      import: InterfaceId, ep: CARDINAL,
      clientMti: BcdDefs.MTIndex, linkOffset: CARDINAL,
      userProc: PROC [Strings.SubString]] ~ { 
    symbolPages: SymbolTable.Handle;
    (data.table).AddNotify[Notifier];
    IF clientMti = BcdDefs.MTNull THEN RETURN;
    symbolPages _ ModuleSymbols[clientMti];
    IF symbolPages # nullPages THEN
      PrintNameFromModule[symbolPages, clientMti, linkOffset, userProc]
    ELSE {
      symbolPages _ InterfaceSymbols[import];
      IF symbolPages # nullPages THEN
      	PrintNameFromInterface[symbolPages, ep, userProc]};
    (data.table).DropNotify[Notifier]};


  ModuleSymbols: PROC [mti: BcdDefs.MTIndex]
      RETURNS [symbolPages: SymbolTable.Handle] ~ { 
    sgi: BcdDefs.SGIndex ~ mtb[mti].sseg;
    IF sgi = BcdDefs.SGNull THEN symbolPages _ nullPages
    ELSE { 
      symbolPages.file _ BcdFileDefs.CapabilityForFile[sgb[sgi].file
	      ! BcdFileDefs.UnknownFile => {GO TO notFound}];
      symbolPages.span _ [base~sgb[sgi].base, pages~sgb[sgi].pages]};
    EXITS 
      notFound => RETURN [nullPages]};
 

  PrintNameFromModule: PROC [
      symbolPages: SymbolTable.Handle,
      importerMti: BcdDefs.MTIndex,
      linkOffset: CARDINAL,
      userProc: PROC [Strings.SubString]] ~ { 
    symbols: SymbolTable.Base _ NIL;
    symbols _ SymbolTable.Acquire[symbolPages
      ! SymbolTable.Missing => {CONTINUE}];
    IF symbols # NIL THEN { 
      OPEN Symbols;
      key: Symbols.BitAddress ~ ComputeAddress[importerMti, linkOffset];
      iCtx: CTXIndex ~ symbols.stHandle.importCtx;
      sei: ISEIndex;
      type: CSEIndex;

      Imported: PROC [sei: Symbols.ISEIndex] RETURNS [BOOL] ~ INLINE {
        RETURN [symbols.seb[sei].linkSpace AND ~symbols.seb[sei].extended]};

      FOR iSei: ISEIndex _ symbols.FirstCtxSe[iCtx], symbols.NextSe[iSei] UNTIL iSei = ISENull DO
        type _ symbols.UnderType[symbols.seb[iSei].idType];
        WITH t~~symbols.seb[type] SELECT FROM
          definition =>
            FOR sei _ symbols.FirstCtxSe[t.defCtx], symbols.NextSe[sei] UNTIL sei = ISENull DO
      	      IF Imported[sei] AND symbols.seb[sei].idValue = key THEN GO TO Found;
      	      ENDLOOP;
          ref =>
            IF Imported[iSei] AND symbols.seb[iSei].idValue = key THEN {
	      sei _ iSei;  GO TO Found};
          ENDCASE => NULL;
        REPEAT
          Found => {
            d: Strings.SubStringDescriptor;
            symbols.SubStringForName[@d, symbols.seb[sei].hash];
            userProc[@d
	      ! UNWIND => {
	        SymbolTable.Release[symbols]; (data.table).DropNotify[Notifier]}]};
        ENDLOOP;
      SymbolTable.Release[symbols]}};

  ComputeAddress: PROC [mti: BcdDefs.MTIndex, linkOffset: CARDINAL] 
      RETURNS [Symbols.BitAddress] ~ {
    linkLength: CARDINAL ~ lfb[mtb[mti].links].length;
    RETURN [[wd~(linkLength-1)-linkOffset, bd~0]]};


  InterfaceSymbols: PROC [id: InterfaceId] RETURNS [symbolPages: SymbolTable.Handle] ~ { 
    s: STRING _ [100];
    file: File.Capability _ File.nullCapability;
    headerSpace: Space.Handle _ Space.nullHandle;

    DeleteHeader: PROC ~ {
      IF headerSpace # Space.nullHandle THEN {
	Space.Delete[headerSpace];
	headerSpace _ Space.nullHandle}};

    IF id.fti # FTNull THEN {
      s: STRING _ [100];
      GetBcdName[s, ftb[id.fti].name];
      file _ OSMiscOps.FindFile[s, $read ! OSMiscOps.FileError => {CONTINUE}]};
    IF file = File.nullCapability THEN symbolPages _ nullPages
    ELSE {
      ENABLE {
	UNWIND => {NULL};
	ANY => {GO TO badFile}};
      BcdBase: PROC [p: LONG POINTER] RETURNS [BcdDefs.Base] ~ INLINE {
	RETURN [LOOPHOLE[p, BcdDefs.Base]]};
      bcd: BcdOps.BcdBase;
      bcdPages: CARDINAL _ 8;
      iMtb, iFtb, iSgb: BcdDefs.Base;
      iSsb: BcdOps.NameString;
      iMti: BcdDefs.MTIndex;
      iSgi: BcdDefs.SGIndex;
      d1, d2: Strings.SubStringDescriptor;
      DO
        headerSpace _ Space.Create[size~bcdPages, parent~Space.virtualMemory];
	headerSpace.Map[window~[file~file, base~1]];
	bcd _ headerSpace.LongPointer[];
	IF bcd.versionIdent # BcdDefs.VersionID THEN GO TO badFile;
	IF bcdPages >= bcd.nPages THEN EXIT;
	bcdPages _ bcd.nPages;
	Space.Delete[headerSpace];  headerSpace _ Space.nullHandle
	ENDLOOP;
      IF bcd.nConfigs # 0 OR ~bcd.definitions THEN
        GO TO badFile;	-- no packaged bcd's (for now)
      iSsb _ LOOPHOLE[bcd + bcd.ssOffset];
      iMtb _ BcdBase[bcd + bcd.mtOffset];
      iFtb _ BcdBase[bcd + bcd.ftOffset];
      iSgb _ BcdBase[bcd + bcd.sgOffset];
      d1 _ [base~@ssb.string, offset~id.name, length~ssb.size[id.name]];
      d2.base _ @iSsb.string;
      iMti _ BcdDefs.MTIndex.FIRST;
      UNTIL iMti = bcd.mtLimit DO
	d2.offset _ iMtb[iMti].name;
	d2.length _ iSsb.size[iMtb[iMti].name];
	IF Strings.EqualSubStrings[@d1, @d2] THEN EXIT;
	iMti _ iMti + BcdDefs.MTRecord.SIZE;
	REPEAT
	  FINISHED =>
	    IF bcd.nModules = 1 THEN iMti _ BcdDefs.MTIndex.FIRST ELSE GOTO badFile;
  	ENDLOOP;
      iSgi _ iMtb[iMti].sseg;
      IF iSgi = BcdDefs.SGNull OR iSgb[iSgi].pages = 0
       OR iSgb[iSgi].file # BcdDefs.FTSelf OR bcd.version # ftb[id.fti].version
	THEN GO TO badFile;
      symbolPages _ [
        file~file,
	span~[base~iSgb[iSgi].base, pages~iSgb[iSgi].pages]];
      DeleteHeader[];
      EXITS
	badFile => {DeleteHeader[]; symbolPages _ nullPages}};
    RETURN};
    
  GetBcdName: PROC [s: Strings.String, n: NameRecord] ~ {
    d: Strings.SubStringDescriptor _
      [base~@ssb.string, offset~n, length~MIN[ssb.size[n], 40]];
    s.length _ 0;
    Strings.AppendSubString[s, @d];
    FOR i: CARDINAL IN [0..s.length) DO IF s[i] = '. THEN RETURN ENDLOOP;
    Strings.AppendString[s, ".bcd"L]};

  PrintNameFromInterface: PROC [
      symbolPages: SymbolTable.Handle,
      ep: CARDINAL,
      userProc: PROC [Strings.SubString]] ~ { 
    symbols: SymbolTable.Base _ NIL;
    symbols _ SymbolTable.Acquire[symbolPages
      ! SymbolTable.Missing => {CONTINUE}];
    IF symbols # NIL THEN { 
      OPEN Symbols;
      outerCtx: CTXIndex ~ symbols.stHandle.outerCtx;
      d: Strings.SubStringDescriptor;
      FOR sei: ISEIndex _ symbols.FirstCtxSe[outerCtx], symbols.NextSe[sei] 
       UNTIL sei = ISENull DO
	SELECT symbols.LinkMode[sei] FROM
	  $val, $ref, $type => 
	    IF symbols.seb[sei].idValue = ep THEN {
	      symbols.SubStringForName[@d, symbols.seb[sei].hash];
              userProc[@d
	        ! UNWIND => {
	          SymbolTable.Release[symbols]; (data.table).DropNotify[Notifier]}]};
	  ENDCASE;
        ENDLOOP;
      SymbolTable.Release[symbols]}};

  }.