-- LookupPack.mesa  last edit, Johnsson  August 8, 1980  6:42 PM
--				Bruce   October 9, 1980  3:33 PM

DIRECTORY
  Actions USING [],
  Ascii USING [SP],
  ComData,
  Copier USING [Outer],
  DContext USING [Enumerate, GetModule],
  DebugFormat USING [BBHandle, BitAddress, EXOI, Foo],
  DebugOps USING [BitAddress, Display, Foo, Lengthen, ShortREAD, UserAborted],
  DHeap USING [AllocFob],
  DI USING [
    CSEIndex, CTXIndex, HTIndex, ISEIndex, Normalize, SearchCtxForVal, SearchCtxList,
    SEIndex, TypeForSe],
  DOutput USING [Char, Text],
  DSyms USING [FindFrame, GFHandle, GFrameMdi, HTIndex, Item, MDIndex, ModuleMdi],
  Frames USING [Invalid],
  Gf USING [CheckStarted, DisplayInMsg, FrameGfi, FrameHti, GFI, Validate],
  Init USING [CheckSymTabLength],
  Lf USING [GF, NoAccessLink, NoPrevious, PC, Previous, Validate],
  Lookup USING [Complete, HTIndex, InOut, MakeFoo, Mode, NotRelocated, StringToHti],
  MachineDefs USING [FHandle, GFHandle, GFTIndex, MaxParmsInStack, SVPointer],
  Pc USING [ContextList, CtxLink, Entry, Exit, FreeContextList],
  PrincOps USING [localbase, SignalDesc],
  State USING [Get, GetGS, GSHandle, Handle],
  Strings USING [SubStringDescriptor],
  SymbolOps USING [FirstCtxSe, NextSe, SubStringForHash],
  Symbols USING [
    ContextLevel, CSEIndex, CTXIndex, CTXNull, ctxType, HTIndex, HTNull,
    IncludedCTXIndex, IncludedCTXNull, ISEIndex, ISENull, lG, MDIndex, MDNull,
    mdType, RecordSEIndex, RecordSENull, SEIndex, SENull, seType, TransferMode],
  SymbolTable USING [Base, Missing],
  Table USING [AddNotify, Base, DropNotify, Notifier],
  UserInput USING [userAbort];

LookupPack: PROGRAM
  IMPORTS com: ComData, DContext, Copier, DebugOps, DHeap, DI, DOutput,
    DSyms, Frames, Gf, Init, Lf, Lookup, Pc, State, SymbolOps,
    SymbolTable, Table, UserInput
  EXPORTS Actions, Lookup =
  BEGIN OPEN Lookup, Symbols;

  Foo: TYPE = DebugOps.Foo;
  GFHandle: TYPE = MachineDefs.GFHandle;
  FHandle: TYPE = MachineDefs.FHandle;
  HTIndex: TYPE = Symbols.HTIndex;

  Fail: PUBLIC SIGNAL [s: STRING] = CODE;
  NotAnXfer: ERROR = CODE;
  SearchingWrongContext: ERROR = CODE;

  data: State.GSHandle _ State.GetGS[];

  seb: Table.Base;
  ctxb: Table.Base;
  mdb: Table.Base;
  notifyCnt: CARDINAL _ 0;

  Notify: Table.Notifier =
    BEGIN OPEN Symbols;
    seb _ base[seType]; ctxb _ base[ctxType]; mdb _ base[mdType];
    END;

  Add: PROCEDURE =
    BEGIN
    IF notifyCnt = 0 THEN Table.AddNotify[Notify];
    notifyCnt _ notifyCnt + 1;
    END;

  Drop: PROCEDURE =
    BEGIN
    IF notifyCnt = 1 THEN Table.DropNotify[Notify];
    notifyCnt _ notifyCnt - 1;
    END;

  InCtx: PUBLIC PROCEDURE [id: HTIndex, ctx: CTXIndex] RETURNS [Foo] =
    BEGIN
    isei: Symbols.ISEIndex _ DI.SearchCtxList[id,ctx];
    RETURN [IF isei = ISENull THEN NIL ELSE MakeFoo[isei]];
    END;

  InGF: PUBLIC PROCEDURE [
    id: HTIndex, gf: GFHandle _ NIL, check: BOOLEAN _ TRUE]
    RETURNS [Foo] =
    BEGIN
    mdi: Symbols.MDIndex;
    p: POINTER;
    IF gf = NIL THEN
      BEGIN
      p _ State.Get[].h.interpretContext;
      gf _ IF ~Gf.Validate[p] THEN Lf.GF[p] ELSE p;
      END;
    mdi _ DSyms.GFrameMdi[gf ! SymbolTable.Missing => GOTO bailout];
    RETURN[GFFoo[id, gf, mdi, check]];
    EXITS
      bailout => RETURN[NIL]
    END;

  InMod: PUBLIC PROC [id: HTIndex, mod: HTIndex _ Symbols.HTNull] RETURNS [Foo] =
    BEGIN
    gf: GFHandle _ NIL;
    mdi: Symbols.MDIndex;
    IF mod = Symbols.HTNull THEN mod _ StringToHti[DContext.GetModule[]];
    gf _ Gf.FrameHti[mod ! Fail => CONTINUE];
    mdi _ DSyms.ModuleMdi[mod ! SymbolTable.Missing => GOTO bailout];
    RETURN[GFFoo[id, gf, mdi, TRUE ! Lookup.NotRelocated => {
      DOutput.Text[" Use Interface.importedVariable, not Interface$importedVariable"L];
      GOTO bailout}]];
    EXITS
      bailout => RETURN[NIL]
    END;

  InLF: PUBLIC PROCEDURE [
    id: HTIndex, lf: FHandle _ NIL, check: BOOLEAN _ TRUE]
    RETURNS [f: Foo] =
    BEGIN
    gf: GFHandle _ NIL;
    ex: DebugFormat.EXOI;
    list: Pc.CtxLink;
    IF lf = NIL THEN lf _ State.Get[].h.interpretContext;
    IF Gf.Validate[LOOPHOLE[lf]] THEN RETURN[InGF[id,LOOPHOLE[lf],check]];
    SELECT TRUE FROM
      Pc.Entry[lf ! SymbolTable.Missing => GOTO bailout] => ex _ entry;
      Pc.Exit[lf] => ex _ exit;
      ENDCASE => ex _ in;
    gf _ Lf.GF[lf ! Frames.Invalid, Lf.NoAccessLink => CONTINUE];
    IF (f _ TryCtx[id,[DebugOps.Lengthen[lf],0],LOOPHOLE[2]]) # NIL THEN RETURN;
    list _ Pc.ContextList[Lf.PC[lf],gf,search,ex];
    IF list = NIL THEN RETURN[InGF[id,gf,check]];
    Add[];
    f _ SearchList[id,list,lf,gf ! UNWIND => {Pc.FreeContextList[list]; Drop[]}];
    Pc.FreeContextList[list];
    Drop[];
    IF f = NIL THEN RETURN[InGF[id,gf,check]];
    EXITS
      bailout => RETURN[NIL]
    END;

  SearchList: PROC [id: HTIndex, list: Pc.CtxLink, lf: FHandle, gf: GFHandle]
    RETURNS [f: Foo] =
    BEGIN
    ba: DebugOps.BitAddress _ [DebugOps.Lengthen[lf],0];
    level: ContextLevel;
    f _ NIL;
    list _ FixupList[list];
    level _ GetLevel[list];
    IF level = lG THEN ba.base _ DebugOps.Lengthen[gf];
    FOR i: Pc.CtxLink _ list, i.link UNTIL i = NIL DO
      ba.useStack _ i.onStack;
      ba.local _ level # lG;
      SELECT GetLevel[i] FROM
	= level => NULL;
	< level => {
	  level _ GetLevel[i];
	  IF level = lG THEN ba.base _ DebugOps.Lengthen[gf]
	  ELSE {
	    lf _ DebugOps.ShortREAD[@lf.local[0]] - PrincOps.localbase;
	    ba.base _ DebugOps.Lengthen[lf]}};
	ENDCASE => ERROR SearchingWrongContext;
      IF (f _ TryProcCtx[id,ba,i]) # NIL THEN EXIT;
      ENDLOOP;
    END;

  FixupList: PROC [list: Pc.CtxLink] RETURNS [Pc.CtxLink] =
    BEGIN
    twoBefore, last: Pc.CtxLink;
    outOfOrder: BOOLEAN _ TRUE;
    WHILE outOfOrder DO
      twoBefore _ last _ NIL;
      outOfOrder _ FALSE;
      FOR i: Pc.CtxLink _ list, i.link UNTIL i = NIL DO
	IF last # NIL AND GetLevel[i] > GetLevel[last] THEN 
	  BEGIN
	  outOfOrder _ TRUE;
	  last.link _ i.link; i.link _ last;
	  IF twoBefore = NIL THEN list _ i ELSE twoBefore.link _ i;
	  EXIT;
	  END;
	twoBefore _ last;
	last _ i;
	ENDLOOP;
      ENDLOOP;
    RETURN[list];
    END;

  GetLevel: PROC [i: Pc.CtxLink] RETURNS [ContextLevel] = {
    RETURN[IF i.null THEN i.level ELSE ctxb[i.ictx].level]};

  OnStack: PUBLIC PROC [
    id: HTIndex, lf: FHandle _ NIL, check: BOOLEAN _ TRUE]
    RETURNS [f: Foo] =
    BEGIN
    h: State.Handle = State.Get[];
    IF h.howSet = break THEN RETURN[InBreakBlock[id,h.interpretContext]];
    IF lf = NIL THEN lf _ h.interpretContext;
    IF data.search THEN RETURN[InLF[id,lf,check]];
    IF Gf.Validate[LOOPHOLE[lf]] THEN RETURN[InGF[id,LOOPHOLE[lf],check]];
    f _ NIL;
    DO
      IF lf = NIL THEN EXIT;
      IF (f_InLF[id,lf,check !SymbolTable.Missing => CONTINUE])#NIL THEN EXIT;
      lf _ Lf.Previous[lf ! Lf.NoPrevious => EXIT];
      ENDLOOP;
    END;

  LocalFrame: PROC [cl: PrincOps.SignalDesc, tm: Symbols.TransferMode]
    RETURNS [isei: Symbols.ISEIndex]=
    BEGIN
    lf: FHandle _ State.Get[].h.interpretContext;
    gf: GFHandle _ NIL;
    list: Pc.CtxLink;
    isei _ Symbols.ISENull;
    IF lf = NIL THEN lf _ DebugOps.ShortREAD[@data.StatePtr.dest];
    IF ~Lf.Validate[lf] THEN RETURN;
    gf _ Lf.GF[lf ! Frames.Invalid, Lf.NoAccessLink => CONTINUE];
    list _ Pc.ContextList[Lf.PC[lf],gf,search,in
      ! SymbolTable.Missing => GOTO bailout];
    IF list = NIL THEN RETURN;
    isei _ SearchListForValue[cl,tm,list,lf
	! UNWIND => Pc.FreeContextList[list]];
    Pc.FreeContextList[list];
    EXITS
      bailout => RETURN[Symbols.ISENull]
    END;

  SearchListForValue: PROC [
    cl: PrincOps.SignalDesc, tm: Symbols.TransferMode, list: Pc.CtxLink,
    lf: FHandle]
    RETURNS [isei: Symbols.ISEIndex] =
    BEGIN
    i: Pc.CtxLink;
    isei _ Symbols.ISENull;
    FOR i _ list, i.link UNTIL i = NIL DO
      IF i.null OR i.ictx = Symbols.IncludedCTXNull THEN LOOP;
      IF (isei _ DI.SearchCtxForVal[cl,i.ictx,tm]) # Symbols.ISENull THEN EXIT;
      ENDLOOP;
    END;

  InBreakBlock: PUBLIC PROC [id: HTIndex, bb: DebugFormat.BBHandle] RETURNS [f: Foo] =
    BEGIN
    list: Pc.CtxLink;
    list _ Pc.ContextList[bb.pc,bb.gf,search,bb.bt.ex];
    IF list # NIL THEN {
      Add[];
      f _ SearchList[id,list,NIL,bb.gf ! 
	Lookup.NotRelocated => RESUME[NIL];
	UNWIND => {Pc.FreeContextList[list]; Drop[]}];
      Pc.FreeContextList[list];
      Drop[];
      IF f # NIL THEN RETURN};
    RETURN[InGF[id,bb.gf,FALSE]];
    END;

  Signal: PUBLIC PROC [cl: PrincOps.SignalDesc]
      RETURNS [isei: Symbols.ISEIndex] =
    BEGIN RETURN[Xfer[cl,signal]]  END;

  Proc: PUBLIC PROC [cl: PrincOps.SignalDesc]
      RETURNS [isei: Symbols.ISEIndex] =
    BEGIN RETURN[Xfer[cl,proc]]  END;

  Xfer: PROC [cl: PrincOps.SignalDesc, tm: Symbols.TransferMode]
      RETURNS [isei: Symbols.ISEIndex] =
    BEGIN OPEN Symbols;
    gf: GFHandle = Gf.FrameGfi[cl.gfi];
    gfi: MachineDefs.GFTIndex;
    syms: DSyms.Item;
    IF gf = NIL THEN RETURN[ISENull];
    gfi _ Gf.GFI[gf] - 1;
    syms _ DSyms.FindFrame[gf];
    IF syms = NIL THEN {
      [] _ DSyms.GFrameMdi[gf ! SymbolTable.Missing => GOTO bailout];
      syms _ DSyms.FindFrame[gf]};
    cl.gfi _ cl.gfi - gfi;
    SELECT TRUE FROM
      (isei _ DI.SearchCtxForVal[cl,syms.outerCtx,tm]) # ISENull => NULL;
      (isei _ DI.SearchCtxForVal[cl,syms.importCtx,tm]) # ISENull => NULL;
      (isei _ DI.SearchCtxForVal[cl,syms.directoryCtx,tm]) # ISENull => NULL;
      (isei _ LocalFrame[cl,tm]) # ISENull => NULL;
      ENDCASE => RETURN[Symbols.ISENull];
    EXITS
      bailout => RETURN[Symbols.ISENull]
    END;

  XferCtx: PUBLIC PROC [sei: SEIndex, base: LONG POINTER, io: InOut]
      RETURNS [f: Foo] =
    BEGIN
    IF sei = SENull THEN RETURN[NIL];
    f _ DHeap.AllocFob[]; --  initialized to all zero
    f.xfer _ TRUE;
    f.there _ TRUE;
    f.addr.base _ base;
    Add[];
    WITH seb[DI.TypeForSe[sei]] SELECT FROM
      transfer =>
	BEGIN
	rsei: Symbols.RecordSEIndex _ IF io = in THEN inRecord ELSE outRecord;
	IF rsei = Symbols.SENull THEN {f.addr.base _ NIL; f.tsei _ Symbols.RecordSENull}
	ELSE
	  BEGIN
	  f.tsei _ rsei;
	  [f.words, f.bits] _ DI.Normalize[seb[rsei].length];
	  END;
	END;
      ENDCASE => {Drop[]; ERROR NotAnXfer};
    Drop[];
    END;

  StateCtx: PUBLIC PROCEDURE [
    sei: SEIndex, sv: MachineDefs.SVPointer, io: InOut,
    max: CARDINAL _ MachineDefs.MaxParmsInStack]
      RETURNS [f: Foo] =
    BEGIN
    locals: POINTER;
    f _ XferCtx[sei,NIL,io];
    IF f = NIL OR f.tsei = Symbols.RecordSENull THEN RETURN;
    locals _ 
      IF f.words > max THEN DebugOps.ShortREAD[@sv.stk[0]] ELSE @sv.stk[0];
    f.addr.base _ DebugOps.Lengthen[locals];
    f.addr.useStack _ TRUE;
    END;

  GFFoo: PROC [hti: HTIndex, gf: GFHandle, mdi: MDIndex, check: BOOLEAN]
    RETURNS [f: Foo] =
    BEGIN OPEN SymbolOps;
    ba: DebugOps.BitAddress;
    syms: DSyms.Item = DSyms.FindFrame[gf];
    IF gf # NIL AND check THEN [] _ Gf.CheckStarted[gf];
    ba _ [base: DebugOps.Lengthen[gf], offset: 0, local: FALSE];
    IF (f _ TryCtx[hti,ba,LOOPHOLE[2]]) # NIL THEN RETURN;
    IF (f _ TryCtx[hti,ba,syms.outerCtx]) # NIL THEN RETURN;
    IF (f _ SearchImportCtx[hti,ba,syms.importCtx]) # NIL THEN RETURN;
    f _ SearchDirectoryCtx[hti,ba,syms.directoryCtx,mdi];
    END;

  SearchDirectoryCtx: PROC [
      hti: HTIndex, ba: DebugOps.BitAddress, ictx: Symbols.CTXIndex,
      mdi: MDIndex]
    RETURNS [f: Foo] =
    BEGIN 
    mdRoot: MDIndex;
    target: CTXIndex;
    sei, isei: Symbols.ISEIndex;
    ss: Strings.SubStringDescriptor;
    found: BOOLEAN;

    Search: PROC [base: SymbolTable.Base] =
      BEGIN
      newMdi: Symbols.MDIndex = base.FindMdi[mdb[mdRoot].stamp];
      ihti: Symbols.HTIndex _ base.FindString[@ss];
      found _ ihti # Symbols.HTNull AND newMdi # Symbols.MDNull;
      IF ~found THEN RETURN;
      FOR i: IncludedCTXIndex _ base.mdb[newMdi].ctx,
      base.ctxb[i].chain UNTIL i = Symbols.CTXNull DO
	IF base.ctxb[i].map # target THEN LOOP;
	isei _ base.SearchContext[ihti,i];
	EXIT;
	REPEAT
	  FINISHED => isei _ Symbols.ISENull;
	ENDLOOP;
      found _ isei # Symbols.ISENull;
      END;

    IF ictx = Symbols.CTXNull THEN RETURN[NIL];
    IF (f _ TryCtx[hti,ba,ictx]) # NIL THEN RETURN;
    Complete[ictx];
    SymbolOps.SubStringForHash[@ss,hti];
    Add[];
    FOR sei _ SymbolOps.FirstCtxSe[ictx], SymbolOps.NextSe[sei]
    UNTIL sei = Symbols.ISENull DO
      ictx _ GetCtx[sei];
      WITH ctxb[ictx] SELECT FROM
	included => {mdRoot _ module; target _ map};
	ENDCASE => LOOP;
      Copier.Outer[mdi,Search];
      IF ~found THEN LOOP;
--      isei _ Copier.TokenSymbol[ictx,LOOPHOLE[isei]];
      isei _ DI.SearchCtxList[hti,ictx];
      IF isei = Symbols.ISENull THEN EXIT;
      SELECT Mode[isei] FROM
	refVal, refProc => NULL;
	ENDCASE => f _ MakeFoo[isei,ba];
      EXIT;
      ENDLOOP;
    Drop[];
    END;

  SearchImportCtx: PROC [
      hti: HTIndex, ba: DebugOps.BitAddress, ictx: Symbols.CTXIndex]
    RETURNS [f: Foo] =
    BEGIN OPEN SymbolOps;
    isei: Symbols.ISEIndex;
    IF ictx = Symbols.CTXNull THEN RETURN[NIL];
    IF (f _ TryCtx[hti,ba,ictx]) # NIL THEN RETURN;
    Complete[ictx];
    Add[];
    FOR isei _ FirstCtxSe[ictx], NextSe[isei] UNTIL isei = Symbols.ISENull DO
      IF (f _ TryCtx[hti,ba,GetCtx[isei]]) # NIL THEN EXIT;
      ENDLOOP;
    Drop[];
    END;

  GetCtx: PROC [isei: Symbols.ISEIndex] RETURNS [ctx: Symbols.CTXIndex] =
    BEGIN 
    csei: Symbols.CSEIndex _ DI.TypeForSe[isei];
    DO
      WITH seb[csei] SELECT FROM
	definition => RETURN[defCtx];
	record => RETURN[fieldCtx];
	ref => csei _ DI.TypeForSe[refType];
	long => csei _ DI.TypeForSe[rangeType];
	ENDCASE => RETURN[Symbols.CTXNull];
      ENDLOOP;
    END;

  TryCtx: PROC [hti: HTIndex, ba: DebugOps.BitAddress, ctx: CTXIndex]
    RETURNS [f: Foo] =
    BEGIN
    isei: Symbols.ISEIndex = DI.SearchCtxList[hti,ctx];
    SELECT TRUE FROM
      UserInput.userAbort => ERROR DebugOps.UserAborted;
      isei = ISENull => RETURN[NIL];
      ba.useStack => ERROR SearchingWrongContext;
      ENDCASE;
    RETURN[MakeFoo[isei, ba]];
    END;

  TryProcCtx: PROC [hti: HTIndex, ba: DebugOps.BitAddress, list: Pc.CtxLink]
    RETURNS [f: Foo] =
    BEGIN
    isei: Symbols.ISEIndex = DI.SearchCtxList[hti,list.ictx];
    stack: POINTER;
    SELECT TRUE FROM
      UserInput.userAbort => ERROR DebugOps.UserAborted;
      isei = ISENull => RETURN[NIL];
      ba.useStack AND ba.base # NIL AND Lookup.Mode[isei] = val => {
	stack _ IF list.indirect THEN DebugOps.ShortREAD[@data.StatePtr.stk[0]]
	ELSE @data.StatePtr.stk[0];
	ba.base _ DebugOps.Lengthen[stack]};
      ENDCASE;
    RETURN[MakeFoo[isei, ba]];
    END;

  FindVar: PUBLIC PROC [var: STRING] = 
    BEGIN
    hti: HTIndex = StringToHti[var];
    f: Foo;
    gf: GFHandle;
    SearchOne: PROC [g: GFHandle] RETURNS [BOOLEAN] =
      BEGIN
      IF (f_InGF[hti,g]) # NIL THEN {gf _ g; RETURN[TRUE]};
      Init.CheckSymTabLength[];
      RETURN[FALSE];
      END;
    DContext.Enumerate[SearchOne];
    IF f = NIL THEN SIGNAL Fail[var];
    f.hti _ Symbols.HTNull; DOutput.Char[Ascii.SP]; DebugOps.Display[f,TRUE];
    Gf.DisplayInMsg[gf, NIL];
    END;

  END.