diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 2c6547b632..8196aec6ad 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,14 +1,7 @@ -- input style after clicking link - fedit broken with listener - maple-like: press enter at old commands to evaluate there -- standalone listener input style - add a socket timeout - balance needs USE: -- command line arguments -- socket protocol -- telnetd and httpd should use multitasking -- error handling in thread: use a different top-level -- 'cascading' styles - html: order of attrs should not matter + docs: @@ -26,6 +19,8 @@ + listener/plugin: +- make inferior.factor nicer to use +- input style after clicking link - plugin should not exit jEdit on fatal errors - auto insert USE: - plugin not unloaded @@ -36,13 +31,16 @@ + native: +- read1 +- telnetd and httpd should use multitasking - read# and eof - sbuf-hashcode - vector-hashcode - clarify suspend -vs- yield - toplevel - irc: stack underflow? - ignore SIGPIPE -- don't allow multiple i/o requests on the same port +- don't allow multiple reads on the same port +- multiple tasks should be able to write to the same port - accept multi-line input in listener - gc call in the middle of some ops might affect callstack - better i/o scheduler @@ -63,6 +61,9 @@ + misc: +- 'cascading' styles +- jedit ==> jedit-word, jedit takes a file name +- some way to run httpd from command line - prettyprinting an empty vector - rethink strhead/strtail&co - namespace clone drops static var bindings diff --git a/factor/listener/FactorListener.java b/factor/listener/FactorListener.java index e8b9d99467..f0c4cf9645 100644 --- a/factor/listener/FactorListener.java +++ b/factor/listener/FactorListener.java @@ -48,7 +48,7 @@ public class FactorListener extends JTextPane = Cursor.getPredefinedCursor (Cursor.WAIT_CURSOR); - public static final Object Link = new Object(); + public static final Object Input = new Object(); public static final Object Actions = new Object(); private EventListenerList listenerList; @@ -56,8 +56,6 @@ public class FactorListener extends JTextPane private Cons readLineContinuation; private int cmdStart = -1; - private SimpleAttributeSet nullAttributes; - //{{{ FactorListener constructor public FactorListener() { @@ -67,8 +65,6 @@ public class FactorListener extends JTextPane listenerList = new EventListenerList(); - nullAttributes = new SimpleAttributeSet(); - /* Replace enter to evaluate the input */ getInputMap().put(KeyStroke.getKeyStroke(KeyEvent.VK_ENTER,0), new EnterAction()); @@ -102,13 +98,12 @@ public class FactorListener extends JTextPane throws BadLocationException { StyledDocument doc = (StyledDocument)getDocument(); + cmdStart = doc.getLength(); + Element elem = doc.getParagraphElement(cmdStart); + /* System.err.println(elem.getAttributes().getClass()); */ setCursor(DefaultCursor); this.readLineContinuation = continuation; - cmdStart = doc.getLength(); setCaretPosition(cmdStart); - setCharacterAttributes(nullAttributes,true); - /* doc.setCharacterAttributes(cmdStart,cmdStart,input,false); - setCharacterAttributes(input,false); */ } //}}} //{{{ getLine() method @@ -284,6 +279,7 @@ public class FactorListener extends JTextPane { public void actionPerformed(ActionEvent evt) { + setCaretPosition(getDocument().getLength()); replaceSelection("\n"); try @@ -319,7 +315,6 @@ public class FactorListener extends JTextPane try { getDocument().remove(caret - 1,1); - setCharacterAttributes(nullAttributes,true); } catch(BadLocationException e) { diff --git a/library/ansi.factor b/library/ansi.factor index 517a5b67f2..4032bb6d9e 100644 --- a/library/ansi.factor +++ b/library/ansi.factor @@ -32,6 +32,7 @@ USE: kernel USE: format USE: namespaces USE: stack +USE: stdio USE: streams USE: strings @@ -75,9 +76,6 @@ USE: strings : ansi-attr-string ( string style -- string ) <% ansi-attrs % reset % %> ; -: ansi-write-attr ( string style stream -- ) - [ ansi-attr-string ] dip fwrite ; - : ( stream -- stream ) #! Wraps the given stream in an ANSI stream. ANSI streams #! support the following character attributes: @@ -86,5 +84,5 @@ USE: strings #! ansi-bg - background color [ ( string style -- ) - [ "stream" get ansi-write-attr ] "fwrite-attr" set + [ ansi-attr-string write ] "fwrite-attr" set ] extend ; diff --git a/library/extend-stream.factor b/library/extend-stream.factor new file mode 100644 index 0000000000..972a2a68ff --- /dev/null +++ b/library/extend-stream.factor @@ -0,0 +1,59 @@ +! :folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +IN: streams +USE: errors +USE: kernel +USE: namespaces +USE: stack +USE: stdio +USE: strings + +: ( stream -- stream ) + #! Create a stream that wraps another stream. Override some + #! or all of the stream words. + [ + "stdio" set + ( -- string ) + [ read ] "freadln" set + ( -- string ) + [ read1 ] "fread1" set + ( count -- string ) + [ read# ] "fread#" set + ( string -- ) + [ write ] "fwrite" set + ( string style -- ) + [ write-attr ] "fwrite-attr" set + ( string -- ) + [ edit ] "fedit" set + ( -- ) + [ flush ] "fflush" set + ( -- ) + [ "stdio" get fclose ] "fclose" set + ( string -- ) + [ print ] "fprint" set + ] extend ; diff --git a/library/httpd/html.factor b/library/httpd/html.factor index 2de495380a..cedf7f7c05 100644 --- a/library/httpd/html.factor +++ b/library/httpd/html.factor @@ -99,8 +99,8 @@ USE: url-encoding [ "link" link-tag ] ] assoc-apply ; -: html-write-attr ( string style stream -- ) - rot chars>entities rot html-attr-string swap fwrite ; +: html-write-attr ( string style -- ) + swap chars>entities swap html-attr-string write ; : ( stream -- stream ) #! Wraps the given stream in an HTML stream. An HTML stream @@ -115,9 +115,9 @@ USE: url-encoding #! italic #! underline [ - [ chars>entities "stream" get fwrite ] "fwrite" set - [ chars>entities "stream" get fprint ] "fprint" set - [ "stream" get html-write-attr ] "fwrite-attr" set + [ chars>entities write ] "fwrite" set + [ chars>entities print ] "fprint" set + [ html-write-attr ] "fwrite-attr" set ] extend ; : with-html-stream ( quot -- ) diff --git a/library/image.factor b/library/image.factor index 84ef401303..5cffaec468 100644 --- a/library/image.factor +++ b/library/image.factor @@ -345,9 +345,9 @@ IN: cross-compiler : write-word ( word -- ) "big-endian" get [ - big-endian-32 + write-big-endian-32 ] [ - little-endian-32 + write-little-endian-32 ] ifte ; : write-image ( image file -- ) diff --git a/library/inferior.factor b/library/inferior.factor new file mode 100644 index 0000000000..e9710f0c58 --- /dev/null +++ b/library/inferior.factor @@ -0,0 +1,117 @@ +! :folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +IN: inferior +USE: combinators +USE: errors +USE: kernel +USE: lists +USE: namespaces +USE: parser +USE: prettyprint +USE: stack +USE: stdio +USE: streams +USE: strings +USE: styles + +! Packets have the following form: +! 1 byte -- type. CHAR: w: write, CHAR: r: read +! 4 bytes -- for write only -- length of write request +! remaining -- unparsed write request -- string then style + +! After a read line request, the server reads a response from +! the client: +! 4 bytes -- length. -1 means EOF +! remaining -- input + +! All multi-byte integers are big endian signed. + +: inferior-server-read ( -- str ) + CHAR: r write flush read-big-endian-32 read# ; + +: inferior-server-write-attr ( str style -- ) + CHAR: w write + [ swap . . ] with-string + dup str-length write-big-endian-32 + write ; + +: ( stream -- stream ) + [ + ( -- str ) + [ inferior-server-read ] "freadln" set + ( str -- ) + [ + default-style inferior-server-write-attr + ] "fwrite" set + ( str style -- ) + [ inferior-server-write-attr ] "fwrite-attr" set + ( string -- ) + [ + "\n" cat2 default-style inferior-server-write-attr + ] "fprint" set + ] extend ; + +: inferior-client-read ( stream -- ? ) + freadln dup [ + dup str-length write-big-endian-32 write flush t + ] [ + drop 0 write-big-endian-32 flush f + ] ifte ; + +: inferior-client-write ( stream -- ? ) + read-big-endian-32 read# dup [ + parse dup [ + uncons car rot fwrite-attr t + ] [ + 2drop f + ] ifte + ] when ; + +: inferior-client-packet ( stream -- ? ) + #! Read from an inferior client socket and print attributed + #! strings that were read to standard output. + read1 dup CHAR: r = [ + drop inferior-client-read + ] [ + dup CHAR: w = [ + drop inferior-client-write + ] [ + "Invalid packet type: " swap cat2 throw + ] ifte + ] ifte ; + +: inferior-client-loop ( stream -- ) + #! The stream is the stream to write to. + dup inferior-client-packet [ + inferior-client-loop + ] [ + drop + ] ifte ; + +: inferior-client ( from -- ) + "stdio" get swap [ inferior-client-loop ] with-stream ; diff --git a/library/inspector.factor b/library/inspector.factor index cf905696b6..d42d29669a 100644 --- a/library/inspector.factor +++ b/library/inspector.factor @@ -67,9 +67,6 @@ USE: vectors #! Unparse non-string keys. [ unswons ?unparse swons ] inject ; -: alist-sort ( list -- list ) - [ swap car swap car str-lexi> ] sort ; - : name-padding ( alist -- col ) [ car ] inject max-str-length ; @@ -78,8 +75,8 @@ USE: vectors [ dupd uncons value. ] each drop ; : describe-assoc ( alist -- ) - alist-keys>str alist-sort (describe-assoc) ; - + alist-keys>str (describe-assoc) ; + : describe-namespace ( namespace -- ) [ vars-values ] bind describe-assoc ; @@ -97,12 +94,12 @@ USE: vectors [ assoc? ] [ describe-assoc ] - [ hashtable? ] - [ describe-hashtable ] - [ has-namespace? ] [ describe-namespace ] + [ hashtable? ] + [ describe-hashtable ] + [ drop t ] [ prettyprint ] ] cond ; diff --git a/library/jedit/jedit-remote.factor b/library/jedit/jedit-remote.factor index 0edfa97970..4cc0022c3b 100644 --- a/library/jedit/jedit-remote.factor +++ b/library/jedit/jedit-remote.factor @@ -70,7 +70,9 @@ USE: unparser : send-jedit-request ( request -- ) jedit-server-info swap "localhost" swap [ - big-endian-32 dup str-length big-endian-16 write flush + write-big-endian-32 + dup str-length write-big-endian-16 + write flush ] with-stream ; : remote-jedit-line/file ( line dir file -- ) diff --git a/library/lists.factor b/library/lists.factor index f80d161803..07ca8d83d2 100644 --- a/library/lists.factor +++ b/library/lists.factor @@ -244,7 +244,7 @@ DEFER: tree-contains? cons ] ifte ; -: each ( [ list ] [ quotation ] -- ) +: each ( list quotation -- ) #! Push each element of a proper list in turn, and apply a #! quotation to each element. #! diff --git a/library/platform/jvm/boot-sumo.factor b/library/platform/jvm/boot-sumo.factor index da24cf63aa..38ab919c7b 100644 --- a/library/platform/jvm/boot-sumo.factor +++ b/library/platform/jvm/boot-sumo.factor @@ -85,6 +85,7 @@ USE: parser "/library/math/simpson.factor" run-resource ! math !!! Development tools. +"/library/extend-stream.factor" run-resource ! streams "/library/stdio-binary.factor" run-resource ! stdio "/library/vocabulary-style.factor" run-resource ! style "/library/prettyprint.factor" run-resource ! prettyprint @@ -99,6 +100,7 @@ USE: parser "/library/platform/jvm/test.factor" run-resource ! test "/library/ansi.factor" run-resource ! ansi "/library/telnetd.factor" run-resource ! telnetd +"/library/inferior.factor" run-resource ! inferior !!! Java -> native VM image cross-compiler. "/library/image.factor" run-resource ! cross-compiler diff --git a/library/platform/jvm/listener.factor b/library/platform/jvm/listener.factor index a17f60546d..9c6ccb67e5 100644 --- a/library/platform/jvm/listener.factor +++ b/library/platform/jvm/listener.factor @@ -102,14 +102,23 @@ USE: unparser [ "size" dupd "FontSize" swing-attribute+ ] ] assoc-apply ; -: reset-attrs ( -- ) - default-style style>attribute-set t - "listener" get +: set-character-attrs ( attrs -- ) + t "listener" get [ "javax.swing.text.AttributeSet" "boolean" ] "javax.swing.JTextPane" "setCharacterAttributes" jinvoke ; +: set-paragraph-attrs ( attrs -- ) + t "listener" get + [ "javax.swing.text.AttributeSet" "boolean" ] + "javax.swing.JTextPane" + "setCharacterAttributes" + jinvoke ; + +: reset-attrs ( -- ) + default-style style>attribute-set set-character-attrs ; + : listener-readln* ( continuation -- ) "listener" get [ "factor.Cons" ] diff --git a/library/platform/jvm/stream.factor b/library/platform/jvm/stream.factor index 4a8f005736..e4241a1911 100644 --- a/library/platform/jvm/stream.factor +++ b/library/platform/jvm/stream.factor @@ -27,6 +27,7 @@ IN: streams USE: combinators +USE: errors USE: kernel USE: lists USE: logic @@ -50,6 +51,16 @@ USE: strings [ "java.io.InputStream" ] "factor.FactorLib" "readLine" jinvoke-static ; +: ( -- ex ) + [ ] "java.io.EOFException" jnew ; + +: >char/eof ( ch -- ch ) + dup -1 = [ throw ] [ >char ] ifte ; + +: /fread1 ( -- string ) + "in" get [ ] "java.io.InputStream" "read" jinvoke + >char/eof ; + : /fread# ( count -- string ) "in" get [ "int" "java.io.InputStream" ] @@ -90,6 +101,8 @@ USE: strings ( -- string ) [ /freadln ] "freadln" set ( count -- string ) + [ /fread1 ] "fread1" set + ( count -- string ) [ /fread# ] "fread#" set ( string -- ) [ /fwrite ] "fwrite" set @@ -103,6 +116,10 @@ USE: strings "in" get [ ] "java.io.BufferedReader" "readLine" jinvoke ; +: /fread1 ( -- string ) + "in" get [ ] "java.io.Reader" "read" jinvoke + >char/eof ; + : /fread# ( -- string ) "in" get [ "int" "java.io.Reader" ] @@ -129,6 +146,8 @@ USE: strings "in" set ( -- string ) [ /freadln ] "freadln" set + ( -- string ) + [ /fread1 ] "fread1" set ( count -- string ) [ /fread# ] "fread#" set ( string -- ) diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index 7953a3f854..340c6a3c79 100644 --- a/library/platform/native/boot-stage2.factor +++ b/library/platform/native/boot-stage2.factor @@ -81,6 +81,8 @@ USE: stdio "/library/math/list-math.factor" "/library/math/simpson.factor" + "/library/extend-stream.factor" + "/library/platform/native/in-thread.factor" "/library/platform/native/network.factor" "/library/logging.factor" "/library/platform/native/random.factor" @@ -93,6 +95,7 @@ USE: stdio "/library/test/test.factor" "/library/ansi.factor" "/library/telnetd.factor" + "/library/inferior.factor" "/library/image.factor" "/library/cross-compiler.factor" diff --git a/library/platform/native/in-thread.factor b/library/platform/native/in-thread.factor new file mode 100644 index 0000000000..b6f23fb729 --- /dev/null +++ b/library/platform/native/in-thread.factor @@ -0,0 +1,51 @@ +! :folding=none:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +IN: threads +USE: combinators +USE: continuations +USE: errors +USE: io-internals +USE: kernel +USE: lists +USE: stack + +: 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 + [ + call + ] [ + [ default-error-handler drop ] when* + ] catch + (yield) + ] callcc0 drop ; diff --git a/library/platform/native/init-stage2.factor b/library/platform/native/init-stage2.factor index 60542ebce3..41fa06735b 100644 --- a/library/platform/native/init-stage2.factor +++ b/library/platform/native/init-stage2.factor @@ -31,6 +31,7 @@ USE: combinators USE: errors USE: httpd-responder USE: kernel +USE: lists USE: namespaces USE: parser USE: random @@ -38,6 +39,8 @@ USE: streams USE: styles USE: words +: cli-args ( -- args ) 10 getenv ; + : warm-boot ( -- ) #! A fully bootstrapped image has this as the boot #! quotation. @@ -51,6 +54,9 @@ USE: words t "user-init" set t "interactive" set + ! The first CLI arg is the image name. + cli-args uncons parse-command-line "image" set + run-user-init "interactive" get [ init-interpreter ] when diff --git a/library/platform/native/io-internals.factor b/library/platform/native/io-internals.factor index 6555e3c424..bfc7ea4987 100644 --- a/library/platform/native/io-internals.factor +++ b/library/platform/native/io-internals.factor @@ -39,7 +39,7 @@ USE: threads : stderr 2 getenv ; : flush-fd ( port -- ) - [ swap add-write-io-task yield ] callcc0 drop ; + [ swap add-write-io-task (yield) ] callcc0 drop ; : wait-to-write ( len port -- ) tuck can-write? [ drop ] [ flush-fd ] ifte ; @@ -50,7 +50,7 @@ USE: threads over wait-to-write write-fd-8 ; : fill-fd ( port -- ) - [ swap add-read-line-io-task yield ] callcc0 drop ; + [ swap add-read-line-io-task (yield) ] callcc0 drop ; : wait-to-read-line ( port -- ) dup can-read-line? [ drop ] [ fill-fd ] ifte ; @@ -59,7 +59,7 @@ USE: threads dup wait-to-read-line read-line-fd-8 dup [ sbuf>str ] when ; : fill-fd# ( count port -- ) - [ -rot add-read-count-io-task yield ] callcc0 2drop ; + [ -rot add-read-count-io-task (yield) ] callcc0 2drop ; : wait-to-read# ( count port -- ) 2dup can-read-count? [ 2drop ] [ fill-fd# ] ifte ; @@ -68,7 +68,7 @@ USE: threads 2dup wait-to-read# read-count-fd-8 dup [ sbuf>str ] when ; : wait-to-accept ( socket -- ) - [ swap add-accept-io-task yield ] callcc0 drop ; + [ swap add-accept-io-task (yield) ] callcc0 drop ; : blocking-accept ( socket -- host port in out ) dup wait-to-accept accept-fd ; diff --git a/library/platform/native/namespaces.factor b/library/platform/native/namespaces.factor index 9fc5266606..87c780d26c 100644 --- a/library/platform/native/namespaces.factor +++ b/library/platform/native/namespaces.factor @@ -78,9 +78,12 @@ DEFER: >n : set ( value variable -- ) namespace set* ; : put ( variable value -- ) namespace put* ; -: vars ( -- list ) namespace hash-keys ; -: values ( -- list ) namespace hash-values ; -: vars-values ( -- list ) namespace hash>alist ; +: alist-sort ( list -- list ) + [ swap car swap car str-lexi> ] sort ; + +: vars-values ( -- list ) namespace hash>alist alist-sort ; +: vars ( -- list ) vars-values [ car ] inject ; +: values ( -- list ) vars-values [ cdr ] inject ; ! We don't have bound objects in native Factor. : namespace? hashtable? ; diff --git a/library/platform/native/threads.factor b/library/platform/native/threads.factor index 686094af12..3822b73cae 100644 --- a/library/platform/native/threads.factor +++ b/library/platform/native/threads.factor @@ -31,9 +31,10 @@ USE: continuations USE: io-internals USE: kernel USE: lists -USE: namespaces USE: stack -USE: strings + +! Core of the multitasker. Used by io-internals.factor and +! in-thread.factor. : run-queue ( -- queue ) 9 getenv ; @@ -45,21 +46,30 @@ USE: strings f set-run-queue ; : next-thread ( -- quot ) + #! Get and remove the next quotation from the run queue. run-queue dup [ uncons set-run-queue ] when ; : schedule-thread ( quot -- ) + #! Add a quotation to the run queue. run-queue cons set-run-queue ; -: yield ( -- ) +: (yield) ( -- ) + #! If there is a quotation in the run queue, call it, + #! otherwise wait for I/O. The currently executing + #! continuation is suspended. Use yield instead. next-thread dup [ call ] [ drop next-io-task dup [ call ] [ - drop yield + drop (yield) ] ifte ] ifte ; -: in-thread ( quot -- ) - [ schedule-thread call yield ] callcc0 drop ; +: 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 (yield) or + #! yield. + [ schedule-thread (yield) ] callcc0 ; diff --git a/library/stdio-binary.factor b/library/stdio-binary.factor index 8cdc5de8b9..8fac1e211e 100644 --- a/library/stdio-binary.factor +++ b/library/stdio-binary.factor @@ -31,27 +31,39 @@ USE: stack USE: streams USE: strings +: read-little-endian-32 ( -- word ) + read1 + read1 8 shift< bitor + read1 16 shift< bitor + read1 24 shift< bitor ; + +: read-big-endian-32 ( -- word ) + read1 24 shift< + read1 16 shift< bitor + read1 8 shift< bitor + read1 bitor ; + : byte3 ( num -- byte ) 24 shift> HEX: ff bitand ; : byte2 ( num -- byte ) 16 shift> HEX: ff bitand ; : byte1 ( num -- byte ) 8 shift> HEX: ff bitand ; : byte0 ( num -- byte ) HEX: ff bitand ; -: little-endian-32 ( word -- ) +: write-little-endian-32 ( word -- ) dup byte0 >char write dup byte1 >char write dup byte2 >char write byte3 >char write ; -: big-endian-32 ( word -- ) +: write-big-endian-32 ( word -- ) dup byte3 >char write dup byte2 >char write dup byte1 >char write byte0 >char write ; -: little-endian-16 ( char -- ) +: write-little-endian-16 ( char -- ) dup byte0 >char write byte1 >char write ; -: big-endian-16 ( char -- ) +: write-big-endian-16 ( char -- ) dup byte1 >char write byte0 >char write ; diff --git a/library/stdio.factor b/library/stdio.factor index ac29f64fb4..91608a1b23 100644 --- a/library/stdio.factor +++ b/library/stdio.factor @@ -52,6 +52,9 @@ USE: streams : read ( -- string ) "stdio" get freadln ; +: read1 ( count -- string ) + "stdio" get fread1 ; + : read# ( count -- string ) "stdio" get fread# ; @@ -76,3 +79,10 @@ USE: streams [ swap "stdio" set [ "stdio" get fclose rethrow ] catch ] with-scope ; + +: with-string ( quot -- str ) + #! Execute a quotation, and push a string containing all + #! text printed by the quotation. + 1024 [ + call "stdio" get stream>str + ] with-stream ; diff --git a/library/stream.factor b/library/stream.factor index 94558f866c..c19dea79d6 100644 --- a/library/stream.factor +++ b/library/stream.factor @@ -40,6 +40,9 @@ USE: strings : freadln ( stream -- string ) [ "freadln" get call ] bind ; +: fread1 ( stream -- string ) + [ "fread1" get call ] bind ; + : fread# ( count stream -- string ) [ "fread#" get call ] bind ; @@ -64,15 +67,17 @@ USE: strings #! Create a stream object. [ ( -- string ) - [ "freadln not implemented." throw ] "freadln" set + [ "freadln not implemented." throw ] "freadln" set + ( -- string ) + [ 1 namespace fread# 0 swap str-nth ] "fread1" set ( count -- string ) - [ "fread# not implemented." throw ] "fread#" set + [ "fread# not implemented." throw ] "fread#" set ( string -- ) - [ "fwrite not implemented." throw ] "fwrite" set + [ "fwrite not implemented." throw ] "fwrite" set ( string style -- ) - [ drop namespace fwrite ] "fwrite-attr" set + [ drop namespace fwrite ] "fwrite-attr" set ( string -- ) - [ "fedit not implemented." throw ] "fedit" set + [ "fedit not implemented." throw ] "fedit" set ( -- ) [ ] "fflush" set ( -- ) @@ -84,29 +89,6 @@ USE: strings ] "fprint" set ] extend ; -: ( stream -- stream ) - #! Create a stream that wraps another stream. Override some - #! or all of the stream words. - [ - "stream" set - ( -- string ) - [ "stream" get freadln ] "freadln" set - ( count -- string ) - [ "stream" get fread# ] "fread#" set - ( string -- ) - [ "stream" get fwrite ] "fwrite" set - ( string style -- ) - [ "stream" get fwrite-attr ] "fwrite-attr" set - ( string -- ) - [ "stream" get fedit ] "fedit" set - ( -- ) - [ "stream" get fflush ] "fflush" set - ( -- ) - [ "stream" get fclose ] "fclose" set - ( string -- ) - [ "stream" get fprint ] "fprint" set - ] extend ; - : ( size -- stream ) #! Creates a new stream for writing to a string buffer. [ diff --git a/library/styles.factor b/library/styles.factor index 0083006306..034c2cacba 100644 --- a/library/styles.factor +++ b/library/styles.factor @@ -28,6 +28,7 @@ IN: styles USE: combinators USE: kernel +USE: lists USE: namespaces USE: stack @@ -71,10 +72,10 @@ USE: stack [ [ "bold" | t ] - ] "prompt" set-style + ] default-style append "prompt" set-style [ [ "ansi-fg" | "0" ] [ "ansi-bg" | "2" ] [ "fg" | [ 255 0 0 ] ] - ] "comments" set-style ; + ] default-style append "comments" set-style ; diff --git a/library/test/threads.factor b/library/test/threads.factor new file mode 100644 index 0000000000..25e00c45fc --- /dev/null +++ b/library/test/threads.factor @@ -0,0 +1,11 @@ +IN: scratchpad + +USE: namespaces +USE: test +USE: threads + +! This only tests co-operative threads in CFactor. + +3 "x" set +[ yield 2 "x" set ] in-thread +[ 2 ] [ yield "x" get ] unit-test diff --git a/library/vocabulary-style.factor b/library/vocabulary-style.factor index 9d5759ce2d..e35db0f84b 100644 --- a/library/vocabulary-style.factor +++ b/library/vocabulary-style.factor @@ -39,7 +39,8 @@ USE: styles "vocabularies" 2rlist get-style ; : set-vocab-style ( style vocab -- ) - "styles" get [ "vocabularies" get ] bind [ set ] bind ; + swap default-style append swap + [ "styles" "vocabularies" ] object-path set* ; : word-style ( word -- style ) word-vocabulary dup [ diff --git a/native/factor.c b/native/factor.c index fe5998e9e4..2bdf8c7404 100644 --- a/native/factor.c +++ b/native/factor.c @@ -2,6 +2,9 @@ int main(int argc, char** argv) { + int i; + CELL args; + if(argc == 1) { printf("Usage: factor [ parameters ... ]\n"); @@ -16,6 +19,15 @@ int main(int argc, char** argv) init_io(); init_signals(); + args = F; + while(--argc != 0) + { + args = tag_cons(cons(tag_object(from_c_string(argv[argc])), + args)); + } + + userenv[ARGS_ENV] = args; + run(); return 0; diff --git a/native/image.c b/native/image.c index e3ef4c8afa..de8012cc3e 100644 --- a/native/image.c +++ b/native/image.c @@ -9,7 +9,7 @@ void load_image(char* filename) fprintf(stderr,"Loading %s...",filename); file = fopen(filename,"rb"); - if(file < 0) + if(file == NULL) fatal_error("Cannot open image for reading",errno); /* read it in native byte order */ @@ -51,7 +51,7 @@ bool save_image(char* filename) fprintf(stderr,"Saving %s...\n",filename); file = fopen(filename,"wb"); - if(file < 0) + if(file == NULL) fatal_error("Cannot open image for writing",errno); h.magic = IMAGE_MAGIC; diff --git a/native/run.h b/native/run.h index 89f5453885..5ae6d40677 100644 --- a/native/run.h +++ b/native/run.h @@ -10,6 +10,7 @@ #define GC_ENV 7 #define BOOT_ENV 8 #define RUNQUEUE_ENV 9 /* used by library only */ +#define ARGS_ENV 10 /* Error handlers restore this */ sigjmp_buf toplevel;