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 <<
  13
  14 ERROR: unix-error errno message ;
  15
  16 : (io-error) ( -- * ) errno dup strerror unix-error ;
  17
  18 : io-error ( n -- ) 0 < [ (io-error) ] when ;
  19
  20 ERROR: unix-system-call-error args errno message word ;
  21
  22 : unix-call-failed? ( ret -- ? )
  23     {
  24         [ { [ integer? ] [ 0 < ] } 1&& ]
  25         [ not ]
  26     } 1|| ;
  27
  28 MACRO:: unix-system-call ( quot -- )
  29     quot inputs :> n
  30     quot first :> word
  31     0 :> ret!
  32     f :> failed!
  33     [
  34         [
  35             n ndup quot call ret!
  36             ret {
  37                 [ unix-call-failed? dup failed! ]
  38                 [ drop errno EINTR = ]
  39             } 1&&
  40         ] loop
  41         failed [
  42             n narray
  43             errno dup strerror
  44             word unix-system-call-error
  45         ] [
  46             n ndrop
  47             ret
  48         ] if
  49     ] ;
  50
  51 >>
  52
  53 HOOK: open-file os ( path flags mode -- fd )
  54
  55 : close-file ( fd -- ) [ close ] unix-system-call drop ;
  56
  57 : _exit ( status -- * )
  58     #! We throw to give this a terminating stack effect.
  59     int f "_exit" { int } alien-invoke "Exit failed" throw ;
  60
  61 M: unix open-file [ open ] unix-system-call ;
  62
  63 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
  64
  65 : change-file-times ( filename access modification -- )
  66     utimbuf <struct>
  67         swap >>modtime
  68         swap >>actime
  69         [ utime ] unix-system-call drop ;
  70
  71 : read-symbolic-link ( path -- path )
  72     PATH_MAX <byte-array> dup [
  73         PATH_MAX
  74         [ readlink ] unix-system-call
  75     ] dip swap head-slice >string ;
  76
  77 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
  78
  79 "debugger" vocab [
  80     "unix.debugger" require
  81 ] when