|
The file Common\DebugTools.fth provides debugging tools for MPE embedded systems created by Forth 6 Cross Compilers. The emphasis is on 32 bit systems and interactive testing. The tools can easily be ported to other systems. Copyright is retained by MPE. The code may be freely used on non-MPE systems for non-commercial use. The copyright notice must be preserved.
Porting the code to other systems is up to you. This code may require some carnal knowledge of how your system works. Most Forths contain the required words, but they may not have the same names that MPE use.
In MPE embedded systems, the USER variables IPVEC and OPVEC contain the address of the device structure used for input and output by KEY, EMIT and friends. In VFX Forth for Windows/Linux, the variables are IP-HANDLE and OP-HANDLE.
: consoleIO \ --
Select debug console for output. By default this
is the CONSOLE device.
console opvec ! console ipvec ! Echoing on Xon/Xoff off ;
: name? \ addr -- flag MPE.0000
Check to see if the supplied address is a valid NFA,
returning true if the address appears to be a valid NFA.
This word is implementation dependent. For MPE cross compilers,
a valid NFA for MPE embedded systems satisfies the following:
count \ c-addr u -- dup $9F and $81 $9F within? 0= \ NFA first byte = 1SIxxxxx, count = xxxxx \ mask = 10011111 if 2drop 0 exit then $01F and bounds ?do i c@ #33 #126 within? 0= \ check all ascii chars if unloop FALSE exit then loop TRUE ;
: ip>nfa \ addr -- nfa
Attempt to move backwards from an address within a definition
to the relevant NFA.
2- \ NFA must be at least 'n' bytes backwards begin dup name? 0= while 1- repeat ;
: >name \ xt -- nfa
Move from a word's xt to its name field. If >NAME does not
exist IP>NFA will be used.
ip>nfa ;
: .name \ nfa --
Given a word's NFA display its name.
count $1F and type ;
: .DWORD \ dw --
Display the 32 bit long word 'dw' as an 8 digit hex number.
base @ hex swap 0 <# # # # # ascii : hold # # # # #> type base ! ;
MPE systems use TICKS ( -- ms) to return a running time count in milliseconds. Windows systems can use the GetTickCount API call.
: times \ n -- ; n TIMES <word>
Execute <word> n times, and display the execution time.
The ticker interrupt must be running.
ticks ' rot 0 \ -- ticks xt n 0 ?do dup execute loop drop ticks swap - . ." ms" ;
: .ColdChain \ --
Display all words added to the cold chain. Note that the first
word added is displayed first. In VFX Forth this word is called
ShowColdChain.
cr ColdChainFirst begin dup while dup cell + @ >name .name \ execute XT @ \ get next entry repeat drop ;
: .decimal \ n --
Display a value as a decimal number.
base @ >r decimal . r> base ! ;
: .hex \ n --
Display a value as a hexadecimal number.
base @ >r hex u. r> base ! ;
: [con \ -- ; R: -- consys
Saves BASE and the current i/o vectors on the return stack,
and then switches to the console and decimal.
r> base @ >r opvec @ >r ipvec @ >r ConsoleIO decimal >r ;
: con] \ -- ; R: consys --
Restores BASE and the current i/o vectors from the return stack.
r> r> ipvec ! r> opvec ! r> base ! >r ;
: CheckFailed \ ip caddr len --
Given the address at the fault occurred and a string, ouput
the string and some diagnostic information.
[con cr type ." failed at " dup .dword ." in " ip>nfa .name con] ;
Especially in multi-tasked systems, stack errors can be fatal. Detecting them as early as possible reduces debugging time. These words rely on Forth return stack cells containing return addresses. This is true on the vast majority of Forth systems except for some 8051 and real-mode 80x86 systems. If you find others, please let us know.
: ?StackDepth \ +n --
If the stack depth before +n is not n, issue a console
warning message and clear the stack. Note that this
word is implementation dependent.
dup 2+ depth = if drop exit endif \ no failure [con cr ." *** Stack fault: depth = " depth 1- 0 .r ." (d) " ." in task " self .task \ indicate current task >r s0 @ sp! r> 0 ?do 0 loop \ set required depth cr ." Stack updated." con] ;
: ?StackEmpty \ --
If the stack depth is non-zero, issue a console
warning message and clear the stack.
0 ?StackDepth ;
: TaskChecks \ --
Use in task to check for creeping stacks and so on. This
word can be extended to provide additional internal
consistency checks.
?StackEmpty ;
: SF{ \ n -- ; R: -- depth
n SF{ .... }SF will check for stack faults.
n describes the stack change between SF{ and }SF.
If the stack change is different, an error message is generated.
This word will work on most systems in which the return address
is held on the return stack.
r> swap depth 2- + >r >r ;
: }SF \ -- ; R: depth -- ; perform stack check
The end of an SF{ ... }SF structure. This word is
not strictly portable as it assumes that the Forth
return stack holds a valid return address. In the
vast majority of cases the assumption is true, but
beware of some 8051 implementations.
See SF{
r> r> depth 2- <> if dup s" Stack check" CheckFailed endif >r ;
Assertions are a useful way to check that the system is behaving correctly. When the phrase:
[ASSERT <test> ASSERT]
is compiled into a piece of code, the test is performed and generates an error report if the result is false. If you do not want the performance overhead of the test, set the value ASSERTS? to zero. To remove even the small overhead of of testing ASSERTS?, comment out the line.
-1 value assert? \ -- n
Returns non-zero if asserts will be tested.
: (assert) \ flag --
If flag is zero, report an ASSERT error.
if exit endif \ faster on some CPUs r@ s" ASSERT" CheckFailed ;
: [assert \ --
Compile the code to start an assert.
?comp \ must be compiling postpone assert? postpone if ; immediate
: assert] \ --
Compile the code to end an assert.
?comp \ must be compiling postpone (assert) postpone then ; immediate
Here is a simple assert that will fail if BASE is not DECIMAL.
|