-- FramesCold.Mesa  Edited by: Sandman  July 18, 1980  10:30 AM
-- 		    Edited by: Bruce  October 21, 1980  12:28 PM

DIRECTORY
  BcdDefs USING [GFTIndex, MTIndex],
  BcdOps USING [BcdBase, MTHandle, NameString, ProcessModules],
  DContext USING [BcdBase, GetGlobal, SameConfig],
  DebugOps USING [Display, Foo, Lengthen, ShortCopyREAD, ShortREAD, UserAborted],
  DebugUsefulDefs USING [Name],
  DI USING [Foo, SEIndex, TypeForSe],
  DOutput USING [Char, EOL, Octal, Text],
  Strings USING [EqualSubStrings, SubString, SubStringDescriptor],
  DSyms USING [FindMod, GFHandle, GFrameMdi, Item, Shared, Stopping],
  Dump USING [FieldCtx, HashVal],
  Frames USING [Cache, Invalid, ValidateF, ValidateGF],
  Gf USING [
    Copied, Deleted, FrameGfi, GFI, Handle, Name, SameModule, Started, Validate],
  DHeap USING [AllocFob],
  Lf USING [GF, Handle, NoPrevious, PC, Previous],
  DLoadState USING [Acquire, AcquireBcd, Invalid, MapConfigToReal, ReleaseBcd, 
  Release],
  Lookup USING [
    Complete, Fail, HTIndex, HtiToString, InOut, StateCtx, StringToHti, XferCtx],
  MachineDefs USING [
    ConfigIndex, FHandle, Frame, GFHandle, GfiToFrame, GfiToOffset, GFTIndex,
    localbase, NullConfig, NullGF, RealToBytePC],
  Pc USING [CBti, ContextList, CtxLink, Entry, Ep, EpToCBti, Exit, FreeContextList, Son],
  SDDefs USING [SD, sGFTLength],
  State USING [Get, GetGS, GSHandle, Handle, LF],
  Storage USING [Free, Node],
  SymbolOps USING [FirstCtxSe],
  Symbols USING [
    CBTIndex, CBTNull, ContextLevel, CTXIndex, CTXNull, ctxType, HTIndex, HTNull,
    IncludedCTXIndex, lG, lL, MDIndex, RecordSENull, SEIndex, seType, bodyType],
  SymbolSegment USING [bodyType, ctxType],
  SymbolTable USING [Missing],
  Table USING [AddNotify, Base, Bounds, DropNotify, Notifier],
  UserInput USING [userAbort];
  
FramesCold: PROGRAM
  IMPORTS
    BcdOps, DContext, DebugOps, DebugUsefulDefs, DI, DLoadState, DOutput,
    Strings, DSyms, Dump, Frames,
    Gf, DHeap, Lf, Lookup, MachineDefs, Pc, State, Storage, SymbolOps, 
    SymbolTable, Table, UserInput
  EXPORTS DebugUsefulDefs, Frames, Gf, Lf =
  BEGIN OPEN Gf, MachineDefs;
  
  CopiedFrame: PUBLIC SIGNAL [name: STRING] = CODE;
  
  data: State.GSHandle = State.GetGS[];
  
  Enumerate: PUBLIC PROC [proc: PROC [Handle] RETURNS [BOOLEAN]] RETURNS [gf: Handle] =
    BEGIN OPEN MachineDefs;
    i: GFTIndex;
    gftLength: CARDINAL = DebugOps.ShortREAD[@SDDefs.SD[SDDefs.sGFTLength]];
    FOR i DECREASING IN [1..gftLength) DO
      gf _ GfiToFrame[i];
      IF gf # NullGF AND GfiToOffset[i] = 0
	AND Validate[gf] AND proc[gf] THEN RETURN;
      ENDLOOP;
    RETURN[NullGF];
    END;
    
  CatchFrame: PUBLIC PROCEDURE [f: FHandle] RETURNS [BOOLEAN] =
    BEGIN OPEN MachineDefs;
    next, L0: FHandle;
    SignalHandle: TYPE = POINTER TO signal Frame;
    CatchHandle: TYPE = POINTER TO catch Frame;
    copy: signal Frame;
    next _ Lf.Previous[f ! ANY => GOTO notcatch];
    IF Lf.GF[next] # data.sigGF THEN GOTO notcatch;
    L0 _ DebugOps.ShortREAD[@LOOPHOLE[f, CatchHandle].staticlink];
    IF ~Frames.ValidateF[(L0 _ LOOPHOLE[L0-localbase])] THEN GOTO notcatch;
    IF ~Frames.ValidateF[next] OR Lf.GF[f] # Lf.GF[L0] THEN GOTO notcatch;
    DebugOps.ShortCopyREAD[from: next, to: @copy, nwords: SIZE[signal Frame]];
    IF ~copy.mark THEN GOTO notcatch;
    RETURN[TRUE];
    EXITS
      notcatch => RETURN[FALSE];
    END;
    
  InMainBody: PUBLIC PROCEDURE [f: FHandle] RETURNS [in: BOOLEAN] =
    BEGIN
    gf: GFHandle _ Lf.GF[f];
    cbti: Symbols.CBTIndex _ Pc.CBti[Lf.PC[f],gf];
    bb: Table.Base _ Table.Bounds[SymbolSegment.bodyType].base;
    ctxb: Table.Base _ Table.Bounds[SymbolSegment.ctxType].base;
    IF cbti = Symbols.CBTNull THEN RETURN [FALSE];
    in _ ctxb[bb[cbti].localCtx].level = Symbols.lG;
    END;
    
  DisplayF: PUBLIC PROC [f: FHandle] =
    BEGIN OPEN DOutput;
    gf: GFHandle _ Lf.GF[f];
    cbti: Symbols.CBTIndex _ Pc.CBti[Lf.PC[f],gf];
    lf: FHandle _ Frames.Cache[f,local];
    IF cbti # Symbols.CBTNull THEN
      BEGIN
      bb: Table.Base _ Table.Bounds[SymbolSegment.bodyType].base;
      Dump.HashVal[bb[cbti].id];
      Text[", "L];
      END;
    Text["L: "L]; Octal[f];
    Text[", PC: "L]; Octal[MachineDefs.RealToBytePC[LOOPHOLE[lf.pc]]];
    DisplayInMsg[gf,NIL];
    END;
    
  FCbti: PROC [f: FHandle] RETURNS [Symbols.CBTIndex] =
    BEGIN RETURN[Pc.CBti[Lf.PC[f],Lf.GF[f]]] END;
    
  DisplayParametersF: PUBLIC PROC [f: FHandle] = 
    BEGIN FrameFoo[f,in,Pc.Entry[f],FCbti[f]] END;
    
  DisplayResultsF: PUBLIC PROC [f: FHandle] =
    BEGIN FrameFoo[f,out,Pc.Exit[f],FCbti[f]] END;
    
  FrameFoo: PROC [
    p: POINTER, io: Lookup.InOut, inState: BOOLEAN, cbti: Symbols.CBTIndex] =
    BEGIN OPEN Symbols;
    f: DebugOps.Foo;
    seb: Table.Base;
    sei: SEIndex;
    IF cbti = CBTNull THEN RETURN;
    sei _ Table.Bounds[SymbolSegment.bodyType].base[cbti].ioType;
    f _ IF inState THEN Lookup.StateCtx[sei, data.StatePtr, io]
      ELSE Lookup.XferCtx[sei, DebugOps.Lengthen[p],io];
    IF f = NIL OR f.tsei = Symbols.RecordSENull THEN RETURN;
    f.indent _ 2;
    f.xfer _ TRUE;
    DOutput.EOL[];
    seb _ Table.Bounds[seType].base;
    WITH seb[DI.TypeForSe[f.tsei]] SELECT FROM
      record => IF seb[SymbolOps.FirstCtxSe[fieldCtx]].hash = HTNull THEN
	DOutput.Text["  (anon) = "L];
      ENDCASE;
    DebugOps.Display[f]
    END;
    
  SetupFoo: PROC [p: POINTER] RETURNS [f: DebugOps.Foo] =
    BEGIN
    f _ DHeap.AllocFob[];
    f.addr.base _ DebugOps.Lengthen[p];
    f.indent _ 2; f.xfer _ f.there _ TRUE;
    END;
    
  DisplayLocalsF: PUBLIC PROC[lf: FHandle] =
    BEGIN OPEN Symbols;
    gf: MachineDefs.GFHandle _ Lf.GF[lf];
    cbti: CBTIndex _ Pc.CBti[Lf.PC[lf],gf];
    f: DebugOps.Foo;
    mainBody: BOOLEAN = InMainBody[lf];
    IF cbti = CBTNull THEN RETURN;
    IF ~CatchFrame[lf] THEN {DisplayParametersF[lf]; DisplayResultsF[lf]};
    f _ SetupFoo[lf];
    IF Pc.Son[cbti] THEN
      BEGIN
      list: Pc.CtxLink _ Pc.ContextList[Lf.PC[lf],gf,print];
      IF list = NIL THEN RETURN;
      DumpContextList[f, DSyms.GFrameMdi[gf], list !
	UNWIND => Pc.FreeContextList[list]];
      Pc.FreeContextList[list];
      END
    ELSE {
      ictx: Symbols.IncludedCTXIndex;
      level: ContextLevel _ Symbols.lG;
      Table.AddNotify[Notify];
      ictx _ LOOPHOLE[bb[cbti].localCtx];
      IF ictx # Symbols.CTXNull THEN level _ ctxb[ictx].level;
      Table.DropNotify[Notify];
      IF level > Symbols.lG THEN DumpOne[f,ictx]};
    END;
    
  DumpOne: PROC [f: DebugOps.Foo, ictx: Symbols.CTXIndex] =
    BEGIN
    IF ictx = Symbols.CTXNull THEN RETURN;
    Lookup.Complete[ictx];
    DOutput.EOL[];
    Dump.FieldCtx[f,ictx,0];
    END;
    
  ctxb: Table.Base;
  bb: Table.Base;
  
  Notify: Table.Notifier = {ctxb _ base[Symbols.ctxType]; bb _ base[Symbols.bodyType]};
  
  DumpContextList: PROC [
    f: DebugOps.Foo, mdi: Symbols.MDIndex, list: Pc.CtxLink] =
    BEGIN OPEN Symbols;
    level: ContextLevel;
    Table.AddNotify[Notify];
    level _ MAX[lL, GetLevel[list]];
    FOR i: Pc.CtxLink _ list, i.link UNTIL i = NIL DO
      level _ MAX[level, GetLevel[i]];
      ENDLOOP;
    FOR i: Pc.CtxLink _ list, i.link UNTIL i = NIL DO
      f.indent _ i.indent;
      IF GetLevel[i] < level OR i.null THEN LOOP;
      DumpOne[f, i.ictx ! UNWIND => Table.DropNotify[Notify]];
      ENDLOOP;
    Table.DropNotify[Notify];
    END;
    
  GetLevel: PROC [i: Pc.CtxLink] RETURNS [Symbols.ContextLevel] = {
    RETURN[IF i.null THEN i.level ELSE ctxb[i.ictx].level]};

  -- global frames
  
  GFCbti: PROC [gf: GFHandle] RETURNS [Symbols.CBTIndex] =
    BEGIN RETURN[Pc.EpToCBti[0,gf]] END;
    
  DisplayParametersGF: PUBLIC PROC [gf: GFHandle] =
    BEGIN
    lf: FHandle _ GetMainBody[gf];
    IF lf # NIL THEN DisplayParametersF[lf]
    ELSE FrameFoo[gf,in,FALSE,GFCbti[gf]];
    END;
    
  DisplayResultsGF: PUBLIC PROC [gf: GFHandle] =
    BEGIN
    lf: FHandle _ GetMainBody[gf];
    IF lf # NIL THEN DisplayResultsF[lf]
    ELSE FrameFoo[gf,out,FALSE,GFCbti[gf]];
    END;
    
  DisplayLocalsGF: PUBLIC PROC [gf: GFHandle] =
    BEGIN
    lf: FHandle _ GetMainBody[gf];
    cbti: Symbols.CBTIndex;
    ictx: Symbols.IncludedCTXIndex;
    cbti _ GFCbti[gf];
    FrameFoo[gf,in,FALSE,cbti];
    FrameFoo[gf,out,FALSE,cbti];
    Table.AddNotify[Notify];
    ictx _ LOOPHOLE[bb[cbti].localCtx];
    Table.DropNotify[Notify];
    DumpOne[SetupFoo[gf],ictx];
    IF lf # NIL THEN DisplayLocalsF[lf];
    END;
    
  DisplayInMsg: PUBLIC PROC [gf: GFHandle, delim: STRING] = {
    OPEN DOutput;
    Text[" (in "L];
    DisplayGF[gf,delim ! Frames.Invalid =>
      {Char[' ]; Octal[f]; Text[" is an invalid global frame!"L]; CONTINUE}];
    Char[')]};
    
  DisplayGF: PUBLIC PROC [gf: GFHandle, delim: STRING] =
    BEGIN OPEN DOutput;
    mod: STRING _ [40];
    Gf.Name[mod, gf ! DLoadState.Invalid, Frames.Invalid => CONTINUE];
    IF mod.length # 0 THEN
      BEGIN
      IF delim # NIL THEN {Text[delim]; Char[' ]};
      Text[mod]; Text[", "L]
      END;
    DOutput.Text["G: "L]; PrintFrame[gf];
    END;
    
  PrintFrame: PROC [gf: GFHandle] = {
    DOutput.Octal[gf];
    IF Copied[gf] THEN DOutput.Char['*];
    IF ~Started[gf] THEN DOutput.Char['~]};
    
  DisplayGFTEntry: PUBLIC PROC [gfi: MachineDefs.GFTIndex] =
    BEGIN
    IF Deleted[gfi] THEN DOutput.Text[" deleted"L]
    ELSE PrintFrame[FrameGfi[gfi]];
    END;
    
  GetMainBody: PUBLIC PROC [gf: GFHandle] RETURNS [f: MachineDefs.FHandle] =
    BEGIN
    looping: CARDINAL _ 0;
    IF ~Frames.ValidateGF[gf] OR ~Gf.Started[gf] THEN RETURN[NIL];
    IF DSyms.Stopping[gf ! SymbolTable.Missing => GOTO null] THEN
      RETURN[DebugOps.ShortREAD[@gf.global[0]]];
    FOR f _ State.LF[], Lf.Previous[f ! Lf.NoPrevious => GOTO null] UNTIL f = NIL DO
      IF (looping _ looping + 1) > 1000 THEN RETURN[NIL];
      IF Lf.GF[f] # gf THEN LOOP;
      IF Pc.Ep[Lf.PC[f],gf].ep = 0 THEN RETURN;
      ENDLOOP;
    EXITS null => RETURN[NIL];
    END;
    
  DisplayGFT: PUBLIC PROCEDURE =
    BEGIN OPEN DOutput;
    GFWrite: PROCEDURE[frame: Handle] RETURNS [BOOLEAN] = 
      BEGIN
      module: STRING _ [40];
      IF frame = MachineDefs.NullGF THEN RETURN[FALSE];
      DebugUsefulDefs.Name[module, frame !
	Frames.Invalid =>  module _ "!Invalid global frame"L];
      Text[module];
      Text[", G:"L]; PrintFrame[frame];
      Text[", gfi:"L]; Octal[GFI[frame]];
      EOL[];
      RETURN[FALSE]
      END;
    EOL[];
    [] _ DLoadState.Acquire[];
    [] _ Enumerate[GFWrite ! UNWIND => DLoadState.Release[]];
    DLoadState.Release[];
    RETURN
    END;
    
  Original: PUBLIC PROCEDURE [new: Handle] RETURNS [old: Handle] =
    BEGIN
    Find: PROC [f: Handle] RETURNS [BOOLEAN] =
      {RETURN[f # new AND ~Copied[f] AND Gf.SameModule[new, f]]};
    IF ~Copied[new] THEN RETURN[new];
    RETURN [Enumerate[Find]]
    END;
    
  FrameItem: TYPE = RECORD [
    next: POINTER TO FrameItem,
    frame: Handle];
    
  FreeFrameItems: PROC [head: POINTER TO FrameItem] RETURNS [nil: POINTER] =
    BEGIN
    nfl, fl: POINTER TO FrameItem;
    FOR fl _ head, nfl UNTIL fl = NIL DO
      nfl _ fl.next;
      Storage.Free[fl];
      ENDLOOP;
    RETURN[NIL]
    END;
    
  WriteFrameItems: PROCEDURE [head: POINTER TO FrameItem, mod: STRING] =
    INLINE BEGIN OPEN DOutput;
    fl: POINTER TO FrameItem;
    EOL[];
    Char['!]; Text[mod]; Text[" has frames at"L];
    FOR fl _ head, fl.next UNTIL fl = NIL DO
      Char[' ]; Octal[fl.frame];
      ENDLOOP;
    EOL[];
    Text["Use SEt Octal context or Display Frame command."L];
    RETURN
    END;
    
  FrameHti: PUBLIC PROCEDURE [hti: Symbols.HTIndex _ Symbols.HTNull]
    RETURNS [f: Handle] =
    BEGIN
    name: STRING _ [40];
    Lookup.HtiToString[hti,name];
    RETURN[Frame[name]];
    END;
    
  Frame: PUBLIC PROCEDURE [name: STRING _ NIL] RETURNS [f: Handle] =
    BEGIN OPEN BcdDefs, BcdOps, MachineDefs;
    data: State.Handle _ State.Get[];
    moddesc: Strings.SubStringDescriptor;
    modss: Strings.SubString _ @moddesc;
    ssb: NameString;
    bcd: BcdOps.BcdBase;
    dsh: DSyms.Item _ NIL;
    FList: POINTER TO FrameItem _ NIL;
    FindModuleString: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] = 
      BEGIN OPEN Strings;
      gfi: GFTIndex;
      ssd: SubStringDescriptor _
	[base: @ssb.string, offset: mth.name, length: ssb.size[mth.name]];
      ss: SubString _ @ssd;
      fl: POINTER TO FrameItem _ FList;
      IF UserInput.userAbort THEN SIGNAL DebugOps.UserAborted;
      IF ~DContext.SameConfig[bcd, mth.config, data.cti] THEN RETURN[FALSE];
      IF EqualSubStrings[ss, modss] THEN
	BEGIN
	IF Deleted[gfi _ DLoadState.MapConfigToReal[mth.gfi, data.config]]
	  THEN RETURN [FALSE];
	FList _ Storage.Node[SIZE[FrameItem]];
	FList^ _ FrameItem[next: fl, frame: GfiToFrame[gfi]];
	END;
      RETURN[FALSE]
      END;
    IF name = NIL THEN RETURN[DContext.GetGlobal[]];
    IF (dsh _ DSyms.FindMod[Lookup.StringToHti[name] ! DSyms.Shared => CONTINUE]) # NIL
      AND (f _ dsh.gf) # MachineDefs.NullGF THEN RETURN;
    moddesc _ Strings.SubStringDescriptor[
      base: name, offset: 0, length: name.length];
    IF data.config = MachineDefs.NullConfig THEN RETURN[NIL];
    [] _ DLoadState.Acquire[];
    bcd _ DLoadState.AcquireBcd[data.config];
    ssb _ LOOPHOLE[bcd+bcd.ssOffset];
    [] _ BcdOps.ProcessModules[bcd, FindModuleString !UNWIND => Cleanup[bcd]];
    Cleanup[bcd];
    IF FList = NIL THEN SIGNAL Lookup.Fail[name];
    IF FList.next = NIL THEN f _ FList.frame
    ELSE
      BEGIN
      SIGNAL CopiedFrame[name ! UNWIND => FList _ FreeFrameItems[FList]];
      f _ MachineDefs.NullGF;
      WriteFrameItems[FList, name];
      END;
    [] _ FreeFrameItems[FList];
    IF dsh # NIL THEN dsh.gf _ f;
    RETURN[f]
    END;
    
  Current: PUBLIC PROC RETURNS [Handle] = {RETURN[DContext.GetGlobal[]]};
  
  Cleanup: PROC [bcd: BcdOps.BcdBase] =
    {DLoadState.ReleaseBcd[bcd]; DLoadState.Release[]};
    
  END.