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 : _exit ( status -- * )
  54     #! We throw to give this a terminating stack effect.
  55     int f "_exit" { int } alien-invoke "Exit failed" throw ;
  56
  57 M: unix open-file [ open ] unix-system-call ;
  58
  59 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
  60
  61 : change-file-times ( filename access modification -- )
  62     utimbuf <struct>
  63         swap >>modtime
  64         swap >>actime
  65         [ utime ] unix-system-call drop ;
  66
  67 : read-symbolic-link ( path -- path )
  68     PATH_MAX <byte-array> dup [
  69         PATH_MAX
  70         [ readlink ] unix-system-call
  71     ] dip swap head-slice >string ;
  72
  73 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
  74
  75 <<
  76
  77 "debugger" vocab [
  78     "unix.debugger" require
  79 ] when
  80
  81 >>