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 alien.c-types alien.libraries
   5 alien.syntax byte-arrays classes.struct combinators
   6 combinators.short-circuit combinators.smart continuations
   7 generalizations io kernel libc locals macros math namespaces
   8 sequences stack-checker strings system unix.time unix.types
   9 vocabs vocabs.loader unix.ffi ;
  10 IN: unix
  11
  12 ERROR: unix-error errno message ;
  13
  14 : (io-error) ( -- * ) errno dup strerror unix-error ;
  15
  16 : io-error ( n -- ) 0 < [ (io-error) ] when ;
  17
  18 ERROR: unix-system-call-error args errno message word ;
  19
  20 : unix-call-failed? ( ret -- ? )
  21     {
  22         [ { [ integer? ] [ 0 < ] } 1&& ]
  23         [ not ]
  24     } 1|| ;
  25
  26 MACRO:: unix-system-call ( quot -- )
  27     quot inputs :> n
  28     quot first :> word
  29     0 :> ret!
  30     f :> failed!
  31     [
  32         [
  33             n ndup quot call ret!
  34             ret {
  35                 [ unix-call-failed? dup failed! ]
  36                 [ drop errno EINTR = ]
  37             } 1&&
  38         ] loop
  39         failed [
  40             n narray
  41             errno dup strerror
  42             word unix-system-call-error
  43         ] [
  44             n ndrop
  45             ret
  46         ] if
  47     ] ;
  48
  49 HOOK: open-file os ( path flags mode -- fd )
  50
  51 : close-file ( fd -- ) [ close ] unix-system-call drop ;
  52
  53 FUNCTION: int _exit ( int status ) ;
  54
  55 M: unix open-file [ open ] unix-system-call ;
  56
  57 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
  58
  59 : change-file-times ( filename access modification -- )
  60     utimbuf <struct>
  61         swap >>modtime
  62         swap >>actime
  63         [ utime ] unix-system-call drop ;
  64
  65 : read-symbolic-link ( path -- path )
  66     PATH_MAX <byte-array> dup [
  67         PATH_MAX
  68         [ readlink ] unix-system-call
  69     ] dip swap head-slice >string ;
  70
  71 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
  72
  73 <<
  74
  75 { "unix" "debugger" } "unix.debugger" require-when
  76
  77 >>