Debugging tools


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.

Implementation dependencies

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 !
;

Miscellaneous

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]
;

Stack checking

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

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]
;

Return stack trace

: 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.

Cold Chain

: ShowColdChain \ --
Display the cold chain