home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Fred Fish Collection 1.5
/
ffcollection-1-5-1992-11.iso
/
ff_disks
/
200-299
/
ff239.lzh
/
JGoodies
/
Guru
/
guru.f
< prev
next >
Wrap
Text File
|
1989-08-21
|
8KB
|
324 lines
\ 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
;