basis/unix/unix.factor

   1 ! Copyright (C) 2005, 2010 Slava Pestov.
   2 ! Copyright (C) 2008 Eduardo Cavazos.
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 USING: accessors alien.c-types alien.syntax byte-arrays
   5 combinators.short-circuit combinators.smart generalizations kernel
   6 libc math sequences sequences.generalizations strings system
   7 unix.ffi vocabs.loader ;
   8 IN: unix
   9
  10 ERROR: unix-system-call-error args errno message word ;
  11
  12 : unix-call-failed? ( ret -- ? )
  13     {
  14         [ { [ integer? ] [ 0 < ] } 1&& ]
  15         [ not ]
  16     } 1|| ;
  17
  18 MACRO:: unix-system-call ( quot -- quot )
  19     quot inputs :> n
  20     quot first :> word
  21     0 :> ret!
  22     f :> failed!
  23     [
  24         [
  25             n ndup quot call ret!
  26             ret {
  27                 [ unix-call-failed? dup failed! ]
  28                 [ drop errno EINTR = ]
  29             } 1&&
  30         ] loop
  31         failed [
  32             n narray
  33             errno dup strerror
  34             word unix-system-call-error
  35         ] [
  36             n ndrop
  37             ret
  38         ] if
  39     ] ;
  40
  41 MACRO:: unix-system-call-allow-eintr ( quot -- quot )
  42     quot inputs :> n
  43     quot first :> word
  44     0 :> ret!
  45     [
  46         n ndup quot call ret!
  47         ret unix-call-failed? [
  48             ! Bug #908
  49             ! Allow EINTR for close(2)
  50             errno EINTR = [
  51                 n narray
  52                 errno dup strerror
  53                 word unix-system-call-error
  54             ] unless
  55         ] [
  56             n ndrop
  57             ret
  58         ] if
  59     ] ;
  60
  61 HOOK: open-file os ( path flags mode -- fd )
  62
  63 : close-file ( fd -- ) [ close ] unix-system-call-allow-eintr drop ;
  64
  65 FUNCTION: int _exit ( int status )
  66
  67 M: unix open-file [ open ] unix-system-call ;
  68
  69 : make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
  70
  71 : truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
  72
  73 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
  74
  75 : change-file-times ( filename access modification -- )
  76     utimbuf new
  77         swap >>modtime
  78         swap >>actime
  79         [ utime ] unix-system-call drop ;
  80
  81 : (read-symbolic-link) ( path bufsiz -- path' )
  82     dup <byte-array> 3dup swap [ readlink ] unix-system-call
  83     pick dupd < [ head >string 2nip ] [
  84         2nip 2 * (read-symbolic-link)
  85     ] if ;
  86
  87 : read-symbolic-link ( path -- path )
  88     4096 (read-symbolic-link) ;
  89
  90 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
  91
  92 { "unix" "debugger" } "unix.debugger" require-when