From: Slava Pestov <slava@shill.internal.stack-effects.com>
Date: Thu, 16 Apr 2009 00:17:43 +0000 (-0500)
Subject: Merge branch 'trace_tool' of git://factorcode.org/git/factor into trace_tool
X-Git-Tag: 0.94~2001^2~4^2~16
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=72487f7f333e230c4307b0cd39994dee23510793

Merge branch 'trace_tool' of git://factorcode.org/git/factor into trace_tool
---

72487f7f333e230c4307b0cd39994dee23510793
diff --cc basis/tools/walker/walker.factor
index e6cdc36fe1,a1f18df57a..72d7cd81cd
--- a/basis/tools/walker/walker.factor
+++ b/basis/tools/walker/walker.factor
@@@ -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