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-vectors
   5 classes.struct combinators.short-circuit combinators.smart
   6 generalizations kernel libc locals math sequences
   7 sequences.generalizations strings system unix.ffi vocabs.loader
   8 ;
   9 IN: unix
  10
  11 ERROR: unix-system-call-error args errno message word ;
  12
  13 : unix-call-failed? ( ret -- ? )
  14     {
  15         [ { [ integer? ] [ 0 < ] } 1&& ]
  16         [ not ]
  17     } 1|| ;
  18
  19 MACRO:: unix-system-call ( quot -- quot )
  20     quot inputs :> n
  21     quot first :> word
  22     0 :> ret!
  23     f :> failed!
  24     [
  25         [
  26             n ndup quot call ret!
  27             ret {
  28                 [ unix-call-failed? dup failed! ]
  29                 [ drop errno EINTR = ]
  30             } 1&&
  31         ] loop
  32         failed [
  33             n narray
  34             errno dup strerror
  35             word throw-unix-system-call-error
  36         ] [
  37             n ndrop
  38             ret
  39         ] if
  40     ] ;
  41
  42 MACRO:: unix-system-call-allow-eintr ( quot -- quot )
  43     quot inputs :> n
  44     quot first :> word
  45     0 :> ret!
  46     [
  47         n ndup quot call ret!
  48         ret unix-call-failed? [
  49             ! Bug #908
  50             ! Allow EINTR for close(2)
  51             errno EINTR = [
  52                 n narray
  53                 errno dup strerror
  54                 word throw-unix-system-call-error
  55             ] unless
  56         ] [
  57             n ndrop
  58             ret
  59         ] if
  60     ] ;
  61
  62 HOOK: open-file os ( path flags mode -- fd )
  63
  64 : close-file ( fd -- ) [ close ] unix-system-call-allow-eintr drop ;
  65
  66 FUNCTION: int _exit ( int status )
  67
  68 M: unix open-file [ open ] unix-system-call ;
  69
  70 : make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
  71
  72 : truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
  73
  74 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
  75
  76 : change-file-times ( filename access modification -- )
  77     utimbuf <struct>
  78         swap >>modtime
  79         swap >>actime
  80         [ utime ] unix-system-call drop ;
  81
  82 : read-symbolic-link ( path -- path )
  83     PATH_MAX <byte-vector> [
  84         underlying>> PATH_MAX
  85         [ readlink ] unix-system-call
  86     ] keep swap >>length >string ;
  87
  88 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
  89
  90 { "unix" "debugger" } "unix.debugger" require-when