unix: Now I see, all too clearly, the error of my ways
							parent
							
								
									1b39855447
								
							
						
					
					
						commit
						3691aa72ec
					
				| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2004, 2008 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
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
 | 
			
		||||
continuations system libc qualified namespaces io.timeouts
 | 
			
		||||
io.encodings.utf8 accessors ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -45,7 +45,7 @@ M: unix (file-appender) ( path -- stream )
 | 
			
		|||
 | 
			
		||||
M: unix touch-file ( path -- )
 | 
			
		||||
    normalize-path
 | 
			
		||||
    dup exists? [ f utime ] [
 | 
			
		||||
    dup exists? [ touch ] [
 | 
			
		||||
        touch-mode file-mode open close
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
USING: alien.c-types kernel math math.bitfields namespaces
 | 
			
		||||
locals accessors combinators threads vectors hashtables
 | 
			
		||||
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.monitors ;
 | 
			
		||||
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.backend io.files io.files.private io.encodings.utf8
 | 
			
		||||
math.parser continuations libc combinators system accessors
 | 
			
		||||
qualified unix.ffi unix ;
 | 
			
		||||
qualified unix ;
 | 
			
		||||
 | 
			
		||||
EXCLUDE: io => read write close ;
 | 
			
		||||
EXCLUDE: io.sockets => accept ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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.
 | 
			
		||||
! 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
 | 
			
		||||
       unix.ffi unix.types unix.system-call ;
 | 
			
		||||
 | 
			
		||||
QUALIFIED: unix.ffi
 | 
			
		||||
       accessors inference macros fry arrays.lib 
 | 
			
		||||
       unix.types ;
 | 
			
		||||
 | 
			
		||||
IN: unix
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -46,9 +46,22 @@ C-STRUCT: passwd
 | 
			
		|||
    { "time_t" "pw_expire" }
 | 
			
		||||
    { "int"    "pw_fields" } ;
 | 
			
		||||
 | 
			
		||||
! ! ! Unix functions
 | 
			
		||||
LIBRARY: factor
 | 
			
		||||
 | 
			
		||||
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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -100,9 +113,23 @@ FUNCTION: int munmap ( void* addr, size_t len ) ;
 | 
			
		|||
FUNCTION: uint ntohl ( uint 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 pipe ( int* filedes ) ;
 | 
			
		||||
| 
						 | 
				
			
			@ -124,6 +151,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 setuid ( uid_t uid ) ;
 | 
			
		||||
FUNCTION: int socket ( int domain, int type, int protocol ) ;
 | 
			
		||||
FUNCTION: char* strerror ( int errno ) ;
 | 
			
		||||
FUNCTION: int symlink ( char* path1, char* path2 ) ;
 | 
			
		||||
FUNCTION: int system ( char* command ) ;
 | 
			
		||||
FUNCTION: int unlink ( char* path ) ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue