Copyright (c) 1996-2004, 2011
MicroProcessor Engineering
133 Hill Lane
Southampton SO15 5AF
England
tel: +44 (0)23 8063 1441
fax: +44 (0)23 8033 9691
net: mpe@mpeforth.com
tech-support@mpeforth.com
web: www.mpeforth.com
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 dup opvec ! 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 where the fault occurred and a string,
output 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) " [ tasking? ] [if] ." in task " self .task \ indicate current task [then] >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
.
: foo \ --
[assert base @ #10 = assert]
;
: rpick \ n -- x
Get a copy of the Nth return stack item.
This works on most systems with a grow-down return stack in
main memory.
: rdepth \ -- n
Return the number of items on the return stack.
This works for most systems with a grow-down stack in
main memory.
: ShowColdChain \ --
Display the cold chain