-- DebugNub.mesa; edited by Sandman October 9, 1980  9:57 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [BYTE],
  BcplOps USING [BcplJSR],
  BFSDefs USING [MakeCFP],
  ControlDefs USING [
    ControlLink, FieldDescriptor, FrameHandle, GlobalFrameHandle, NullFrame,
    StateVector, SVPointer],
  CoreSwapDefs USING [
    BBArray, BBHandle, CallDP, DebugParameter, VersionID, ExternalStateVector,
    level, PuntInfo, PuntTable, StartDP, SVPointer, SwapReason, UBBPointer,
    UserBreakBlock],
  DiskDefs USING [RealDA],
  ForgotDefs USING [BitmapDS],
  FrameDefs USING [LockCode, UnlockCode, UnNew],
  FrameOps USING [
    GetReturnFrame, GetReturnLink, MyLocalFrame, SetReturnFrame, SetReturnLink],
  ImageDefs USING [
    AbortMesa, AddCleanupProcedure, AddFileRequest, AllReasons, CleanupItem,
    CleanupMask, CleanupProcedure, FileRequest, PuntMesa, StopMesa,
    UserCleanupProc],
  KeyDefs USING [Keys],
  LoadStateOps USING [state],
  MiscOps USING [BitmapPages],
  Mopcodes USING [zRFS],
  NubOps USING [Place],
  NucleusOps USING [Wart],
  ProcessDefs USING [DisableInterrupts, EnableInterrupts],
  SDDefs USING [
    sBreakBlock, sBreakBlockSize, sCallDebugger, sCoreSwap, SD, sInterrupt,
    sProcessBreakpoint, sUncaughtSignal],
  SegmentDefs USING [
    DataSegmentHandle, DefaultXMBase, DeleteDataSegment, DeleteFileSegment,
    FileHandle, FileSegmentHandle, GetFileSegmentDA, InsufficientVM,
    LongDataSegmentAddress, LongVMtoDataSegment, MakeDataSegment, memConfig,
    NewFileSegment, Read, ReleaseFile, UnlockFile],
  SwapperOps USING [systemTable],
  Storage USING [Node, CopyString, Free, FreeString];

DebugNub: PROGRAM [user: PROGRAM]
  IMPORTS
    BFSDefs, CoreSwapDefs, DiskDefs, FrameDefs, FrameOps, ImageDefs, LoadStateOps,
    BcplOps, NucleusOps, ProcessDefs, SegmentDefs, SwapperOps, Storage
  EXPORTS CoreSwapDefs, MiscOps, NubOps
  SHARES SegmentDefs, ControlDefs =
  BEGIN OPEN CoreSwapDefs, SegmentDefs;

  WhereAmI: PUBLIC PROCEDURE RETURNS [NubOps.Place] = {RETURN[normal]};

  FrameHandle: TYPE = ControlDefs.FrameHandle;
  SVPointer: TYPE = ControlDefs.SVPointer;

  ProcessBreakpoint: PROCEDURE [s: SVPointer] =
    BEGIN -- called by BRK trap handler in resident code
    inst: AltoDefs.BYTE;
    swap: BOOLEAN;
    IF ~Swappable THEN BEGIN SwatBreak[s]; RETURN END;
    [inst, swap] _ DoBreakpoint[s];
    IF swap THEN
      BEGIN
      FrameDefs.LockCode[s.dest];
      CoreSwap[breakpoint, s];
      FrameDefs.UnlockCode[s.dest];
      END
    ELSE s.instbyte _ inst; --replant the instruction and go on
    RETURN
    END;

  DoBreakpoint: PROCEDURE [s: SVPointer] RETURNS [AltoDefs.BYTE, BOOLEAN] =
    BEGIN OPEN ControlDefs;
    ubb: CoreSwapDefs.UBBPointer;
    bba: BBHandle = SDDefs.SD[SDDefs.sBreakBlock];
    i: CARDINAL;
    l: FrameHandle _ s.dest;
    FOR i IN [0..bba.length) DO
      ubb _ @bba.blocks[i];
      IF ubb.frame = l.accesslink AND ubb.pc = l.pc THEN
	IF TrueCondition[ubb, l, s] THEN EXIT ELSE RETURN[ubb.inst, FALSE];
      ENDLOOP;
    RETURN[0, TRUE];
    END;

  TrueCondition: PROCEDURE [ubb: CoreSwapDefs.UBBPointer, base: POINTER, s: SVPointer]
    RETURNS [BOOLEAN] =
    BEGIN --decide whether to take the breakpoint
    fd: ControlDefs.FieldDescriptor;
    locL, locR: POINTER;
    left, right: UNSPECIFIED;
    IF ubb.counterL THEN
      IF (ubb.ptrL _ ubb.ptrL + 1) = ubb.ptrR THEN
	BEGIN ubb.ptrL _ LOOPHOLE[0]; RETURN[TRUE] END
      ELSE RETURN[FALSE];
    locL _ SELECT TRUE FROM
       ubb.localL => base + LOOPHOLE[ubb.ptrL, CARDINAL],
       ubb.stackRelative => @s.stk[LOOPHOLE[ubb.ptrL, CARDINAL]],
       ENDCASE => ubb.ptrL;
    fd _ [offset: 0, posn: ubb.posnL, size: ubb.sizeL];
    left _ ReadField[locL, fd];
    IF ~ubb.immediateR THEN
      BEGIN
      fd _ [offset: 0, posn: ubb.posnR, size: ubb.sizeR];
      locR _ IF ubb.localR THEN base + LOOPHOLE[ubb.ptrR, CARDINAL] ELSE ubb.ptrR;
      right _ ReadField[locR, fd];
      END
    ELSE right _ ubb.ptrR;
    RETURN[
      SELECT ubb.relation FROM
	lt => left < right,
	gt => left > right,
	eq => left = right,
	ne => left # right,
	le => left <= right,
	ge => left >= right,
	ENDCASE => FALSE]
    END;

  ReadField: PROCEDURE [POINTER, ControlDefs.FieldDescriptor]
    RETURNS [UNSPECIFIED] = MACHINE CODE BEGIN Mopcodes.zRFS END;

  NumberBlocks: CARDINAL = 5;

  InitBreakBlocks: PROCEDURE =
    BEGIN OPEN SDDefs;
    p: CoreSwapDefs.BBHandle _ Storage.Node[
      SIZE[UserBreakBlock]*NumberBlocks + SIZE[BBArray]];
    SD[sBreakBlock] _ p;
    SD[sBreakBlockSize] _ SIZE[UserBreakBlock]*NumberBlocks + SIZE[BBArray];
    p.length _ 0;
    RETURN
    END;

  SwatBreak: PROCEDURE [s: CoreSwapDefs.SVPointer] =
    BEGIN OPEN BcplOps;
    break: RECORD [a, b: WORD];
    break _ [77400B, 1400B];
    s.instbyte _ BcplJSR[JSR, @break, 0];
    RETURN
    END;

  Interrupt: PROCEDURE =
    BEGIN -- called by BRK trap handler in resident code
    state: ControlDefs.StateVector;
    state _ STATE;
    state.dest _ FrameOps.MyLocalFrame[];
    CoreSwap[breakpoint, @state];
    END;

  Catcher: PROCEDURE [msg, signal: UNSPECIFIED, frame: FrameHandle] =
    BEGIN OPEN ControlDefs;
    SignallerGF: GlobalFrameHandle;
    state: StateVector;
    f: FrameHandle;
    state.stk[0] _ msg;
    state.stk[1] _ signal;
    state.stkptr _ 0;
    -- the call stack below here is: Signaller, [Signaller,] offender
    f _ FrameOps.GetReturnFrame[];
    SignallerGF _ f.accesslink;
    state.dest _ f _ f.returnlink.frame;
    IF f.accesslink = SignallerGF THEN state.dest _ f.returnlink;
    IF ~Swappable THEN BEGIN SwatBreak[@state]; RETURN END;
    BEGIN
    CoreSwap[uncaughtsignal, @state ! ABORTED => IF signal = ABORTED THEN GOTO abort];
    EXITS abort => {BackStop[frame]; ERROR KillThisTurkey};
    END;
    RETURN
    END;

  BackStop: PROCEDURE [root: FrameHandle] =
    BEGIN
    endProcess: ControlDefs.ControlLink _ root.returnlink;
    caller: PROCEDURE = LOOPHOLE[FrameOps.GetReturnLink[]];
    root.returnlink _ LOOPHOLE[FrameOps.MyLocalFrame[]];
    FrameOps.SetReturnFrame[ControlDefs.NullFrame];
    caller[ ! KillThisTurkey => CONTINUE];
    FrameOps.SetReturnLink[endProcess];
    RETURN
    END;

  KillThisTurkey: SIGNAL = CODE;

  -- The core swapper

  Quit: SIGNAL = CODE;
  CantSwap: PUBLIC SIGNAL = CODE;
  DoSwap: PORT [POINTER TO ExternalStateVector];

  parmstring: STRING _ [40];

  CoreSwap: PUBLIC PROCEDURE [why: SwapReason, sp: SVPointer] =
    BEGIN OPEN BcplOps;
    loadstate: FileSegmentHandle _ LoadStateOps.state;
    e: ExternalStateVector;
    DP: DebugParameter;
    decode: PROCEDURE RETURNS [BOOLEAN] =
      BEGIN OPEN ControlDefs; -- decode the SwapReason
      f: GlobalFrameHandle;
      lsv: StateVector;
      SELECT e.reason FROM
	proceed, resume => RETURN[TRUE];
	call =>
	  BEGIN
	  lsv _ LOOPHOLE[e.parameter, CallDP].sv;
	  lsv.source _ FrameOps.MyLocalFrame[];
	  TRANSFER WITH lsv;
	  lsv _ STATE;
	  LOOPHOLE[e.parameter, CallDP].sv _ lsv;
	  why _ return;
	  END;
	start =>
	  BEGIN
	  f _ LOOPHOLE[e.parameter, StartDP].frame;
	  IF ~f.started THEN START LOOPHOLE[f, PROGRAM] ELSE RESTART f;
	  why _ return;
	  END;
	quit => SIGNAL Quit;
	kill => ImageDefs.AbortMesa[];
	showscreen =>
	  BEGIN
	  UNTIL KeyDefs.Keys.Spare3 = down DO NULL ENDLOOP;
	  why _ return;
	  END;
	ENDCASE => BEGIN RETURN[TRUE]; END;
      RETURN[FALSE]
      END;
    -- Body of CoreSwap
    IF ~Swappable THEN SIGNAL CantSwap;
    DP.string _ parmstring;
    e _
      [state: sp, reason:, level:, tables: @SwapperOps.systemTable,
	drumFile: MesaCoreFH, parameter: @DP, versionident: VersionID,
	loadstateCFA:
	[fp: loadstate.file.fp,
	  fa: [page: loadstate.base, byte: 0, da: GetFileSegmentDA[loadstate]]],
	lspages: loadstate.pages, mds: 0, bitmap: debuggerBitmap,
	bitmapPages: bitmapPages, fill: ALL[0]];
    DO
      e.reason _ why;
      ImageDefs.UserCleanupProc[OutLd ! ANY => CONTINUE];
      ProcessDefs.DisableInterrupts[];
      DoSwap[@e];
      ProcessDefs.EnableInterrupts[];
      ImageDefs.UserCleanupProc[InLd];
      BEGIN
      IF decode[
	! ABORTED => IF e.level > 0 THEN {why _ return; CONTINUE};
	Quit => GOTO abort] THEN EXIT
      EXITS abort => ERROR ABORTED;
      END;
      ENDLOOP;
    RETURN
    END;

  -- initialization

  Swappable: BOOLEAN;

  puntData: PuntTable;
  MesaCoreFH: FileHandle _ NIL;

  FindFiles: PROCEDURE =
    BEGIN OPEN ControlDefs;
    f: FileHandle;
    s: FileSegmentHandle;
    puntData.puntESV.reason _ punt;
    puntData.puntESV.tables _ @SwapperOps.systemTable;
    s _ LoadStateOps.state;
    puntData.puntESV.versionident _ VersionID;
    puntData.puntESV.loadstateCFA.fp _ s.file.fp;
    puntData.puntESV.loadstateCFA.fa _
      [page: s.base, byte: 0, da: GetFileSegmentDA[s]];
    puntData.puntESV.lspages _ s.pages;
    puntData.pDebuggerFP _ puntData.pCoreFP _ LOOPHOLE[0];
    puntData.puntESV.bitmap _ NIL;
    puntData.puntESV.bitmapPages _ 0;
    puntData.puntESV.fill _ ALL[0];
    Swappable _ TRUE;
    IF (f _ requests[core].file) = NIL THEN
      IF (f _ requests[swatee].file) = NIL THEN Swappable _ FALSE ELSE NULL
    ELSE
      IF requests[swatee].file # NIL THEN
	BEGIN OPEN SegmentDefs;
	fh: FileHandle = requests[swatee].file;
	UnlockFile[fh];
	ReleaseFile[fh];
	END;
    IF Swappable THEN
      BEGIN OPEN DiskDefs, SegmentDefs;
      ENABLE ANY => GOTO bad;
      puntData.puntESV.drumFile _ MesaCoreFH _ f;
      s _ NewFileSegment[f, 1, 1, Read];
      BFSDefs.MakeCFP[@puntData.coreFP, @f.fp];
      puntData.coreFP.leaderDA _ LOOPHOLE[RealDA[GetFileSegmentDA[s]]];
      puntData.pCoreFP _ @puntData.coreFP;
      DeleteFileSegment[s];
      IF (f _ requests[debugger].file) = NIL THEN GOTO bad;
      s _ NewFileSegment[f, 1, 1, Read];
      BFSDefs.MakeCFP[@puntData.debuggerFP, @f.fp];
      puntData.debuggerFP.leaderDA _ LOOPHOLE[RealDA[GetFileSegmentDA[s]]];
      puntData.pDebuggerFP _ @puntData.debuggerFP;
      UnlockFile[f];
      DeleteFileSegment[s];
      EXITS bad => Swappable _ FALSE;
      END
    ELSE puntData.pDebuggerFP _ NIL;
    Storage.FreeString[requests[debugger].name];
    Storage.FreeString[requests[core].name];
    Storage.FreeString[requests[swatee].name];
    Storage.Free[requests];
    puntData.puntESV.drumFile _ MesaCoreFH;
    IF bitmapWanted THEN AllocateDebuggerBitmap[MiscOps.BitmapPages];
    PuntInfo^ _ @puntData;
    RETURN
    END;

  RequestType: TYPE = {debugger, core, swatee};
  Requests: TYPE = ARRAY RequestType OF ImageDefs.FileRequest;
  requests: POINTER TO Requests;

  debuggerBitmap: PUBLIC LONG POINTER _ NIL;
  bitmapPages: CARDINAL _ 0;
  bitmapWanted: BOOLEAN _ TRUE;

  AllocateDebuggerBitmap: PUBLIC PROCEDURE [nPages: CARDINAL] =
    BEGIN OPEN SegmentDefs;
    seg: DataSegmentHandle;
    IF debuggerBitmap # NIL THEN ReleaseDebuggerBitmap[];
    bitmapWanted _ TRUE;
    IF ~memConfig.useXM OR ~Swappable THEN RETURN;
    seg _ MakeDataSegment[
      base: DefaultXMBase, pages: (bitmapPages _ nPages) !
      InsufficientVM => {seg _ NIL; CONTINUE}];
    IF seg # NIL THEN
      BEGIN
      debuggerBitmap _ LongDataSegmentAddress[seg];
      seg.type _ ForgotDefs.BitmapDS;
      puntData.puntESV.bitmap _ debuggerBitmap;
      puntData.puntESV.bitmapPages _ nPages;
      END;
    END;

  ReleaseDebuggerBitmap: PUBLIC PROCEDURE =
    BEGIN OPEN SegmentDefs;
    seg: DataSegmentHandle;
    IF debuggerBitmap # NIL THEN
      BEGIN
      seg _ LongVMtoDataSegment[debuggerBitmap];
      debuggerBitmap _ puntData.puntESV.bitmap _ NIL;
      bitmapPages _ puntData.puntESV.bitmapPages _ 0;
      DeleteDataSegment[seg];
      END;
    bitmapWanted _ FALSE;
    END;

  RequestFiles: PROCEDURE =
    BEGIN OPEN Storage;
    requests _ Node[SIZE[Requests]];
    requests[debugger] _
      [file: NIL, access: Read, link:, name: CopyString["MesaDebugger."L]];
    requests[core] _
      [file: NIL, access: Read, link:, name: CopyString["MesaCore."L]];
    requests[swatee] _
      [file: NIL, access: Read, link:, name: CopyString["Swatee."L]];
    ImageDefs.AddFileRequest[@requests[debugger]];
    ImageDefs.AddFileRequest[@requests[core]];
    ImageDefs.AddFileRequest[@requests[swatee]];
    END;

  bypassExec: PUBLIC BOOLEAN _ FALSE;

  item1: ImageDefs.CleanupItem _
    [link:, proc: GoToDebugger,
      mask: ImageDefs.CleanupMask[Finish] + ImageDefs.CleanupMask[Abort]];

  GoToDebugger: ImageDefs.CleanupProcedure =
    BEGIN
    IF ~bypassExec THEN RETURN;
    IF debuggerBitmap = NIL THEN AllocateDebuggerBitmap[MiscOps.BitmapPages];
    CoreSwapDefs.level _ -1;
    bypassExec _ FALSE;
    CallTheDebugger["You Called?"L];
    END;

  item2: ImageDefs.CleanupItem _
    [link:, proc: CleanupNub, mask: ImageDefs.AllReasons];

  CleanupNub: ImageDefs.CleanupProcedure =
    BEGIN
    save: BOOLEAN _ bitmapWanted;
    SELECT why FROM
      Save => {RequestFiles[]; ReleaseDebuggerBitmap[]; bitmapWanted _ save};
      Restore => FindFiles[];
      Checkpoint => {ReleaseDebuggerBitmap[]; bitmapWanted _ save};
      Continue, Restart =>
	IF bitmapWanted THEN AllocateDebuggerBitmap[MiscOps.BitmapPages];
      ENDCASE;
    END;

  CallTheDebugger: PROCEDURE [s: STRING] =
    BEGIN -- user's entry point to debugger
    state: ControlDefs.StateVector;
    filler0, filler1: CARDINAL;
    state _ STATE;
    state.stk[0] _ s;
    state.stkptr _ 1;
    state.dest _ FrameOps.GetReturnLink[];
    CoreSwap[explicitcall, @state];
    IF FALSE THEN filler0 _ filler1 _ 0;
    RETURN
    END;

  SetSD: PROCEDURE =
    BEGIN OPEN SDDefs;
    sd: POINTER TO ARRAY [0..0) OF UNSPECIFIED _ SD;
    sd[sProcessBreakpoint] _ ProcessBreakpoint;
    sd[sUncaughtSignal] _ Catcher;
    sd[sInterrupt] _ Interrupt;
    sd[sCallDebugger] _ CallTheDebugger;
    END;

  -- Main body

  P: TYPE = MACHINE DEPENDENT RECORD [in, out: UNSPECIFIED]; -- PORT

  LOOPHOLE[DoSwap, P] _ [in: 0, out: SDDefs.SD[SDDefs.sCoreSwap]];
  RequestFiles[];

  ImageDefs.AddCleanupProcedure[@item1];
  START user;

  STOP;

  BEGIN
  ENABLE ANY => ImageDefs.PuntMesa;
  FindFiles[];
  InitBreakBlocks[];
  SetSD[];
  FrameDefs.UnNew[LOOPHOLE[NucleusOps.Wart]];
  END;

  ImageDefs.AddCleanupProcedure[@item2];
  RESTART user[ ! ABORTED => CONTINUE];
  ImageDefs.StopMesa[];

  END...