steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-05-10 15:40:20 -05:00
parent a9b4a69e00 2ef23e1fef
commit 1c7b9079a9
15 changed files with 194 additions and 181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
core/io/files/files-tests.factor
View File

@ -66,6 +66,9 @@ strings accessors io.encodings.utf8 math ;
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ "" ] [ "" file-name ] unit-test [ "" ] [ "" file-name ] unit-test
[ "freetype6.dll" ] [ "resource:freetype6.dll" file-name ] unit-test
[ "freetype6.dll" ] [ "resource:/freetype6.dll" file-name ] unit-test
[ ] [ [ ] [
{ "Hello world." } { "Hello world." }
"test-foo.txt" temp-file ascii set-file-lines "test-foo.txt" temp-file ascii set-file-lines

4
core/io/files/files.factor
View File

@ -142,7 +142,9 @@ PRIVATE>
: file-name ( path -- string ) : file-name ( path -- string )
dup root-directory? [ dup root-directory? [
right-trim-separators right-trim-separators
dup last-path-separator [ 1+ tail ] [ drop ] if dup last-path-separator [ 1+ tail ] [
drop "resource:" ?head [ file-name ] when
] if
] unless ; ] unless ;
! File info ! File info

2
extra/io/unix/backend/backend.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien generic assocs kernel kernel.private math USING: alien generic assocs kernel kernel.private math
io.nonblocking sequences strings structs sbufs threads unix io.nonblocking sequences strings structs sbufs threads unix.ffi unix
vectors io.buffers io.backend io.encodings math.parser vectors io.buffers io.backend io.encodings math.parser
continuations system libc qualified namespaces io.timeouts continuations system libc qualified namespaces io.timeouts
io.encodings.utf8 accessors ; io.encodings.utf8 accessors ;

2
extra/io/unix/kqueue/kqueue.factor Normal file → Executable file
View File

@ -3,7 +3,7 @@
USING: alien.c-types kernel math math.bitfields namespaces USING: alien.c-types kernel math math.bitfields namespaces
locals accessors combinators threads vectors hashtables locals accessors combinators threads vectors hashtables
sequences assocs continuations sets sequences assocs continuations sets
unix unix.time unix.kqueue unix.process unix.ffi unix unix.time unix.kqueue unix.process
io.nonblocking io.unix.backend io.launcher io.unix.launcher io.nonblocking io.unix.backend io.launcher io.unix.launcher
io.monitors ; io.monitors ;
IN: io.unix.kqueue IN: io.unix.kqueue

2
extra/io/unix/sockets/sockets.factor
View File

@ -5,7 +5,7 @@ namespaces threads sequences byte-arrays io.nonblocking
io.binary io.unix.backend io.streams.duplex io.sockets.impl io.binary io.unix.backend io.streams.duplex io.sockets.impl
io.backend io.files io.files.private io.encodings.utf8 io.backend io.files io.files.private io.encodings.utf8
math.parser continuations libc combinators system accessors math.parser continuations libc combinators system accessors
qualified unix ; qualified unix.ffi unix ;
EXCLUDE: io => read write close ; EXCLUDE: io => read write close ;
EXCLUDE: io.sockets => accept ; EXCLUDE: io.sockets => accept ;

60
extra/math/miller-rabin/miller-rabin.factor
View File

@ -3,21 +3,9 @@ math.functions math.ranges namespaces random sequences
hashtables sets ; hashtables sets ;
IN: math.miller-rabin IN: math.miller-rabin
SYMBOL: a : >even ( n -- int ) dup even? [ 1- ] unless ; foldable
SYMBOL: n : >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
SYMBOL: r : next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
SYMBOL: s
SYMBOL: count
SYMBOL: trials
: >even ( n -- int )
dup even? [ 1- ] unless ; foldable
: >odd ( n -- int )
dup even? [ 1+ ] when ; foldable
: next-odd ( m -- n )
dup even? [ 1+ ] [ 2 + ] if ;
TUPLE: positive-even-expected n ; TUPLE: positive-even-expected n ;
@ -28,34 +16,30 @@ TUPLE: positive-even-expected n ;
#! factor an integer into s * 2^r #! factor an integer into s * 2^r
0 swap (factor-2s) ; 0 swap (factor-2s) ;
:: (miller-rabin) ( n prime?! -- ? ) :: (miller-rabin) ( n trials -- ? )
n 1- factor-2s s set r set [let | r [ n 1- factor-2s drop ]
trials get [ s [ n 1- factor-2s nip ]
n 1- [1,b] random a set prime?! [ t ]
a get s get n ^mod 1 = [ a! [ 0 ]
0 count set count! [ 0 ] |
r get [ trials [
2^ s get * a get swap n ^mod n - -1 = [ n 1- [1,b] random a!
count [ 1+ ] change a s n ^mod 1 = [
r get + 0 count!
] when r [
2^ s * a swap n ^mod n - -1 =
[ count 1+ count! r + ] when
] each ] each
count get zero? [ count zero? [ f prime?! trials + ] when
f prime?! ] unless drop
trials get + ] each prime? ] ;
] when
] unless
drop
] each prime? ;
TUPLE: miller-rabin-bounds ;
: miller-rabin* ( n numtrials -- ? ) : miller-rabin* ( n numtrials -- ? )
over { over {
{ [ dup 1 <= ] [ 3drop f ] } { [ dup 1 <= ] [ 3drop f ] }
{ [ dup 2 = ] [ 3drop t ] } { [ dup 2 = ] [ 3drop t ] }
{ [ dup even? ] [ 3drop f ] } { [ dup even? ] [ 3drop f ] }
[ [ drop trials set t (miller-rabin) ] with-scope ] [ [ drop (miller-rabin) ] with-scope ]
} cond ; } cond ;
: miller-rabin ( n -- ? ) 10 miller-rabin* ; : miller-rabin ( n -- ? ) 10 miller-rabin* ;
@ -66,7 +50,11 @@ TUPLE: miller-rabin-bounds ;
: random-prime ( numbits -- p ) : random-prime ( numbits -- p )
random-bits next-prime ; random-bits next-prime ;
ERROR: no-relative-prime n ;
: (find-relative-prime) ( n guess -- p ) : (find-relative-prime) ( n guess -- p )
over 1 <= [ over no-relative-prime ] when
dup 1 <= [ drop 3 ] when
2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ; 2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
: find-relative-prime* ( n guess -- p ) : find-relative-prime* ( n guess -- p )

190
extra/tar/tar.factor
View File

@ -1,99 +1,92 @@
USING: combinators io io.files io.streams.string kernel math USING: combinators io io.files io.streams.string kernel math
math.parser continuations namespaces pack prettyprint sequences math.parser continuations namespaces pack prettyprint sequences
strings system hexdump io.encodings.binary inspector accessors ; strings system hexdump io.encodings.binary inspector accessors
io.backend symbols byte-arrays ;
IN: tar IN: tar
: zero-checksum 256 ; : zero-checksum 256 ; inline
: block-size 512 ; inline
TUPLE: tar-header name mode uid gid size mtime checksum typeflag TUPLE: tar-header name mode uid gid size mtime checksum typeflag
linkname magic version uname gname devmajor devminor prefix ; linkname magic version uname gname devmajor devminor prefix ;
ERROR: checksum-error ;
: <tar-header> ( -- obj ) tar-header new ; SYMBOLS: base-dir filename ;
: tar-trim ( seq -- newseq ) : tar-trim ( seq -- newseq ) [ "\0 " member? ] trim ;
[ "\0 " member? ] trim ;
: read-tar-header ( -- obj ) : read-tar-header ( -- obj )
<tar-header> \ tar-header new
100 read-c-string* over set-tar-header-name 100 read-c-string* >>name
8 read-c-string* tar-trim oct> over set-tar-header-mode 8 read-c-string* tar-trim oct> >>mode
8 read-c-string* tar-trim oct> over set-tar-header-uid 8 read-c-string* tar-trim oct> >>uid
8 read-c-string* tar-trim oct> over set-tar-header-gid 8 read-c-string* tar-trim oct> >>gid
12 read-c-string* tar-trim oct> over set-tar-header-size 12 read-c-string* tar-trim oct> >>size
12 read-c-string* tar-trim oct> over set-tar-header-mtime 12 read-c-string* tar-trim oct> >>mtime
8 read-c-string* tar-trim oct> over set-tar-header-checksum 8 read-c-string* tar-trim oct> >>checksum
read1 over set-tar-header-typeflag read1 >>typeflag
100 read-c-string* over set-tar-header-linkname 100 read-c-string* >>linkname
6 read over set-tar-header-magic 6 read >>magic
2 read over set-tar-header-version 2 read >>version
32 read-c-string* over set-tar-header-uname 32 read-c-string* >>uname
32 read-c-string* over set-tar-header-gname 32 read-c-string* >>gname
8 read tar-trim oct> over set-tar-header-devmajor 8 read tar-trim oct> >>devmajor
8 read tar-trim oct> over set-tar-header-devminor 8 read tar-trim oct> >>devminor
155 read-c-string* over set-tar-header-prefix ; 155 read-c-string* >>prefix ;
: header-checksum ( seq -- x ) : header-checksum ( seq -- x )
148 cut-slice 8 tail-slice 148 cut-slice 8 tail-slice
[ sum ] bi@ + 256 + ; [ sum ] bi@ + 256 + ;
TUPLE: checksum-error ; : read-data-blocks ( tar-header -- )
TUPLE: malformed-block-error ; dup size>> 0 > [
block-size read [
SYMBOL: base-dir over size>> dup block-size <= [
SYMBOL: out-stream head-slice >byte-array write drop
SYMBOL: filename
: (read-data-blocks) ( tar-header -- )
512 read [
over tar-header-size dup 512 <= [
head-slice
>string write
drop
] [ ] [
drop drop write
>string write [ block-size - ] change-size
dup tar-header-size 512 - over set-tar-header-size read-data-blocks
(read-data-blocks)
] if ] if
] [ ] [
drop drop
] if* ; ] if*
] [
: read-data-blocks ( tar-header out -- ) drop
[ (read-data-blocks) ] with-output-stream* ; ] if ;
: parse-tar-header ( seq -- obj ) : parse-tar-header ( seq -- obj )
[ header-checksum ] keep over zero-checksum = [ [ header-checksum ] keep over zero-checksum = [
2drop 2drop
\ tar-header new \ tar-header new
0 over set-tar-header-size 0 >>size
0 over set-tar-header-checksum 0 >>checksum
] [ ] [
[ read-tar-header ] with-string-reader [ read-tar-header ] with-string-reader
[ tar-header-checksum = [ [ checksum>> = [ checksum-error ] unless ] keep
\ checksum-error new throw
] unless
] keep
] if ; ] if ;
ERROR: unknown-typeflag ch ; ERROR: unknown-typeflag ch ;
M: unknown-typeflag summary ( obj -- str ) M: unknown-typeflag summary ( obj -- str )
ch>> 1string ch>> 1string "Unknown typeflag: " prepend ;
"Unknown typeflag: " prepend ;
: tar-append-path ( path -- newpath ) : tar-prepend-path ( path -- newpath )
base-dir get prepend-path ; base-dir get prepend-path ;
: read/write-blocks ( tar-header path -- )
binary [ read-data-blocks ] with-file-writer ;
! Normal file ! Normal file
: typeflag-0 : typeflag-0 ( header -- )
name>> tar-append-path binary <file-writer> dup name>> tar-prepend-path read/write-blocks ;
[ read-data-blocks ] keep dispose ;
! Hard link ! Hard link
: typeflag-1 ( header -- ) unknown-typeflag ; : typeflag-1 ( header -- ) unknown-typeflag ;
! Symlink ! Symlink
: typeflag-2 ( header -- ) unknown-typeflag ; : typeflag-2 ( header -- )
[ name>> ] [ linkname>> ] bi
[ make-link ] 2curry ignore-errors ;
! character special ! character special
: typeflag-3 ( header -- ) unknown-typeflag ; : typeflag-3 ( header -- ) unknown-typeflag ;
@ -103,7 +96,7 @@ M: unknown-typeflag summary ( obj -- str )
! Directory ! Directory
: typeflag-5 ( header -- ) : typeflag-5 ( header -- )
tar-header-name tar-append-path make-directories ; name>> tar-prepend-path make-directories ;
! FIFO ! FIFO
: typeflag-6 ( header -- ) unknown-typeflag ; : typeflag-6 ( header -- ) unknown-typeflag ;
@ -118,7 +111,7 @@ M: unknown-typeflag summary ( obj -- str )
: typeflag-9 ( header -- ) unknown-typeflag ; : typeflag-9 ( header -- ) unknown-typeflag ;
! Global POSIX header ! Global POSIX header
: typeflag-g ( header -- ) unknown-typeflag ; : typeflag-g ( header -- ) typeflag-0 ;
! Extended POSIX header ! Extended POSIX header
: typeflag-x ( header -- ) unknown-typeflag ; : typeflag-x ( header -- ) unknown-typeflag ;
@ -140,10 +133,10 @@ M: unknown-typeflag summary ( obj -- str )
! Long file name ! Long file name
: typeflag-L ( header -- ) : typeflag-L ( header -- )
<string-writer> [ read-data-blocks ] keep drop ;
>string [ zero? ] right-trim filename set ! <string-writer> [ read-data-blocks ] keep
global [ "long filename: " write filename get . flush ] bind ! >string [ zero? ] right-trim filename set
filename get tar-append-path make-directories ; ! filename get tar-prepend-path make-directories ;
! Multi volume continuation entry ! Multi volume continuation entry
: typeflag-M ( header -- ) unknown-typeflag ; : typeflag-M ( header -- ) unknown-typeflag ;
@ -161,56 +154,39 @@ M: unknown-typeflag summary ( obj -- str )
: typeflag-X ( header -- ) unknown-typeflag ; : typeflag-X ( header -- ) unknown-typeflag ;
: (parse-tar) ( -- ) : (parse-tar) ( -- )
512 read block-size read dup length 512 = [
global [ dup hexdump. flush ] bind
[
parse-tar-header parse-tar-header
! global [ dup tar-header-name [ print flush ] when* ] bind dup typeflag>>
dup tar-header-typeflag
{ {
{ 0 [ typeflag-0 ] } { 0 [ typeflag-0 ] }
{ CHAR: 0 [ typeflag-0 ] } { CHAR: 0 [ typeflag-0 ] }
{ CHAR: 1 [ typeflag-1 ] } ! { CHAR: 1 [ typeflag-1 ] }
{ CHAR: 2 [ typeflag-2 ] } { CHAR: 2 [ typeflag-2 ] }
{ CHAR: 3 [ typeflag-3 ] } ! { CHAR: 3 [ typeflag-3 ] }
{ CHAR: 4 [ typeflag-4 ] } ! { CHAR: 4 [ typeflag-4 ] }
{ CHAR: 5 [ typeflag-5 ] } { CHAR: 5 [ typeflag-5 ] }
{ CHAR: 6 [ typeflag-6 ] } ! { CHAR: 6 [ typeflag-6 ] }
{ CHAR: 7 [ typeflag-7 ] } ! { CHAR: 7 [ typeflag-7 ] }
{ CHAR: g [ typeflag-g ] } { CHAR: g [ typeflag-g ] }
{ CHAR: x [ typeflag-x ] } ! { CHAR: x [ typeflag-x ] }
{ CHAR: A [ typeflag-A ] } ! { CHAR: A [ typeflag-A ] }
{ CHAR: D [ typeflag-D ] } ! { CHAR: D [ typeflag-D ] }
{ CHAR: E [ typeflag-E ] } ! { CHAR: E [ typeflag-E ] }
{ CHAR: I [ typeflag-I ] } ! { CHAR: I [ typeflag-I ] }
{ CHAR: K [ typeflag-K ] } ! { CHAR: K [ typeflag-K ] }
{ CHAR: L [ typeflag-L ] } ! { CHAR: L [ typeflag-L ] }
{ CHAR: M [ typeflag-M ] } ! { CHAR: M [ typeflag-M ] }
{ CHAR: N [ typeflag-N ] } ! { CHAR: N [ typeflag-N ] }
{ CHAR: S [ typeflag-S ] } ! { CHAR: S [ typeflag-S ] }
{ CHAR: V [ typeflag-V ] } ! { CHAR: V [ typeflag-V ] }
{ CHAR: X [ typeflag-X ] } ! { CHAR: X [ typeflag-X ] }
[ unknown-typeflag ] { f [ drop ] }
} case } case (parse-tar)
! dup tar-header-size zero? [ ] [
! out-stream get [ dispose ] when drop
! out-stream off ] if ;
! drop
! ] [
! dup tar-header-name
! dup parent-dir base-dir prepend-path
! global [ dup [ . flush ] when* ] bind
! make-directories <file-writer>
! out-stream set
! read-tar-blocks
! ] if
(parse-tar)
] when* ;
: parse-tar ( path -- obj ) : parse-tar ( path -- )
binary [ normalize-path dup parent-directory base-dir [
"resource:tar-test" base-dir set binary [ (parse-tar) ] with-file-reader
global [ nl nl nl "Starting to parse .tar..." print flush ] bind ] with-variable ;
global [ "Expanding to: " write base-dir get . flush ] bind
(parse-tar)
] with-file-writer ;

2
extra/tools/deploy/backend/backend.factor
View File

@ -13,7 +13,7 @@ IN: tools.deploy.backend
[ prepend-path ] dip append vm over copy-file ; [ prepend-path ] dip append vm over copy-file ;
: copy-fonts ( name dir -- ) : copy-fonts ( name dir -- )
append-path "fonts/" resource-path swap copy-tree-into ; append-path "resource:fonts/" swap copy-tree-into ;
: image-name ( vocab bundle-name -- str ) : image-name ( vocab bundle-name -- str )
prepend-path ".image" append ; prepend-path ".image" append ;

7
extra/tools/deploy/windows/windows-tests.factor Executable file
View File

@ -0,0 +1,7 @@
IN: tools.deploy.windows.tests
USING: tools.deploy.windows tools.test sequences ;
[ t ] [
"foo" "resource:temp/test-copy-files" create-exe-dir
".exe" tail?
] unit-test

27
extra/tools/deploy/windows/windows.factor
View File

@ -2,12 +2,15 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.files kernel namespaces sequences system USING: io io.files kernel namespaces sequences system
tools.deploy.backend tools.deploy.config assocs hashtables tools.deploy.backend tools.deploy.config assocs hashtables
prettyprint windows.shell32 windows.user32 ; prettyprint combinators windows.shell32 windows.user32 ;
IN: tools.deploy.windows IN: tools.deploy.windows
: copy-dlls ( bundle-name -- ) : copy-dlls ( bundle-name -- )
{ "resource:freetype6.dll" "resource:zlib1.dll" "resource:factor.dll" } {
swap copy-files-into ; "resource:freetype6.dll"
"resource:zlib1.dll"
"resource:factor.dll"
} swap copy-files-into ;
: create-exe-dir ( vocab bundle-name -- vm ) : create-exe-dir ( vocab bundle-name -- vm )
dup copy-dlls dup copy-dlls
@ -15,11 +18,15 @@ IN: tools.deploy.windows
".exe" copy-vm ; ".exe" copy-vm ;
M: winnt deploy* M: winnt deploy*
"." resource-path [ "resource:" [
dup deploy-config [ deploy-name over deploy-config at
[ deploy-name get create-exe-dir ] keep [
[ deploy-name get image-name ] keep {
[ namespace make-deploy-image ] keep [ create-exe-dir ]
open-in-explorer [ image-name ]
] bind [ drop ]
[ drop deploy-config ]
} 2cleave make-deploy-image
]
[ nip open-in-explorer ] 2bi
] with-directory ; ] with-directory ;

2
extra/tools/time/time-docs.factor Normal file → Executable file
View File

@ -16,7 +16,7 @@ ABOUT: "timing"
HELP: benchmark HELP: benchmark
{ $values { "quot" "a quotation" } { $values { "quot" "a quotation" }
{ "runtime" "an integer denoting milliseconds" } } { "runtime" "an integer denoting milliseconds" } }
{ $description "Runs a quotation, measuring the total wall clock time and the total time spent in the garbage collector." } { $description "Runs a quotation, measuring the total wall clock time." }
{ $notes "A nicer word for interactive use is " { $link time } "." } ; { $notes "A nicer word for interactive use is " { $link time } "." } ;
HELP: time HELP: time

3
extra/unix/ffi/ffi.factor
View File

@ -10,3 +10,6 @@ C-STRUCT: utimbuf
{ "time_t" "modtime" } ; { "time_t" "modtime" } ;
FUNCTION: int utime ( char* path, utimebuf* buf ) ; FUNCTION: int utime ( char* path, utimebuf* buf ) ;
FUNCTION: int err_no ( ) ;
FUNCTION: char* strerror ( int errno ) ;

15
extra/unix/system-call/system-call.factor Normal file
View File

@ -0,0 +1,15 @@
USING: kernel continuations sequences math accessors inference macros
fry arrays.lib unix.ffi ;
IN: unix.system-call
ERROR: unix-system-call-error word args message ;
MACRO: unix-system-call ( quot -- )
[ ] [ infer in>> ] [ first ] tri
'[
[ @ dup 0 < [ dup throw ] [ ] if ]
[ drop , narray , swap err_no strerror unix-system-call-error ]
recover
] ;

40
extra/unix/unix.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel libc structs USING: alien alien.c-types alien.syntax kernel libc structs
math namespaces system combinators vocabs.loader unix.ffi unix.types math namespaces system combinators vocabs.loader qualified
qualified ; unix.ffi unix.types unix.system-call ;
QUALIFIED: unix.ffi QUALIFIED: unix.ffi
@ -27,9 +27,27 @@ TYPEDEF: ulong size_t
: ESRCH 3 ; inline : ESRCH 3 ; inline
: EEXIST 17 ; inline : EEXIST 17 ; inline
C-STRUCT: group
{ "char*" "gr_name" }
{ "char*" "gr_passwd" }
{ "int" "gr_gid" }
{ "char**" "gr_mem" } ;
C-STRUCT: passwd
{ "char*" "pw_name" }
{ "char*" "pw_passwd" }
{ "uid_t" "pw_uid" }
{ "gid_t" "pw_gid" }
{ "time_t" "pw_change" }
{ "char*" "pw_class" }
{ "char*" "pw_gecos" }
{ "char*" "pw_dir" }
{ "char*" "pw_shell" }
{ "time_t" "pw_expire" }
{ "int" "pw_fields" } ;
! ! ! Unix functions ! ! ! Unix functions
LIBRARY: factor LIBRARY: factor
FUNCTION: int err_no ( ) ;
FUNCTION: void clear_err_no ( ) ; FUNCTION: void clear_err_no ( ) ;
LIBRARY: libc LIBRARY: libc
@ -64,6 +82,9 @@ FUNCTION: int getdtablesize ;
FUNCTION: gid_t getegid ; FUNCTION: gid_t getegid ;
FUNCTION: uid_t geteuid ; FUNCTION: uid_t geteuid ;
FUNCTION: gid_t getgid ; FUNCTION: gid_t getgid ;
FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
FUNCTION: int gethostname ( char* name, int len ) ; FUNCTION: int gethostname ( char* name, int len ) ;
FUNCTION: uid_t getuid ; FUNCTION: uid_t getuid ;
@ -78,19 +99,10 @@ FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_
FUNCTION: int munmap ( void* addr, size_t len ) ; FUNCTION: int munmap ( void* addr, size_t len ) ;
FUNCTION: uint ntohl ( uint n ) ; FUNCTION: uint ntohl ( uint n ) ;
FUNCTION: ushort ntohs ( ushort n ) ; FUNCTION: ushort ntohs ( ushort n ) ;
FUNCTION: char* strerror ( int errno ) ;
ERROR: open-error path flags prot message ; : open ( path flags prot -- int ) [ unix.ffi:open ] unix-system-call ;
: open ( path flags prot -- int ) : utime ( path buf -- ) [ unix.ffi:utime ] unix-system-call drop ;
3dup unix.ffi:open
dup 0 >= [ >r 3drop r> ] [ drop err_no strerror open-error ] if ;
ERROR: utime-error path message ;
: utime ( path buf -- )
dupd unix.ffi:utime
0 = [ drop ] [ err_no strerror utime-error ] if ;
FUNCTION: int pclose ( void* file ) ; FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ; FUNCTION: int pipe ( int* filedes ) ;