-- FramesHot.mesa  last edit, Bruce  September 22, 1980  5:47 PM

DIRECTORY
  DebugOps USING [GFHandle, ReadCodeByte, ShortCopyREAD, ShortREAD, UserAborted],
  DOutput USING [Line, Octal],
  Frames USING [LG],
  Gf USING [],
  Inline USING [DIVMOD],
  Lf USING [],
  MachineDefs USING [
    BytePC, ControlLink, FHandle, Frame, GFHandle, GfiToFrame, GfiToOffset, GFTIndex,
    GlobalFrame, NullGF, NullOffset, RealToBytePC, TypeOfLink],
  Mopcodes USING [zBRK, zNOOP],
  PrincOps USING [ControlLink, EPIndex, EPRange, FrameCodeBase, ProcDesc],
  State USING [GetGS, GSHandle],
  Storage USING [Free, Node],
  UserInput USING [userAbort];

FramesHot: PROGRAM 
  IMPORTS DebugOps, DOutput, Inline, MachineDefs, State, Storage, UserInput
  EXPORTS Frames, Gf, Lf =
  BEGIN OPEN MachineDefs;

  NoPrevious: PUBLIC SIGNAL [f: FHandle] = CODE;
  Invalid: PUBLIC SIGNAL [f: POINTER] = CODE;
  Clobbered: PUBLIC SIGNAL [f: FHandle] = CODE;
  NoAccessLink: PUBLIC SIGNAL [f: FHandle] = CODE;

  FramePointer: TYPE = MACHINE DEPENDENT RECORD [SELECT OVERLAID * FROM
    pointer => [fill: [0..77777B], lg: Frames.LG],
    link => [cl: PrincOps.ControlLink],
    fullPointer => [frame: POINTER],
    ENDCASE];

  Item: TYPE = POINTER TO ItemObject;
  ItemObject: TYPE = MACHINE DEPENDENT RECORD [
    link: Item,
    fp: FramePointer,
    frame: SELECT OVERLAID * FROM
      global => [globalFrame: GlobalFrame],
      local => [localFrame: local Frame],
      ENDCASE];

  data: State.GSHandle _ State.GetGS[];
  Head: Item _ NIL;

  Cache: PUBLIC PROC [f: POINTER, lg: Frames.LG] RETURNS [copy: POINTER] = 
    BEGIN
    p,last: Item;
    fp: FramePointer;
    IF f = NIL THEN ERROR Invalid[f];
    FOR p _ Head, p.link UNTIL p = NIL DO
      IF p.fp.lg = lg THEN
	BEGIN
	fp _ p.fp; fp.cl.tag _ FALSE;  -- zero out tag
	IF fp.frame = f THEN
	  BEGIN
	  copy _ @p.frame;
	  IF p = Head OR last = Head THEN RETURN;
	  last.link _ p.link; p.link _ Head; Head _ p;
	  RETURN;
	  END;
	END;
      last _ p;
      ENDLOOP;
    p _ Storage.Node[IF lg = global THEN SIZE[global ItemObject]
      ELSE SIZE[local ItemObject]];
    fp.cl _ LOOPHOLE[f,PrincOps.ControlLink];
    IF fp.cl.tag THEN ERROR Invalid[f];
    fp.lg _ lg;
    copy _ @p.frame;
    p^ _ [link: Head, fp: fp, frame:];
    Head _ p;
    DebugOps.ShortCopyREAD[from: f, to: copy,
      nwords: IF lg = global THEN SIZE[GlobalFrame] ELSE SIZE[local Frame]];
    END;

  FlushFrameCache: PUBLIC PROCEDURE =
    BEGIN
    p, next: Item;
    FOR p _ Head, next UNTIL p = NIL DO
      next _ p.link;
      Storage.Free[p];
      ENDLOOP;
    Head _ NIL;
    END;

  Type: PUBLIC PROC [p: POINTER] RETURNS [Frames.LG] = {
    RETURN[IF ValidateGF[p] THEN global ELSE local]};

  CheckF: PUBLIC PROCEDURE [f: FHandle] =
    BEGIN IF ~ValidateF[f] THEN SIGNAL Invalid[f] END;

  ValidateF: PUBLIC PROCEDURE [f: FHandle] RETURNS [BOOLEAN] =
    BEGIN
    gf: GFHandle;
    IF f = NIL THEN RETURN[FALSE];
    IF (LOOPHOLE[f,CARDINAL] MOD 4) # 0 THEN RETURN[FALSE];
    f _ Cache[f,local];
    gf _ f.accesslink;
    IF gf = MachineDefs.NullGF THEN RETURN[FALSE];
    RETURN [ValidateGF[gf]];
    END;

  GF: PUBLIC PROCEDURE [f: FHandle] RETURNS [gf: GFHandle] =
    BEGIN
    CheckF[f];
    f _ Cache[f,local];
    gf _ f.accesslink;
    IF gf = MachineDefs.NullGF THEN SIGNAL NoAccessLink[f];
    CheckGF[gf];
    END;

  PC: PUBLIC PROCEDURE [f: FHandle] RETURNS [pc: BytePC] =
    BEGIN
    lf: FHandle _ Cache[f,local];
    CheckF[f];
    pc _ MachineDefs.RealToBytePC[LOOPHOLE[lf.pc]];
    IF data.breakFrame = f THEN RETURN;
    IF pc # 0 THEN
      BEGIN OPEN Mopcodes, DebugOps;
      IF ReadCodeByte[lf.accesslink,pc] # zBRK THEN pc _ [pc-1];
      IF ReadCodeByte[lf.accesslink,pc] = zNOOP THEN pc _ [pc-1];
      END;
    END;

  Previous: PUBLIC PROCEDURE [f: FHandle] RETURNS [prev: FHandle] =
    BEGIN
    link: MachineDefs.ControlLink;
    CheckF[f];
    f _ Cache[f,local];
    IF UserInput.userAbort THEN SIGNAL DebugOps.UserAborted;
    link _ LOOPHOLE[f.returnlink];
    THROUGH [0..100] DO 
      SELECT MachineDefs.TypeOfLink[link] FROM
      frame =>
	IF link.frame = NIL THEN GOTO noPrev
	ELSE IF ~ValidateF[link.frame] THEN GOTO clobbered
	ELSE RETURN[link.frame];
      procedure => GOTO noPrev;
      indirect => link _ DebugOps.ShortREAD[LOOPHOLE[link]];
      ENDCASE => GOTO clobbered;
    REPEAT
      noPrev => ERROR NoPrevious[f];
      clobbered => ERROR Clobbered[f];
      FINISHED => ERROR Clobbered[f];
    ENDLOOP
    END;

  ValidateGF: PUBLIC PROC [gf: GFHandle] RETURNS [BOOLEAN] =
    BEGIN
    cl: PrincOps.ControlLink _ LOOPHOLE[gf];
    gfi: MachineDefs.GFTIndex;
    IF gf = NIL THEN RETURN[FALSE];
    IF cl.proc OR cl.indirect THEN RETURN[FALSE];
    gfi _ GFI[gf];
    RETURN[MachineDefs.GfiToFrame[gfi] = gf]
    END;

  CheckGF: PUBLIC PROC[gf: GFHandle] = 
    BEGIN IF ~ValidateGF[gf] THEN SIGNAL Invalid[gf] END;
  
  Copied: PUBLIC PROCEDURE [gf: GFHandle] RETURNS [BOOLEAN] =
    BEGIN gf _ Cache[gf,global]; RETURN[gf.copied] END;

  Started: PUBLIC PROCEDURE [gf: GFHandle] RETURNS [BOOLEAN] =
    BEGIN gf _ Cache[gf,global]; RETURN[gf.started] END;

  Shared: PUBLIC PROCEDURE [gf: GFHandle] RETURNS [BOOLEAN] =
    BEGIN gf _ Cache[gf,global]; RETURN[gf.shared] END;

  CheckStarted: PUBLIC PROC [gf: GFHandle] RETURNS [running: BOOLEAN] =
    BEGIN
    running _ Started[gf];
    IF running THEN RETURN;
    DOutput.Octal[gf]; DOutput.Line[" is not started!"L];
    END;

  GFI: PUBLIC PROCEDURE [gf: GFHandle] RETURNS [MachineDefs.GFTIndex] =
    BEGIN gf _ Cache[gf,global]; RETURN[gf.gfi] END;

  Links: PUBLIC PROCEDURE [gf: GFHandle] RETURNS [BOOLEAN] =
    BEGIN gf _ Cache[gf,global]; RETURN[gf.codelinks] END;

  CodeBase: PUBLIC PROC [gf: GFHandle] RETURNS [PrincOps.FrameCodeBase] =
    BEGIN gf _ Cache[gf,global]; RETURN[gf.code] END;

  Deleted: PUBLIC PROC [gfi: MachineDefs.GFTIndex] RETURNS [BOOLEAN] = {
    RETURN[MachineDefs.GfiToFrame[gfi] = NullGF AND
      MachineDefs.GfiToOffset[gfi] = MachineDefs.NullOffset]};

  MakeDesc: PUBLIC PROC [gf: GFHandle, ep: CARDINAL] RETURNS [pd: PrincOps.ProcDesc] =
    BEGIN
    base: CARDINAL;
    offset: PrincOps.EPIndex;
    [base, offset] _ Inline.DIVMOD[ep, PrincOps.EPRange];
    pd.gfi _ GFI[gf] + base;
    pd.ep _ offset;
    pd.tag _ TRUE;
    END;

  PreDeclared: PUBLIC PROC [u: UNSPECIFIED] RETURNS [BOOLEAN] =
    BEGIN
    Signals: ARRAY [0..4) OF INTEGER = [-1,1,3,5];
    FOR i: CARDINAL IN [0..4) DO
      IF u = Signals[i] THEN RETURN[TRUE]
      ENDLOOP;
    RETURN[FALSE]
    END;

  NewLink: PUBLIC PROC [ocl: ControlLink]
    RETURNS [ncl: PrincOps.ControlLink] =
    BEGIN
    IF PreDeclared[ocl] THEN RETURN[LOOPHOLE[ocl]];
    SELECT TypeOfLink[ocl] FROM
      indirect, frame => ncl _ LOOPHOLE[ocl];
      procedure => {ncl.gfi _ ocl.gfi; ncl.ep _ ocl.ep; ncl.tag _ TRUE};
      ENDCASE => ncl _ LOOPHOLE[1];
    END;

  AddGfi: PUBLIC PROC [gf: GFHandle, cl: PrincOps.ControlLink]
    RETURNS [pd: PrincOps.ProcDesc] = {
      pd _ LOOPHOLE[cl]; pd.gfi _ pd.gfi + GFI[gf] - 1};

  FrameGfi: PUBLIC PROC [gfi: GFTIndex] RETURNS [GFHandle] = {
    RETURN[MachineDefs.GfiToFrame[gfi]]};

  END.