Merge branch 'master' of git://factorcode.org/git/factor
						commit
						c32d648c8d
					
				| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
! Copyright (C) 2004, 2008 Slava Pestov.
 | 
					! Copyright (C) 2004, 2008 Slava Pestov.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: alien generic assocs kernel kernel.private math
 | 
					USING: alien generic assocs kernel kernel.private math
 | 
				
			||||||
io.nonblocking sequences strings structs sbufs threads unix.ffi unix
 | 
					io.nonblocking sequences strings structs sbufs threads unix
 | 
				
			||||||
vectors io.buffers io.backend io.encodings math.parser
 | 
					vectors io.buffers io.backend io.encodings math.parser
 | 
				
			||||||
continuations system libc qualified namespaces io.timeouts
 | 
					continuations system libc qualified namespaces io.timeouts
 | 
				
			||||||
io.encodings.utf8 accessors ;
 | 
					io.encodings.utf8 accessors ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -45,7 +45,7 @@ M: unix (file-appender) ( path -- stream )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: unix touch-file ( path -- )
 | 
					M: unix touch-file ( path -- )
 | 
				
			||||||
    normalize-path
 | 
					    normalize-path
 | 
				
			||||||
    dup exists? [ f utime ] [
 | 
					    dup exists? [ touch ] [
 | 
				
			||||||
        touch-mode file-mode open close
 | 
					        touch-mode file-mode open close
 | 
				
			||||||
    ] if ;
 | 
					    ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -3,7 +3,7 @@
 | 
				
			||||||
USING: alien.c-types kernel math math.bitfields namespaces
 | 
					USING: alien.c-types kernel math math.bitfields namespaces
 | 
				
			||||||
locals accessors combinators threads vectors hashtables
 | 
					locals accessors combinators threads vectors hashtables
 | 
				
			||||||
sequences assocs continuations sets
 | 
					sequences assocs continuations sets
 | 
				
			||||||
unix.ffi unix unix.time unix.kqueue unix.process
 | 
					unix unix.time unix.kqueue unix.process
 | 
				
			||||||
io.nonblocking io.unix.backend io.launcher io.unix.launcher
 | 
					io.nonblocking io.unix.backend io.launcher io.unix.launcher
 | 
				
			||||||
io.monitors ;
 | 
					io.monitors ;
 | 
				
			||||||
IN: io.unix.kqueue
 | 
					IN: io.unix.kqueue
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -5,7 +5,7 @@ namespaces threads sequences byte-arrays io.nonblocking
 | 
				
			||||||
io.binary io.unix.backend io.streams.duplex io.sockets.impl
 | 
					io.binary io.unix.backend io.streams.duplex io.sockets.impl
 | 
				
			||||||
io.backend io.files io.files.private io.encodings.utf8
 | 
					io.backend io.files io.files.private io.encodings.utf8
 | 
				
			||||||
math.parser continuations libc combinators system accessors
 | 
					math.parser continuations libc combinators system accessors
 | 
				
			||||||
qualified unix.ffi unix ;
 | 
					qualified unix ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
EXCLUDE: io => read write close ;
 | 
					EXCLUDE: io => read write close ;
 | 
				
			||||||
EXCLUDE: io.sockets => accept ;
 | 
					EXCLUDE: io.sockets => accept ;
 | 
				
			||||||
| 
						 | 
					@ -67,7 +67,7 @@ TUPLE: accept-task < input-task ;
 | 
				
			||||||
    accept-task <io-task> ;
 | 
					    accept-task <io-task> ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: accept-sockaddr ( port -- fd sockaddr )
 | 
					: accept-sockaddr ( port -- fd sockaddr )
 | 
				
			||||||
    dup port-handle swap server-port-addr sockaddr-type
 | 
					    [ handle>> ] [ addr>> sockaddr-type ] bi
 | 
				
			||||||
    dup <c-object> [ swap heap-size <int> accept ] keep ; inline
 | 
					    dup <c-object> [ swap heap-size <int> accept ] keep ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: do-accept ( port fd sockaddr -- )
 | 
					: do-accept ( port fd sockaddr -- )
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,15 +0,0 @@
 | 
				
			||||||
 | 
					 | 
				
			||||||
USING: alien.syntax ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
IN: unix.ffi
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
FUNCTION: int open ( char* path, int flags, int prot ) ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
C-STRUCT: utimbuf
 | 
					 | 
				
			||||||
    { "time_t" "actime"  }
 | 
					 | 
				
			||||||
    { "time_t" "modtime" } ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
FUNCTION: int utime ( char* path, utimebuf* buf ) ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
FUNCTION: int err_no ( ) ;
 | 
					 | 
				
			||||||
FUNCTION: char* strerror ( int errno ) ;
 | 
					 | 
				
			||||||
| 
						 | 
					@ -1,15 +0,0 @@
 | 
				
			||||||
 | 
					 | 
				
			||||||
USING: kernel continuations sequences math accessors inference macros
 | 
					 | 
				
			||||||
       fry arrays.lib unix.ffi ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
IN: unix.system-call
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
ERROR: unix-system-call-error word args message ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
MACRO: unix-system-call ( quot -- )
 | 
					 | 
				
			||||||
    [ ] [ infer in>> ] [ first ] tri
 | 
					 | 
				
			||||||
   '[
 | 
					 | 
				
			||||||
        [ @ dup 0 < [ dup throw ] [ ] if ]
 | 
					 | 
				
			||||||
        [ drop , narray , swap err_no strerror unix-system-call-error ]
 | 
					 | 
				
			||||||
        recover
 | 
					 | 
				
			||||||
    ] ;
 | 
					 | 
				
			||||||
| 
						 | 
					@ -1,11 +1,11 @@
 | 
				
			||||||
! Copyright (C) 2005, 2007 Slava Pestov.
 | 
					! Copyright (C) 2005, 2007 Slava Pestov.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
USING: alien alien.c-types alien.syntax kernel libc structs
 | 
					USING: alien alien.c-types alien.syntax kernel libc structs sequences
 | 
				
			||||||
 | 
					       continuations
 | 
				
			||||||
       math namespaces system combinators vocabs.loader qualified
 | 
					       math namespaces system combinators vocabs.loader qualified
 | 
				
			||||||
       unix.ffi unix.types unix.system-call ;
 | 
					       accessors inference macros fry arrays.lib 
 | 
				
			||||||
 | 
					       unix.types ;
 | 
				
			||||||
QUALIFIED: unix.ffi
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
IN: unix
 | 
					IN: unix
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -46,9 +46,22 @@ C-STRUCT: passwd
 | 
				
			||||||
    { "time_t" "pw_expire" }
 | 
					    { "time_t" "pw_expire" }
 | 
				
			||||||
    { "int"    "pw_fields" } ;
 | 
					    { "int"    "pw_fields" } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! ! ! Unix functions
 | 
					 | 
				
			||||||
LIBRARY: factor
 | 
					LIBRARY: factor
 | 
				
			||||||
 | 
					
 | 
				
			||||||
FUNCTION: void clear_err_no ( ) ;
 | 
					FUNCTION: void clear_err_no ( ) ;
 | 
				
			||||||
 | 
					FUNCTION: int err_no ( ) ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					ERROR: unix-system-call-error word args message ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					DEFER: strerror
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					MACRO: unix-system-call ( quot -- )
 | 
				
			||||||
 | 
					    [ ] [ infer in>> ] [ first ] tri
 | 
				
			||||||
 | 
					   '[
 | 
				
			||||||
 | 
					        [ @ dup 0 < [ dup throw ] [ ] if ]
 | 
				
			||||||
 | 
					        [ drop , narray , swap err_no strerror unix-system-call-error ]
 | 
				
			||||||
 | 
					        recover
 | 
				
			||||||
 | 
					    ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
LIBRARY: libc
 | 
					LIBRARY: libc
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -101,9 +114,23 @@ FUNCTION: int munmap ( void* addr, size_t len ) ;
 | 
				
			||||||
FUNCTION: uint ntohl ( uint n ) ;
 | 
					FUNCTION: uint ntohl ( uint n ) ;
 | 
				
			||||||
FUNCTION: ushort ntohs ( ushort n ) ;
 | 
					FUNCTION: ushort ntohs ( ushort n ) ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: open ( path flags prot -- int ) [ unix.ffi:open ] unix-system-call ;
 | 
					FUNCTION: int open ( char* path, int flags, int prot ) ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: utime ( path buf -- ) [ unix.ffi:utime ] unix-system-call drop ;
 | 
					: open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					C-STRUCT: utimbuf
 | 
				
			||||||
 | 
					    { "time_t" "actime"  }
 | 
				
			||||||
 | 
					    { "time_t" "modtime" } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					FUNCTION: int utime ( char* path, utimebuf* buf ) ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: touch ( filename -- ) f [ utime ] unix-system-call drop ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: change-file-times ( filename access modification -- )
 | 
				
			||||||
 | 
					    "utimebuf" <c-object>
 | 
				
			||||||
 | 
					    tuck set-utimbuf-modtime
 | 
				
			||||||
 | 
					    tuck set-utimbuf-actime
 | 
				
			||||||
 | 
					    [ utime ] unix-system-call drop ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
FUNCTION: int pclose ( void* file ) ;
 | 
					FUNCTION: int pclose ( void* file ) ;
 | 
				
			||||||
FUNCTION: int pipe ( int* filedes ) ;
 | 
					FUNCTION: int pipe ( int* filedes ) ;
 | 
				
			||||||
| 
						 | 
					@ -125,6 +152,7 @@ FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ;
 | 
				
			||||||
FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ;
 | 
					FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ;
 | 
				
			||||||
FUNCTION: int setuid ( uid_t uid ) ;
 | 
					FUNCTION: int setuid ( uid_t uid ) ;
 | 
				
			||||||
FUNCTION: int socket ( int domain, int type, int protocol ) ;
 | 
					FUNCTION: int socket ( int domain, int type, int protocol ) ;
 | 
				
			||||||
 | 
					FUNCTION: char* strerror ( int errno ) ;
 | 
				
			||||||
FUNCTION: int symlink ( char* path1, char* path2 ) ;
 | 
					FUNCTION: int symlink ( char* path1, char* path2 ) ;
 | 
				
			||||||
FUNCTION: int system ( char* command ) ;
 | 
					FUNCTION: int system ( char* command ) ;
 | 
				
			||||||
FUNCTION: int unlink ( char* path ) ;
 | 
					FUNCTION: int unlink ( char* path ) ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue