91 lines
2.3 KiB
Factor
91 lines
2.3 KiB
Factor
! Copyright (C) 2005, 2010 Slava Pestov.
|
|
! Copyright (C) 2008 Eduardo Cavazos.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors alien.c-types alien.syntax byte-vectors
|
|
classes.struct combinators.short-circuit combinators.smart
|
|
generalizations kernel libc locals math sequences
|
|
sequences.generalizations strings system unix.ffi vocabs.loader
|
|
;
|
|
IN: unix
|
|
|
|
ERROR: unix-system-call-error args errno message word ;
|
|
|
|
: unix-call-failed? ( ret -- ? )
|
|
{
|
|
[ { [ integer? ] [ 0 < ] } 1&& ]
|
|
[ not ]
|
|
} 1|| ;
|
|
|
|
MACRO:: unix-system-call ( quot -- quot )
|
|
quot inputs :> n
|
|
quot first :> word
|
|
0 :> ret!
|
|
f :> failed!
|
|
[
|
|
[
|
|
n ndup quot call ret!
|
|
ret {
|
|
[ unix-call-failed? dup failed! ]
|
|
[ drop errno EINTR = ]
|
|
} 1&&
|
|
] loop
|
|
failed [
|
|
n narray
|
|
errno dup strerror
|
|
word throw-unix-system-call-error
|
|
] [
|
|
n ndrop
|
|
ret
|
|
] if
|
|
] ;
|
|
|
|
MACRO:: unix-system-call-allow-eintr ( quot -- quot )
|
|
quot inputs :> n
|
|
quot first :> word
|
|
0 :> ret!
|
|
[
|
|
n ndup quot call ret!
|
|
ret unix-call-failed? [
|
|
! Bug #908
|
|
! Allow EINTR for close(2)
|
|
errno EINTR = [
|
|
n narray
|
|
errno dup strerror
|
|
word throw-unix-system-call-error
|
|
] unless
|
|
] [
|
|
n ndrop
|
|
ret
|
|
] if
|
|
] ;
|
|
|
|
HOOK: open-file os ( path flags mode -- fd )
|
|
|
|
: close-file ( fd -- ) [ close ] unix-system-call-allow-eintr drop ;
|
|
|
|
FUNCTION: int _exit ( int status )
|
|
|
|
M: unix open-file [ open ] unix-system-call ;
|
|
|
|
: make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
|
|
|
|
: truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
|
|
|
|
: touch ( filename -- ) f [ utime ] unix-system-call drop ;
|
|
|
|
: change-file-times ( filename access modification -- )
|
|
utimbuf <struct>
|
|
swap >>modtime
|
|
swap >>actime
|
|
[ utime ] unix-system-call drop ;
|
|
|
|
: read-symbolic-link ( path -- path )
|
|
PATH_MAX <byte-vector> [
|
|
underlying>> PATH_MAX
|
|
[ readlink ] unix-system-call
|
|
] keep swap >>length >string ;
|
|
|
|
: unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
|
|
|
|
{ "unix" "debugger" } "unix.debugger" require-when
|