1 ! Copyright (C) 2004, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: threads kernel namespaces continuations combinators
4 sequences math namespaces.private continuations.private
5 concurrency.messaging quotations kernel.private words
6 sequences.private assocs models models.arrow arrays accessors
7 generic generic.standard definitions make sbufs
8 tools.continuations parser ;
11 SYMBOL: show-walker-hook ! ( status continuation thread -- )
13 ! Thread local in thread being walked
16 ! Thread local in walker thread
17 SYMBOL: walking-thread
19 SYMBOL: walker-continuation
20 SYMBOL: walker-history
22 DEFER: start-walker-thread
24 : get-walker-thread ( -- status continuation thread )
26 [ variables>> walker-status swap at ]
27 [ variables>> walker-continuation swap at ]
32 2dup start-walker-thread
35 : walk ( quot -- quot' )
36 \ break prefix [ break rethrow ] recover ;
38 << \ walk t "no-compile" set-word-prop >>
43 [ show-walker-hook get call ] keep
48 ! Messages sent to walker thread
62 : status ( -- symbol )
63 walker-status tget value>> ;
65 : set-status ( symbol -- )
66 walker-status tget set-model ;
69 +running+ set-status ;
71 : walker-stopped ( -- )
72 +stopped+ set-status ;
74 : step-into-all-loop ( -- )
76 [ status +running+ eq? ] [
83 { step-into-all [ f ] }
85 { f [ +stopped+ set-status f ] }
87 [ walker-continuation tget set-model ]
88 [ continuation-step-into ] bi
94 : continuation-step-back ( continuation -- continuation' )
97 [ [ nip pop ] unless-empty ] bi ;
99 : walker-suspended ( continuation -- continuation' )
100 +suspended+ set-status
101 [ status +suspended+ eq? ] [
102 dup walker-history tget push
103 dup walker-continuation tget set-model
106 ! These are sent by the walker tool. We reply
108 { step [ continuation-step keep-running ] }
109 { step-out [ continuation-step-out keep-running ] }
110 { step-into [ continuation-step-into keep-running ] }
111 { step-all [ keep-running ] }
112 { step-into-all [ step-into-all-loop ] }
113 { abandon [ drop f keep-running ] }
114 ! Pass quotation to debugged thread
115 { call-in [ keep-running ] }
116 ! Pass previous continuation to debugged thread
117 { step-back [ continuation-step-back ] }
124 [ status +stopped+ eq? ] [
127 ! ignore these commands while the thread is
133 { step-into-all [ step-into-all-loop f ] }
136 { f [ walker-stopped f ] }
137 ! thread hit a breakpoint and sent us the
138 ! continuation, so we modify it and send it
145 : associate-thread ( walker -- )
147 [ f walker-thread tget send-synchronous drop ]
148 self (>>exit-handler) ;
150 : start-walker-thread ( status continuation -- thread' )
153 walker-continuation tset
155 V{ } clone walker-history tset
158 "Walker on " self name>> append spawn
159 [ associate-thread ] keep ;
164 SYNTAX: B \ break parsed ;