]> gitweb.factorcode.org Git - factor.git/commitdiff
Debugging threads
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 7 May 2008 03:20:27 +0000 (22:20 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 7 May 2008 03:20:27 +0000 (22:20 -0500)
1  2 
core/debugger/debugger.factor
core/listener/listener.factor
core/threads/threads.factor
extra/ui/tools/interactor/interactor.factor
extra/ui/tools/listener/listener.factor

index ee3352b71973e7367c5bca52f9b7ed1162c606c5,8360019646716a4708e93f490d204f1e05f6802b..df7d33f41c7d3f229ed54fbe12a3e97dd3b250d1
@@@ -64,13 -63,17 +64,14 @@@ M: string error. print 
      [ global [ "Error in print-error!" print drop ] bind ]
      recover ;
  
 -SYMBOL: error-hook
 -
 -[
++: print-error-and-restarts ( error -- )
+     print-error
+     restarts.
+     nl
 -    "Type :help for debugging help." print flush
 -] error-hook set-global
++    "Type :help for debugging help." print flush ;
  : try ( quot -- )
-     [
-         print-error
-         restarts.
-         nl
-         "Type :help for debugging help." print flush
-     ] recover ;
 -    [ error-hook get call ] recover ;
++    [ print-error-and-restarts ] recover ;
  
  ERROR: assert got expect ;
  
index cc4580c2cf9b59cecf73e2f7e210c73752e9a20d,ddb29bb7686ddfa10ae5731b37b763027304f0c7..e00e64f4bcfc7e0f0d656747760bb687071eb86e
@@@ -43,11 -46,9 +43,13 @@@ M: object stream-read-quo
      "( " in get " )" 3append
      H{ { background { 1 0.7 0.7 1 } } } format bl flush ;
  
 +SYMBOL: error-hook
 +
++[ print-error-and-restarts ] error-hook set-global
++
  : listen ( -- )
      listener-hook get call prompt.
 -    [ read-quot [ try ] [ bye ] if* ]
 +    [ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
      [
          dup parse-error? [
              error-hook get call
index cbca7ac0291dcb2041dbc8f5b90c776b7b13f33a,fc3915e4625eeee1d20d88a8be6b31b7923934f8..32d5e5234d2a281aa8ea367d3df98f1f2cd589b4
@@@ -91,9 -90,11 +91,11 @@@ PRIVATE
          [ sleep-queue heap-peek nip millis [-] ]
      } cond ;
  
+ DEFER: stop
  <PRIVATE
  
 -: schedule-sleep ( thread ms -- )
 +: schedule-sleep ( thread dt -- )
      >r check-registered dup r> sleep-queue heap-push*
      >>sleep-entry drop ;
  
index 4f5090fda27bafe89f717cffbec3a1b4b0de40a1,734f6cb4b852c25c9bfa308a4991851f013645c0..74fc437e054e8c473118c89c64edaf2f8559d081
@@@ -1,23 -1,29 +1,29 @@@
  ! Copyright (C) 2006, 2008 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: arrays assocs combinators continuations documents
-  hashtables io io.styles kernel math
- math.vectors models namespaces parser prettyprint quotations
- sequences strings threads listener
- classes.tuple ui.commands ui.gadgets ui.gadgets.editors
- ui.gadgets.presentations ui.gadgets.worlds ui.gestures
- definitions boxes calendar concurrency.flags ui.tools.workspace
- accessors math.order ;
 -hashtables io io.styles kernel math math.vectors models
 -namespaces parser prettyprint quotations sequences strings
 -threads listener classes.tuple ui.commands ui.gadgets
++hashtables io io.styles kernel math math.order math.vectors
++models namespaces parser prettyprint quotations sequences
++strings threads listener classes.tuple ui.commands ui.gadgets
+ ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
+ ui.gestures definitions calendar concurrency.flags
+ ui.tools.workspace accessors ;
  IN: ui.tools.interactor
  
- TUPLE: interactor history output flag thread help ;
+ ! If waiting is t, we're waiting for user input, and invoking
+ ! evaluate-input resumes the thread.
+ TUPLE: interactor output history flag thread waiting help ;
+ : register-self ( interactor -- )
+     self >>thread drop ;
  
  : interactor-continuation ( interactor -- continuation )
-     interactor-thread box-value
-     thread-continuation box-value ;
+     thread>> continuation>> value>> ;
  
  : interactor-busy? ( interactor -- ? )
-     interactor-thread box-full? not ;
+     #! We're busy if there's no thread to resume.
+     [ waiting>> ]
+     [ thread>> dup [ thread-registered? ] when ]
+     bi and not ;
  
  : interactor-use ( interactor -- seq )
      dup interactor-busy? [ drop f ] [
@@@ -69,9 -69,9 +69,9 @@@ M: interactor model-change
      [ H{ { font-style bold } } format ] with-nesting ;
  
  : interactor-input. ( string interactor -- )
-     interactor-output [
+     output>> [
          dup string? [ dup write-input nl ] [ short. ] if
 -    ] with-stream* ;
 +    ] with-output-stream* ;
  
  : add-interactor-history ( str interactor -- )
      over empty? [ 2drop ] [ interactor-history push-new ] if ;
index 484b0008613f931337d83ee5537e1dec4e8795bb,9057e1c4bdbe9b0d52cdf84d42b02637ced64588..b09732ed2c9f6c19c37514f4620e127ce6d58d93
@@@ -16,11 -16,11 +16,11 @@@ TUPLE: listener-gadget input output sta
      <scrolling-pane> g-> set-listener-gadget-output
      <scroller> "Output" <labelled-gadget> 1 track, ;
  
 -: <listener-stream> ( listener -- stream )
 -    [ input>> ] [ output>> <pane-stream> ] bi <duplex-stream> ;
 +: listener-streams ( listener -- input output )
 +    [ input>> ] [ output>> <pane-stream> ] bi ;
  
  : <listener-input> ( listener -- gadget )
-     listener-gadget-output <pane-stream> <interactor> ;
+     output>> <pane-stream> <interactor> ;
  
  : listener-input, ( -- )
      g <listener-input> g-> set-listener-gadget-input
@@@ -146,18 -143,18 +143,18 @@@ M: stack-display tool-scrolle
      swap show-tool inspect-object ;
  
  : listener-thread ( listener -- )
 -    dup <listener-stream> [
 -        [ [  ui-listener-hook ] curry  listener-hook set ]
 -        [ [     ui-error-hook ] curry     error-hook set ]
 +    dup listener-streams [
-         [
-             [ [ ui-listener-hook ] curry listener-hook set ]
-             [ [ ui-error-hook ] curry error-hook set ]
-             [ [ ui-inspector-hook ] curry inspector-hook set ] tri
-             welcome.
-             listener
-         ] with-input-stream*
-     ] with-output-stream* ;
++        [ [ ui-listener-hook ] curry listener-hook set ]
++        [ [ ui-error-hook ] curry error-hook set ]
+         [ [ ui-inspector-hook ] curry inspector-hook set ] tri
+         welcome.
+         listener
 -    ] with-stream* ;
++    ] with-streams* ;
  
  : start-listener-thread ( listener -- )
-     [ listener-thread ] curry "Listener" spawn drop ;
+     [
+         [ input>> register-self ] [ listener-thread ] bi
+     ] curry "Listener" spawn drop ;
  
  : restart-listener ( listener -- )
      #! Returns when listener is ready to receive input.