\ debuffer.fr - Debuffer initialization and softwords.

\ Build the disassembly table.
.( debuffer 1.3 - loading... ) cr
load table68k.fr

\ Load online documentation.
load help.fr

: .b ( n -- ) base @ >r hex 00 <#             # # #> r> base ! type space ;
: .w ( n -- ) base @ >r hex 00 <#         # # # # #> r> base ! type space ;
: .l ( n -- ) base @ >r hex 00 <# # # # # # # # # #> r> base ! type space ;

: ?b ( a -- ) @ .b ;   : ?byte ( a -- ) @byte .b ;
: ?w ( a -- ) @ .w ;   : ?word ( a -- ) @word .w ;
: ?l ( a -- ) @ .l ;   : ?long ( a -- ) @long .l ;

\ Convenience words for displaying registers.
: .d0 ( -- ) d0 ?l ;   : .a0 ( -- ) a0 ?l ;
: .d1 ( -- ) d1 ?l ;   : .a1 ( -- ) a1 ?l ;
: .d2 ( -- ) d2 ?l ;   : .a2 ( -- ) a2 ?l ;
: .d3 ( -- ) d3 ?l ;   : .a3 ( -- ) a3 ?l ;
: .d4 ( -- ) d4 ?l ;   : .a4 ( -- ) a4 ?l ;
: .d5 ( -- ) d5 ?l ;   : .a5 ( -- ) a5 ?l ;
: .d6 ( -- ) d6 ?l ;   : .a6 ( -- ) a6 ?l ;   : .fp ( -- ) fp ?l ;
: .d7 ( -- ) d7 ?l ;

: .usp ( -- ) usp ?l ;
: .ssp ( -- ) ssp ?l ;
: .pc  ( -- ) pc  ?l ;
: .sr  ( -- ) sr  ?w ;

: .regs ( -- )
	." d0:  " .d0   ." a0: " .a0 cr
	." d1:  " .d1   ." a1: " .a1 cr
	." d2:  " .d2   ." a2: " .a2 cr
	." d3:  " .d3   ." a3: " .a3 cr
	." d4:  " .d4   ." a4: " .a4 cr
	." d5:  " .d5   ." a5: " .a5 cr
	." d6:  " .d6   ." a6: " .a6 cr
	." d7:  " .d7                cr
	." usp: " .usp               cr
	." ssp: " .ssp               cr
	." pc:  " .pc                cr
	." sr:  " .sr                cr ;

\ Ascii dump
: .addr ( n -- ) base @ >r hex 00 <# 58 hold # # # # # # # # #> r> base ! cr type space ;
: .a ( n -- )
	dup  32 < if 46  else
	dup 128 < if dup else
	             46
	then then emit drop ;
: ?a @byte .a ;

: da ( addr count -- )
	over + over
	do
		i over - 64 mod 0= if i .addr then
		i ?a
	loop drop cr ;

\ Word dump
: dw ( addr count -- )
	2 * over + over
	do
		i over - 24 mod 0= if i .addr then
		i ?word
	2 +loop drop cr ;

\ Long dump
: dd ( addr count -- )
	4 * over + over
	do
		i over - 24 mod 0= if i .addr then
		i ?long
	4 +loop drop cr ;

\ Backtrace - dump the stack.
: bt ( -- )
	pc @ fp @
	begin
		swap ln dup 4 + @long swap dup @long dup rot > 0=
	until 2drop ;

\ Single step.
: step ( -- ) 0x8000 sr w@ or sr w! go ;

\ Step over, a next replacement (next doesn't work for bra, bcc and rts).
\ 0x61 = bsr, 0x4e4f = Systrap, 0x4E 10xx xxxx = JSR
: over ( -- )
		pc @ @byte 0x61 = pc @ @word 0x4e4f = or
		pc @ @word 0xFFC0 and 0x4E80 = or
	if next else step then ;

\ Step out of the current routine.
: out ( addr -- ) fp @ 4 + @long to ;

\ Define more user-friendly "go" and "wait" words.
: wait-msg ( -- ) ." Waiting for debug event... " cr ;
: go   ( -- ) wait-msg go   ;
: wait ( -- ) wait-msg wait ;

\ Go directly into wait mode.
\ .( Type "bye" to exit. Type "help" for online help. ) cr
wait