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

comitting initial unix I/O rewrite work

cvs
Slava Pestov 2005-03-30 00:58:22 +00:00
parent 7e1ca7fb9e
commit 6ac4c9900f
4 changed files with 139 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,6 +22,7 @@ t [
"/library/in-thread.factor"
"/library/random.factor"
"/library/io/buffer.factor"
"/library/io/network.factor"
"/library/io/logging.factor"
"/library/io/stdio-binary.factor"
@ -102,7 +103,6 @@ t [
] pull-in
os "win32" = [
"/library/io/buffer.factor"
"/library/win32/win32-io.factor"
"/library/win32/win32-errors.factor"
"/library/win32/winsock.factor"

31
library/unix/files.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: files
USING: alien kernel math namespaces ;
: cd ( dir -- )
"void" "libc" "chdir" [ "char*" ] alien-invoke ;
: stat ( path -- [ dir? mode size mtime ] )
<stat> tuck sys-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 )
sys-opendir [
[
[ dirent-name , ] [ dup sys-readdir null>f ] while
] make-list swap sys-closedir
] [
[ ]
] ifte* ;
: cwd ( -- str )
<string-box> dup 255 sys-getcwd io-error string-box-value ;

15
library/unix/io.factor Normal file
View File

@ -0,0 +1,15 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: io-internals
USING: errors kernel math ;
: file-mode OCT: 0600 ;
: io-error ( n -- ) 0 < [ errno strerror throw ] when ;
: open-read ( path -- fd )
O_RDONLY file-mode sys-open dup io-error ;
: open-write ( path -- fd )
O_WRONLY O_CREAT bitor O_TRUNC bitor file-mode sys-open
dup io-error ;

92
library/unix/syscalls.factor Normal file
View File

@ -0,0 +1,92 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: io-internals
USING: alien errors kernel math namespaces ;
ALIAS: ulonglong off_t
ALIAS: long ssize_t
ALIAS: ulong size_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
: sys-stat ( path stat -- n )
"int" "libc" "stat" [ "char*" "stat*" ] alien-invoke ;
: sys-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
: sys-readdir ( dir* -- dirent* )
"dirent*" "libc" "readdir" [ "void*" ] alien-invoke ;
: sys-closedir ( dir* -- )
"void" "libc" "closedir" [ "void*" ] alien-invoke ;
BEGIN-STRUCT: string-box
FIELD: uchar256 value
END-STRUCT
: errno ( -- n )
"int" "libc" "errno" alien-global ;
: strerror ( n -- str )
"char*" "libc" "strerror" [ "int" ] alien-invoke ;
: sys-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 ;
: sys-open ( path flags prot -- fd )
"int" "libc" "open" [ "char*" "int" "int" ] alien-invoke ;
: sys-close ( fd -- )
"void" "libc" "close" [ "int" ] alien-invoke ;
: sys-read ( fd buf nbytes -- n )
"ssize_t" "libc" "read" [ "int" "void*" "size_t" ] alien-invoke ;
: sys-write ( fd buf nbytes -- n )
"ssize_t" "libc" "write" [ "int" "void*" "size_t" ] alien-invoke ;
: MSG_OOB HEX: 1 ;
: sys-recv ( fd buf nbytes flags -- )
"ssize_t" "libc" "read" [ "int" "void*" "size_t" "int" ] alien-invoke ;