\ Decode GURU numbers ... Mike Haas, ... Nov. 27, 1987

include? clone         gu:CloneNames


ANEW Task-GURU.f


decimal


variable digit1        variable Invalid
variable general       variable SubSystem
variable specific


: color1   $ 9b emit  ." 31m" flushemit ;

: color3   $ 9b emit  ." 33m" flushemit ;


: Number?+  ( $string -- d1 true / false )
\
\ same as NUMBER? but 0-len string returns FALSE
\
  dup count upper
  dup c@ 1 max over c!   Number?
;


: ParseNumber   ( -- n1 true / false )
  invalid @ 0=
  IF
     bl word   ( -- adrcnt )  number?+
     IF
        ( -- d1 )
        IF
           \ number is too big...
           invalid on
        THEN
     ELSE
        \ string is not a number...
        invalid on
     THEN
  THEN
  invalid @ 0=
;

: .COMMAND  ( -- )
  >in @   >in off  bl word  $type  >in !
;

: .HELP
  cr  ." Usage:  "  .command ."  <GuruNumber>"   cr
  cr  ." 'GuruNumber' is the unsigned, 32-bit hex number"
  cr  ." that appears leftmost in the guru alert." cr
;


: .TYPE       color1  ."     Alert Type: "  color3   ;
: .SUBSYSTEM  color1  ."   Generated by: "  color3   ;
: .GENERAL    color1  ."  General Cause: "  color3   ;
: .SPECIFIC   color1  ." Specific Cause: "  color3   ;


: "LIB   ."  Library"  ;
: "DEV   ."  Device"   ;
: "RES   ."  Resource" ;
: "ERR   ."  error"    ;
: "MEM   ." , no memory" ;


: ID.SUBSYSTEM  ( system -- )
  CASE
    $ 01 OF  ." Exec"       "lib   ENDOF
    $ 02 OF  ." Graphics"   "lib   ENDOF
    $ 03 OF  ." Layers"     "lib   ENDOF
    $ 04 OF  ." Intuition"  "lib   ENDOF
    $ 05 OF  ." Math"       "lib   ENDOF
    $ 06 OF  ." Clist"      "lib   ENDOF
    $ 07 OF  ." DOS"        "lib   ENDOF
    $ 08 OF  ." RAM"        "lib   ENDOF
    $ 09 OF  ." Icon"       "lib   ENDOF
    $ 0a OF  ." Expansion"  "lib   ENDOF
    $ 10 OF  ." Audio"      "dev   ENDOF
    $ 11 OF  ." Console"    "dev   ENDOF
    $ 12 OF  ." GamePort"   "dev   ENDOF
    $ 13 OF  ." Keyboard"   "dev   ENDOF
    $ 14 OF  ." TrackDisk"  "dev   ENDOF
    $ 15 OF  ." Timer"      "dev   ENDOF
    $ 20 OF  ." CIA"        "res   ENDOF
    $ 21 OF  ." Disk"       "res   ENDOF
    $ 22 OF  ." Misc"       "res   ENDOF
    $ 30 OF  ." BootStrap"         ENDOF
    $ 31 OF  ." Workbench"         ENDOF
    $ 32 OF  ." DiskCopy"          ENDOF
  ENDCASE
;


: ID.GENERAL  ( gen -- )
  CASE
    $ 01 OF  ." Insufficient memory"   ENDOF
    $ 02 OF  ." MakeLibrary"  "err     ENDOF
    $ 03 OF  ." OpenLibrary"  "err     ENDOF
    $ 04 OF  ." OpenDevice"   "err     ENDOF
    $ 05 OF  ." OpenResource" "err     ENDOF
    $ 06 OF  ." I/O"          "err     ENDOF
    $ 07 OF  ." NoSignal"              ENDOF
  ENDCASE
;


: ID.Exec    ( -- )
  Specific @
  CASE
    $ 01 OF  ." 68000 exception vector checksum"      ENDOF
    $ 02 OF  ." ExecBase checksum"                    ENDOF
    $ 03 OF  ." Library checksum"                     ENDOF
    $ 04 OF  ." No memory to make library"            ENDOF
    $ 05 OF  ." Corrupted memory list"                ENDOF
    $ 06 OF  ." No memory for interrupt servers"      ENDOF
    $ 07 OF  ." InitStruct() of an APTR source"       ENDOF
    $ 08 OF  ." A semaphore is in an illegal state"   ENDOF
    $ 09 OF  ." Freeing memory that is already free"  ENDOF
    $ 0a OF  ." Illegal 68000 exception taken"        ENDOF
  ENDCASE
;


: ID.Graphics    ( -- )
  Specific @
  CASE
    $ 06 OF  ." Long frame" "mem                 ENDOF
    $ 07 OF  ." Short frame" "mem                ENDOF
    $ 09 OF  ." Text, no memory for TempRas"     ENDOF
    $ 0a OF  ." BltBitMap" "mem                  ENDOF
    $ 0b OF  ." Regions" "mem                    ENDOF
    $ 30 OF  ." MakeVPort" "mem                  ENDOF
  $ 1234 OF  ." Emergency memory not available"  ENDOF
  ENDCASE
;


: ID.Intuition    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Unknown gadget type"                  ENDOF
    $ 02 OF  ." CreatePort()" "mem                    ENDOF
    $ 03 OF  ." Item plane alloc" "mem                ENDOF
    $ 04 OF  ." Sub alloc" "mem                       ENDOF
    $ 05 OF  ." Plane alloc" "mem                     ENDOF
    $ 06 OF  ." Item box top < relative zero"         ENDOF
    $ 07 OF  ." Open screen" "mem                     ENDOF
    $ 08 OF  ." Open screen, raster alloc" "mem       ENDOF
    $ 09 OF  ." Open sys screen, unknown type"        ENDOF
    $ 0a OF  ." Add SW gadgets" "mem                  ENDOF
    $ 0b OF  ." Open window" "mem                     ENDOF
    $ 0c OF  ." Bad state return entering Intuition"  ENDOF
    $ 0d OF  ." Bad message received by IDCMP"        ENDOF
    $ 0e OF  ." Wierd echo causing incomprehension"   ENDOF
    $ 0f OF  ." Couldn't open the Console Device"     ENDOF
  ENDCASE
;


: ID.DOS    ( -- )
  Specific @
  CASE
    $ 01 OF  ." No memory at startup"        ENDOF
    $ 02 OF  ." EndTask() didn't"            ENDOF
    $ 03 OF  ." Qpkt failure"                ENDOF
    $ 04 OF  ." Unexpected packet received"  ENDOF
    $ 05 OF  ." Freevec failed"              ENDOF
    $ 06 OF  ." Disk block sequence error"   ENDOF
    $ 07 OF  ." Bitmap corrupt"              ENDOF
    $ 08 OF  ." Key already free"            ENDOF
    $ 09 OF  ." Invalid checksum"            ENDOF
    $ 0a OF  ." Disk error"                  ENDOF
    $ 0b OF  ." Key out of range"            ENDOF
    $ 0c OF  ." Bad overlay"                 ENDOF
  ENDCASE
;


: ID.RAM    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Overlays illegal for library segments"  ENDOF
  ENDCASE
;


: ID.Expansion    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Bad expansion free"  ENDOF
  ENDCASE
;


: ID.TrackDisk    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Calibration seek error"  ENDOF
    $ 02 OF  ." Delay error on timer wait"  ENDOF
  ENDCASE
;


: ID.Timer    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Bad request"  ENDOF
    $ 02 OF  ." Power supply not supplying ticks"  ENDOF
  ENDCASE
;


: ID.Disk    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Get unit: already has disk"  ENDOF
    $ 02 OF  ." Interrupt: no active unit"  ENDOF
  ENDCASE
;


: ID.BootStrap    ( -- )
  Specific @
  CASE
    $ 01 OF  ." Boot code returned an error"  ENDOF
  ENDCASE
;


: ID.SPECIFIC  ( -- )
  SubSystem @
  CASE
    $ 01 OF  ID.Exec          ENDOF
    $ 02 OF  ID.Graphics      ENDOF
    $ 04 OF  ID.Intuition     ENDOF
    $ 07 OF  ID.DOS           ENDOF
    $ 08 OF  ID.RAM           ENDOF
    $ 14 OF  ID.TrackDisk     ENDOF
    $ 15 OF  ID.Timer         ENDOF
    $ 21 OF  ID.Disk          ENDOF
    $ 30 OF  ID.BootStrap     ENDOF
  ENDCASE
;


: AnalyzeSystem  ( -- )
  digit1 @
\
  dup $ 8000,0000 and  .TYPE
  IF  ." DEADEND"  ELSE ." RECOVERABLE"  THEN  cr
\ 
  .SubSystem  SubSystem @  ID.Subsystem  cr
\
  ( -- digit1 )  dup $ ff,0000 and  16 -shift  ?dup
  IF
     .GENERAL  ID.General  cr
  THEN
\
  ( -- digit1 )  $ ffff and  ?dup
  IF
     .SPECIFIC  specific !  ID.Specific  cr
  THEN
\
;


: AnalyzeTrap  ( -- )
  .TYPE   ." 68000 Trap" cr
  .GENERAL  digit1 @
  CASE
    $ 02 OF  ." Bus error"  ENDOF
    $ 03 OF  ." Address error"  ENDOF
    $ 04 OF  ." Illegal instruction"  ENDOF
    $ 05 OF  ." Divide by zero"  ENDOF
    $ 06 OF  ." CHK instruction"  ENDOF
    $ 07 OF  ." TRAPV (Overflow)"  ENDOF
    $ 08 OF  ." Priviledge violation"  ENDOF
    $ 09 OF  ." Instruction trace"  ENDOF
    $ 0a OF  ." Line A emulation"  ENDOF
    $ 0b OF  ." Line F emulation"  ENDOF
             ." User trap"
  ENDCASE cr
;


: AnalyzeGuru  ( -- )
  color1
  digit1 @  $ 7f00,0000 and  24 -shift  dup SubSystem !
  IF
     AnalyzeSystem
  ELSE
     AnalyzeTrap
  THEN
;


: Guru   ( -- , <xxxx yyyy> OR <xxxx.yyyy> )
  >newline  .command ."  1.0 by Mike Haas, written in JForth" cr
  invalid off  hex ParseNumber
  IF
     digit1 !
  THEN
  \
  Invalid @
  IF
     here w@ $ 013f -
     IF
        cr ." Error in argument: "  here $type  cr
     THEN
     .help
  ELSE
     AnalyzeGuru
  THEN
  color1
;