]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'trace_tool' of git://factorcode.org/git/factor into trace_tool
authorSlava Pestov <slava@shill.internal.stack-effects.com>
Thu, 16 Apr 2009 00:17:43 +0000 (19:17 -0500)
committerSlava Pestov <slava@shill.internal.stack-effects.com>
Thu, 16 Apr 2009 00:17:43 +0000 (19:17 -0500)
1  2 
basis/tools/walker/walker.factor

index e6cdc36fe1314b7f3fdd9c9b293f3d107ee6ecd8,a1f18df57af6c5de52de2dc8243b6f0420e0c92e..72d7cd81cd0d3f96794a48f23a465ff4e8d69152
@@@ -34,76 -35,14 +35,26 @@@ DEFER: start-walker-threa
  : walk ( quot -- quot' )
      \ break prefix [ break rethrow ] recover ;
  
- GENERIC: add-breakpoint ( quot -- quot' )
- M: callable add-breakpoint
-     dup [ break ] head? [ \ break prefix ] unless ;
- M: array add-breakpoint
-     [ add-breakpoint ] map ;
- M: object add-breakpoint ;
- : (step-into-quot) ( quot -- ) add-breakpoint call ;
- : (step-into-dip) ( quot -- ) add-breakpoint dip ;
- : (step-into-2dip) ( quot -- ) add-breakpoint 2dip ;
- : (step-into-3dip) ( quot -- ) add-breakpoint 3dip ;
- : (step-into-if) ( true false ? -- ) ? (step-into-quot) ;
- : (step-into-dispatch) ( array n -- ) nth (step-into-quot) ;
- : (step-into-execute) ( word -- )
-     {
-         { [ dup "step-into" word-prop ] [ "step-into" word-prop call ] }
-         { [ dup standard-generic? ] [ effective-method (step-into-execute) ] }
-         { [ dup hook-generic? ] [ effective-method (step-into-execute) ] }
-         { [ dup uses \ suspend swap member? ] [ execute break ] }
-         { [ dup primitive? ] [ execute break ] }
-         [ def>> (step-into-quot) ]
-     } cond ;
- \ (step-into-execute) t "step-into?" set-word-prop
- : (step-into-continuation) ( -- )
-     continuation callstack >>call break ;
- : (step-into-call-next-method) ( method -- )
-     next-method-quot (step-into-quot) ;
+ break-hook [
+     [
+         get-walker-thread
+         [ show-walker-hook get call ] keep
+         send-synchronous
+     ]
+ ] initialize
  
 +<< {
 +    (step-into-quot)
 +    (step-into-dip)
 +    (step-into-2dip)
 +    (step-into-3dip)
 +    (step-into-if)
 +    (step-into-dispatch)
 +    (step-into-execute)
 +    (step-into-continuation)
 +    (step-into-call-next-method)
 +} [ t "no-compile" set-word-prop ] each >>
 +
  ! Messages sent to walker thread
  SYMBOL: step
  SYMBOL: step-out