1 \ @(#) trace.fth 98/01/28 1.2
\r
2 \ TRACE ( <name> -- , trace pForth word )
\r
4 \ Single step debugger.
\r
5 \ TRACE ( i*x <name> -- , setup trace for Forth word )
\r
6 \ S ( -- , step over )
\r
7 \ SM ( many -- , step over many times )
\r
8 \ SD ( -- , step down )
\r
9 \ G ( -- , go to end of word )
\r
10 \ GD ( n -- , go down N levels from current level, stop at end of this level )
\r
12 \ This debugger works by emulating the inner interpreter of pForth.
\r
13 \ It executes code and maintains a separate return stack for the
\r
14 \ program under test. Thus all primitives that operate on the return
\r
15 \ stack, such as DO and R> must be trapped. Local variables must
\r
16 \ also be handled specially. Several state variables are also
\r
17 \ saved and restored to establish the context for the program being
\r
20 \ Copyright 1997 Phil Burk
\r
23 \ 19990930 John Providenza - Fixed stack bugs in GD
\r
27 : SPACE.TO.COLUMN ( col -- )
\r
31 : IS.PRIMITIVE? ( xt -- flag , true if kernel primitive )
\r
35 0 value TRACE_IP \ instruction pointer
\r
36 0 value TRACE_LEVEL \ level of descent for inner interpreter
\r
37 0 value TRACE_LEVEL_MAX \ maximum level of descent
\r
41 \ use fake return stack
\r
42 128 cells constant TRACE_RETURN_SIZE \ size of return stack in bytes
\r
43 create TRACE-RETURN-STACK TRACE_RETURN_SIZE 16 + allot
\r
45 : TRACE.>R ( n -- ) trace-rsp @ cell- dup trace-rsp ! ! ; \ *(--rsp) = n
\r
46 : TRACE.R> ( -- n ) trace-rsp @ dup @ swap cell+ trace-rsp ! ; \ n = *rsp++
\r
47 : TRACE.R@ ( -- n ) trace-rsp @ @ ; ; \ n = *rsp
\r
48 : TRACE.RPICK ( index -- n ) cells trace-rsp @ + @ ; ; \ n = rsp[index]
\r
49 : TRACE.0RP ( -- n ) trace-return-stack trace_return_size + 8 + trace-rsp ! ;
\r
50 : TRACE.RDROP ( -- ) cell trace-rsp +! ;
\r
51 : TRACE.RCHECK ( -- , abort if return stack out of range )
\r
52 trace-rsp @ trace-return-stack u<
\r
53 abort" TRACE return stack OVERFLOW!"
\r
54 trace-rsp @ trace-return-stack trace_return_size + 12 + u>
\r
55 abort" TRACE return stack UNDERFLOW!"
\r
58 \ save and restore several state variables
\r
59 10 cells constant TRACE_STATE_SIZE
\r
60 create TRACE-STATE-1 TRACE_STATE_SIZE allot
\r
61 create TRACE-STATE-2 TRACE_STATE_SIZE allot
\r
63 variable TRACE-STATE-PTR
\r
64 : TRACE.SAVE++ ( addr -- , save next thing )
\r
65 @ trace-state-ptr @ !
\r
66 cell trace-state-ptr +!
\r
69 : TRACE.SAVE.STATE ( -- )
\r
75 : TRACE.SAVE.STATE1 ( -- , save normal state )
\r
76 trace-state-1 trace-state-ptr !
\r
79 : TRACE.SAVE.STATE2 ( -- , save state of word being debugged )
\r
80 trace-state-2 trace-state-ptr !
\r
85 : TRACE.RESTORE++ ( addr -- , restore next thing )
\r
86 trace-state-ptr @ @ swap !
\r
87 cell trace-state-ptr +!
\r
90 : TRACE.RESTORE.STATE ( -- )
\r
91 state trace.restore++
\r
93 base trace.restore++
\r
96 : TRACE.RESTORE.STATE1 ( -- )
\r
97 trace-state-1 trace-state-ptr !
\r
100 : TRACE.RESTORE.STATE2 ( -- )
\r
101 trace-state-2 trace-state-ptr !
\r
102 trace.restore.state
\r
105 \ The implementation of these pForth primitives is specific to pForth.
\r
107 variable TRACE-LOCALS-PTR \ point to top of local frame
\r
109 \ create a return stack frame for NUM local variables
\r
110 : TRACE.(LOCAL.ENTRY) ( x0 x1 ... xn n -- ) { num | lp -- }
\r
111 trace-locals-ptr @ trace.>r
\r
112 trace-rsp @ trace-locals-ptr !
\r
113 trace-rsp @ num cells - trace-rsp ! \ make room for locals
\r
118 cell +-> lp \ move data into locals frame on return stack
\r
122 : TRACE.(LOCAL.EXIT) ( -- )
\r
123 trace-locals-ptr @ trace-rsp !
\r
124 trace.r> trace-locals-ptr !
\r
126 : TRACE.(LOCAL@) ( l# -- n , fetch from local frame )
\r
127 trace-locals-ptr @ swap cells - @
\r
129 : TRACE.(1_LOCAL@) ( -- n ) 1 trace.(local@) ;
\r
130 : TRACE.(2_LOCAL@) ( -- n ) 2 trace.(local@) ;
\r
131 : TRACE.(3_LOCAL@) ( -- n ) 3 trace.(local@) ;
\r
132 : TRACE.(4_LOCAL@) ( -- n ) 4 trace.(local@) ;
\r
133 : TRACE.(5_LOCAL@) ( -- n ) 5 trace.(local@) ;
\r
134 : TRACE.(6_LOCAL@) ( -- n ) 6 trace.(local@) ;
\r
135 : TRACE.(7_LOCAL@) ( -- n ) 7 trace.(local@) ;
\r
136 : TRACE.(8_LOCAL@) ( -- n ) 8 trace.(local@) ;
\r
138 : TRACE.(LOCAL!) ( n l# -- , store into local frame )
\r
139 trace-locals-ptr @ swap cells - !
\r
141 : TRACE.(1_LOCAL!) ( -- n ) 1 trace.(local!) ;
\r
142 : TRACE.(2_LOCAL!) ( -- n ) 2 trace.(local!) ;
\r
143 : TRACE.(3_LOCAL!) ( -- n ) 3 trace.(local!) ;
\r
144 : TRACE.(4_LOCAL!) ( -- n ) 4 trace.(local!) ;
\r
145 : TRACE.(5_LOCAL!) ( -- n ) 5 trace.(local!) ;
\r
146 : TRACE.(6_LOCAL!) ( -- n ) 6 trace.(local!) ;
\r
147 : TRACE.(7_LOCAL!) ( -- n ) 7 trace.(local!) ;
\r
148 : TRACE.(8_LOCAL!) ( -- n ) 8 trace.(local!) ;
\r
150 : TRACE.(LOCAL+!) ( n l# -- , store into local frame )
\r
151 trace-locals-ptr @ swap cells - +!
\r
153 : TRACE.(?DO) { limit start ip -- ip' }
\r
156 ip @ +-> ip \ BRANCH
\r
165 : TRACE.(LOOP) { ip | limit indx -- ip' }
\r
167 trace.r> 1+ -> indx
\r
179 : TRACE.(+LOOP) { delta ip | limit indx oldindx -- ip' }
\r
181 trace.r> -> oldindx
\r
182 oldindx delta + -> indx
\r
183 \ /* Do indices cross boundary between LIMIT-1 and LIMIT ? */
\r
184 \ if( ( (OldIndex - Limit) & ((Limit-1) - NewIndex) & 0x80000000 ) ||
\r
185 \ ( (NewIndex - Limit) & ((Limit-1) - OldIndex) & 0x80000000 ) )
\r
186 oldindx limit - limit 1- indx - AND $ 80000000 AND
\r
187 indx limit - limit 1- oldindx - AND $ 80000000 AND OR
\r
198 : TRACE.CHECK.IP { ip -- }
\r
199 ip ['] first_colon u<
\r
202 ." TRACE - IP out of range = " ip .hex cr
\r
207 : TRACE.SHOW.IP { ip -- , print name and offset }
\r
208 ip code> >name dup id.
\r
209 name> >code ip swap - ." +" .
\r
212 : TRACE.SHOW.STACK { | mdepth -- }
\r
214 ." <" base @ decimal 1 .r ." :"
\r
217 depth 5 min -> mdepth
\r
220 ." ... " \ if we don't show entire stack
\r
224 mdepth i 1+ - pick . \ show numbers in current base
\r
228 : TRACE.SHOW.NEXT { ip -- }
\r
231 \ show word name and offset
\r
237 40 space.to.column ." ||"
\r
238 trace_level 2* spaces
\r
241 \ show primitive about to be executed
\r
243 \ trap any primitives that are followed by inline data
\r
245 ['] (LITERAL) OF ip @ . ENDOF
\r
246 ['] (ALITERAL) OF ip a@ . ENDOF
\r
247 [ exists? (FLITERAL) [IF] ]
\r
248 ['] (FLITERAL) OF ip f@ f. ENDOF
\r
250 ['] BRANCH OF ip @ . ENDOF
\r
251 ['] 0BRANCH OF ip @ . ENDOF
\r
252 ['] (.") OF ip count type .' "' ENDOF
\r
253 ['] (C") OF ip count type .' "' ENDOF
\r
254 ['] (S") OF ip count type .' "' ENDOF
\r
256 65 space.to.column ." >> "
\r
259 : TRACE.DO.PRIMITIVE { ip xt | oldhere -- ip' , perform code at ip }
\r
262 0 OF -1 +-> trace_level trace.r> -> ip ENDOF \ EXIT
\r
263 ['] (CREATE) OF ip cell- body_offset + ENDOF
\r
264 ['] (LITERAL) OF ip @ cell +-> ip ENDOF
\r
265 ['] (ALITERAL) OF ip a@ cell +-> ip ENDOF
\r
266 [ exists? (FLITERAL) [IF] ]
\r
267 ['] (FLITERAL) OF ip f@ 1 floats +-> ip ENDOF
\r
269 ['] BRANCH OF ip @ +-> ip ENDOF
\r
270 ['] 0BRANCH OF 0= IF ip @ +-> ip ELSE cell +-> ip THEN ENDOF
\r
271 ['] >R OF trace.>r ENDOF
\r
272 ['] R> OF trace.r> ENDOF
\r
273 ['] R@ OF trace.r@ ENDOF
\r
274 ['] RDROP OF trace.rdrop ENDOF
\r
275 ['] 2>R OF trace.>r trace.>r ENDOF
\r
276 ['] 2R> OF trace.r> trace.r> ENDOF
\r
277 ['] 2R@ OF trace.r@ 1 trace.rpick ENDOF
\r
278 ['] i OF 1 trace.rpick ENDOF
\r
279 ['] j OF 3 trace.rpick ENDOF
\r
280 ['] (LEAVE) OF trace.rdrop trace.rdrop ip @ +-> ip ENDOF
\r
281 ['] (LOOP) OF ip trace.(loop) -> ip ENDOF
\r
282 ['] (+LOOP) OF ip trace.(+loop) -> ip ENDOF
\r
283 ['] (DO) OF trace.>r trace.>r ENDOF
\r
284 ['] (?DO) OF ip trace.(?do) -> ip ENDOF
\r
285 ['] (.") OF ip count type ip count + aligned -> ip ENDOF
\r
286 ['] (C") OF ip ip count + aligned -> ip ENDOF
\r
287 ['] (S") OF ip count ip count + aligned -> ip ENDOF
\r
288 ['] (LOCAL.ENTRY) OF trace.(local.entry) ENDOF
\r
289 ['] (LOCAL.EXIT) OF trace.(local.exit) ENDOF
\r
290 ['] (LOCAL@) OF trace.(local@) ENDOF
\r
291 ['] (1_LOCAL@) OF trace.(1_local@) ENDOF
\r
292 ['] (2_LOCAL@) OF trace.(2_local@) ENDOF
\r
293 ['] (3_LOCAL@) OF trace.(3_local@) ENDOF
\r
294 ['] (4_LOCAL@) OF trace.(4_local@) ENDOF
\r
295 ['] (5_LOCAL@) OF trace.(5_local@) ENDOF
\r
296 ['] (6_LOCAL@) OF trace.(6_local@) ENDOF
\r
297 ['] (7_LOCAL@) OF trace.(7_local@) ENDOF
\r
298 ['] (8_LOCAL@) OF trace.(8_local@) ENDOF
\r
299 ['] (LOCAL!) OF trace.(local!) ENDOF
\r
300 ['] (1_LOCAL!) OF trace.(1_local!) ENDOF
\r
301 ['] (2_LOCAL!) OF trace.(2_local!) ENDOF
\r
302 ['] (3_LOCAL!) OF trace.(3_local!) ENDOF
\r
303 ['] (4_LOCAL!) OF trace.(4_local!) ENDOF
\r
304 ['] (5_LOCAL!) OF trace.(5_local!) ENDOF
\r
305 ['] (6_LOCAL!) OF trace.(6_local!) ENDOF
\r
306 ['] (7_LOCAL!) OF trace.(7_local!) ENDOF
\r
307 ['] (8_LOCAL!) OF trace.(8_local!) ENDOF
\r
308 ['] (LOCAL+!) OF trace.(local+!) ENDOF
\r
314 : TRACE.DO.NEXT { ip | xt oldhere -- ip' , perform code at ip }
\r
316 \ set context for word under test
\r
319 trace.restore.state2
\r
321 \ get execution token
\r
327 ip xt trace.do.primitive -> ip
\r
329 trace_level trace_level_max <
\r
331 ip trace.>r \ threaded execution
\r
333 xt codebase + -> ip
\r
335 \ treat it as a primitive
\r
336 ip xt trace.do.primitive -> ip
\r
339 \ restore original context
\r
342 trace.restore.state1
\r
347 : TRACE.NEXT { ip | xt -- ip' }
\r
350 ip trace.do.next -> ip
\r
364 : TRACE ( i*x <name> -- i*x , setup trace environment )
\r
365 ' dup is.primitive?
\r
367 drop ." Sorry. You can't trace a primitive." cr
\r
370 trace_level -> trace_level_max
\r
373 trace_ip trace.show.next
\r
379 : s ( -- , step over )
\r
380 trace_level -> trace_level_max
\r
381 trace_ip trace.next -> trace_ip
\r
384 : sd ( -- , step down )
\r
385 trace_level 1+ -> trace_level_max
\r
386 trace_ip trace.next -> trace_ip
\r
389 : sm ( many -- , step many times )
\r
390 trace_level -> trace_level_max
\r
393 trace_ip trace.next -> trace_ip
\r
397 defer trace.user ( IP -- stop? )
\r
400 : gd { more_levels | stop_level -- }
\r
401 here what's trace.user u< \ has it been forgotten?
\r
403 ." Resetting TRACE.USER !!!" cr
\r
404 ['] 0= is trace.user
\r
409 or \ 19990930 - OR was missing
\r
411 ." GD level out of range (0-10), = " more_levels . cr
\r
413 trace_level more_levels + -> trace_level_max
\r
414 trace_level 1- -> stop_level
\r
416 trace_ip trace.user \ call deferred user word
\r
417 ?dup \ leave flag for UNTIL \ 19990930 - was DUP
\r
419 ." TRACE.USER returned " dup . ." so stopping execution." cr
\r
421 trace_ip trace.next -> trace_ip
\r
422 trace_level stop_level > not
\r
428 : g ( -- , execute until end of word )
\r
432 : TRACE.HELP ( -- )
\r
433 ." TRACE ( i*x <name> -- , setup trace for Forth word )" cr
\r
434 ." S ( -- , step over )" cr
\r
435 ." SM ( many -- , step over many times )" cr
\r
436 ." SD ( -- , step down )" cr
\r
437 ." G ( -- , go to end of word )" cr
\r
438 ." GD ( n -- , go down N levels from current level," cr
\r
439 ." stop at end of this level )" cr
\r
447 : FOO dup IF 1 + . THEN 77 var1 @ + . ;
\r
448 : ZOO 29 foo 99 22 + . ;
\r
449 : ROO 92 >r 1 r@ + . r> . ;
\r
450 : MOO c" hello" count type
\r
451 ." This is a message." cr
\r
452 s" another message" type cr
\r
454 : KOO 7 FOO ." DONE" ;
\r
455 : TR.DO 4 0 DO i . LOOP ;
\r
456 : TR.?DO 0 ?DO i . LOOP ;
\r
457 : TR.LOC1 { aa bb } aa bb + . ;
\r
458 : TR.LOC2 789 >r 4 5 tr.loc1 r> . ;
\r