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