steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

read1 stream operation added, inferior.factor styled text communication protocol

cvs
Slava Pestov 2004-08-22 05:46:26 +00:00
parent 4e0057e110
commit 67ea27e49c
28 changed files with 394 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
TODO.FACTOR.txt
View File

@ -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

15
factor/listener/FactorListener.java
View File

@ -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)
{

6
library/ansi.factor
View File

@ -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 ;
: <ansi-stream> ( 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
<extend-stream> [
( string style -- )
[ "stream" get ansi-write-attr ] "fwrite-attr" set
[ ansi-attr-string write ] "fwrite-attr" set
] extend ;

59
library/extend-stream.factor Normal file
View File

@ -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
: <extend-stream> ( stream -- stream )
#! Create a stream that wraps another stream. Override some
#! or all of the stream words.
<stream> [
"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 ;

10
library/httpd/html.factor
View File

@ -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 ;
: <html-stream> ( stream -- stream )
#! Wraps the given stream in an HTML stream. An HTML stream
@ -115,9 +115,9 @@ USE: url-encoding
#! italic
#! underline
<extend-stream> [
[ 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 -- )

4
library/image.factor
View File

@ -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 -- )

117
library/inferior.factor Normal file
View File

@ -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 ;
: <inferior-server-stream> ( stream -- stream )
<extend-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 ;

11
library/inspector.factor
View File

@ -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,7 +75,7 @@ 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 ;

4
library/jedit/jedit-remote.factor
View File

@ -70,7 +70,9 @@ USE: unparser
: send-jedit-request ( request -- )
jedit-server-info swap "localhost" swap <client> [
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 -- )

2
library/lists.factor
View File

@ -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.
#!

2
library/platform/jvm/boot-sumo.factor
View File

@ -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

15
library/platform/jvm/listener.factor
View File

@ -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" ]

19
library/platform/jvm/stream.factor
View File

@ -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 ;
: <eof-exception> ( -- ex )
[ ] "java.io.EOFException" jnew ;
: >char/eof ( ch -- ch )
dup -1 = [ <eof-exception> throw ] [ >char ] ifte ;
: <byte-stream>/fread1 ( -- string )
"in" get [ ] "java.io.InputStream" "read" jinvoke
>char/eof ;
: <byte-stream>/fread# ( count -- string )
"in" get
[ "int" "java.io.InputStream" ]
@ -90,6 +101,8 @@ USE: strings
( -- string )
[ <byte-stream>/freadln ] "freadln" set
( count -- string )
[ <byte-stream>/fread1 ] "fread1" set
( count -- string )
[ <byte-stream>/fread# ] "fread#" set
( string -- )
[ <byte-stream>/fwrite ] "fwrite" set
@ -103,6 +116,10 @@ USE: strings
"in" get [ ] "java.io.BufferedReader" "readLine"
jinvoke ;
: <char-stream>/fread1 ( -- string )
"in" get [ ] "java.io.Reader" "read" jinvoke
>char/eof ;
: <char-stream>/fread# ( -- string )
"in" get
[ "int" "java.io.Reader" ]
@ -129,6 +146,8 @@ USE: strings
"in" set
( -- string )
[ <char-stream>/freadln ] "freadln" set
( -- string )
[ <char-stream>/fread1 ] "fread1" set
( count -- string )
[ <char-stream>/fread# ] "fread#" set
( string -- )

3
library/platform/native/boot-stage2.factor
View File

@ -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"

51
library/platform/native/in-thread.factor Normal file
View File

@ -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 ;

6
library/platform/native/init-stage2.factor
View File

@ -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

8
library/platform/native/io-internals.factor
View File

@ -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 ;

9
library/platform/native/namespaces.factor
View File

@ -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? ;

22
library/platform/native/threads.factor
View File

@ -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 ;

20
library/stdio-binary.factor
View File

@ -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 ;

10
library/stdio.factor
View File

@ -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 <string-output-stream> [
call "stdio" get stream>str
] with-stream ;

38
library/stream.factor
View File

@ -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.
<namespace> [
( -- 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 ;
: <extend-stream> ( stream -- stream )
#! Create a stream that wraps another stream. Override some
#! or all of the stream words.
<stream> [
"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 ;
: <string-output-stream> ( size -- stream )
#! Creates a new stream for writing to a string buffer.
<stream> [

5
library/styles.factor
View File

@ -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 ;

11
library/test/threads.factor Normal file
View File

@ -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

3
library/vocabulary-style.factor
View File

@ -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 [

12
native/factor.c
View File

@ -2,6 +2,9 @@
int main(int argc, char** argv)
{
int i;
CELL args;
if(argc == 1)
{
printf("Usage: factor <image file> [ 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;

4
native/image.c
View File

@ -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;

1
native/run.h
View File

@ -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;