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 HOOK: open-file os ( path flags mode -- fd )
  44
  45 : close-file ( fd -- ) [ close ] unix-system-call drop ;
  46
  47 FUNCTION: int _exit ( int status ) ;
  48
  49 M: unix open-file [ open ] unix-system-call ;
  50
  51 : make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
  52
  53 : truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
  54
  55 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
  56
  57 : change-file-times ( filename access modification -- )
  58     utimbuf <struct>
  59         swap >>modtime
  60         swap >>actime
  61         [ utime ] unix-system-call drop ;
  62
  63 : read-symbolic-link ( path -- path )
  64     PATH_MAX <byte-vector> [
  65         underlying>> PATH_MAX
  66         [ readlink ] unix-system-call
  67     ] keep swap >>length >string ;
  68
  69 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
  70
  71 <<
  72
  73 { "unix" "debugger" } "unix.debugger" require-when
  74
  75 >>