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

some progress on getting FFI I/O working on Linux

cvs
Slava Pestov 2005-04-29 06:37:12 +00:00
parent bcf605142b
commit bd5198bf39
30 changed files with 199 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -1,5 +1,6 @@
CC = gcc
DEFAULT_CFLAGS = -Wall -O3 -fomit-frame-pointer $(SITE_CFLAGS)
#DEFAULT_CFLAGS = -g $(SITE_CFLAGS)
DEFAULT_LIBS = -lm
STRIP = strip

11
TODO.FACTOR.txt
View File

@ -1,21 +1,21 @@
0.74:
- trailing newlines in read-line output value
- local structs are 4 times larger than they should be
- ppc ffi relocation
- faster layout
- faster repaint
- linux? bsd? words
- forgotten words not removed from cross-reference
- get all-tests to run with -no-compile
- review errno
- freebsd 4 -pthread errno
- mac os x ffi
- linux i/o
- implement fcopy
- fix httpd
- fix jedit plugin
- if external factor is down, don't add tons of random shit to the dictionary
- scalar * matrix, vector * matrix, matrix * vector need to work
- turning vectors into row and column matrices
- make-matrix is slow and ugly
- move 2repeat somewhere else
- rotating cube demo
+ ui:
@ -30,6 +30,7 @@
+ ffi:
- clarify powerpc passing of value struct parameters
- char* struct members
- box/unbox_signed/unsigned_8
- ffi unicode strings: null char security hole

15
doc/handbook.tex
View File

@ -2861,8 +2861,17 @@ Cotangent&\texttt{cot}&\texttt{coth}&\texttt{acot}&\texttt{acoth}
\end{tabular}
\section{Streams}
\glossary{name=stream,
description={a source or sink of characters supporting some subset of the stream protocol, used as an end-point for input/output operations}}
Input and output is centered around the concept of a \emph{stream}, which is a source or
sink of characters.
\subsection{Stream protocol}
\glossary{name=input stream,
description={a stream that implements the \texttt{stream-readln} and \texttt{stream-read} generic words and can be used for character input}}
\glossary{name=output stream,
description={a stream that implements the \texttt{stream-write-attr}, \texttt{stream-flush} and \texttt{stream-auto-flush} generic words and can be used for character output}}
\subsection{Reading and writing files}
@ -2872,6 +2881,12 @@ Cotangent&\texttt{cot}&\texttt{coth}&\texttt{acot}&\texttt{acoth}
\subsection{Formatted output}
\subsection{Special streams}
null stream
duplex stream
string output stream
\subsection{Printing objects}
\subsubsection{The unparser}

2
factor/jedit/TextAreaPopup.java
View File

@ -72,7 +72,7 @@ public class TextAreaPopup extends JWindow
int caret = textArea.getCaretPosition()
- textArea.getLineStartOffset(line);
int start = FactorPlugin.getWordStartOffset(lineText,caret);
Point loc = textArea.offsetToXY(line,start);
Point loc = textArea.offsetToXY(line,start,new Point(0,0));
loc.y += textArea.getPainter().getFontMetrics().getHeight();
SwingUtilities.convertPointToScreen(loc,textArea.getPainter());
setLocation(loc);

1
library/bootstrap/boot-stage2.factor
View File

@ -37,6 +37,7 @@ t [
"/library/inference/types.factor"
"/library/compiler/assembler.factor"
"/library/compiler/relocate.factor"
"/library/compiler/xt.factor"
"/library/compiler/optimizer.factor"
"/library/compiler/linearizer.factor"

16
library/bootstrap/boot-stage3.factor
View File

@ -6,7 +6,6 @@ lists namespaces parser sequences stdio unparser words ;
"Bootstrap stage 3..." print
unix? [
"libc" "libc.so" "cdecl" add-library
"sdl" "libSDL.so" "cdecl" add-library
"sdl-gfx" "libSDL_gfx.so" "cdecl" add-library
"sdl-ttf" "libSDL_ttf.so" "cdecl" add-library
@ -131,14 +130,25 @@ t [
] pull-in
compile? [
os "freebsd" = [
"/library/unix/syscalls-freebsd.factor"
] pull-in
os "linux" = [
"/library/unix/syscalls-linux.factor"
] pull-in
unix? [
"/library/unix/syscalls.factor"
] pull-in
unix? [
"/library/unix/io.factor"
"/library/unix/sockets.factor"
"/library/unix/files.factor"
] pull-in
win32? [
os "win32" = [
"/library/win32/win32-io.factor"
"/library/win32/win32-errors.factor"
"/library/win32/winsock.factor"

6
library/bootstrap/image.factor
View File

@ -194,7 +194,7 @@ M: cons ' ( c -- tagged )
( Strings )
: align-string ( n str -- )
tuck string-length - CHAR: \0 fill cat2 ;
tuck length - CHAR: \0 fill cat2 ;
: emit-chars ( str -- )
>list "big-endian" get [ reverse ] unless
@ -203,7 +203,7 @@ M: cons ' ( c -- tagged )
: (pack-string) ( n list -- )
#! Emit bytes for a string, with n characters per word.
[
2dup string-length > [ dupd align-string ] when
2dup length > [ dupd align-string ] when
emit-chars
] each drop ;
@ -213,7 +213,7 @@ M: cons ' ( c -- tagged )
: emit-string ( string -- )
object-tag here-as swap
string-type >header emit
dup string-length emit-fixnum
dup length emit-fixnum
dup hashcode emit-fixnum
"\0" cat2 pack-string
align-here ;

8
library/collections/hashtables.factor
View File

@ -40,6 +40,10 @@ IN: kernel-internals
: hash-size+ ( hash -- ) dup hash-size 1 + swap set-hash-size ;
: hash-size- ( hash -- ) dup hash-size 1 - swap set-hash-size ;
: grow-hash ( hash -- )
#! A good way to earn a living.
dup hash-size 2 * <array> swap set-hash-array ;
IN: hashtables
: bucket-count ( hash -- n ) hash-array length ;
@ -68,10 +72,6 @@ IN: hashtables
: rehash? ( hash -- ? )
dup bucket-count 3 * 2 /i swap hash-size < ;
: grow-hash ( hash -- )
#! A good way to earn a living.
dup hash-size 2 * <array> swap set-hash-array ;
: (hash>alist) ( alist n hash -- alist )
2dup bucket-count >= [
2drop

15
library/collections/strings.factor
View File

@ -3,14 +3,20 @@
IN: strings USING: generic kernel kernel-internals lists math
sequences ;
! Strings
BUILTIN: string 12 [ 1 length f ] [ 2 hashcode f ] ;
UNION: text string integer ;
M: string = string= ;
BUILTIN: sbuf 13 ;
UNION: text string integer ;
M: string nth string-nth ;
: string> ( str1 str2 -- ? )
! Returns if the first string lexicographically follows str2
string-compare 0 > ;
: length< ( seq seq -- ? )
#! Compare sequence lengths.
swap length swap length < ;
@ -34,10 +40,6 @@ M: string nth string-nth ;
: string-contains? ( substr str -- ? )
swap index-of -1 = not ;
: string> ( str1 str2 -- ? )
! Returns if the first string lexicographically follows str2
string-compare 0 > ;
: string-head ( index str -- str )
#! Returns a new string, from the beginning of the string
#! until the given index.
@ -95,6 +97,7 @@ M: string nth string-nth ;
rot string-head swap
] ifte ;
! Characters
PREDICATE: integer blank " \t\n\r" string-contains? ;
PREDICATE: integer letter CHAR: a CHAR: z between? ;
PREDICATE: integer LETTER CHAR: A CHAR: Z between? ;
@ -113,5 +116,3 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
over LETTER? or
over digit? or
swap "/_?." string-contains? or ;
: string-length ( deprecated ) length ;

12
library/compiler/ppc/alien.factor
View File

@ -5,17 +5,17 @@ USING: alien compiler inference kernel kernel-internals lists
math memory namespaces words ;
\ alien-invoke [
uncons load-dll dlsym compile-call-far
uncons load-dll 2dup rel-dlsym-16/16 dlsym compile-call-far
] "generator" set-word-prop
#parameters [
dup 0 = [ drop ] [ 1 1 rot SUBI ] ifte
dup 0 = [ drop ] [ 16 align 1 1 rot SUBI ] ifte
] "generator" set-word-prop
: stack@ cell * neg cell - ;
: stack@ cell * cell + ;
#unbox [
uncons f dlsym compile-call-far
uncons f 2dup rel-dlsym-16/16 dlsym compile-call-far
3 1 rot stack@ STW
] "generator" set-word-prop
@ -24,9 +24,9 @@ math memory namespaces words ;
] "generator" set-word-prop
#box [
f dlsym compile-call-far
f 2dup rel-dlsym-16/16 dlsym compile-call-far
] "generator" set-word-prop
#cleanup [
dup 0 = [ drop ] [ 1 1 rot ADDI ] ifte
dup 0 = [ drop ] [ 16 align 1 1 rot ADDI ] ifte
] "generator" set-word-prop

4
library/compiler/ppc/generator.factor
View File

@ -53,7 +53,7 @@ words ;
#call-label [
! Hack: length of instruction sequence that follows
compiled-offset 20 + 18 LOAD32 rel-address-16/16
rel-address-16/16 compiled-offset 20 + 18 LOAD32
1 1 -16 STWU
18 1 20 STW
0 B relative-24
@ -94,7 +94,7 @@ words ;
18 18 1 SRAWI
! The value 24 is a magic number. It is the length of the
! instruction sequence that follows to be generated.
compiled-offset 24 + 19 LOAD32 rel-address-16/16
rel-address-16/16 compiled-offset 24 + 19 LOAD32
18 18 19 ADD
18 18 0 LWZ
18 MTLR

44
library/compiler/relocate.factor Normal file
View File

@ -0,0 +1,44 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: compiler
USING: assembler kernel lists math namespaces sequences words ;
! To support saving compiled code to disk, generator words
! append relocation instructions to this vector.
SYMBOL: relocation-table
: rel, ( n -- ) relocation-table get push ;
: relocating compiled-offset cell - rel, ;
: rel-primitive ( word rel/abs -- )
#! If flag is true; relative.
0 1 ? rel, relocating word-primitive rel, ;
: rel-dlsym ( name dll rel/abs -- )
#! If flag is true; relative.
2 3 ? rel, relocating cons intern-literal rel, ;
: rel-address ( rel/abs -- )
#! Relocate address just compiled. If flag is true,
#! relative, and there is nothing to do.
[ 4 rel, relocating 0 rel, ] unless ;
: rel-word ( word rel/abs -- )
#! If flag is true; relative.
over primitive? [ rel-primitive ] [ nip rel-address ] ifte ;
! PowerPC relocations
: rel-primitive-16/16 ( word -- )
#! This is called before a sequence like
#! 19 LOAD32
#! 19 MTCTR
#! BCTR
5 rel, compiled-offset rel, word-primitive rel, ;
: rel-dlsym-16/16 ( name dll -- )
6 rel, compiled-offset rel, cons intern-literal rel, ;
: rel-address-16/16 ( -- )
7 rel, compiled-offset rel, 0 rel, ;

37
library/compiler/xt.factor
View File

@ -4,43 +4,6 @@ IN: compiler
USING: assembler errors generic kernel lists math namespaces
prettyprint sequences strings vectors words ;
! To support saving compiled code to disk, generator words
! append relocation instructions to this vector.
SYMBOL: relocation-table
: rel, ( n -- ) relocation-table get push ;
: relocating compiled-offset cell - rel, ;
: rel-primitive ( word rel/abs -- )
#! If flag is true; relative.
0 1 ? rel, relocating word-primitive rel, ;
: rel-dlsym ( name dll rel/abs -- )
#! If flag is true; relative.
2 3 ? rel, relocating cons intern-literal rel, ;
: rel-address ( rel/abs -- )
#! Relocate address just compiled. If flag is true,
#! relative, and there is nothing to do.
[ 4 rel, relocating 0 rel, ] unless ;
: rel-word ( word rel/abs -- )
#! If flag is true; relative.
over primitive? [ rel-primitive ] [ nip rel-address ] ifte ;
! PowerPC relocations
: rel-primitive-16/16 ( word -- )
#! This is called before a sequence like
#! 19 LOAD32
#! 19 MTCTR
#! BCTR
5 rel, compiled-offset rel, word-primitive rel, ;
: rel-address-16/16 ( -- )
6 rel, relocating 0 rel, ;
! We use a hashtable "compiled-xts" that maps words to
! xt's that are currently being compiled. The commit-xt's word
! sets the xt of each word in the hashtable to the value in the

6
library/httpd/url-encoding.factor
View File

@ -20,7 +20,7 @@ unparser ;
[ hex> ] [ [ drop f ] when ] catch ;
: url-decode-hex ( index str -- )
2dup string-length 2 - >= [
2dup length 2 - >= [
2drop
] [
>r 1 + dup 2 + r> substring catch-hex> [ , ] when*
@ -33,10 +33,10 @@ unparser ;
dup CHAR: + = [ drop CHAR: \s ] when , >r 1 + r> ;
: url-decode-iter ( index str -- )
2dup string-length >= [
2dup length >= [
2drop
] [
2dup string-nth dup CHAR: % = [
2dup nth dup CHAR: % = [
drop url-decode-%
] [
url-decode-+-or-other

11
library/io/buffer.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2004, 2005 Mackenzie Straight.
! See http://factor.sf.net/license.txt for BSD license.
IN: io-internals
USING: alien errors kernel kernel-internals math strings ;
USING: alien errors kernel kernel-internals math sequences
strings ;
TUPLE: buffer size ptr fill pos ;
@ -67,14 +68,14 @@ C: buffer ( size -- buffer )
dup buffer-size swap buffer-fill - ;
: check-overflow ( string buffer -- )
buffer-capacity swap string-length < [
buffer-capacity swap length < [
"Buffer overflow" throw
] when ;
: >buffer ( string buffer -- )
2dup check-overflow
[ dup buffer-ptr swap buffer-fill + string>memory ] 2keep
[ buffer-fill swap string-length + ] keep set-buffer-fill ;
[ buffer-fill swap length + ] keep set-buffer-fill ;
: buffer-extend ( length buffer -- )
#! Increases the size of the buffer by length.
@ -101,7 +102,7 @@ C: buffer ( size -- buffer )
: buffer-set ( string buffer -- )
2dup buffer-ptr string>memory
>r string-length r> buffer-reset ;
>r length r> buffer-reset ;
: string>buffer ( string - -buffer )
dup string-length <buffer> tuck buffer-set ;
dup length <buffer> tuck buffer-set ;

4
library/kernel.factor
View File

@ -37,6 +37,4 @@ M: object clone ;
: cpu ( -- arch ) 7 getenv ;
: os ( -- os ) 11 getenv ;
: win32? ( -- ? ) os "win32" = ;
: freebsd? ( -- ? ) os "freebsd" = ;
: linux? ( -- ? ) os "linux" = ;
: unix? ( -- ? ) freebsd? linux? or ;
: unix? ( -- ? ) os "freebsd" = os "linux" = or ;

2
library/syntax/parse-numbers.factor
View File

@ -17,7 +17,7 @@ M: object digit> not-a-number ;
2dup < [ rot * + ] [ not-a-number ] ifte ;
: (base>) ( base str -- num )
dup string-length 0 = [
dup empty? [
not-a-number
] [
0 swap [ digit> pick digit+ ] seq-each nip

14
library/test/benchmark/strings.factor
View File

@ -1,18 +1,12 @@
USE: strings
USE: kernel
USE: math
USE: test
USE: lists
USE: namespaces
USE: compiler
USING: compiler kernel math namespaces sequences strings test ;
! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
: string-step ( n str -- )
2dup string-length > [
2dup length > [
dup [ "123" , , "456" , , "789" , ] make-string
dup dup string-length 2 /i 0 swap rot substring
swap dup string-length 2 /i 1 + 1 swap rot substring cat2
dup dup length 2 /i 0 swap rot substring
swap dup length 2 /i 1 + 1 swap rot substring append
string-step
] [
2drop

9
library/test/line-editor.factor
View File

@ -1,10 +1,5 @@
IN: temporary
USE: namespaces
USE: line-editor
USE: test
USE: strings
USE: kernel
USE: prettyprint
USING: kernel line-editor namespaces sequences strings test ;
<line-editor> "editor" set
@ -15,7 +10,7 @@ USE: prettyprint
[ t ] [
"editor" get [ caret get ] bind
"Hello world" string-length =
"Hello world" length =
] unit-test
[ "Hello, crazy world" ] [

6
library/tools/jedit-wire.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: jedit
USING: generic kernel listener lists namespaces parser
prettyprint stdio streams strings words ;
prettyprint sequences stdio streams strings words ;
! Wire protocol for jEdit to evaluate Factor code.
! Packets are of the form:
@ -14,7 +14,7 @@ prettyprint stdio streams strings words ;
! captured with with-string.
: write-packet ( string -- )
dup string-length write-big-endian-32 write flush ;
dup length write-big-endian-32 write flush ;
: read-packet ( -- string )
read-big-endian-32 read ;
@ -40,7 +40,7 @@ prettyprint stdio streams strings words ;
: jedit-write-attr ( str style -- )
CHAR: w write
[ swap . . ] with-string
dup string-length write-big-endian-32
dup length write-big-endian-32
write ;
TUPLE: jedit-stream ;

6
library/tools/jedit.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: jedit
USING: files kernel lists namespaces parser streams stdio
strings unparser words ;
USING: files kernel lists namespaces parser sequences stdio
streams strings unparser words ;
: jedit-server-file ( -- path )
"jedit-server-file" get
@ -26,7 +26,7 @@ strings unparser words ;
: send-jedit-request ( request -- )
jedit-server-info swap "localhost" swap <client> [
write-big-endian-32
dup string-length write-big-endian-16
dup length write-big-endian-16
write flush
] with-stream ;

6
library/ui/line-editor.factor
View File

@ -61,7 +61,7 @@ SYMBOL: history-index
: set-line-text ( text -- )
#! Call this in the line editor scope.
dup line-text set string-length caret set ;
dup line-text set length caret set ;
: goto-history ( n -- )
#! Call this in the line editor scope.
@ -100,7 +100,7 @@ SYMBOL: history-index
: caret-insert ( str offset -- )
#! Call this in the line editor scope.
caret get <= [
string-length caret [ + ] change
length caret [ + ] change
] [
drop
] ifte ;
@ -146,4 +146,4 @@ SYMBOL: history-index
: right ( -- )
#! Call this in the line editor scope.
caret [ 1 + line-text get string-length min ] change ;
caret [ 1 + line-text get length min ] change ;

4
library/ui/text.factor
View File

@ -56,7 +56,7 @@ global [
] when ;
: size-string ( font text -- w h )
>r lookup-font r> filter-nulls dup string-length 0 = [
>r lookup-font r> filter-nulls dup empty? [
drop TTF_FontHeight 0 swap
] [
<int-box> <int-box> [ TTF_SizeUNICODE drop ] 2keep
@ -75,7 +75,7 @@ M: string shape-h ( text -- h )
drop font get lookup-font TTF_FontHeight ;
M: string draw-shape ( text -- )
dup string-length 0 = [
dup empty? [
drop
] [
filter-nulls font get lookup-font swap

33
library/unix/files.factor
View File

@ -1,38 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: files
! We want the system call stat to shadow the word stat we define
USING: alien io-internals kernel math namespaces unix-internals ;
: cd ( dir -- )
"void" "libc" "chdir" [ "char*" ] alien-invoke ;
: stat ( path -- [ dir? mode size mtime ] )
<stat> tuck stat 0 < [
drop f
] [
[
dup stat-mode dup S_ISDIR ,
S_IFMT bitnot bitand ,
dup stat-size ,
stat-mtime ,
] make-list
] ifte ;
: (directory) ( path -- list )
opendir [
[
[ dirent-name , ] [ dup readdir null>f ] while
] make-list swap closedir
] [
[ ]
] ifte* ;
: cwd ( -- str )
<string-box> dup 255 getcwd io-error string-box-value ;
IN: streams
USE: io-internals
: <file-reader> ( path -- stream ) open-read <reader> ;
: <file-writer> ( path -- stream ) open-write <writer> ;

3
library/unix/io.factor
View File

@ -26,7 +26,8 @@ C: port ( handle buffer -- port )
[ >r dup init-handle r> set-port-handle ] keep ;
M: port stream-close ( port -- )
dup port-handle close buffer-free ;
dup port-handle close
delegate [ buffer-free ] when* ;
: buffered-port 8192 <port> ;

10
library/unix/sockets.factor
View File

@ -4,7 +4,7 @@
! We need to fiddle with the exact search order here, since
! unix-internals::accept shadows streams::accept.
IN: io-internals
USING: streams ;
USING: namespaces streams unparser ;
USING: alien generic kernel math unix-internals ;
: init-sockaddr ( port -- sockaddr )
@ -62,6 +62,14 @@ M: accept-task io-task-events ( task -- events )
: wait-to-accept ( server -- )
[ swap <accept-task> add-io-task io-multiplex ] callcc0 drop ;
: inet-ntoa ( n -- str )
ntohl [
dup -24 shift HEX: ff bitand unparse % CHAR: . ,
dup -16 shift HEX: ff bitand unparse % CHAR: . ,
dup -8 shift HEX: ff bitand unparse % CHAR: . ,
HEX: ff bitand unparse %
] make-string ;
: do-accept ( fd -- fd host port )
<sockaddr-in>
[ "sockaddr-in" c-size box-int accept dup io-error ] keep

23
library/unix/syscalls-freebsd.factor Normal file
View File

@ -0,0 +1,23 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: unix-internals
! FreeBSD
: O_RDONLY HEX: 0000 ;
: O_WRONLY HEX: 0001 ;
: O_RDWR HEX: 0002 ;
: O_CREAT HEX: 0200 ;
: O_TRUNC HEX: 0400 ;
: POLLIN HEX: 0001 ; ! any readable data available
: POLLPRI HEX: 0002 ; ! OOB/Urgent readable data
: POLLOUT HEX: 0004 ; ! file descriptor is writeable
: POLLRDNORM HEX: 0040 ; ! non-OOB/URG data available
: POLLWRNORM POLLOUT ; ! no write type differentiation
: POLLRDBAND HEX: 0080 ; ! OOB/Urgent readable data
: POLLWRBAND HEX: 0100 ; ! OOB/Urgent data can be written
: SOL_SOCKET HEX: ffff ; ! options for socket level
: SO_REUSEADDR HEX: 4 ; ! allow local address reuse
: INADDR_ANY 0 ;

23
library/unix/syscalls-linux.factor Normal file
View File

@ -0,0 +1,23 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: unix-internals
! Linux.
: O_RDONLY HEX: 0000 ;
: O_WRONLY HEX: 0001 ;
: O_RDWR HEX: 0002 ;
: O_CREAT HEX: 0040 ;
: O_TRUNC HEX: 0200 ;
: POLLIN HEX: 0001 ;
: POLLPRI HEX: 0002 ;
: POLLOUT HEX: 0004 ;
: POLLRDNORM HEX: 0040 ;
: POLLWRNORM HEX: 0100 ;
: POLLRDBAND HEX: 0080 ;
: POLLWRBAND HEX: 0200 ;
: SOL_SOCKET 1 ;
: SO_REUSEADDR 2 ;
: INADDR_ANY 0 ;

83
library/unix/syscalls.factor
View File

@ -11,75 +11,14 @@ ALIAS: ulong size_t
ALIAS: uint socklen_t
ALIAS: uint in_addr_t
BEGIN-STRUCT: stat
FIELD: uint dev
FIELD: uint ino
FIELD: ushort mode
FIELD: ushort nlink
FIELD: uint uid
FIELD: uint gid
FIELD: uint rdev
FIELD: ulong atime
FIELD: ulong atimensec
FIELD: ulong mtime
FIELD: ulong mtimensec
FIELD: ulong ctime
FIELD: ulong ctimensec
FIELD: off_t size
FIELD: off_t blocks
FIELD: uint blksize
FIELD: uint flags
FIELD: uint gen
FIELD: uint padding
FIELD: ulonglong padding
FIELD: ulonglong padding
END-STRUCT
: S_IFMT OCT: 0170000 ; inline
: S_ISDIR ( m -- ? ) OCT: 0170000 bitand OCT: 0040000 = ; inline
: stat ( path stat -- n )
"int" "libc" "stat" [ "char*" "stat*" ] alien-invoke ;
: opendir ( path -- dir* )
"void*" "libc" "opendir" [ "char*" ] alien-invoke ;
BEGIN-STRUCT: dirent
FIELD: uint fileno
FIELD: ushort reclen
FIELD: uchar type
FIELD: uchar namlen
FIELD: uchar256 name
END-STRUCT
: readdir ( dir* -- dirent* )
"dirent*" "libc" "readdir" [ "void*" ] alien-invoke ;
: closedir ( dir* -- )
"void" "libc" "closedir" [ "void*" ] alien-invoke ;
BEGIN-STRUCT: string-box
FIELD: uchar256 value
END-STRUCT
: EINPROGRESS 36 ;
: errno ( -- n )
"int" "libc" "errno" alien-global ;
"int" f "factor_errno" [ ] alien-invoke ;
: strerror ( n -- str )
"char*" "libc" "strerror" [ "int" ] alien-invoke ;
: getcwd ( str len -- n )
"int" "libc" "getcwd" [ "string-box*" "uint" ] alien-invoke ;
: O_RDONLY HEX: 0000 ;
: O_WRONLY HEX: 0001 ;
: O_RDWR HEX: 0002 ;
: O_CREAT HEX: 0200 ;
: O_TRUNC HEX: 0400 ;
: open ( path flags prot -- fd )
"int" "libc" "open" [ "char*" "int" "int" ] alien-invoke ;
@ -98,25 +37,12 @@ END-STRUCT
: write ( fd buf nbytes -- n )
"ssize_t" "libc" "write" [ "int" "ulong" "size_t" ] alien-invoke ;
: MSG_OOB HEX: 1 ;
: recv ( fd buf nbytes flags -- )
"ssize_t" "libc" "read" [ "int" "ulong" "size_t" "int" ] alien-invoke ;
BEGIN-STRUCT: pollfd
FIELD: int fd
FIELD: short events
FIELD: short revents
END-STRUCT
: POLLIN HEX: 0001 ; ! any readable data available
: POLLPRI HEX: 0002 ; ! OOB/Urgent readable data
: POLLOUT HEX: 0004 ; ! file descriptor is writeable
: POLLRDNORM HEX: 0040 ; ! non-OOB/URG data available
: POLLWRNORM POLLOUT ; ! no write type differentiation
: POLLRDBAND HEX: 0080 ; ! OOB/Urgent readable data
: POLLWRBAND HEX: 0100 ; ! OOB/Urgent data can be written
: read-events POLLIN POLLRDNORM bitor POLLRDBAND bitor ;
: write-events POLLOUT POLLWRNORM bitor POLLWRBAND bitor ;
@ -159,10 +85,6 @@ END-STRUCT
: socket ( domain type protocol -- n )
"int" "libc" "socket" [ "int" "int" "int" ] alien-invoke ;
: SOL_SOCKET HEX: ffff ; ! options for socket level
: SO_REUSEADDR HEX: 4 ; ! allow local address reuse
: INADDR_ANY 0 ;
: setsockopt ( s level optname optval optlen -- n )
"int" "libc" "setsockopt" [ "int" "int" "int" "void*" "socklen_t" ] alien-invoke ;
@ -178,9 +100,6 @@ END-STRUCT
: accept ( s sockaddr socklen -- n )
"int" "libc" "accept" [ "int" "sockaddr-in*" "int-box*" ] alien-invoke ;
: inet-ntoa ( sockaddr -- string )
"char*" "libc" "inet_ntoa" [ "in_addr_t" ] alien-invoke ;
: htonl ( n -- n )
"uint" "libc" "htonl" [ "uint" ] alien-invoke ;

16
library/win32/win32-stream.factor
View File

@ -24,9 +24,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: win32-stream
USING: alien continuations generic kernel kernel-internals lists math
namespaces prettyprint stdio streams strings threads win32-api
win32-io-internals io-internals ;
USING: alien continuations generic io-internals kernel
kernel-internals lists math namespaces prettyprint sequences
stdio streams strings threads win32-api win32-io-internals ;
TUPLE: win32-stream this ; ! FIXME: rewrite using tuples
GENERIC: win32-stream-handle
@ -70,11 +70,11 @@ M: integer do-write ( int -- )
>r ch>string r> >buffer ;
M: string do-write ( str -- )
dup string-length out-buffer get buffer-capacity <= [
dup length out-buffer get buffer-capacity <= [
out-buffer get >buffer
] [
dup string-length out-buffer get buffer-size > [
dup string-length out-buffer get buffer-extend do-write
dup length out-buffer get buffer-size > [
dup length out-buffer get buffer-extend do-write
] [ flush-output do-write ] ifte
] ifte ;
@ -103,7 +103,7 @@ M: string do-write ( str -- )
drop sbuf>string
] [
dup consume-input
dup string-length dup 0 = [
dup length dup 0 = [
3drop sbuf>string-or-f
] [
>r swap r> - >r swap [ sbuf-append ] keep r> do-read-count
@ -114,7 +114,7 @@ M: string do-write ( str -- )
1 in-buffer get buffer-first-n ;
: do-read-line ( sbuf -- str )
1 consume-input dup string-length 0 = [ drop sbuf>string-or-f ] [
1 consume-input dup length 0 = [ drop sbuf>string-or-f ] [
dup "\r" = [
peek-input "\n" = [ 1 consume-input drop ] when
drop sbuf>string