diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 2fb590a5a0..1cbcc78c56 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,8 +1,6 @@ - reader syntax for arrays, byte arrays, displaced aliens - sleep word -- docstrings appear twice - fix infer hang -- fix sort out of bounds + ui: @@ -82,7 +80,6 @@ - split: return vectors - specialized arrays -- clear special word props when redefining words - there is a problem with hashcodes of words and bootstrapping - delegating generic words with a non-standard picker - powerpc has weird callstack residue diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index a4a153ac6b..0eea452912 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -26,11 +26,7 @@ namespaces prettyprint sequences strings words ; ! FFI code does not run in the interpreter. -TUPLE: alien-error symbol library ; - -C: alien-error ( lib sym -- ) - [ set-alien-error-symbol ] keep - [ set-alien-error-library ] keep ; +TUPLE: alien-error library symbol ; M: alien-error error. ( error -- ) "C library interface words cannot be interpreted. " write diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index c5af463403..4ee4d27ee3 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -33,6 +33,7 @@ sequences io vectors words ; "/library/math/ratio.factor" "/library/math/float.factor" "/library/math/complex.factor" + "/library/math/random.factor" "/library/collections/growable.factor" "/library/collections/cons.factor" @@ -50,6 +51,7 @@ sequences io vectors words ; "/library/collections/sequence-sort.factor" "/library/collections/strings-epilogue.factor" "/library/collections/tree-each.factor" + "/library/collections/queues.factor" "/library/math/matrices.factor" @@ -66,8 +68,8 @@ sequences io vectors words ; "/library/io/string-streams.factor" "/library/io/c-streams.factor" "/library/io/files.factor" - - "/library/threads.factor" + "/library/io/directories.factor" + "/library/io/binary.factor" "/library/syntax/parse-numbers.factor" "/library/syntax/parse-words.factor" @@ -91,10 +93,29 @@ sequences io vectors words ; "/library/syntax/prettyprint.factor" + "/library/io/logging.factor" + "/library/tools/gensym.factor" "/library/tools/interpreter.factor" "/library/tools/debugger.factor" "/library/tools/memory.factor" + "/library/tools/listener.factor" + "/library/tools/word-tools.factor" + "/library/tools/walker.factor" + "/library/tools/jedit.factor" + + "/library/test/test.factor" + + "/library/tools/annotations.factor" + "/library/tools/inspector.factor" + + "/library/syntax/see.factor" + + "/library/threads.factor" + + "/library/tools/telnetd.factor" + + "/library/bootstrap/image.factor" "/library/inference/dataflow.factor" "/library/inference/inference.factor" @@ -128,8 +149,6 @@ sequences io vectors words ; "/library/cli.factor" - "/library/tools/memory.factor" - "/library/bootstrap/init.factor" } [ dup print parse-resource % ] each diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index e5bed970be..e04ec496b3 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -34,8 +34,6 @@ cpu "ppc" = [ "/library/compiler/ppc/alien.factor" ] pull-in -"Compiling base..." print - "statically-linked" get [ unix? [ "sdl" "libSDL.so" "cdecl" add-library @@ -59,6 +57,8 @@ cpu "ppc" = [ : compile? "compile" get supported-cpu? and ; compile? [ + "Compiling base..." print + \ car compile \ * compile \ = compile @@ -78,27 +78,6 @@ t [ "/library/math/pow.factor" "/library/math/trig-hyp.factor" "/library/math/arc-trig-hyp.factor" - "/library/math/random.factor" - - "/library/in-thread.factor" - - "/library/io/directories.factor" - "/library/io/binary.factor" - - "/library/eval-catch.factor" - "/library/tools/listener.factor" - "/library/tools/word-tools.factor" - "/library/syntax/see.factor" - "/library/test/test.factor" - "/library/tools/walker.factor" - "/library/tools/annotations.factor" - "/library/tools/inspector.factor" - "/library/bootstrap/image.factor" - - "/library/io/logging.factor" - - "/library/tools/telnetd.factor" - "/library/tools/jedit.factor" "/library/httpd/load.factor" "/library/sdl/load.factor" diff --git a/library/collections/cons.factor b/library/collections/cons.factor index 4192b09b9f..65b9806e95 100644 --- a/library/collections/cons.factor +++ b/library/collections/cons.factor @@ -35,21 +35,6 @@ PREDICATE: general-list list ( list -- ? ) : 2car ( cons cons -- car car ) swap car swap car ; inline : 2cdr ( cons cons -- car car ) swap cdr swap cdr ; inline -: ( -- queue ) - #! Make a new functional queue. - [[ [ ] [ ] ]] ; foldable - -: queue-empty? ( queue -- ? ) - uncons or not ; foldable - -: enque ( obj queue -- queue ) - uncons >r cons r> cons ; foldable - -: deque ( queue -- obj queue ) - uncons - [ uncons swapd cons ] [ reverse uncons f swons ] ifte* ; - foldable - M: cons = ( obj cons -- ? ) 2dup eq? [ 2drop t diff --git a/library/collections/queues.factor b/library/collections/queues.factor new file mode 100644 index 0000000000..7e3ed95a00 --- /dev/null +++ b/library/collections/queues.factor @@ -0,0 +1,24 @@ +IN: queues +USING: errors kernel lists math sequences vectors ; + +TUPLE: queue in out ; + +C: queue ( -- queue ) ; + +: queue-empty? ( queue -- ? ) + dup queue-in swap queue-out or not ; + +: enque ( obj queue -- ) + [ queue-in cons ] keep set-queue-in ; + +: deque ( queue -- obj ) + dup queue-out [ + uncons rot set-queue-out + ] [ + dup queue-in [ + reverse uncons pick set-queue-out + f rot set-queue-in + ] [ + "Empty queue" throw + ] ifte* + ] ifte* ; diff --git a/library/collections/sequence-sort.factor b/library/collections/sequence-sort.factor index ad8dd71cac..6555bdd31f 100644 --- a/library/collections/sequence-sort.factor +++ b/library/collections/sequence-sort.factor @@ -72,7 +72,7 @@ DEFER: (nsort) IN: sequences : nsort ( seq quot -- | quot: elt elt -- -1/0/1 ) - swap dup empty? + swap dup length 1 <= [ 2drop ] [ 0 over length 1 - (nsort) ] ifte ; inline : sort ( seq quot -- seq | quot: elt elt -- -1/0/1 ) diff --git a/library/eval-catch.factor b/library/eval-catch.factor deleted file mode 100644 index 68b8833f8c..0000000000 --- a/library/eval-catch.factor +++ /dev/null @@ -1,9 +0,0 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: parser USING: kernel errors io ; - -: eval-catch ( str -- ) - [ eval ] [ [ print-error debug-help drop ] when* ] catch ; - -: eval>string ( in -- out ) - [ eval-catch ] string-out ; diff --git a/library/generic/generic.factor b/library/generic/generic.factor index eb028bf5a7..8571568259 100644 --- a/library/generic/generic.factor +++ b/library/generic/generic.factor @@ -62,7 +62,7 @@ SYMBOL: builtin "methods" word-prop hash-keys [ class-compare ] sort ; : make-generic ( word -- ) - dup dup "combination" word-prop call (define-compound) ; + dup dup "combination" word-prop call define-compound ; : define-method ( class generic definition -- ) -rot diff --git a/library/in-thread.factor b/library/in-thread.factor deleted file mode 100644 index 140123b7e9..0000000000 --- a/library/in-thread.factor +++ /dev/null @@ -1,19 +0,0 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: threads -USING: errors kernel lists namespaces sequences ; - -: in-thread ( quot -- ) - #! Execute a quotation in a co-operative thread. The - #! quotation begins executing immediately, and execution - #! after the 'in-thread' call in the original thread - #! resumes when the quotation yields, either due to blocking - #! I/O or an explicit call to 'yield'. - [ - schedule-thread - ! Clear stacks since we never go up from this point - [ ] set-catchstack - { } set-callstack - try - stop - ] callcc0 drop ; diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor index 6aebdb785d..483dcdfe50 100644 --- a/library/io/c-streams.factor +++ b/library/io/c-streams.factor @@ -34,6 +34,8 @@ M: c-stream stream-close ( stream -- ) : init-io ( -- ) 13 getenv 14 getenv t stdio set ; +: io-multiplex ( ms -- ) drop ; + IN: io : ( path -- stream ) diff --git a/library/syntax/generic.factor b/library/syntax/generic.factor index c611ddb143..eaf9959eae 100644 --- a/library/syntax/generic.factor +++ b/library/syntax/generic.factor @@ -8,11 +8,11 @@ words ; : GENERIC: #! GENERIC: bar == G: bar simple-combination ; - CREATE define-generic ; parsing + CREATE dup reset-word define-generic ; parsing : G: #! G: word combination ; - CREATE [ define-generic* ] [ ] ; parsing + CREATE dup reset-word [ define-generic* ] [ ] ; parsing : COMPLEMENT: ( -- ) #! Followed by a class name, then a complemented class. diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index 8436bb5b66..2e9dff7438 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -62,7 +62,8 @@ words ; ! Word definitions : : #! Begin a word definition. Word name follows. - CREATE [ define-compound ] [ ] "in-definition" on ; parsing + CREATE dup reset-generic [ define-compound ] + [ ] "in-definition" on ; parsing : ; #! End a word definition. @@ -71,7 +72,7 @@ words ; ! Symbols : SYMBOL: #! A symbol is a word that pushes itself when executed. - CREATE define-symbol ; parsing + CREATE dup reset-generic define-symbol ; parsing : \ #! Word literals: \ foo @@ -90,7 +91,7 @@ words ; : DEFER: #! Create a word with no definition. Used for mutually #! recursive words. - CREATE drop ; parsing + CREATE dup reset-generic drop ; parsing : FORGET: #! Followed by a word name. The word is removed from its diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 878c9c3ce7..f568030ae9 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -321,7 +321,7 @@ M: wrapper pprint* ( wrapper -- ) : unparse-short ( object -- str ) [ pprint-short ] string-out ; -: unparse-short ( object -- ) +: unparse-short. ( object -- ) dup unparse-short swap write-object terpri ; : [.] ( sequence -- ) [ unparse-short. ] each ; diff --git a/library/test/inspector.factor b/library/test/inspector.factor index ad245af241..7c08ce93b0 100644 --- a/library/test/inspector.factor +++ b/library/test/inspector.factor @@ -1,7 +1,11 @@ IN: temporary -USING: test inspector prettyprint math ; +USING: inspector math namespaces prettyprint test ; + +[[ "hello" "world" ]] inspect + +[ "hello" ] [ 0 get ] unit-test +[ "world" ] [ 1 get ] unit-test -[[ 1 2 ]] inspect [ 1 2 3 ] inspect f inspect \ + inspect diff --git a/library/test/listener.factor b/library/test/listener.factor deleted file mode 100644 index 353728fbcf..0000000000 --- a/library/test/listener.factor +++ /dev/null @@ -1,11 +0,0 @@ -IN: temporary -USE: namespaces -USE: io -USE: test -USE: parser - -[ - [ 4 ] [ "2 2 +" eval-catch ] unit-test - "The following will print an error; ignore it." print terpri - [ ] [ "clear drop" eval-catch ] unit-test -] with-scope diff --git a/library/test/lists/queues.factor b/library/test/lists/queues.factor index c8a7251e6e..082381afbd 100644 --- a/library/test/lists/queues.factor +++ b/library/test/lists/queues.factor @@ -1,7 +1,12 @@ IN: temporary -USING: kernel lists math sequences test ; +USING: kernel math namespaces queues sequences test ; -[ { 1 2 3 4 5 } ] [ - [ 1 2 3 4 5 ] [ swap enque ] each - 5 [ drop deque swap ] map nip -] unit-test + "queue" set + +[ t ] [ "queue" get queue-empty? ] unit-test + +[ ] [ [ 1 2 3 4 5 ] [ "queue" get enque ] each ] unit-test + +[ { 1 2 3 4 5 } ] [ 5 [ drop "queue" get deque ] map ] unit-test + +[ "queue" get deque ] unit-test-fails diff --git a/library/test/parser.factor b/library/test/parser.factor index c7d6ce9d55..3305ee51ff 100644 --- a/library/test/parser.factor +++ b/library/test/parser.factor @@ -69,8 +69,4 @@ unit-test ! Test EOL comments in multiline strings. [ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test -[ 4 ] [ "2 2 +" eval-catch ] unit-test -[ "4\n" ] [ "2 2 + ." eval>string ] unit-test -[ ] [ "fdafdf" eval-catch ] unit-test - [ word ] [ \ f class ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index 80e8c3495e..711305e864 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -80,7 +80,7 @@ SYMBOL: failures "continuations" "errors" "hashtables" "strings" "namespaces" "generic" "tuple" "files" "parser" "parse-number" "init" "io/io" - "listener" "vectors" "words" "prettyprint" "random" + "vectors" "words" "prettyprint" "random" "stream" "math/bitops" "math/math-combinators" "math/rational" "math/float" "math/complex" "math/irrational" "math/integer" diff --git a/library/threads.factor b/library/threads.factor index e2e8402487..f0c96a196b 100644 --- a/library/threads.factor +++ b/library/threads.factor @@ -2,32 +2,48 @@ ! Copyright (C) 2005 Mackenzie Straight. ! See http://factor.sf.net/license.txt for BSD license. IN: threads -USING: errors kernel kernel-internals lists namespaces ; - -! Core of the multitasker. Used by io-internals.factor and -! in-thread.factor. +USING: errors hashtables io-internals kernel lists math +namespaces queues sequences vectors ; -: run-queue ( -- queue ) 9 getenv ; -: set-run-queue ( queue -- ) 9 setenv ; -: init-threads ( -- ) set-run-queue ; +! Co-operative multitasker. + +: run-queue ( -- queue ) \ run-queue global hash ; + +: schedule-thread ( quot -- ) run-queue enque ; + +: sleep-queue ( -- vec ) \ sleep-queue global hash ; + +: sleep-queue* ( -- vec ) + sleep-queue dup [ 2car swap - ] nsort ; + +: sleep-time ( sorted-queue -- ms ) + dup empty? [ drop -1 ] [ peek car millis - 0 max ] ifte ; + +DEFER: next-thread + +: do-sleep ( -- quot ) + sleep-queue* dup sleep-time dup 0 = + [ drop pop ] [ io-multiplex next-thread ] ifte ; : next-thread ( -- quot ) - run-queue dup queue-empty? [ - drop f - ] [ - deque set-run-queue - ] ifte ; + run-queue dup queue-empty? [ drop do-sleep ] [ deque ] ifte ; -: schedule-thread ( quot -- ) - run-queue enque set-run-queue ; +: stop ( -- ) next-thread call ; -: stop ( -- ) - #! Stop the current thread and begin executing the next one. - next-thread [ call ] [ "No more tasks" throw ] ifte* ; +: yield ( -- ) [ schedule-thread stop ] callcc0 ; -: yield ( -- ) - #! Add the current continuation to the run queue, and yield - #! to the next quotation. The current continuation will - #! eventually be restored by a future call to stop or - #! yield. - [ schedule-thread stop ] callcc0 ; +: sleep ( ms -- ) + millis + [ cons sleep-queue push stop ] callcc0 drop ; + +: in-thread ( quot -- ) + [ + schedule-thread + [ ] set-catchstack { } set-callstack + try stop + ] callcc0 drop ; + +: init-threads ( -- ) + global [ + \ run-queue set + 10 \ sleep-queue set + ] bind ; diff --git a/library/tools/annotations.factor b/library/tools/annotations.factor index 9484bee494..0f2c883426 100644 --- a/library/tools/annotations.factor +++ b/library/tools/annotations.factor @@ -10,7 +10,7 @@ USING: interpreter io kernel lists namespaces prettyprint sequences strings test ; : annotate ( word quot -- | quot: word def -- def ) - over >r >r dup word-def r> call r> swap (define-compound) ; + over >r >r dup word-def r> call r> swap define-compound ; inline : (watch) ( word def -- def ) diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor index 1a92619530..12ff72dcbf 100644 --- a/library/tools/inspector.factor +++ b/library/tools/inspector.factor @@ -28,8 +28,11 @@ M: hashtable sheet dup hash-keys swap hash-values 2vector ; [ max-length ] keep [ swap CHAR: \s pad-right ] map-with ; +: sheet-numbers ( sheet -- sheet ) + dup first length >vector 1vector swap append ; + : format-sheet ( sheet -- list ) - dup first length >vector swons + sheet-numbers dup peek over first [ set ] 2each [ format-column ] map flip diff --git a/library/tools/jedit.factor b/library/tools/jedit.factor index bceced0fe3..ead715d2d4 100644 --- a/library/tools/jedit.factor +++ b/library/tools/jedit.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: jedit -USING: io kernel lists namespaces parser prettyprint sequences -strings unparser vectors words ; +USING: errors io kernel lists namespaces parser prettyprint +sequences strings unparser vectors words ; ! Some words to send requests to a running jEdit instance to ! edit files and position the cursor on a specific line number. @@ -63,6 +63,9 @@ strings unparser vectors words ; : read-packet ( -- string ) 4 read be> read ; +: eval>string ( str -- ) + [ [ [ eval ] keep ] try drop ] string-out ; + : wire-server ( -- ) #! Repeatedly read jEdit requests and execute them. Return #! on EOF. diff --git a/library/unix/io.factor b/library/unix/io.factor index 8bbf1290d0..add19d9f9d 100644 --- a/library/unix/io.factor +++ b/library/unix/io.factor @@ -300,10 +300,6 @@ M: port stream-close ( stream -- ) : ( infd outfd flush? -- stream ) >r >r r> r> ; -: idle-io-task ( -- ) - [ schedule-thread 10 io-multiplex stop ] callcc0 - idle-io-task ; - USE: io : init-io ( -- ) @@ -315,5 +311,4 @@ USE: io write-tasks set FD_SETSIZE write-fdset set 0 1 t stdio set - ] bind - [ idle-io-task ] in-thread ; + ] bind ; diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 8c1e71d579..a09f26a65f 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -85,10 +85,10 @@ SYMBOL: vocabularies : init-search-path ( -- ) "scratchpad" "in" set [ - "compiler" "errors" "gadgets" "generic" - "hashtables" "help" "inference" "inspector" "interpreter" + "compiler" "errors" "gadgets" "generic" "hashtables" + "help" "inference" "inspector" "interpreter" "io" "jedit" "kernel" "listener" "lists" "math" "matrices" - "memory" "namespaces" "parser" "prettyprint" - "sequences" "io" "strings" "styles" "syntax" "test" - "threads" "vectors" "words" "scratchpad" + "memory" "namespaces" "parser" "prettyprint" "queues" + "scratchpad" "sequences" "strings" "styles" "syntax" + "test" "threads" "vectors" "words" ] "use" set ; diff --git a/library/words.factor b/library/words.factor index dcbb95c06d..119d44d950 100644 --- a/library/words.factor +++ b/library/words.factor @@ -111,18 +111,18 @@ M: symbol definer drop \ SYMBOL: ; PREDICATE: word compound ( obj -- ? ) word-primitive 1 = ; M: compound definer drop \ : ; -: (define-compound) ( word def -- ) +: define-compound ( word def -- ) >r dup dup remove-crossref r> 1 swap define add-crossref ; : reset-props ( word seq -- ) [ f swap set-word-prop ] each-with ; -: reset-generic ( word -- ) - #! Make a word no longer be generic. - { "methods" "combination" } reset-props ; +: reset-word ( word -- ) + { "parsing" "inline" "foldable" "flushable" "predicating" } + reset-props ; -: define-compound ( word def -- ) - over reset-generic (define-compound) ; +: reset-generic ( word -- ) + dup reset-word { "methods" "combination" } reset-props ; GENERIC: literalize ( obj -- obj ) diff --git a/native/run.h b/native/run.h index e09986e11c..e9cb3c04ab 100644 --- a/native/run.h +++ b/native/run.h @@ -8,7 +8,7 @@ #define CATCHSTACK_ENV 6 /* used by library only */ #define CPU_ENV 7 #define BOOT_ENV 8 -#define RUNQUEUE_ENV 9 /* used by library only */ +#define UNUSED_ENV 9 #define ARGS_ENV 10 #define OS_ENV 11 #define ERROR_ENV 12 /* a marker consed onto kernel errors */