# a new attempt at a usable debugger.. the previous one had several
# problems that prevented it from being useful. wanted features:

# 1. inspect a stack frame
# 2. breakpoints
# 3. continuing
# 4. single stepping

# a debugger only makes sense when a console is attached. this means
# we have a toplevel input/output mechanism.


# THIS SEEMS TO WORK but, there's some weird stuff going on with the
# previous version..  probably nothing more than accessing XT when
# code is already dropped..., but there were some weird list
# inconsistencies (first == 0, while elements = -9 after stack_clear)



# FIXME: need to check backtrace etc...


# debugger
# when started with 'debug', the backtrace is split into DS and RS
# DS is swapped in, and when 'continue' is executed,
# RS is swapped in too

# so, the deal is: when an error occurs, you run 'debug', fix the
# context and 'continue' after the word that has generated the error, 
# or you can restart the instruction in some cases using 'retry'

# there is no reason why the number of 'continues' and 'retries'
# should be limited. feel free to save/restore the backtrace and
# play around with it.

# if the 'original' error is handled by exception handlers behind your back, 
# there is no way to catch it until it is rethrown, which for debuggin purposes 
# is usually too late). still, if you know where it went wrong, you can
# just store the correct xt in console-error-xt, and hit retry.

# stub used for executing an xt through a 'leave'
create r-execute-stub ] r> pass execute [ 

: rs-add-stub 
 	dup >r push 
 	r-execute-stub
 	r> push ;
; "( xt rs.var -- )\tAdd an xt + stub to call it to a return stack variable." doc

() variable! debug-rs


: debug						# load debugger from backtrace
	backtrace-task
	dup .task @ 				# print it and copy
	unpack swap >r
	swapdata drop				# install data stack
	r> debug-rs ! ;				# save return stack

: continue 					# continue task past the point of failure
	debug-rs @ swapreturn drop ;

: retry
	backtrace-xt @ debug-rs 
	rs-add-stub continue ;;

: debug-load					# load xt in debugger
	() debug-rs >r r !			# clear debuggin rs
	['] quit r rs-add-stub			# make it fall into quit
	r>  rs-add-stub ;			# add trampoline



# OBSOLETE


# context swapping
# temp var: task swapping takes the ground from under our feet.
# (()()) variable! tmp-task			
# : task@ 
# 	tmp-task @> swaptask tmp-task !
# 	tmp-task @ swaptask drop
# 	tmp-task @>  ;			"( -- task )\tReturn a copy of the current task (continuation)." doc

# : task! swaptask drop ;			"( task -- )\tSet the current task (continuation)." doc



# : >r-swap
# 	postpone r> 
# 	postpone swap 
# 	postpone >r 
# 	postpone >r ; immediate

# : xt>r 	>r-swap r-execute-stub >r-swap ;
# "( xt -- )\tinstall handler on return stack" doc

# parse word, will be executed on leave
# : onleave 
# 	read find 
# 	postpone literal 
# 	postpone xt>r ; immediate


# context saving on RS
# : [local!] dup >r @ swap r ! r> ; # ( new var -- old var )
# :  local!  postpone [local!] postpone >r postpone >r ;
# : restore postpone r> postpone r> postpone ! ;