home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 04 / debg_mod / debugger.mod < prev    next >
Encoding:
Modula Implementation  |  1988-01-27  |  11.0 KB  |  368 lines
  1. IMPLEMENTATION MODULE Debugger;
  2. (*-------------------------------------------------------*
  3.  * Das Modul Debugger enthält Routinen zur Fehlersuche.  *
  4.  * Die implementierten Funktionen schreiben bei ihrem    *
  5.  * Aufruf Informationen in eine Debugger-Datei vom Typ   *
  6.  * Stream.                                               *
  7.  * (C) 1988 Frank F. Wachtmeister & PASCAL International *
  8.  *-------------------------------------------------------*)
  9.  
  10. FROM SYSTEM  IMPORT BYTE, WORD, LONGWORD, ADDRESS;
  11. FROM Streams IMPORT Stream, StreamKinds, OpenStream,
  12.                     CloseStream, EOS;
  13. FROM GEMX    IMPORT ErrorCause, ErrorContextType,
  14.                     ErrorProcessor, ErrorContext,
  15.                     ErrorProcessorType;
  16. FROM TextIO  IMPORT in, out, REad, REadString,
  17.                     WRiteString, WRiteCard, WRiteInt,
  18.                     WRiteReal, WRiteLn, WRiteOct, WRiteHex,
  19.                     WRiteAdr, WRiteHexAdr, WRite;
  20. FROM Strings IMPORT String, Length, Assign;
  21.  
  22. (*-------------------------------------------------------*
  23.  * Man kann auch eine spezielle Einlese-Prozedur verwen- *
  24.  * den, aus der dann Zeile und Spalte verwendet werden   *
  25.  * können, um den Fehler in der Quelldatei zu lokali-    *
  26.  * sieren. Hier heißt sie Analyser.                      *
  27.  *-------------------------------------------------------*
  28.  *   FROM Analyser   IMPORT line, column;                *
  29.  *-------------------------------------------------------*)
  30.  
  31. VAR
  32.    init, active : BOOLEAN;
  33.    i,  SNr      : CARDINAL;
  34.    debugname    : String;
  35.    NormalError  : ErrorProcessorType;
  36.  
  37. PROCEDURE Error (err: INTEGER);
  38. (*-------------------------------------------------------*
  39.  * Error gibt eine Fehlermeldung in Abhängigkeit von der *
  40.  * Fehlernummer aus in der Form:                         *
  41.  * 'Fehler Nr. <nr> in Zeile <xx> Spalte <yy>.           *
  42.  *  < Fehlerbeschreibung >                               *
  43.  * Die Ausgabe erfolgt in das zuvor definierte debug.    *
  44.  * Die Fehlerbeschreibung befindet sich in der Datei     *
  45.  * ERRORS.TXT. Der Programmlauf wird beendet, wenn       *
  46.  * stop = TRUE.                                          *
  47.  *-------------------------------------------------------*)
  48.  
  49. VAR ErrorDescript: Stream;
  50.     i            : CARDINAL;
  51.     s            : String;
  52.     reply        : INTEGER;
  53.  
  54. BEGIN
  55.   IF err<0 THEN err:=-err
  56.   ELSIF err>0 THEN
  57.    OpenStream (ErrorDescript, ErrorText, READ, reply);
  58.    WRiteString (debug, 'Fehler Nr. ');
  59.    WRiteCard (debug, err, 4);
  60. (* An dieser Stelle kann die Ausgabe der Zeile und       *)
  61. (* Spalte erfolgen, an der der Fehler auftrat.           *)
  62. (* line und column wurden aus dem Lesemodul importiert.  *)
  63. (* WRiteString (debug, ' in Zeile ' );                   *)
  64. (* WRiteCard (debug, line , 4);                          *)
  65. (* WRiteString (debug, ' , Spalte ' );                   *)
  66. (* WRiteCard (debug, column,4);                          *)
  67.    WRite (debug, '.');  WRiteLn (debug);
  68.    FOR i:=1 TO err DO
  69.       IF NOT EOS(ErrorDescript) THEN
  70.          REadString (ErrorDescript, s)
  71.       END;
  72.    END;
  73.    IF EOS (ErrorDescript) THEN Assign (s,'') END;
  74.    Message (s);
  75.    IF stop THEN HALT END;
  76.   END;
  77. END Error;
  78.  
  79. (*-------------------------------------------------------*
  80.  *                  Typen für Debugging                  *
  81.  *-------------------------------------------------------*)
  82.  
  83. TYPE                             (* Typen-Konvertierung: *)
  84.    ByteType = RECORD
  85.       CASE : CHAR OF
  86.       'a': Byte: BYTE;               |
  87.       'b': Char: CHAR;               |
  88.       'c': Bool: BOOLEAN;            |
  89.       'd': Set : SET OF [0..7];      |
  90.       END;
  91.    END;
  92.  
  93.    WordType = RECORD
  94.       CASE :  CHAR OF
  95.       'a': Word    : WORD;           |
  96.       'b': Integer : INTEGER;        |
  97.       'c': Cardinal: CARDINAL;       |
  98.       'd': Set     : SET OF [0..15]; |
  99.       END;
  100.    END;
  101.  
  102.    LongWordType = RECORD
  103.       CASE : CHAR OF
  104.       'a': LongWord : LONGWORD;      |
  105.       'b': Address  : ADDRESS;       |
  106.       'c': Real     : REAL;          |
  107.       'd': Set      : SET OF [0..31];|
  108.       END;
  109.    END;
  110.  
  111.    SubType = RECORD
  112.       CASE : BOOLEAN OF
  113.          TRUE : Long : LONGCARD; |
  114.          FALSE: c1,c2: CARDINAL; |
  115.       END;
  116.    END;
  117.  
  118.  
  119. PROCEDURE ErrorProc;
  120.  
  121. VAR err: ErrorContextType;
  122.     i:   INTEGER;
  123.  
  124. BEGIN
  125.    err:=ErrorContext;
  126.    Error (err.Error+70);
  127.    WRiteString (debug, 'Error came from: ');
  128.    CASE err.CameFrom OF
  129.       XError      : WRiteString (debug,'XError');    |
  130.       XRaise      : WRiteString (debug,'XRaise');    |
  131.       XPropagate  : WRiteString (debug,'xPropagate');|
  132.    END;
  133.    WRiteLn (debug); WRiteLn (debug);
  134.    Message  ('Processor Status:');
  135.    ShowLong ('PC', err.PC);
  136.    ShowWord ('SR', err.SR);
  137.    ShowLong ('A5', err.A5);
  138.    ShowLong ('A6', err.A6);
  139.    ShowLong ('A7', err.A7);
  140.    Message ('Program terminated by Debugger.');
  141.    CloseStream (debug,i);
  142.    NormalError;
  143. END ErrorProc;
  144.  
  145.  
  146. PROCEDURE InitDebugger (VAR name: ARRAY OF CHAR);
  147. (*-------------------------------------------------------*
  148.  * InitDebugger initialisiert und aktiviert den Debugger.*
  149.  * Hier wird der Debug-Stream eröffnet und der normale   *
  150.  * ErrorProzessor des Moduls GEMX überschrieben.         *
  151.  * Die Variable name gibt den Dateinamen an.             *
  152.  *-------------------------------------------------------*)
  153.  
  154. VAR
  155.    i: INTEGER;
  156.    c: CHAR;
  157.    s: SubType;
  158.  
  159. BEGIN
  160.    IF Length(name)=0 THEN name:='CON:'; END;
  161.    Assign (debugname,name);
  162.    OpenStream (debug, name, READWRITE, i);
  163.    init:=(i=0);
  164.    IF init THEN
  165.       NormalError   :=ErrorProcessor;
  166.       ErrorProcessor:=ErrorProc;
  167.       active:=TRUE;
  168.       SNr:=0;
  169.       WRiteString (debug,'Calls, Var   ');
  170.       WRiteString (debug,' HEX-Val  ');
  171.       WRiteString (debug,'   DEC-Val ');
  172.       WRiteString (debug,'CHAR,INT,REAL');
  173.       WRiteString (debug,'   Bits');
  174.       WRiteLn     (debug);
  175.    ELSE
  176.       WRiteString (out,'Debugger-File nicht geöffnet!');
  177.       WRiteString ('  Fehler: ');
  178.       WRiteInt    (out,i,1); WRiteLn (out);
  179.       REad (in,c);
  180.       HALT;
  181.    END;
  182. END InitDebugger;
  183.  
  184. PROCEDURE Activate (act: BOOLEAN);
  185. (*-------------------------------------------------------*
  186.  * Activate schaltet den Debugger-Modus ein (TRUE) oder  *
  187.  * aus (FALSE).                                          *
  188.  *-------------------------------------------------------*)
  189.  
  190. VAR i: INTEGER;
  191.  
  192. BEGIN
  193.    IF (NOT active) & act THEN
  194.       InitDebugger (debugname)
  195.    ELSIF active & (NOT act) THEN
  196.       CloseStream (debug,i)
  197.    END;
  198.    active:=act;
  199. END Activate;
  200.  
  201. PROCEDURE Into (VAR WhatRoutine: ARRAY OF CHAR);
  202. (*-------------------------------------------------------*
  203.  * Zeigt den Eintritt in eine Prozedur an. Information   *
  204.  * der Form: "I: <WhatRoutine>" wird in den Debug-Stream *
  205.  * geschrieben.                                          *
  206.  *-------------------------------------------------------*)
  207.  
  208. VAR i,j: CARDINAL;
  209.  
  210. BEGIN
  211.  INC (SNr);
  212.  IF active THEN
  213.    IF SNr>60 THEN j:=60 ELSE j:=SNr END;
  214.    FOR i:=0 TO j DO
  215.       WRite (debug,' ');
  216.    END;
  217.    WRiteString (debug, 'I: '); Message ( WhatRoutine );
  218.  END;
  219. END Into;
  220.  
  221. PROCEDURE Leaving (VAR WhatRoutine: ARRAY OF CHAR);
  222. (*-------------------------------------------------------*
  223.  * Zeigt den Austritt aus einer Prozedur an. Information *
  224.  * der Form: "L: <WhatRoutine>" wird in den Debug-Stream *
  225.  * geschrieben.                                          *
  226.  *-------------------------------------------------------*)
  227.  
  228. VAR i,j: CARDINAL;
  229.  
  230. BEGIN
  231.  IF active THEN
  232.    IF SNr>60 THEN j:=60 ELSE j:=SNr END;
  233.    FOR i:=0 TO j DO
  234.       WRite (debug,' ');
  235.    END;
  236.    WRiteString (debug, 'L: '); Message ( WhatRoutine );
  237.  END;
  238.  DEC (SNr);
  239.  IF SNr<1  THEN SNr:=1; END;
  240. END Leaving;
  241.  
  242. PROCEDURE Message (VAR mess: ARRAY OF CHAR);
  243. (*-------------------------------------------------------*
  244.  * Ausgabe des Strings mess in den Debugger-Stream.      *
  245.  *-------------------------------------------------------*)
  246.  
  247. BEGIN
  248.  IF active THEN
  249.    WRiteString (debug, mess);
  250.    WRiteLn (debug);
  251.  END;
  252. END Message;
  253.  
  254.  
  255. PROCEDURE WriteName (VAR name: ARRAY OF CHAR);
  256.  
  257. VAR i: CARDINAL;
  258.  
  259. BEGIN
  260.    WRiteString (debug,name);
  261.    IF Length(name)<9 THEN
  262.       FOR i:=Length(name) TO 9 DO WRite (debug,' '); END;
  263.    END;
  264.    WRiteString (debug,'=');
  265. END WriteName;
  266.  
  267. PROCEDURE ShowByte (VAR name: ARRAY OF CHAR; byte: BYTE);
  268. (*-------------------------------------------------------*
  269.  * Ausgabe von Name und Inhalt einer Variablen der Größe *
  270.  * von einem Byte: CHAR, BYTE, SET OF 0..7, BOOLEAN      *
  271.  *-------------------------------------------------------*)
  272.  
  273. VAR
  274.    b: ByteType;
  275.    i: CARDINAL;
  276.  
  277. BEGIN
  278.  IF active THEN
  279.    b.Byte:=byte;
  280.    WriteName (name);
  281.    WITH b DO
  282.       i:=ORD(Char);
  283.       WRiteHex (debug,i, 9); WRiteString (debug,' ');
  284.       WRiteCard(debug,i,12); WRiteString (debug,' ');
  285.       WRite (debug,'"');
  286.       IF i>30 THEN WRite (debug,Char);
  287.       ELSE WRite (debug,' '); END;
  288.       WRiteString (debug,'"    ');
  289.       IF Bool THEN WRiteString (debug,' TRUE ')
  290.       ELSE WRiteString (debug,'FALSE ')  END;
  291.       FOR i:=7 TO 0 BY -1 DO
  292.          IF i IN Set THEN WRite (debug,'1')
  293.          ELSE WRite (debug,'0') END
  294.       END;
  295.    END;
  296.    WRiteLn (debug);
  297.  END;
  298. END ShowByte;
  299.  
  300. PROCEDURE ShowWord (VAR name: ARRAY OF CHAR; word: WORD);
  301. (*-------------------------------------------------------*
  302.  * Ausgabe von Name und Inhalt einer Variablen der Größe *
  303.  * von einem Word: INTEGER, CARDINAL, WORD               *
  304.  *-------------------------------------------------------*)
  305.  
  306. VAR
  307.    w: WordType;
  308.    i: CARDINAL;
  309.  
  310. BEGIN
  311.  IF active THEN
  312.    w.Word:=word;
  313.    WriteName (name);
  314.    WITH w DO
  315.       WRiteHex (debug,Cardinal, 9);
  316.       WRiteString (debug,' ');
  317.       WRiteCard(debug,Cardinal,12);
  318.       WRiteString (debug,' ');
  319.       WRiteInt (debug,Integer ,11);
  320.       WRiteString (debug,'I ');
  321.       FOR i:=15 TO 0 BY-1 DO
  322.          IF i IN Set THEN WRite (debug,'1')
  323.          ELSE WRite (debug,'0') END
  324.       END;
  325.    END;
  326.    WRiteLn (debug);
  327.  END;
  328. END ShowWord;
  329.  
  330. PROCEDURE ShowLong (VAR name: ARRAY OF CHAR;
  331.                         long: LONGWORD);
  332. (*-------------------------------------------------------*
  333.  * Ausgabe von Name und Inhalt einer Variablen der Größe *
  334.  * von einem LONGWORD: LONGWORD, LONGINT, LONGCARD, REAL *
  335.  *-------------------------------------------------------*)
  336.  
  337. VAR
  338.    w: LongWordType;
  339.    i,j: CARDINAL;
  340.    n1,n2: ARRAY[1..20] OF CHAR;
  341.  
  342. BEGIN
  343.  IF active THEN
  344.    w.LongWord:=long;
  345.    WriteName (name);
  346.    WITH w DO
  347.       WRiteHexAdr (debug, Address, 9);
  348.       WRiteString (debug,' ');
  349.       WRiteAdr (debug, Address,12);
  350.       WRiteString (debug,' ');
  351.       WRiteReal (debug,Real,12,-1);
  352.       WRiteString (debug,' ');
  353.       FOR i:=31 TO 0 BY -1 DO
  354.          IF i IN Set THEN WRite (debug,'1')
  355.          ELSE WRite (debug,'0') END
  356.       END;
  357.    END;
  358.    WRiteLn (debug);
  359.  END;
  360. END ShowLong;
  361.  
  362. BEGIN (* Debugger *)
  363.    stop  :=FALSE;
  364.    init  :=FALSE;
  365.    active:=FALSE;
  366.    Assign (debugname,'CON:');
  367. END Debugger.
  368.