-- BreakPoint.Mesa, edited by Bruce  October 25, 1980  7:59 PM

DIRECTORY
  BP USING [BBHandle, BytePC, Error, FreeUserBB, GFHandle],
  DebugFormat USING [BBHandle, BreakBlock, BreakType, EXOI, Foo],
  DebugOps USING [
    Foo, GFHandle, Numeric, ReadCodeByte, StringExpToDecimal, StringExpToOctal,
    WriteCodeByte, CommandNotAllowed],
  DI USING [DerefProcDesc, Foo, GetControlLink, NotAProcedure],
  DOutput USING [Char, Decimal, EOL, Line, Octal, Text],
  Drum USING [Free],
  DSyms USING [GFHandle, GFrameMdi, NoFGT],
  Dump USING [HashVal],
  Gf USING [DisplayInMsg, Frame, FrameGfi, GFI, Original],
  DHeap USING [Zero],
  Lookup USING [Fail, HTIndex, OnStack, StringToHti],
  MachineDefs USING [BYTE, GFHandle, UserBreakBlock],
  Mopcodes USING [op, zBRK, zLINKB, zNOOP, zPORTI, zRET],
  Pc USING [BytePC, CBti, EntryPC, EpToCBti, EVRange, EVSize, ExitPC, LinkToCbti],
  PrincOps USING [BytePC, ControlLink],
  Source USING [BytePC, Display, FileMissing],
  Storage USING [CopyString, Free, FreeString, Node],
  String USING [AppendString],
  Symbols USING [bodyType, CBTIndex, CBTNull, HTIndex, MDIndex],
  SymbolSegment USING [bodyType],
  SymbolTable USING [Missing],
  Table USING [Base, Bounds];
  
BreakPoint: PROGRAM
  IMPORTS BP, DebugOps, DI, DOutput, Drum, DSyms, Dump, Gf, DHeap, Lookup,
    Pc, Source, Storage, String, SymbolTable, Table
  EXPORTS BP =
  BEGIN OPEN BP;
  
-- a collection of procedures to set and clear breakpoints

  BreakType: TYPE = DebugFormat.BreakType;
  BreakBlock: TYPE = DebugFormat.BreakBlock;
  UserBreakBlock: TYPE = MachineDefs.UserBreakBlock;
  
  Fail: PUBLIC SIGNAL [type: Error] = CODE;
  AlreadyFree: ERROR = CODE;
  
  SetBlocks: BBHandle _ NIL;
  number: CARDINAL;
  
  Alloc: PUBLIC PROCEDURE RETURNS [bb: BBHandle] = 
    BEGIN
    last: BBHandle _ NIL;
    bb _ Storage.Node[SIZE[BreakBlock]];
    DHeap.Zero[bb, SIZE[BreakBlock]];
    bb.num _ number _ number + 1;
    FOR p: BBHandle _ SetBlocks, p.link UNTIL p = NIL DO last _ p; ENDLOOP;
    IF last # NIL THEN last.link _ bb ELSE SetBlocks _ bb;  
    END;
    
  Free: PUBLIC PROC [bb: BBHandle] =
    BEGIN
    last: BBHandle _ NIL;
    Find: PROC [b: BBHandle] RETURNS [BOOLEAN] = {
      IF b = bb THEN RETURN[TRUE];
      last _ b;
      RETURN[FALSE]};
    IF EnumerateBBs[Find] = NIL THEN ERROR AlreadyFree;
    IF last # NIL THEN last.link _ bb.link ELSE SetBlocks _ bb.link;  -- take out of chain
    FreeOne[bb, FALSE];
    END;
    
  FreeOne: PROC [bb: BBHandle, newSession: BOOLEAN] =
    BEGIN
    IF bb.condition # NIL THEN {
      Storage.FreeString[bb.condition];
      IF ~newSession THEN FreeUserBB[bb.gf, bb.pc]};
    IF bb.exp # NIL THEN Storage.FreeString[bb.exp];
    Storage.Free[bb];
    END;
    
  ResetBBs: PUBLIC PROC =
    BEGIN
    bb, next: BBHandle;
    FOR bb _ SetBlocks, next UNTIL bb = NIL DO
      next _ bb.link; FreeOne[bb, TRUE];
      ENDLOOP;
    SetBlocks _ NIL;
    number _ 0;
    END;
    
  EnumerateBBs: PUBLIC PROC [
    proc: PROC [BBHandle] RETURNS [BOOLEAN], gf: GFHandle _ NIL]
    RETURNS [bb: BBHandle] =
    BEGIN
    FOR bb _ SetBlocks, bb.link UNTIL bb = NIL DO
      IF gf # NIL AND bb.gf # gf THEN LOOP;
      IF proc[bb] THEN RETURN;
      ENDLOOP;
    END;
    
  DeleteBB: PUBLIC PROC [bb: BBHandle] RETURNS [last: BOOLEAN] =
    BEGIN
    Find: PROC [break: BBHandle] RETURNS [BOOLEAN] = 
      {IF bb = break THEN missing _ FALSE; cnt _ cnt + 1; RETURN[FALSE]};
    cnt: CARDINAL _ 0;
    missing: BOOLEAN _ TRUE;
    [] _ EnumerateBBs[Find,bb.gf];
    IF missing THEN WriteError[notFound];
    Free[bb];
    RETURN[cnt=1]
    END;
    
  FindBB: PUBLIC PROC [gf: GFHandle, pc: BytePC] RETURNS [bb: BBHandle] =
    BEGIN
    FindOne: PROC [b: BBHandle] RETURNS [BOOLEAN] = {RETURN[b.pc = pc]};
    bb _ EnumerateBBs[FindOne, Gf.Original[gf]];
    END;
    
  FindBBNum: PUBLIC PROC [c: CARDINAL] RETURNS [bb: BBHandle] =
    BEGIN
    FindOne: PROC [b: BBHandle] RETURNS [BOOLEAN] = {RETURN[b.num = c]};
    bb _ EnumerateBBs[FindOne];
    END;
    
  Insert: PUBLIC PROC [
    gf: GFHandle, pc: BytePC, bt: DebugFormat.BreakType, haveSyms: BOOLEAN]
    RETURNS [bb: BBHandle] =
    BEGIN   --set breakpoint on the specified statement
    op: MachineDefs.BYTE;
    pass: {one, two} _ one;
    bb _ FindBB[gf, pc];
    IF bb # NIL THEN 
      BEGIN
      IF bb.bt.bt = bt.bt THEN ERROR Fail[alreadySet];
      bb.bt.bt _ bt.bt;
      RETURN;
      END;
    gf _ Gf.Original[gf];
    DO
      SELECT (op _ DebugOps.ReadCodeByte[gf,pc]) FROM
	Mopcodes.zPORTI => ERROR Fail[portI];
	Mopcodes.zLINKB => IF pass = one THEN pc _ [pc + 2]; 
	Mopcodes.zNOOP => IF pass = one THEN pc _ [pc + 1]; 
	ENDCASE =>
	  IF bt.ex # exit OR op = Mopcodes.zRET OR op = Mopcodes.zBRK THEN
	    EXIT
	  ELSE ERROR Fail[noReturn];
      IF pass = two THEN ERROR Fail[notExchangable];
      pass _ two;
      ENDLOOP;
    DebugOps.WriteCodeByte[gf, pc, Mopcodes.zBRK !
      DebugOps.CommandNotAllowed => ERROR Fail[spare2]];
    bb _ Alloc[];  -- comes back zeroed, except for num and link
    bb.gf _ gf;
    bb.pc _ pc;
    bb.inst _ op;
    bb.bt _ bt;
    bb.symbolsAvailable _ haveSyms;
    END;
    
  Remove: PUBLIC PROCEDURE [gf: GFHandle, pc: BytePC] =
    BEGIN   --remove breakpoint on the specified statement
    p: BBHandle;
    op: MachineDefs.BYTE;
    pass: {one, two} _ one;
    DO
      SELECT (op _ DebugOps.ReadCodeByte[gf,pc]) FROM
	Mopcodes.zLINKB => IF pass = one THEN pc _ [pc + 2]; 
	Mopcodes.zNOOP => IF pass = one THEN pc _ [pc + 1]; 
	Mopcodes.zBRK => EXIT;
	ENDCASE => ERROR Fail[notFound];
      IF pass = two THEN ERROR Fail[notFound];
      pass _ two;
      ENDLOOP;
    gf _ Gf.Original[gf];
    IF (p _ FindBB[gf,pc]) = NIL THEN ERROR Fail[notFound];
    op _ p.inst;
    IF DeleteBB[p] THEN Drum.Free[gf];
    DebugOps.WriteCodeByte[gf,pc,op];
    RETURN
    END;
    
  GetCbti: PROC [s: STRING]
      RETURNS [cbti: Symbols.CBTIndex, cl: PrincOps.ControlLink] =
    BEGIN
    hti: Symbols.HTIndex = Lookup.StringToHti[s];
    f: DebugOps.Foo _ Lookup.OnStack[id: hti, check: FALSE];
    IF f = NIL THEN ERROR Lookup.Fail[s];
    cl _ DI.DerefProcDesc[DI.GetControlLink[f]];
    cbti _ Pc.LinkToCbti[cl];
    END;
    
  SetUp: PROC [s: STRING, ex: DebugFormat.EXOI, noSyms: BOOLEAN _ FALSE]
      RETURNS [gf: GFHandle, pc: BytePC] =
    BEGIN
    cl: PrincOps.ControlLink;
    cbti: Symbols.CBTIndex;
    [cbti,cl] _ GetCbti[s ! DI.NotAProcedure => GOTO inline];
    gf _ Gf.FrameGfi[cl.gfi];
    IF CheckInline[cbti] THEN GOTO inline;
    IF ex = entry THEN
      BEGIN
      cl.gfi _ cl.gfi-Gf.GFI[gf];
      pc _ Pc.EntryPC[LOOPHOLE[cl,CARDINAL]/2, gf, noSyms !
	SymbolTable.Missing => {noSyms _ TRUE; RETRY}]
      END
    ELSE
      BEGIN
      IF cbti = Symbols.CBTNull THEN AbortWithWrittenError[noSym];
      pc _ Pc.ExitPC[cbti];
      END;
    EXITS inline => AbortWithWrittenError[inInline];
    END;
    
  CheckInline: PROC [cbti: Symbols.CBTIndex] RETURNS [inline: BOOLEAN] =
    BEGIN
    bb: Table.Base;
    IF cbti = Symbols.CBTNull THEN RETURN[FALSE];
    bb _ Table.Bounds[SymbolSegment.bodyType].base;
    RETURN[bb[cbti].inline]
    END;
    
  SetIt: PROC [body: STRING, bt: BreakType] =
    BEGIN
    gf: GFHandle;
    pc: BytePC;
    syms: BOOLEAN _ TRUE;
    [gf,pc] _ SetUp[body,bt.ex];
    [] _ DSyms.GFrameMdi[gf,TRUE !
      DSyms.NoFGT, SymbolTable.Missing => {syms _ FALSE; CONTINUE}];
    DOutput.Char[' ];
    SetOne[gf,pc,bt,syms];
    END;
    
  SetOne: PROC [gf: GFHandle, pc: BytePC, bt: BreakType, syms: BOOLEAN] =
    BEGIN
    bb: BBHandle;
    bb _ Insert[gf,pc,bt,syms ! Fail => WriteError[type]];
    DOutput.Text["Breakpoint #"L]; DOutput.Decimal[bb.num];
    DOutput.Line["."L];
    END;
    
  ClearIt: PROCEDURE [body: STRING, ex: DebugFormat.EXOI] =
    BEGIN
    pc, nosymspc: BytePC;
    gf: GFHandle;
    nosyms: BOOLEAN;
    [gf,pc] _ SetUp[body,ex];
    FOR nosyms IN BOOLEAN DO
      Remove[gf, pc ! Fail =>
	IF nosyms OR type # notFound OR ex # entry THEN WriteError[type] 
	ELSE
	  BEGIN
	  nosymspc _ SetUp[body,ex,TRUE].pc;
	  IF nosymspc = pc THEN WriteError[type] ELSE {pc _ nosymspc; LOOP}
	  END];
      EXIT
      ENDLOOP;
    END;
    
  ClearAllBreaks: PUBLIC PROC =
    BEGIN
    bb, next: BBHandle;
    FOR bb _ SetBlocks, next UNTIL bb = NIL DO
      next _ bb.link;
      Remove[bb.gf, bb.pc ! Fail => 
	BEGIN OPEN DOutput;
	Decimal[bb.num]; Text[" -- "L]; WriteError[type]; EOL[];
	CONTINUE;
	END];
      ENDLOOP;
    END;
    
  GetBreak: PROC [num: STRING] RETURNS [bb: DebugFormat.BBHandle] =
    BEGIN
    i: INTEGER _ DebugOps.StringExpToDecimal[num];
    bb _ FindBBNum[LOOPHOLE[i,CARDINAL]];
    IF bb = NIL THEN {WriteError[notFound]; DOutput.EOL[]};
    END;
    
  ClearBreak: PUBLIC PROC [bbNum: STRING] = {ClearDefault[GetBreak[bbNum]]};
  
  ClearDefault: PUBLIC PROC [bb: BBHandle] = {IF bb # NIL THEN Remove[bb.gf, bb.pc]};
  BreakEntry: PUBLIC PROC [proc: STRING] = {SetIt[proc,[entry,break]]};
  BreakExit: PUBLIC PROC [proc: STRING] = {SetIt[proc,[exit,break]]};
  TraceEntry: PUBLIC PROC [proc: STRING] = {SetIt[proc,[entry,trace]]};
  TraceExit: PUBLIC PROC [proc: STRING] = {SetIt[proc,[exit,trace]]};
  
  ClearEntryBreak, ClearEntryTrace: PUBLIC PROC [proc: STRING] = 
    BEGIN ClearIt[proc,entry] END;
    
  ClearXitBreak, ClearXitTrace: PUBLIC PROC [proc: STRING] = 
    BEGIN ClearIt[proc,exit] END;
    
  BreakAllEntries: PUBLIC PROC [mod, exp: STRING] =
    BEGIN DoAll[mod,[entry,break],exp,TRUE] END;
    
  BreakAllXits: PUBLIC PROC [mod, exp: STRING] =
    BEGIN DoAll[mod,[exit,break],exp,TRUE] END;
    
  TraceAllEntries: PUBLIC PROC [mod, exp: STRING] =
    BEGIN DoAll[mod,[entry,trace],exp,TRUE] END;
    
  TraceAllXits: PUBLIC PROC [mod, exp: STRING] =
    BEGIN DoAll[mod,[exit,trace],exp,TRUE] END;
    
  ClearAllEntries: PUBLIC PROC [mod: STRING] =
    BEGIN DoAll[mod,[entry,break],NIL,FALSE] END;
    
  ClearAllXits: PUBLIC PROC [mod: STRING] =
    BEGIN DoAll[mod,[exit,break],NIL,FALSE] END;
    
  Expressionalize: PUBLIC PROC [bb: BBHandle, exp: STRING] =
    BEGIN
    IF bb = NIL THEN RETURN;
    IF bb.exp # NIL THEN Storage.FreeString[bb.exp];
    bb.exp _ exp;
    END;
    
  AttachExpression: PUBLIC PROC [bbNum, exp: STRING] =
    BEGIN
    bb: BBHandle _ FindBBNum[DebugOps.StringExpToDecimal[bbNum]];
    IF bb # NIL THEN Expressionalize[bb,Storage.CopyString[exp]]
    ELSE AbortWithWrittenError[notFound];
    END;
    
  ClearExpression: PUBLIC PROC [bbNum: STRING] = {AttachExpression[bbNum,NIL]};
  
  DoAll: PROC [mod: STRING, bt: BreakType, exp: STRING, set: BOOLEAN] =
    BEGIN
    mdi: Symbols.MDIndex;
    maxEp: Pc.EVRange;
    pc: BytePC;
    cbti: Symbols.CBTIndex;
    gf: GFHandle _
      IF DebugOps.Numeric[mod] THEN LOOPHOLE[DebugOps.StringExpToOctal[mod]]
      ELSE Gf.Frame[mod];
    mdi _ DSyms.GFrameMdi[gf ! SymbolTable.Missing => {
      AbortWithWrittenError[noSym]; ERROR}];
    maxEp _ Pc.EVSize[mdi];
    DOutput.EOL[];
    FOR i: Pc.EVRange IN (0..maxEp] DO
      cbti _ Pc.EpToCBti[i,gf];
      SELECT bt.ex FROM
	entry => pc _ Pc.EntryPC[i,gf];
	exit => pc _ Pc.ExitPC[cbti];
	ENDCASE => ERROR;
      PrintName[cbti]; DOutput.Text[" -- "L];
      IF set THEN SetOne[gf,pc,bt,TRUE ! Fail => {DOutput.EOL[]; CONTINUE}]
      ELSE Remove[gf,pc !
	Fail => {WriteError[type]; DOutput.EOL[]; CONTINUE}];
      ENDLOOP;
    END;
    
  PrintName: PROC [cbti: Symbols.CBTIndex] =
    BEGIN
    bb: Table.Base _ Table.Bounds[Symbols.bodyType].base;
    IF cbti = Symbols.CBTNull THEN RETURN;
    Dump.HashVal[bb[cbti].id];
    END;
    
  Convert: PROC [gf,pc: STRING] RETURNS [GFHandle, BytePC] =
    BEGIN
    RETURN[LOOPHOLE[
      DebugOps.StringExpToOctal[gf]],[DebugOps.StringExpToOctal[pc]]]
    END;
    
  OctalBreak: PUBLIC PROCEDURE [gf,pc: STRING] =
    BEGIN
    ogf: GFHandle;
    opc: BytePC;
    [ogf,opc] _ Convert[gf: gf, pc: pc];
    DOutput.Text[" -- "L];
    SetOne[ogf, opc, [octal,break], FALSE];
    RETURN
    END;
    
  ClearOctal: PUBLIC PROC [gf,pc: STRING] =
    BEGIN
    ogf: GFHandle;
    opc: BytePC;
    [ogf,opc] _ Convert[gf: gf, pc: pc];
    Remove[ogf, opc];
    RETURN
    END;
    
  ListBreaks: PUBLIC PROCEDURE = {
    IF SetBlocks = NIL THEN DOutput.Line["None set!"L] 
    ELSE [] _ EnumerateBBs[ListOne]};
    
  ListBreak: PUBLIC PROC [bbNum: STRING] = {List[GetBreak[bbNum]]};
  
  ListOne: PROC [bb: BBHandle] RETURNS [BOOLEAN] = {List[bb]; RETURN[FALSE]};
  
  List: PUBLIC PROCEDURE [b: BBHandle]=
    BEGIN OPEN DOutput;
    IF b = NIL THEN RETURN;
    Decimal[b.num]; Text[" -- "L];
    IF b.bt.ex = octal THEN
      BEGIN
      Text["Octal-break in frame: "L]; Octal[b.gf];
      Text[", byte-pc: "L]; Octal[b.pc]; Line["."L];
      END
    ELSE
      BEGIN
      Text[IF b.bt.bt = break THEN "Break"L ELSE "Trace"L];
      Text[SELECT b.bt.ex FROM
	entry => " at entry to "L,
	exit => " at exit from "L,
	ENDCASE => " in "L];
      PrintName[Pc.CBti[b.pc,b.gf]];
      Gf.DisplayInMsg[b.gf,NIL]; Char['.];
      IF b.condition # NIL THEN {Text["  Condition: "L]; Text[b.condition]};
      IF b.exp # NIL THEN {Text["  Keystrokes: "L]; Text[b.exp]};
      EOL[];
      IF b.bt.ex = in THEN Source.Display[b.gf,b.pc,FALSE
	! Source.FileMissing => {Text[name]; Line[" not found!"L]};
	SymbolTable.Missing => Line["Symboltable not found!"L]];
      END;
    RETURN
    END;
    
  AbortWithError: PUBLIC PROC [err: Error] =
    BEGIN
    IF err IN Error[tooManyConditions..alreadySet] THEN ERROR Fail[err];
    SIGNAL Fail[err];
    END;
    
  AbortWithWrittenError: PUBLIC PROC [err: Error] = {WriteError[err]; AbortWithError[err]};
  
  WriteError: PUBLIC PROCEDURE [err: Error] =
    BEGIN
    msg: STRING _ [60];
    AppendError[msg,err];
    DOutput.Text[msg];
    END;
    
  AppendError: PUBLIC PROCEDURE [s: STRING, err: Error] =
    BEGIN
    String.AppendString[s, SELECT err FROM
      tooManyConditions => " too many conditional breaks!"L,
      invalidRelation => " invalid relation!"L,
      conditionNotFound => " user break block not found!"L,
      size => " variable is larger than a word!"L,
      stack => " rhs on stack not allowed!"L,
      portI => " can't break on port!"L,
      notExchangable => " no exchangable code found!"L,
      notFound => " breakpoint not found!"L,
      noneSet => " no breaks have been set!"L,
      noSym => " symboltable missing!"L,
      spare1 => " Can't dereference or access array to test condition!"L,
      inInline => " not allowed in INLINE!"L,
      alreadySet => " already set!"L,
      noReturn => " does not return!"L,
      worryOn => " conditions not checked in Worry mode!"L,
      spare2 => " ! Patch table full"L,
      ENDCASE => "??"L];
    RETURN
    END;
    
END.