(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: Debug                Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  This Module is not meant to be used by application programs! It will   *)
(*  be imported automatically when you compile a module using option '-g'. *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Dieses Modul wird beim Compilieren mit Option '-g' automatisch         *)
(*  importiert. Es sollte nicht in eigenen Programmen verwendet werden!!!  *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE Debug;

IMPORT e * := Exec,
       es  := ExecSupport,
       rq  := Requests,
       d   := Dos,
       ol  := OberonLib,
       sys := SYSTEM;


CONST
  ODebugPort = "ODebug_V1.0_HereIAm";
(* $IF English THEN *)
  ODebugAktiv1 = "ODebug ist currently active. Select";
  ODebugAktiv2 = "'Run' to start without using ODebug.";
  StartODebug1 = "Please start ODebug first, or select";
  StartODebug2 = "'Run' to start without using ODebug.";
  Run          = " Run ";
  Retry        = " Retry ";
  Cancel       = " Cancel ";
  oom          = "Out of memory!";
(* $ELSE *)
  ODebugAktiv1 = "ODebug ist gerade aktiv. 'Run' startet";
  ODebugAktiv2 = "das Programm ohne ODebug.";
  StartODebug1 = "Bitte zuerst ODebug starten,";
  StartODebug2 = "oder 'Run' selektieren.";
  Run          = " Run ";
  Retry        = " Retry ";
  Cancel       = " Cancel ";
  oom          = "Nicht genügend Speicher vorhanden!";
(* $END *)

TYPE
  String * = ARRAY 256 OF CHAR;
  StringPtr * = UNTRACED POINTER TO String;
  Breaks = UNTRACED POINTER TO ARRAY MAX(LONGINT) DIV 6 OF STRUCT
             module : StringPtr;
             statement: INTEGER;
           END;
  DebugMsgPtr = UNTRACED POINTER TO DebugMsg;
  DebugMsg = STRUCT (msg: e.Message)
              action: INTEGER;     (* siehe unten                         *)
              module: StringPtr;   (* Name des aktiven Moduls             *)
              statement: INTEGER;  (* nächstes Statment                   *)
              guru: LONGINT;       (* Fehler bei action=runtimeerr (s.u.) *)
              odebugAlive: BOOLEAN;(* Lebt ODebug() noch?                 *)
              sprint: BOOLEAN;     (* Sprint-Modus?                       *)
              procedure: INTEGER;  (* Prozedur (bei action=newproc)       *)
              varbase: e.ADDRESS;  (* Basisadr. der Variablen (newproc)   *)
              mod: INTEGER;        (* Modulenummer bei (bei newmod)       *)
              runQuick: BOOLEAN;   (* RunQuick-Modus?                     *)
              anzBreaks: LONGINT;  (* Anzahl der Brkpoints (bei runQuick) *)
              breakPoints: Breaks; (* Breakpointliste (bei runQuick)      *)
             END;

  DebugPortPtr = UNTRACED POINTER TO DebugPort;
  DebugPort = STRUCT (port: e.MsgPort)
                inuse: BOOLEAN;
              END;


CONST
(* DebugMsg.action *)
  tracing   = 0;  (* normales Trace (jeweils vor dem Statement)    *)
  hereweare = 1;  (* Begrüßung                                     *)
  cheerio   = 2;  (* Verabschiedung                                *)
  runtimeerr= 3;  (* Laufzeitfehler!                               *)
  newproc   = 4;  (* Neue Prozedur beginnt                         *)
  endproc   = 5;  (* Prozedur beendet                              *)
  newmod    = 6;  (* Varbase von importiertem Modul wird übergeben *)
  varbase   = 7;  (* Varbase von debuggtem Modul wird übergeben    *)

VAR
  Me: d.ProcessPtr;
  dbPort : e.MsgPortPtr;
  replyPort: e.MsgPortPtr;
  msg: DebugMsgPtr;
  Module* : StringPtr;  (* In welchem Modul sind wir gerade? *)

  i: LONGINT; (* Zäher für Trace() (global, damit keine Localen Vars nötig sind) *)


(* $StackChk- *)

TYPE
 TrapInfoType = STRUCT
                  trap: LONGINT;
                  ssw:  INTEGER;
                  adr:  LONGINT;
                  ir:   INTEGER;
                  sr:   INTEGER;
                  pc:   LONGINT;
                END;

VAR
  TrapInfo: TrapInfoType;


PROCEDURE TrapHandler;
BEGIN
  IF msg.odebugAlive & (Me=e.exec.thisTask) THEN
    msg.action := runtimeerr;
    msg.guru   := TrapInfo.trap;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
  END;
  HALT(20);
END TrapHandler;


PROCEDURE * TrapProc;   (* $NilChk- *)

BEGIN
(* $IFNOT SmallData *)
  sys.INLINE(0588FH);       (*    ADDQ.L  #4,A7         *)
(* $END *)
  ol.SetA5;
  sys.SETREG(8,TrapHandler);
  sys.SETREG(9,sys.ADR(TrapInfo));
  sys.INLINE(
    0201FH,               (*    move.l  (A7)+,D0      *)
    02280H,               (*    move.l  D0,(A1)       *)
    0B07CH,00003H,        (*    cmp     #3,D0         *)
    06208H,               (*    bhi.s   l             *)
    0235FH,00004H,        (*    move.l  (a7)+, 4(a1)  *)
    0235FH,00008H,        (*    move.l  (a7)+, 8(a1)  *)
    03357H,0000CH,        (* l: move.w  (a7) ,12(a1)  *)
    0236FH,00002H,0000EH, (*    move.l  2(a7),14(a1)  *)
    02F48H,00002H,        (*    move.l  A0,    2(A7)  *)
    04E73H);              (*    rte                   *)
END TrapProc;



PROCEDURE Trace*(stat: INTEGER); (* $SaveAllRegs+ *)
BEGIN
  IF msg.odebugAlive & (Me=e.exec.thisTask) THEN
    msg.statement := stat;
    msg.module := Module;
    IF msg.sprint THEN RETURN END;
    IF msg.runQuick THEN
      i := msg.anzBreaks;
      LOOP
        DEC(i);
        IF i<0 THEN RETURN END;
        IF (stat  =msg.breakPoints[i].statement) &
           (Module=msg.breakPoints[i].module   ) THEN
          EXIT;
        END;
      END;
    END;
    Me.task.trapCode := TrapProc;
    msg.action := tracing;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
    IF ~ msg.odebugAlive THEN HALT(20) END;
  END;
END Trace;


PROCEDURE NewProc*(vars: e.ADDRESS; proc: INTEGER); (* $SaveAllRegs+ *)
BEGIN
  IF msg.odebugAlive & ~ msg.sprint & (Me=e.exec.thisTask) THEN
    msg.action    := newproc;
    msg.module    := Module;
    msg.procedure := proc;
    msg.varbase   := vars;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
    IF ~ msg.odebugAlive THEN HALT(20) END;
  END;
END NewProc;


PROCEDURE EndProc*; (* $SaveAllRegs+ *)
BEGIN
  IF msg.odebugAlive & ~ msg.sprint & (Me=e.exec.thisTask) THEN
    msg.action    := endproc;
    msg.module    := Module;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
    IF ~ msg.odebugAlive THEN HALT(20) END;
  END;
END EndProc;


PROCEDURE NewMod*(mod: INTEGER; vars: e.ADDRESS); (* $SaveAllRegs+ *)
BEGIN
  IF msg.odebugAlive & ~ msg.sprint & (Me=e.exec.thisTask) THEN
    msg.action    := newmod;
    msg.module    := Module;
    msg.mod       := mod;
    msg.varbase   := vars;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
    IF ~ msg.odebugAlive THEN HALT(20) END;
  END;
END NewMod;


PROCEDURE VarBase*(vars: e.ADDRESS); (* $SaveAllRegs+ *)
BEGIN
(* TrapProc nochmal setzen, da sie evtl. von anderem Modul (NoGuru)
   auch gesetzt wurde. *)
  IF msg.odebugAlive & (Me=e.exec.thisTask) THEN
    Me.task.trapCode := TrapProc;
    msg.action    := varbase;
    msg.module    := Module;
    msg.varbase   := vars;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
    IF ~ msg.odebugAlive THEN HALT(20) END;
  END;
END VarBase;


BEGIN

  Me := sys.VAL(d.ProcessPtr,ol.Me);

  INCL(ol.MemReqs,e.public);
  NEW(msg);
  EXCL(ol.MemReqs,e.public);
  rq.Assert(msg#NIL,oom);
  replyPort := es.CreatePort("",0); rq.Assert(replyPort#NIL,oom);
  msg.msg.replyPort := replyPort;
  msg.msg.length    := sys.SIZE(DebugMsg);
  msg.odebugAlive := TRUE;

  LOOP
    e.Forbid;
      dbPort  := e.FindPort(ODebugPort);
      IF dbPort#NIL THEN
        WITH dbPort : DebugPort DO
          IF dbPort.inuse THEN
            dbPort := NIL;
            e.Permit;
            msg.odebugAlive := FALSE;
            IF rq.Request(ODebugAktiv1,ODebugAktiv2,Run,Cancel) THEN EXIT
                                                                ELSE HALT(20);
            END;
          END;
          dbPort.inuse := TRUE;
        END;
        e.Permit;
        EXIT
      END;
    e.Permit;
    IF ~ rq.Request(StartODebug1,StartODebug2,Retry,Run) THEN
      msg.odebugAlive := FALSE;
      EXIT
    END;
  END;

  IF msg.odebugAlive THEN
    msg.action := hereweare;
    e.PutMsg(dbPort,msg);
    REPEAT
      e.WaitPort(replyPort);
    UNTIL e.GetMsg(replyPort)=msg;
  END;

CLOSE

  IF dbPort#NIL THEN
    IF msg.odebugAlive THEN
      msg.action := cheerio;
      e.PutMsg(dbPort,msg);
      REPEAT
        e.WaitPort(replyPort);
      UNTIL e.GetMsg(replyPort)=msg;
    END;
  END;

  IF replyPort#NIL THEN es.DeletePort(replyPort) END;

END Debug.