\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: debug.fth
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ - Do no alter or remove copyright notices
\ - Redistribution and use of this software in source and binary forms, with
\ or without modification, are permitted provided that the following
\ - Redistribution of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\ - Redistribution in binary form must reproduce the above copyright notice,
\ this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\ Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\ This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ ========== Copyright Header End ============================================
\ debug.fth 1.15 95/04/19
\ Copyright 1985-1990 Bradley Forthware
\ Debugger. Thanks, Mike Perry, Henry Laxen, Mark Smeder.
\ The debugger lets you single step the execution of a high level
\ definition. To invoke the debugger, type debug xxx where xxx is
\ the name of the word you wish to trace. When xxx executes, you will
\ get a single step trace showing you the word within xxx that
\ is about to execute, and the contents of the parameter stack.
\ Debugging makes everything run slightly slower, even outside
\ the word being debugged. see debug-off
\ debug name Mark that word for debugging
\ stepping Debug in single step mode
\ tracing Debug in trace mode
\ debug-off Turn off the debugger (makes the system run fast again)
\ resume Exit from a pushed interpreter (see the f keystroke)
\ Keystroke commands while you're single-stepping:
\ c continue; trace without single stepping
\ g go; turn off stepping and continue execution
\ f push a Forth interpreter; execute "resume" to get back
\ q abort back to the top level
only forth also definitions
variable slow-next? slow-next? off
only forth hidden also forth also definitions
: (debug) (s low-adr hi-adr -- ) recursive
\ Refuse to debug the kernel; it's too dangerous
over low-dictionary-adr ['] (debug) between
abort" The source debugger cannot debug the Forth kernel."
unbug 1 cnt ! ip> ! <ip ! pnext
here low-dictionary-adr slow-next
: 'unnest (s pfa -- pfa' )
begin dup ta1+ swap token@ ['] unnest = until
\ Enter and leave the debugger
dup colon-cf? 0= abort" Not a colon definition"
>body dup 'unnest (debug) true is first-time?
\ Go up the return stack until we find the return address left by our caller
na1+ dup @ dup in-dictionary? if ( rs-adr ip )
ip>token token@ <ip @ body> =
cr ." [ Up to " dup .name ." ]" cr ( ip cfa )
over token@ .name ( ip cfa )
>body swap 'unnest (debug)
defer to-debug-window ' noop is to-debug-window
defer restore-window ' noop is restore-window
: .debug-short-help ( -- )
." Stepper keys: <space> Down Up Continue Forth Go Help ? See $tring Quit" cr
: .debug-long-help ( -- )
." <space> Execute displayed word" cr
." D Down: Step down into displayed word" cr
." U Up: Finish current definition and step in its caller" cr
." C Continue: trace current definition without stopping" cr
." F Forth: enter a subordinate Forth interpreter" cr
." G Go: resume normal exection (stop debugging)" cr
." H Help: display this message" cr
." ? Display short list of debug commands" cr
." S See: Decompile definition being debugged" cr
." $ Display top of stack as adr,len text string" cr
." Q Quit: abandon execution of the debugged word" cr
d# 24 constant cmd-column
: to-cmd-column ( -- ) cmd-column to-column ;
??cr ." : " <ip @ body> .name
step? @ if to-debug-window then
cmd-column 2+ to-column ." ( " .s ." )" cr \ Show stack
ip@ .token drop \ Show word name
key dup bl < if drop bl then dup emit upc
['] (debug catch if drop false else cr true then
ascii U of up1 true endof \ Up
ascii C of step? @ 0= step? ! true endof \ Continue
cr ." Type 'resume' to return to debugger" cr
ascii G of <ip off ip> off cr true endof \ Go
ascii H of cr .debug-long-help false endof \ Help
ascii S of cr <ip @ body> (see) false endof \ Help
ascii ? of cr .debug-short-help false endof \ Help
ascii $ of space 2dup type cr to-cmd-column false endof \ String
ascii Q of cr ." unbug" abort true endof \ Quit
ip@ token@ dup ['] unnest = swap ['] exit = or if
only forth bug also forth definitions
: resume (s -- ) true is exit-interact? pnext ;
: stepping (s -- ) step? on ;
: tracing (s -- ) step? off ;
unbug here low-dictionary-adr fast-next slow-next? off
only forth also definitions
projects / OpenSPARC-T2-SAM / blob