X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Funix%2Funix.factor;h=2d09096451db447bb591a23b054cbf03a57afda0;hp=101736ea1f76681775989406def1f41ef4d500b4;hb=1542ebe47c58f140e5929772ad71f5d2ad46ec51;hpb=30cfbc85124e17a2d502e49b9bd4d0caf18cf8bb

diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index 101736ea1f..2d09096451 100644
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -1,20 +1,12 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! Copyright (C) 2008 Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.libraries
-alien.syntax byte-arrays classes.struct combinators
-combinators.short-circuit combinators.smart continuations
-generalizations io kernel libc locals macros math namespaces
-sequences sequences.generalizations stack-checker strings system
-unix.time unix.types vocabs vocabs.loader unix.ffi ;
+USING: accessors alien.c-types alien.syntax byte-arrays
+combinators.short-circuit combinators.smart generalizations kernel
+libc math sequences sequences.generalizations strings system
+unix.ffi vocabs.loader ;
 IN: unix
 
-ERROR: unix-error errno message ;
-
-: (io-error) ( -- * ) errno dup strerror unix-error ;
-
-: io-error ( n -- ) 0 < [ (io-error) ] when ;
-
 ERROR: unix-system-call-error args errno message word ;
 
 : unix-call-failed? ( ret -- ? )
@@ -23,7 +15,7 @@ ERROR: unix-system-call-error args errno message word ;
         [ not ]
     } 1|| ;
 
-MACRO:: unix-system-call ( quot -- )
+MACRO:: unix-system-call ( quot -- quot )
     quot inputs :> n
     quot first :> word
     0 :> ret!
@@ -46,32 +38,55 @@ MACRO:: unix-system-call ( quot -- )
         ] if
     ] ;
 
+MACRO:: unix-system-call-allow-eintr ( quot -- quot )
+    quot inputs :> n
+    quot first :> word
+    0 :> ret!
+    [
+        n ndup quot call ret!
+        ret unix-call-failed? [
+            ! Bug #908
+            ! Allow EINTR for close(2)
+            errno EINTR = [
+                n narray
+                errno dup strerror
+                word unix-system-call-error
+            ] unless
+        ] [
+            n ndrop
+            ret
+        ] if
+    ] ;
+
 HOOK: open-file os ( path flags mode -- fd )
 
-: close-file ( fd -- ) [ close ] unix-system-call drop ;
+: close-file ( fd -- ) [ close ] unix-system-call-allow-eintr drop ;
 
-FUNCTION: int _exit ( int status ) ;
+FUNCTION: int _exit ( int status )
 
 M: unix open-file [ open ] unix-system-call ;
 
+: make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
+
+: truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
+
 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
 
 : change-file-times ( filename access modification -- )
-    utimbuf <struct>
+    utimbuf new
         swap >>modtime
         swap >>actime
         [ utime ] unix-system-call drop ;
 
+: (read-symbolic-link) ( path bufsiz -- path' )
+    dup <byte-array> 3dup swap [ readlink ] unix-system-call
+    pick dupd < [ head >string 2nip ] [
+        2nip 2 * (read-symbolic-link)
+    ] if ;
+
 : read-symbolic-link ( path -- path )
-    PATH_MAX <byte-array> dup [
-        PATH_MAX
-        [ readlink ] unix-system-call
-    ] dip swap head-slice >string ;
+    4096 (read-symbolic-link) ;
 
 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
 
-<<
-
 { "unix" "debugger" } "unix.debugger" require-when
-
->>