home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / Debug.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  9.6 KB  |  315 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: Debug                Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1992 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. (*-------------------------------------------------------------------------*)
  10. (*                                                                         *)
  11. (*  This Module is not meant to be used by application programs! It will   *)
  12. (*  be imported automatically when you compile a module using option '-g'. *)
  13. (*                                                                         *)
  14. (*-------------------------------------------------------------------------*)
  15.  
  16. (*-------------------------------------------------------------------------*)
  17. (*                                                                         *)
  18. (*  Dieses Modul wird beim Compilieren mit Option '-g' automatisch         *)
  19. (*  importiert. Es sollte nicht in eigenen Programmen verwendet werden!!!  *)
  20. (*                                                                         *)
  21. (*-------------------------------------------------------------------------*)
  22.  
  23. MODULE Debug;
  24.  
  25. IMPORT e * := Exec,
  26.        es  := ExecSupport,
  27.        rq  := Requests,
  28.        d   := Dos,
  29.        ol  := OberonLib,
  30.        sys := SYSTEM;
  31.  
  32.  
  33. CONST
  34.   ODebugPort = "ODebug_V1.0_HereIAm";
  35. (* $IF English THEN *)
  36.   ODebugAktiv1 = "ODebug ist currently active. Select";
  37.   ODebugAktiv2 = "'Run' to start without using ODebug.";
  38.   StartODebug1 = "Please start ODebug first, or select";
  39.   StartODebug2 = "'Run' to start without using ODebug.";
  40.   Run          = " Run ";
  41.   Retry        = " Retry ";
  42.   Cancel       = " Cancel ";
  43.   oom          = "Out of memory!";
  44. (* $ELSE *)
  45.   ODebugAktiv1 = "ODebug ist gerade aktiv. 'Run' startet";
  46.   ODebugAktiv2 = "das Programm ohne ODebug.";
  47.   StartODebug1 = "Bitte zuerst ODebug starten,";
  48.   StartODebug2 = "oder 'Run' selektieren.";
  49.   Run          = " Run ";
  50.   Retry        = " Retry ";
  51.   Cancel       = " Cancel ";
  52.   oom          = "Nicht genügend Speicher vorhanden!";
  53. (* $END *)
  54.  
  55. TYPE
  56.   String * = ARRAY 256 OF CHAR;
  57.   StringPtr * = UNTRACED POINTER TO String;
  58.   Breaks = UNTRACED POINTER TO ARRAY MAX(LONGINT) DIV 6 OF STRUCT
  59.              module : StringPtr;
  60.              statement: INTEGER;
  61.            END;
  62.   DebugMsgPtr = UNTRACED POINTER TO DebugMsg;
  63.   DebugMsg = STRUCT (msg: e.Message)
  64.               action: INTEGER;     (* siehe unten                         *)
  65.               module: StringPtr;   (* Name des aktiven Moduls             *)
  66.               statement: INTEGER;  (* nächstes Statment                   *)
  67.               guru: LONGINT;       (* Fehler bei action=runtimeerr (s.u.) *)
  68.               odebugAlive: BOOLEAN;(* Lebt ODebug() noch?                 *)
  69.               sprint: BOOLEAN;     (* Sprint-Modus?                       *)
  70.               procedure: INTEGER;  (* Prozedur (bei action=newproc)       *)
  71.               varbase: e.ADDRESS;  (* Basisadr. der Variablen (newproc)   *)
  72.               mod: INTEGER;        (* Modulenummer bei (bei newmod)       *)
  73.               runQuick: BOOLEAN;   (* RunQuick-Modus?                     *)
  74.               anzBreaks: LONGINT;  (* Anzahl der Brkpoints (bei runQuick) *)
  75.               breakPoints: Breaks; (* Breakpointliste (bei runQuick)      *)
  76.              END;
  77.  
  78.   DebugPortPtr = UNTRACED POINTER TO DebugPort;
  79.   DebugPort = STRUCT (port: e.MsgPort)
  80.                 inuse: BOOLEAN;
  81.               END;
  82.  
  83.  
  84. CONST
  85. (* DebugMsg.action *)
  86.   tracing   = 0;  (* normales Trace (jeweils vor dem Statement)    *)
  87.   hereweare = 1;  (* Begrüßung                                     *)
  88.   cheerio   = 2;  (* Verabschiedung                                *)
  89.   runtimeerr= 3;  (* Laufzeitfehler!                               *)
  90.   newproc   = 4;  (* Neue Prozedur beginnt                         *)
  91.   endproc   = 5;  (* Prozedur beendet                              *)
  92.   newmod    = 6;  (* Varbase von importiertem Modul wird übergeben *)
  93.   varbase   = 7;  (* Varbase von debuggtem Modul wird übergeben    *)
  94.  
  95. VAR
  96.   Me: d.ProcessPtr;
  97.   dbPort : e.MsgPortPtr;
  98.   replyPort: e.MsgPortPtr;
  99.   msg: DebugMsgPtr;
  100.   Module* : StringPtr;  (* In welchem Modul sind wir gerade? *)
  101.  
  102.   i: LONGINT; (* Zäher für Trace() (global, damit keine Localen Vars nötig sind) *)
  103.  
  104.  
  105. (* $StackChk- *)
  106.  
  107. TYPE
  108.  TrapInfoType = STRUCT
  109.                   trap: LONGINT;
  110.                   ssw:  INTEGER;
  111.                   adr:  LONGINT;
  112.                   ir:   INTEGER;
  113.                   sr:   INTEGER;
  114.                   pc:   LONGINT;
  115.                 END;
  116.  
  117. VAR
  118.   TrapInfo: TrapInfoType;
  119.  
  120.  
  121. PROCEDURE TrapHandler;
  122. BEGIN
  123.   IF msg.odebugAlive & (Me=e.exec.thisTask) THEN
  124.     msg.action := runtimeerr;
  125.     msg.guru   := TrapInfo.trap;
  126.     e.PutMsg(dbPort,msg);
  127.     REPEAT
  128.       e.WaitPort(replyPort);
  129.     UNTIL e.GetMsg(replyPort)=msg;
  130.   END;
  131.   HALT(20);
  132. END TrapHandler;
  133.  
  134.  
  135. PROCEDURE * TrapProc;   (* $NilChk- *)
  136.  
  137. BEGIN
  138. (* $IFNOT SmallData *)
  139.   sys.INLINE(0588FH);       (*    ADDQ.L  #4,A7         *)
  140. (* $END *)
  141.   ol.SetA5;
  142.   sys.SETREG(8,TrapHandler);
  143.   sys.SETREG(9,sys.ADR(TrapInfo));
  144.   sys.INLINE(
  145.     0201FH,               (*    move.l  (A7)+,D0      *)
  146.     02280H,               (*    move.l  D0,(A1)       *)
  147.     0B07CH,00003H,        (*    cmp     #3,D0         *)
  148.     06208H,               (*    bhi.s   l             *)
  149.     0235FH,00004H,        (*    move.l  (a7)+, 4(a1)  *)
  150.     0235FH,00008H,        (*    move.l  (a7)+, 8(a1)  *)
  151.     03357H,0000CH,        (* l: move.w  (a7) ,12(a1)  *)
  152.     0236FH,00002H,0000EH, (*    move.l  2(a7),14(a1)  *)
  153.     02F48H,00002H,        (*    move.l  A0,    2(A7)  *)
  154.     04E73H);              (*    rte                   *)
  155. END TrapProc;
  156.  
  157.  
  158.  
  159. PROCEDURE Trace*(stat: INTEGER); (* $SaveAllRegs+ *)
  160. BEGIN
  161.   IF msg.odebugAlive & (Me=e.exec.thisTask) THEN
  162.     msg.statement := stat;
  163.     msg.module := Module;
  164.     IF msg.sprint THEN RETURN END;
  165.     IF msg.runQuick THEN
  166.       i := msg.anzBreaks;
  167.       LOOP
  168.         DEC(i);
  169.         IF i<0 THEN RETURN END;
  170.         IF (stat  =msg.breakPoints[i].statement) &
  171.            (Module=msg.breakPoints[i].module   ) THEN
  172.           EXIT;
  173.         END;
  174.       END;
  175.     END;
  176.     Me.task.trapCode := TrapProc;
  177.     msg.action := tracing;
  178.     e.PutMsg(dbPort,msg);
  179.     REPEAT
  180.       e.WaitPort(replyPort);
  181.     UNTIL e.GetMsg(replyPort)=msg;
  182.     IF ~ msg.odebugAlive THEN HALT(20) END;
  183.   END;
  184. END Trace;
  185.  
  186.  
  187. PROCEDURE NewProc*(vars: e.ADDRESS; proc: INTEGER); (* $SaveAllRegs+ *)
  188. BEGIN
  189.   IF msg.odebugAlive & ~ msg.sprint & (Me=e.exec.thisTask) THEN
  190.     msg.action    := newproc;
  191.     msg.module    := Module;
  192.     msg.procedure := proc;
  193.     msg.varbase   := vars;
  194.     e.PutMsg(dbPort,msg);
  195.     REPEAT
  196.       e.WaitPort(replyPort);
  197.     UNTIL e.GetMsg(replyPort)=msg;
  198.     IF ~ msg.odebugAlive THEN HALT(20) END;
  199.   END;
  200. END NewProc;
  201.  
  202.  
  203. PROCEDURE EndProc*; (* $SaveAllRegs+ *)
  204. BEGIN
  205.   IF msg.odebugAlive & ~ msg.sprint & (Me=e.exec.thisTask) THEN
  206.     msg.action    := endproc;
  207.     msg.module    := Module;
  208.     e.PutMsg(dbPort,msg);
  209.     REPEAT
  210.       e.WaitPort(replyPort);
  211.     UNTIL e.GetMsg(replyPort)=msg;
  212.     IF ~ msg.odebugAlive THEN HALT(20) END;
  213.   END;
  214. END EndProc;
  215.  
  216.  
  217. PROCEDURE NewMod*(mod: INTEGER; vars: e.ADDRESS); (* $SaveAllRegs+ *)
  218. BEGIN
  219.   IF msg.odebugAlive & ~ msg.sprint & (Me=e.exec.thisTask) THEN
  220.     msg.action    := newmod;
  221.     msg.module    := Module;
  222.     msg.mod       := mod;
  223.     msg.varbase   := vars;
  224.     e.PutMsg(dbPort,msg);
  225.     REPEAT
  226.       e.WaitPort(replyPort);
  227.     UNTIL e.GetMsg(replyPort)=msg;
  228.     IF ~ msg.odebugAlive THEN HALT(20) END;
  229.   END;
  230. END NewMod;
  231.  
  232.  
  233. PROCEDURE VarBase*(vars: e.ADDRESS); (* $SaveAllRegs+ *)
  234. BEGIN
  235. (* TrapProc nochmal setzen, da sie evtl. von anderem Modul (NoGuru)
  236.    auch gesetzt wurde. *)
  237.   IF msg.odebugAlive & (Me=e.exec.thisTask) THEN
  238.     Me.task.trapCode := TrapProc;
  239.     msg.action    := varbase;
  240.     msg.module    := Module;
  241.     msg.varbase   := vars;
  242.     e.PutMsg(dbPort,msg);
  243.     REPEAT
  244.       e.WaitPort(replyPort);
  245.     UNTIL e.GetMsg(replyPort)=msg;
  246.     IF ~ msg.odebugAlive THEN HALT(20) END;
  247.   END;
  248. END VarBase;
  249.  
  250.  
  251. BEGIN
  252.  
  253.   Me := sys.VAL(d.ProcessPtr,ol.Me);
  254.  
  255.   INCL(ol.MemReqs,e.public);
  256.   NEW(msg);
  257.   EXCL(ol.MemReqs,e.public);
  258.   rq.Assert(msg#NIL,oom);
  259.   replyPort := es.CreatePort("",0); rq.Assert(replyPort#NIL,oom);
  260.   msg.msg.replyPort := replyPort;
  261.   msg.msg.length    := sys.SIZE(DebugMsg);
  262.   msg.odebugAlive := TRUE;
  263.  
  264.   LOOP
  265.     e.Forbid;
  266.       dbPort  := e.FindPort(ODebugPort);
  267.       IF dbPort#NIL THEN
  268.         WITH dbPort : DebugPort DO
  269.           IF dbPort.inuse THEN
  270.             dbPort := NIL;
  271.             e.Permit;
  272.             msg.odebugAlive := FALSE;
  273.             IF rq.Request(ODebugAktiv1,ODebugAktiv2,Run,Cancel) THEN EXIT
  274.                                                                 ELSE HALT(20);
  275.             END;
  276.           END;
  277.           dbPort.inuse := TRUE;
  278.         END;
  279.         e.Permit;
  280.         EXIT
  281.       END;
  282.     e.Permit;
  283.     IF ~ rq.Request(StartODebug1,StartODebug2,Retry,Run) THEN
  284.       msg.odebugAlive := FALSE;
  285.       EXIT
  286.     END;
  287.   END;
  288.  
  289.   IF msg.odebugAlive THEN
  290.     msg.action := hereweare;
  291.     e.PutMsg(dbPort,msg);
  292.     REPEAT
  293.       e.WaitPort(replyPort);
  294.     UNTIL e.GetMsg(replyPort)=msg;
  295.   END;
  296.  
  297. CLOSE
  298.  
  299.   IF dbPort#NIL THEN
  300.     IF msg.odebugAlive THEN
  301.       msg.action := cheerio;
  302.       e.PutMsg(dbPort,msg);
  303.       REPEAT
  304.         e.WaitPort(replyPort);
  305.       UNTIL e.GetMsg(replyPort)=msg;
  306.     END;
  307.   END;
  308.  
  309.   IF replyPort#NIL THEN es.DeletePort(replyPort) END;
  310.  
  311. END Debug.
  312.  
  313.  
  314.  
  315.