telnetd fix

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 8191667d9a5f9ef46e135b288f1de400e760220b..6c3deaf68010e7fbcae3219217639997e6ee0c4a 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -4,7 +4,6 @@
 - type inference\r
 - some way to step over a word in the stepper\r
 - step: print NEXT word to execute, not word that JUST executed\r
-- step: start a nested listener\r
 \r
 + compiler/ffi:\r
 \r
@@ -37,10 +36,8 @@
 \r
 + kernel:\r
 \r
-- dissolve library/platform/native/\r
 - profiler is inaccurate: wrong word on cs\r
 - better i/o scheduler\r
-- >lower, >upper for strings\r
 - don't rehash strings on every startup\r
 - remove sbufs\r
 - cat, reverse-cat primitives\r
@@ -52,11 +49,9 @@
 \r
 + misc:\r
 \r
-- alist -vs- assoc terminology\r
 - jedit ==> jedit-word, jedit takes a file name\r
 - command line parsing cleanup\r
 - nicer way to combine two paths\r
-- catchstack lists\r
 - OOP\r
 - ditch object paths\r
 - browser responder for word links in HTTPd; inspect responder for\r

diff --git a/factor/jedit/ListenerAttributeSet.java b/factor/jedit/ListenerAttributeSet.java
index e003b4ec7e46c9d8d11c97e06554a01833afbe9c..6c8f4f07b14a88ae56ea8e0d77aae75548475bec 100644 (file)
--- a/factor/jedit/ListenerAttributeSet.java
+++ b/factor/jedit/ListenerAttributeSet.java
@@ -32,7 +32,7 @@ package factor.jedit;
 import console.*;
 import factor.Cons;
 import javax.swing.text.*;
-import javax.swing.Action;
+import javax.swing.*;
 import java.awt.Color;
 import org.gjt.sp.jedit.GUIUtilities;
 
@@ -69,8 +69,10 @@ public class ListenerAttributeSet extends SimpleAttributeSet
                else if("actions".equals(key))
                        addAttribute(ConsolePane.Actions,createActionsMenu((Cons)value));
                else if("icon".equals(key))
-                       addAttribute(StyleConstants.IconAttribute,
-                               GUIUtilities.loadIcon((String)value));
+               {
+                       StyleConstants.setIcon(this,GUIUtilities.loadIcon(
+                               "jeditresource:/Factor.jar!" + value));
+               }
        } //}}}
        
        //{{{ toColor() method

diff --git a/library/bootstrap/init-stage2.factor b/library/bootstrap/init-stage2.factor
index 61bc481de65273770cf337a23ccbfe085e877eba..986ceac01b2df3d9dc3166d4d22f27d070cc4ebd 100644 (file)
--- a/library/bootstrap/init-stage2.factor
+++ b/library/bootstrap/init-stage2.factor
@@ -79,7 +79,8 @@ USE: unparser
 
 [
     warm-boot
-    "interactive" get [ init-listener ] when
+    garbage-collection
+    "interactive" get [ print-banner listener ] when
     0 exit*
 ] set-boot
 
@@ -88,7 +89,6 @@ init-error-handler
 0 [ drop succ ] each-word unparse write " words" print 
 
 "Inferring stack effects..." print
-[ 2 car ] [ ] catch
 0 [ unit try-infer [ succ ] when ] each-word
 unparse write " words have a stack effect" print
 

diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor
index 5bbd9133504e404af1b2ac6198d76ef15333b566..a88b4a6f4135031554d041d6c31b575480954ec5 100644 (file)
--- a/library/bootstrap/init.factor
+++ b/library/bootstrap/init.factor
@@ -40,7 +40,6 @@ USE: vectors
 
 : boot ( -- )
     #! Initialize an interpreter with the basic services.
-    init-errors
     init-namespaces
     init-threads
     init-stdio

diff --git a/library/errors.factor b/library/errors.factor
index 42fd177d0d7eb68c38538d12d6649d31449dfc5e..36ab85ba6e5e3d29a43575ecd5e8ba6bddba22bc 100644 (file)
--- a/library/errors.factor
+++ b/library/errors.factor
@@ -38,16 +38,11 @@ USE: vectors
 
 ! This is a very lightweight exception handling system.
 
-: catchstack* ( -- cs ) 6 getenv ;
-: catchstack ( -- cs ) catchstack* vector-clone ;
-: set-catchstack* ( cs -- ) 6 setenv ;
-: set-catchstack ( cs -- ) vector-clone set-catchstack* ;
+: catchstack ( -- cs ) 6 getenv ;
+: set-catchstack ( cs -- ) 6 setenv ;
 
-: init-errors ( -- )
-    64 <vector> set-catchstack* ;
-
-: >c ( catch -- ) catchstack* vector-push ;
-: c> ( catch -- ) catchstack* vector-pop ;
+: >c ( catch -- ) catchstack cons set-catchstack ;
+: c> ( catch -- ) catchstack uncons set-catchstack ;
 
 : save-error ( error -- )
     #! Save the stacks and parser state for post-mortem

diff --git a/library/eval-catch.factor b/library/eval-catch.factor
index 5d7ceeda6c63611a04395b1aee1f97e201f2a0a7..216f3bc80264dc6cd341e2c743d9eef4b135efcd 100644 (file)
--- a/library/eval-catch.factor
+++ b/library/eval-catch.factor
@@ -32,7 +32,7 @@ USE: combinators
 USE: stdio
 
 : eval-catch ( str -- )
-    [ eval ] print-error ;
+    [ eval ] [ [ default-error-handler drop ] when* ] catch ;
 
 : eval>string ( in -- out )
     [ eval-catch ] with-string ;

diff --git a/library/in-thread.factor b/library/in-thread.factor
index 6c5cf8cf1c66fe8e0e8c00680f57b02af35ebe7d..71dfac12cc2749e1f6374f622b329980eb6b154d 100644 (file)
--- a/library/in-thread.factor
+++ b/library/in-thread.factor
@@ -43,7 +43,7 @@ USE: stack
     [
         schedule-thread
         ! Clear stacks since we never go up from this point
-        { } set-catchstack
+        [ ] set-catchstack
         { } set-callstack
         print-error
         (yield)

diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index 03fd40d2ef057adb505064636ba12b1f60197617..a2bb55154abf6dc8354d56bd209b409484e69b23 100644 (file)
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -116,10 +116,10 @@ DEFER: prettyprint*
     write-attr ;
 
 : prettyprint-[ ( indent -- indent )
-        \ [ prettyprint-word <prettyprint ;
+    \ [ prettyprint-word <prettyprint ;
 
 : prettyprint-] ( indent -- indent )
-        prettyprint> \ ] prettyprint-word ;
+    prettyprint> \ ] prettyprint-word ;
 
 : prettyprint-list ( indent list -- indent )
     #! Pretty-print a list, without [ and ].
@@ -156,10 +156,10 @@ DEFER: prettyprint*
     ] ifte ;
 
 : prettyprint-{{ ( indent -- indent )
-        \ {{ prettyprint-word <prettyprint ;
+    \ {{ prettyprint-word <prettyprint ;
 
 : prettyprint-}} ( indent -- indent )
-        prettyprint> \ }} prettyprint-word ;
+    prettyprint> \ }} prettyprint-word ;
 
 : prettyprint-{{}} ( indent hashtable -- indent )
     hash>alist dup length 0 = [
@@ -206,10 +206,10 @@ DEFER: prettyprint*
     #! Unparse each element on its own line.
     stack>list [ . ] each ;
 
-: .n namestack  [.] ;
 : .s datastack  {.} ;
 : .r callstack  {.} ;
-: .c catchstack {.} ;
+: .n namestack  [.] ;
+: .c catchstack [.] ;
 
 ! For integers only
 : .b >bin print ;

diff --git a/library/test/benchmark/ack.factor b/library/test/benchmark/ack.factor
index 59bd1eab4aa841c58b845625916b5c558bc3a4ba..49fe4a96340718cbaf598fa3cac53425b025f361 100644 (file)
--- a/library/test/benchmark/ack.factor
+++ b/library/test/benchmark/ack.factor
@@ -16,6 +16,6 @@ USE: test
         ] [
             dupd pred ack >r pred r> ack
         ] ifte
-    ] ifte ; compiled
+    ] ifte ;
 
 [ 4093 ] [ 3 9 ack ] unit-test

diff --git a/library/test/errors.factor b/library/test/errors.factor
index 7c3a6904a5de7bdbcc672329498c7873fa35fab1..0b16ffc7d40566d3c3f8b3c15cfb7c801ce535de 100644 (file)
--- a/library/test/errors.factor
+++ b/library/test/errors.factor
@@ -5,6 +5,8 @@ USE: namespaces
 USE: stack
 USE: test
 USE: lists
+USE: parser
+USE: stdio
 
 [ f ] [ [ ] [ ] catch ] unit-test
 
@@ -16,5 +18,10 @@ USE: lists
     "Hello" =
 ] unit-test
 
-[ ] [ [ ] print-error ] unit-test
-[ ] [ [ 2 car ] print-error ] unit-test
+"!!! The following error is part of the test" print
+
+[ ] [ [ 6 [ 12 [ "2 car" ] ] ] default-error-handler ] unit-test
+
+"!!! The following error is part of the test" print
+
+[ [ "2 car" ] parse ] [ default-error-handler ] catch

diff --git a/library/test/threads.factor b/library/test/threads.factor
index 0a298d9bcb7b904dd3daac55090170baaf6eca49..d537bbcc97c9d6a9f1b1832a6b8c13dc76d5d4d8 100644 (file)
--- a/library/test/threads.factor
+++ b/library/test/threads.factor
@@ -15,3 +15,4 @@ USE: errors
 [ 2 ] [ yield "x" get ] unit-test
 [ ] [ [ flush ] in-thread flush ] unit-test
 [ ] [ [ "Errors, errors" throw ] in-thread ] unit-test
+yield

diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index 06ed1bf62fcf32bced08379b521f5a188abf1a10..54efff5857af1a169dd2c71f1bd1b035be82ae17 100644 (file)
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -147,12 +147,16 @@ USE: math
 : :s ( -- ) "error-datastack"  get {.} ;
 : :r ( -- ) "error-callstack"  get {.} ;
 : :n ( -- ) "error-namestack"  get [.] ;
-: :c ( -- ) "error-catchstack" get {.} ;
+: :c ( -- ) "error-catchstack" get [.] ;
 
 : :get ( var -- value ) "error-namestack" get (get) ;
 
+: flush-error-handler ( error -- )
+    #! Last resort.
+    [ "Error in default error handler!" print drop ] when ;
+
 : default-error-handler ( error -- )
-    #! Print the error and return to the top level.
+    #! Print the error.
     [
         in-parser? [ parse-dump ] [ standard-dump ] ifte
 
@@ -160,7 +164,9 @@ USE: math
         "show stacks at time of error." print
         \ :get prettyprint-word
         " ( var -- value ) inspects the error namestack." print
-    ] when* ;
+    ] [
+        flush-error-handler
+    ] catch ;
 
 : print-error ( quot -- )
     #! Execute a quotation, and if it throws an error, print it

diff --git a/library/tools/inference.factor b/library/tools/inference.factor
index 01d1d69644f047a19b54874b1cf44d2106369846..c9d29d7ec891a9d754ad7ff985879aa851387e2c 100644 (file)
--- a/library/tools/inference.factor
+++ b/library/tools/inference.factor
@@ -145,14 +145,14 @@ DEFER: (infer)
 
 : apply-compound ( word -- )
     #! Infer a compound word's stack effect.
-    dup "inline" word-property [
+    dup "inline-infer" word-property [
         inline-compound
     ] [
         [
             infer-compound consume/produce
         ] [
             [
-                dup t "inline" set-word-property
+                dup t "inline-infer" set-word-property
                 inline-compound
             ] when
         ] catch

diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor
index 7f3566ad0bae4db5701cf92043c1edb715463b23..d91546378994fa122495a3209d7aec3fcb26c718 100644 (file)
--- a/library/tools/interpreter.factor
+++ b/library/tools/interpreter.factor
@@ -44,6 +44,7 @@ USE: stdio
 ! partial evaluation, also for trace and step.
 
 ! Meta-stacks
+USE: listener
 SYMBOL: meta-r
 : push-r meta-r get vector-push ;
 : pop-r meta-r get vector-pop ;
@@ -176,7 +177,7 @@ SYMBOL: meta-cf
 
 : &c
     #! Print stepper catch stack.
-    meta-c get {.} ;
+    meta-c get [.] ;
 
 : &get ( var -- value )
     #! Print stepper variable value.
@@ -197,10 +198,15 @@ SYMBOL: meta-cf
     " ( var -- value ) inspects the stepper namestack." print
     \ step prettyprint-word " -- single step" print
     \ (trace) prettyprint-word " -- trace until end" print
-    \ (run) prettyprint-word " -- run until end" print ;
+    \ (run) prettyprint-word " -- run until end" print
+    \ exit prettyprint-word " -- exit single-stepper" print ;
 
 : walk ( quot -- )
     #! Single-step through execution of a quotation.
-    init-interpreter
-    meta-cf set
-    walk-banner ;
+    [
+        "walk" listener-prompt set
+        init-interpreter
+        meta-cf set
+        walk-banner
+        listener
+    ] with-scope ;

diff --git a/library/tools/jedit-wire.factor b/library/tools/jedit-wire.factor
index 682791508e473bb41f6d5a58adf52f5daacdedc9..69da9fedc1d67ccefa8c4bc76c3368f6a9ba7f92 100644 (file)
--- a/library/tools/jedit-wire.factor
+++ b/library/tools/jedit-wire.factor
@@ -46,6 +46,7 @@ USE: words
 !
 ! jEdit sends a packet with code to eval, it receives the output
 ! captured with with-string.
+USE: listener
 : write-packet ( string -- )
     dup str-length write-big-endian-32 write flush ;
 
@@ -102,7 +103,8 @@ USE: words
 
 : stream-server ( -- )
     #! Execute this in the inferior Factor.
-    "stdio" get <jedit-stream> "stdio" set ;
+    "stdio" get <jedit-stream> "stdio" set
+    print-banner ;
 
 : jedit-lookup ( word vocabs -- )
     #! A utility word called by the Factor plugin to get some

diff --git a/library/tools/listener.factor b/library/tools/listener.factor
index 483fda356a968cb2d6da10a1521655d074d54c5f..3963827711d4f7abf0ce149598c65a1de62e6868 100644 (file)
--- a/library/tools/listener.factor
+++ b/library/tools/listener.factor
@@ -45,18 +45,13 @@ USE: vectors
 
 SYMBOL: cont-prompt
 SYMBOL: listener-prompt
+SYMBOL: quit-flag
 
 global [
     "..." cont-prompt set
     "ok" listener-prompt set
 ] bind
 
-: print-banner ( -- )
-    "Factor " write version print
-    "Copyright (C) 2003, 2004 Slava Pestov" print
-    "Copyright (C) 2004 Chris Double" print
-    "Type ``exit'' to exit, ``help'' for help." print ;
-
 : prompt. ( text -- )
     "prompt" style write-attr
     ! Print the space without a style, to workaround a bug in
@@ -65,7 +60,8 @@ global [
     " " write flush ;
 
 : exit ( -- )
-    "quit-flag" on ;
+    #! Exit the current listener.
+    quit-flag on ;
 
 : (read-multiline) ( quot depth -- quot ? )
     #! Flag indicates EOF.
@@ -85,16 +81,14 @@ global [
     #! EOF.
     f depth (read-multiline) >r reverse r> ;
 
-: listener-step ( -- )
+: listen ( -- )
+    #! Wait for user input, and execute.
     listener-prompt get prompt.
     [ read-multiline [ call ] [ exit ] ifte ] print-error ;
 
-: listener-loop ( -- )
-    "quit-flag" get [
-        "quit-flag" off
-    ] [
-        listener-step listener-loop
-    ] ifte ;
+: listener ( -- )
+    #! Run a listener loop that executes user input.
+    quit-flag get [ quit-flag off ] [ listen listener ] ifte ;
 
 : kb. 1024 /i unparse write " KB" write ;
 
@@ -109,13 +103,14 @@ global [
     "Data space: " write (room.)
     "Code space: " write (room.) ;
 
-: init-listener ( -- )
-    print-banner
+: print-banner ( -- )
+    "Factor " write version print
+    "Copyright (C) 2003, 2004 Slava Pestov" print
+    "Copyright (C) 2004 Chris Double" print
+    "Type ``exit'' to exit, ``help'' for help." print
     terpri
     room.
-    terpri
-
-    listener-loop ;
+    terpri ;
 
 : help ( -- )
     "SESSION:" print

diff --git a/library/tools/telnetd.factor b/library/tools/telnetd.factor
index a0c1603116074db74679ea2caa64b1030ee9b725..813961f6287b44a49f6fe8bb70fdfb59d1765a0b 100644 (file)
--- a/library/tools/telnetd.factor
+++ b/library/tools/telnetd.factor
@@ -42,29 +42,16 @@ USE: threads
     dup [
         "client" set
         log-client
-        listener-loop
+        listener
     ] with-stream ;
 
 : telnet-connection ( socket -- )
     [ telnet-client ] in-thread drop ;
 
-: quit-flag ( -- ? )
-    global [ "telnetd-quit-flag" get ] bind ;
-
-: clear-quit-flag ( --  )
-    global [ f "telnetd-quit-flag" set ] bind ;
-
 : telnetd-loop ( server -- server )
-    quit-flag [
-        dup >r accept telnet-connection r>
-        telnetd-loop
-    ] unless ;
+    [ [ accept telnet-connection ] keep ] forever ;
 
 : telnetd ( port -- )
     [
-        <server> [
-            telnetd-loop
-        ] [
-            clear-quit-flag swap fclose rethrow
-        ] catch
+        <server> [ telnetd-loop ] [ swap fclose rethrow ] catch
     ] with-logging ;