home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / NoGuru.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  8.4 KB  |  298 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: NoGuru               Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1991 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. (*
  10.  * To compile use "Oberon [-dma] SET English NoGuru" to get an english
  11.  * version of this module. Use "Oberon [-d] NoGuru" to get a german one.
  12.  *)
  13.  
  14. (* $IF NoGuruRq *)
  15. MODULE NoGuruRq;
  16. (* $ELSE *)
  17. MODULE NoGuru;
  18. (* $END *)
  19.  
  20. IMPORT wb := Workbench,
  21.        e  := Exec,
  22.              Alerts,
  23.              io,
  24. (* $IF GarbageCollector *)
  25.        gc := GarbageCollector,
  26. (* $END *)
  27. (* $IF NoGuruRq *)
  28.        rq := Requests,
  29. (* $END *)
  30.        ol := OberonLib,
  31.        s  := SYSTEM;
  32.  
  33. (* $StackChk- *)
  34.  
  35. (*------------------------------------------------------------*)
  36.  
  37. (* Die Traps haben folgende Bedeutung:
  38.  
  39.       2   Busfehler
  40.       3   Addressfehler
  41.       4   ill. Befehl
  42.       5   Division durch 0
  43.       6   Chk (Bereichsfehler)
  44.       7   TrapV (Overflow)
  45.       8   Privilegverletzung
  46.       9   Trace-Vektor
  47.       A   Line-A
  48.       B   Line-F
  49.  
  50.  C - 1F   Guru # x
  51.  
  52.      20   Trap # 0 (Bereichsfehler)
  53.      21   Trap # 1 (ungültiger Case index)
  54.      22   Trap # 2 (Stack überlauf)
  55.      23   Trap # 3 (Nil-Zeiger dereferenziert)
  56.      24   Trap # 4 (Funktion ohne RETURN beendet)
  57.      25   Trap # 5 (Fehler bei Typüberprüfung festgestellt)
  58.      26   Trap # 6 (falscher Prozessor installiert)
  59.      27   Trap # 7 (Zeiger ist ungerade (Adressfehle))
  60.      28   Trap # 8 (User Break (^C));
  61.      29   Trap # 9 (Out of memory);
  62.  
  63. 22 -255   Guru # x
  64.  
  65. *)
  66.  
  67. TYPE
  68.  TrapInfoType = RECORD
  69.                   trap: LONGINT;
  70.                   ssw:  INTEGER;
  71.                   adr:  LONGINT;
  72.                   ir:   INTEGER;
  73.                   sr:   INTEGER;
  74.                   pc:   LONGINT;
  75.                 END;
  76. TYPE
  77.   SegTrackProc = PROCEDURE (Address{8}: s.ADDRESS;
  78.                             VAR SegNum{9}: LONGINT;
  79.                             VAR Offset{10}: LONGINT): e.STRPTR;
  80.   SegSemPtr = UNTRACED POINTER TO SegSem;
  81.   SegSem = STRUCT (semaphore: e.SignalSemaphore)
  82.     find: SegTrackProc;
  83.   END;
  84. VAR
  85.   TrapInfo: TrapInfoType;
  86.   A: ARRAY 8 OF LONGINT;
  87.   D: ARRAY 8 OF LONGINT;
  88.   Msg: ARRAY 80 OF CHAR;
  89.   Me: e.TaskPtr;
  90.   Sem: SegSemPtr;
  91.   SegNum, Offset: LONGINT;
  92.   SegName: ARRAY 256 OF CHAR;
  93.   NamePtr: e.STRPTR;
  94.  
  95. (* $IFNOT NoGuruRq *)
  96.   string:ARRAY 32 OF CHAR;
  97.   i: INTEGER;
  98. (* $END *)
  99.  
  100.  
  101. PROCEDURE Assert*(cc: BOOLEAN; msg: ARRAY OF CHAR); (* $CopyArrays- *)
  102.  
  103. BEGIN
  104. (* $IF NoGuruRq *)
  105.   rq.Assert(cc,msg);
  106. (* $ELSE *)
  107.   IF ~ cc THEN
  108.     io.WriteString(" *** ");
  109.     io.WriteString(msg);
  110.     io.WriteLn;
  111.     HALT(20);
  112.   END;
  113. (* $END *)
  114. END Assert;
  115.  
  116.  
  117. PROCEDURE TrapHandler;
  118. BEGIN
  119.   IF Sem # NIL THEN
  120.     e.Forbid;
  121.     NamePtr := Sem.find (TrapInfo.pc, SegNum, Offset);
  122.     IF NamePtr # NIL THEN
  123.       (* $OddChk- *)
  124.       COPY (NamePtr^, SegName);
  125.       (* $OddChk= *)
  126.     END;
  127.     e.Permit;
  128.   ELSE
  129.     NamePtr := NIL;
  130.   END;
  131.  
  132.   IF e.exec.thisTask#Me THEN
  133.     IF NamePtr = NIL THEN
  134.       IF Alerts.Alert("Task %s (Task=%lx) failed:\nGuru = %lx\nPC   = %lx\n"
  135.                       "  ---  press button to continue  ---",
  136.                       e.exec.thisTask.node.name,
  137.                       e.exec.thisTask,
  138.                       TrapInfo.trap,
  139.                       TrapInfo.pc) THEN END;
  140.     ELSE
  141.       IF Alerts.Alert("Task %s (Task=%lx) failed:\nGuru = %lx\nPC   = %lx\n"
  142.                       "SegTracker: %s : Hunk %ld, Offset $%08lx\n"
  143.                       "  ---  press button to continue  ---",
  144.                       e.exec.thisTask.node.name,
  145.                       e.exec.thisTask,
  146.                       TrapInfo.trap,
  147.                       TrapInfo.pc,
  148.                       s.ADR (SegName),
  149.                       SegNum,
  150.                       Offset) THEN END;
  151.     END;
  152.     HALT(20);
  153.   END;
  154.   A[7] := s.REG(15);
  155.  
  156. (* $IF GarbageCollector *)
  157.   gc.mutator.locals := NIL;
  158. (* $END *)
  159.  
  160.   s.SETREG(15,ol.OldSP);
  161.  
  162. (* $IF English THEN *)
  163.  
  164.   CASE TrapInfo.trap OF
  165.   02H: Msg := "Buserror" |
  166.   03H: Msg := "Addresserror" |
  167.   04H: Msg := "Illegal instruction" |
  168.   05H: Msg := "Division by 0" |
  169.   06H: Msg := "Rangecheck error (CHK)" |
  170.   07H: Msg := "Overflow (TRAPV)" |
  171.   08H: Msg := "Privilege violation" |
  172.   09H: Msg := "Trace-Vector" |
  173.   0AH: Msg := "Line-A" |
  174.   0BH: Msg := "Line-F" |
  175.   20H: Msg := "Trap # 0 (Rangecheck error)" |
  176.   21H: Msg := "Trap # 1 (illegal CASE-index)" |
  177.   22H: Msg := "Trap # 2 (Stack overflow)" |
  178.   23H: Msg := "Trap # 3 (NIL-Pointer dereferenced)" |
  179.   24H: Msg := "Trap # 4 (Missing RETURN-statement)" |
  180.   25H: Msg := "Trap # 5 (Typ-check error)" |
  181.   26H: Msg := "Trap # 6 (need faster processor)" |
  182.   27H: Msg := "Trap # 7 (uneven pointer used)" |
  183.   28H: Msg := "Trap # 8 (User Break, ^C)" |
  184.   29H: Msg := "Trap # 8 (Speichermangel)" |
  185.   ELSE Msg := " Guru # 00H";
  186.        INC(Msg[8],SHORT(SHORT(TrapInfo.trap DIV 16))); IF Msg[8]>"0" THEN INC(Msg[8],7) END;
  187.        INC(Msg[9],SHORT(SHORT(TrapInfo.trap MOD 16))); IF Msg[9]>"0" THEN INC(Msg[9],7) END;
  188.   END;
  189.  
  190. (* $ELSE *)
  191.  
  192.   CASE TrapInfo.trap OF
  193.   02H: Msg := "Busfehler" |
  194.   03H: Msg := "Addressfehler" |
  195.   04H: Msg := "Illegaler Befehl" |
  196.   05H: Msg := "Division durch 0" |
  197.   06H: Msg := "Chk (Bereichsfehler)" |
  198.   07H: Msg := "TrapV (Überlauf)" |
  199.   08H: Msg := "Privilegverletzung" |
  200.   09H: Msg := "Trace-Vektor" |
  201.   0AH: Msg := "Line-A" |
  202.   0BH: Msg := "Line-F" |
  203.   20H: Msg := "Trap # 0 (Bereichsfehler)" |
  204.   21H: Msg := "Trap # 1 (ungültiger Case index)" |
  205.   22H: Msg := "Trap # 2 (Stack überlauf)" |
  206.   23H: Msg := "Trap # 3 (Nil-Zeiger dereferenziert)" |
  207.   24H: Msg := "Trap # 4 (Funktion ohne RETURN beendet)" |
  208.   25H: Msg := "Trap # 5 (Typ-Check Fehler)" |
  209.   26H: Msg := "Trap # 6 (falscher Prozessor installiert)" |
  210.   27H: Msg := "Trap # 6 (ungerader Zeiger dereferenziert (Adressfehler))" |
  211.   28H: Msg := "Trap # 8 (User Break)" |
  212.   29H: Msg := "Trap # 8 (Ouf of memory)" |
  213.   ELSE Msg := " ??? "
  214.   END;
  215.  
  216. (* $END *)
  217.  
  218. (* $IF NoGuruRq *)
  219.  
  220.   rq.Fail(Msg);
  221.  
  222. (* $ELSE *)
  223.  
  224.   io.WriteString("Guru #"); io.WriteHex(TrapInfo.trap,4);
  225.   io.WriteString(": \[1;33m");
  226.   io.WriteString(Msg);
  227.   io.WriteString("\[m\nDx ");
  228.   i := 0;
  229.   REPEAT
  230.     io.WriteHex(D[i],8); io.Write(" "); IF i=3 THEN io.Write(" ") END;
  231.     INC(i);
  232.   UNTIL i=8;
  233.   io.WriteString("\nAx ");
  234.   i := 0;
  235.   REPEAT
  236.     io.WriteHex(A[i],8); io.Write(" "); IF i=3 THEN io.Write(" ") END;
  237.     INC(i);
  238.   UNTIL i=8;
  239.   IF TrapInfo.trap<=3 THEN
  240.     io.WriteString("\nssw   "); io.WriteHex(TrapInfo.ssw,4);
  241.     io.WriteString("\nadr   "); io.WriteHex(TrapInfo.adr,8);
  242.     io.WriteString("\nir    "); io.WriteHex(TrapInfo.ir ,4);
  243.   END;
  244.   IF NamePtr # NIL THEN
  245.     io.WriteString("\nsegment "); io.WriteString(SegName);
  246.     io.WriteString("\nhunk    "); io.WriteInt(SegNum,4);
  247.     io.WriteString("\noffset  "); io.WriteHex(Offset,8);
  248.   END;
  249.   io.WriteString("\nsr "); io.WriteHex(TrapInfo.sr,4);
  250.   io.WriteString("\npc "); io.WriteHex(TrapInfo.pc,8);
  251.   io.WriteString("\n<RETURN>"); io.ReadString(string);
  252.   HALT(20);
  253.  
  254. (* $END *)
  255.  
  256. END TrapHandler;
  257.  
  258.  
  259. PROCEDURE TrapProc; (* $NilChk- *)
  260.  
  261. BEGIN
  262. (* $IFNOT SmallData *)
  263.   s.INLINE(0588FH);       (*    ADDQ.L  #4,A7         *)
  264. (* $END *)
  265.   s.INLINE(048E7H,0FEH);  (*    MOVEM.L A0-A6,-(A7)   *)
  266.   ol.SetA5;
  267.   s.SETREG(8,TrapHandler);
  268.   s.SETREG(9,s.ADR(TrapInfo.trap));
  269.   s.SETREG(11,s.ADR(D));
  270.   s.SETREG(12,s.ADR(A));
  271.   s.INLINE(
  272.     048D3H,000FFH,        (*    MOVEM.L D0-D7,(A3)    *)
  273.     04CDFH,0007FH,        (*    MOVEM.L (A7)+,D0-D6   *)
  274.     048D4H,0007FH,        (*    MOVEM.L D0-D6,(A4)    *)
  275.     0201FH,               (*    move.l  (A7)+,D0      *)
  276.     02280H,               (*    move.l  D0,(A1)       *)
  277.     0B07CH,00003H,        (*    cmp     #3,D0         *)
  278.     06208H,               (*    bhi.s   l             *)
  279.     0235FH,00004H,        (*    move.l  (a7)+, 4(a1)  *)
  280.     0235FH,00008H,        (*    move.l  (a7)+, 8(a1)  *)
  281.     03357H,0000CH,        (* l: move.w  (a7) ,12(a1)  *)
  282.     0236FH,00002H,0000EH, (*    move.l  2(a7),14(a1)  *)
  283.     02F48H,00002H,        (*    move.l  A0,    2(A7)  *)
  284.     04E73H);              (*    rte                   *)
  285.  
  286. END TrapProc;
  287.  
  288.  
  289. BEGIN
  290.   Sem := e.FindSemaphore ("SegTracker");
  291.   Me          := s.VAL(e.TaskPtr,ol.Me);
  292.   Me.trapCode := TrapProc;
  293. (* $IF NoGuruRq *)
  294. END NoGuruRq.
  295. (* $ELSE *)
  296. END NoGuru.
  297. (* $END *)
  298.