2010-01-14 10:10:13 -05:00
|
|
|
! Copyright (C) 2005, 2010 Slava Pestov.
|
2009-01-18 18:28:36 -05:00
|
|
|
! Copyright (C) 2008 Eduardo Cavazos.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2010-01-19 17:53:15 -05:00
|
|
|
USING: accessors alien alien.c-types alien.libraries
|
2013-03-29 14:36:13 -04:00
|
|
|
alien.syntax byte-vectors classes.struct combinators
|
2010-01-19 17:53:15 -05:00
|
|
|
combinators.short-circuit combinators.smart continuations
|
|
|
|
generalizations io kernel libc locals macros math namespaces
|
2010-05-18 18:36:47 -04:00
|
|
|
sequences sequences.generalizations stack-checker strings system
|
|
|
|
unix.time unix.types vocabs vocabs.loader unix.ffi ;
|
2008-02-28 13:46:01 -05:00
|
|
|
IN: unix
|
2008-02-26 21:59:46 -05:00
|
|
|
|
2008-05-21 16:54:02 -04:00
|
|
|
ERROR: unix-system-call-error args errno message word ;
|
|
|
|
|
2010-01-19 17:53:15 -05:00
|
|
|
: unix-call-failed? ( ret -- ? )
|
|
|
|
{
|
|
|
|
[ { [ integer? ] [ 0 < ] } 1&& ]
|
|
|
|
[ not ]
|
|
|
|
} 1|| ;
|
|
|
|
|
2008-05-14 01:44:27 -04:00
|
|
|
MACRO:: unix-system-call ( quot -- )
|
2010-01-14 10:10:13 -05:00
|
|
|
quot inputs :> n
|
2009-10-27 22:50:31 -04:00
|
|
|
quot first :> word
|
2010-01-19 17:53:15 -05:00
|
|
|
0 :> ret!
|
|
|
|
f :> failed!
|
2009-10-27 22:50:31 -04:00
|
|
|
[
|
2010-01-19 17:53:15 -05:00
|
|
|
[
|
|
|
|
n ndup quot call ret!
|
|
|
|
ret {
|
|
|
|
[ unix-call-failed? dup failed! ]
|
|
|
|
[ drop errno EINTR = ]
|
|
|
|
} 1&&
|
|
|
|
] loop
|
|
|
|
failed [
|
2009-10-27 22:50:31 -04:00
|
|
|
n narray
|
|
|
|
errno dup strerror
|
|
|
|
word unix-system-call-error
|
|
|
|
] [
|
2010-01-19 17:53:15 -05:00
|
|
|
n ndrop
|
|
|
|
ret
|
2009-10-27 22:50:31 -04:00
|
|
|
] if
|
2008-05-14 01:44:27 -04:00
|
|
|
] ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-09-27 23:16:07 -04:00
|
|
|
HOOK: open-file os ( path flags mode -- fd )
|
|
|
|
|
2008-05-13 23:59:42 -04:00
|
|
|
: close-file ( fd -- ) [ close ] unix-system-call drop ;
|
|
|
|
|
2010-04-15 01:04:04 -04:00
|
|
|
FUNCTION: int _exit ( int status ) ;
|
2008-05-12 18:11:40 -04:00
|
|
|
|
2009-05-07 17:41:37 -04:00
|
|
|
M: unix open-file [ open ] unix-system-call ;
|
2008-10-19 14:09:48 -04:00
|
|
|
|
2012-10-24 23:08:32 -04:00
|
|
|
: make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
|
|
|
|
|
2012-10-26 00:51:08 -04:00
|
|
|
: truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
|
|
|
|
|
2008-05-12 18:11:40 -04:00
|
|
|
: touch ( filename -- ) f [ utime ] unix-system-call drop ;
|
2008-05-08 07:13:14 -04:00
|
|
|
|
2008-05-12 18:11:40 -04:00
|
|
|
: change-file-times ( filename access modification -- )
|
2009-08-31 00:07:46 -04:00
|
|
|
utimbuf <struct>
|
|
|
|
swap >>modtime
|
|
|
|
swap >>actime
|
|
|
|
[ utime ] unix-system-call drop ;
|
2008-05-09 17:24:17 -04:00
|
|
|
|
2008-05-13 19:28:43 -04:00
|
|
|
: read-symbolic-link ( path -- path )
|
2013-03-29 14:36:13 -04:00
|
|
|
PATH_MAX <byte-vector> [
|
|
|
|
underlying>> PATH_MAX
|
2008-11-29 21:19:40 -05:00
|
|
|
[ readlink ] unix-system-call
|
2013-03-29 14:36:13 -04:00
|
|
|
] keep swap >>length >string ;
|
2008-05-13 19:28:43 -04:00
|
|
|
|
2008-05-13 20:05:12 -04:00
|
|
|
: unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
|
2008-05-13 19:40:09 -04:00
|
|
|
|
2010-01-20 23:42:07 -05:00
|
|
|
<<
|
2007-11-04 14:42:18 -05:00
|
|
|
|
2010-04-18 15:29:24 -04:00
|
|
|
{ "unix" "debugger" } "unix.debugger" require-when
|
2007-12-28 21:46:06 -05:00
|
|
|
|
2010-01-20 23:42:07 -05:00
|
|
|
>>
|