From 5337366643fab269ae264b390c2dae96efdbc2c9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 9 May 2008 21:11:27 -0500
Subject: [PATCH 01/14] fix compiler errors in tar, can untar the linux kernel
now
---
extra/tar/tar.factor | 190 +++++++++++++++++++------------------------
1 file changed, 83 insertions(+), 107 deletions(-)
diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor
index b5d01b6ed2..644cf9aa72 100755
--- a/extra/tar/tar.factor
+++ b/extra/tar/tar.factor
@@ -1,99 +1,92 @@
USING: combinators io io.files io.streams.string kernel math
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
-: zero-checksum 256 ;
+: zero-checksum 256 ; inline
+: block-size 512 ; inline
TUPLE: tar-header name mode uid gid size mtime checksum typeflag
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 )
- [ "\0 " member? ] trim ;
+: tar-trim ( seq -- newseq ) [ "\0 " member? ] trim ;
: read-tar-header ( -- obj )
- <tar-header>
- 100 read-c-string* over set-tar-header-name
- 8 read-c-string* tar-trim oct> over set-tar-header-mode
- 8 read-c-string* tar-trim oct> over set-tar-header-uid
- 8 read-c-string* tar-trim oct> over set-tar-header-gid
- 12 read-c-string* tar-trim oct> over set-tar-header-size
- 12 read-c-string* tar-trim oct> over set-tar-header-mtime
- 8 read-c-string* tar-trim oct> over set-tar-header-checksum
- read1 over set-tar-header-typeflag
- 100 read-c-string* over set-tar-header-linkname
- 6 read over set-tar-header-magic
- 2 read over set-tar-header-version
- 32 read-c-string* over set-tar-header-uname
- 32 read-c-string* over set-tar-header-gname
- 8 read tar-trim oct> over set-tar-header-devmajor
- 8 read tar-trim oct> over set-tar-header-devminor
- 155 read-c-string* over set-tar-header-prefix ;
+ \ tar-header new
+ 100 read-c-string* >>name
+ 8 read-c-string* tar-trim oct> >>mode
+ 8 read-c-string* tar-trim oct> >>uid
+ 8 read-c-string* tar-trim oct> >>gid
+ 12 read-c-string* tar-trim oct> >>size
+ 12 read-c-string* tar-trim oct> >>mtime
+ 8 read-c-string* tar-trim oct> >>checksum
+ read1 >>typeflag
+ 100 read-c-string* >>linkname
+ 6 read >>magic
+ 2 read >>version
+ 32 read-c-string* >>uname
+ 32 read-c-string* >>gname
+ 8 read tar-trim oct> >>devmajor
+ 8 read tar-trim oct> >>devminor
+ 155 read-c-string* >>prefix ;
: header-checksum ( seq -- x )
148 cut-slice 8 tail-slice
[ sum ] bi@ + 256 + ;
-TUPLE: checksum-error ;
-TUPLE: malformed-block-error ;
-
-SYMBOL: base-dir
-SYMBOL: out-stream
-SYMBOL: filename
-
-: (read-data-blocks) ( tar-header -- )
- 512 read [
- over tar-header-size dup 512 <= [
- head-slice
- >string write
- drop
+: read-data-blocks ( tar-header -- )
+ dup size>> 0 > [
+ block-size read [
+ over size>> dup block-size <= [
+ head-slice >byte-array write drop
+ ] [
+ drop write
+ [ block-size - ] change-size
+ read-data-blocks
+ ] if
] [
drop
- >string write
- dup tar-header-size 512 - over set-tar-header-size
- (read-data-blocks)
- ] if
+ ] if*
] [
drop
- ] if* ;
-
-: read-data-blocks ( tar-header out -- )
- [ (read-data-blocks) ] with-output-stream* ;
+ ] if ;
: parse-tar-header ( seq -- obj )
[ header-checksum ] keep over zero-checksum = [
2drop
\ tar-header new
- 0 over set-tar-header-size
- 0 over set-tar-header-checksum
+ 0 >>size
+ 0 >>checksum
] [
[ read-tar-header ] with-string-reader
- [ tar-header-checksum = [
- \ checksum-error new throw
- ] unless
- ] keep
+ [ checksum>> = [ checksum-error ] unless ] keep
] if ;
ERROR: unknown-typeflag ch ;
M: unknown-typeflag summary ( obj -- str )
- ch>> 1string
- "Unknown typeflag: " prepend ;
+ ch>> 1string "Unknown typeflag: " prepend ;
-: tar-append-path ( path -- newpath )
+: tar-prepend-path ( path -- newpath )
base-dir get prepend-path ;
+: read/write-blocks ( tar-header path -- )
+ binary [ read-data-blocks ] with-file-writer ;
+
! Normal file
-: typeflag-0
- name>> tar-append-path binary <file-writer>
- [ read-data-blocks ] keep dispose ;
+: typeflag-0 ( header -- )
+ dup name>> tar-prepend-path read/write-blocks ;
! Hard link
: typeflag-1 ( header -- ) unknown-typeflag ;
! Symlink
-: typeflag-2 ( header -- ) unknown-typeflag ;
+: typeflag-2 ( header -- )
+ [ name>> ] [ linkname>> ] bi
+ [ make-link ] 2curry ignore-errors ;
! character special
: typeflag-3 ( header -- ) unknown-typeflag ;
@@ -103,7 +96,7 @@ M: unknown-typeflag summary ( obj -- str )
! Directory
: typeflag-5 ( header -- )
- tar-header-name tar-append-path make-directories ;
+ name>> tar-prepend-path make-directories ;
! FIFO
: typeflag-6 ( header -- ) unknown-typeflag ;
@@ -118,7 +111,7 @@ M: unknown-typeflag summary ( obj -- str )
: typeflag-9 ( header -- ) unknown-typeflag ;
! Global POSIX header
-: typeflag-g ( header -- ) unknown-typeflag ;
+: typeflag-g ( header -- ) typeflag-0 ;
! Extended POSIX header
: typeflag-x ( header -- ) unknown-typeflag ;
@@ -140,10 +133,10 @@ M: unknown-typeflag summary ( obj -- str )
! Long file name
: typeflag-L ( header -- )
- <string-writer> [ read-data-blocks ] keep
- >string [ zero? ] right-trim filename set
- global [ "long filename: " write filename get . flush ] bind
- filename get tar-append-path make-directories ;
+ drop ;
+ ! <string-writer> [ read-data-blocks ] keep
+ ! >string [ zero? ] right-trim filename set
+ ! filename get tar-prepend-path make-directories ;
! Multi volume continuation entry
: typeflag-M ( header -- ) unknown-typeflag ;
@@ -161,56 +154,39 @@ M: unknown-typeflag summary ( obj -- str )
: typeflag-X ( header -- ) unknown-typeflag ;
: (parse-tar) ( -- )
- 512 read
- global [ dup hexdump. flush ] bind
- [
+ block-size read dup length 512 = [
parse-tar-header
- ! global [ dup tar-header-name [ print flush ] when* ] bind
- dup tar-header-typeflag
+ dup typeflag>>
{
{ 0 [ typeflag-0 ] }
{ CHAR: 0 [ typeflag-0 ] }
- { CHAR: 1 [ typeflag-1 ] }
+ ! { CHAR: 1 [ typeflag-1 ] }
{ CHAR: 2 [ typeflag-2 ] }
- { CHAR: 3 [ typeflag-3 ] }
- { CHAR: 4 [ typeflag-4 ] }
+ ! { CHAR: 3 [ typeflag-3 ] }
+ ! { CHAR: 4 [ typeflag-4 ] }
{ CHAR: 5 [ typeflag-5 ] }
- { CHAR: 6 [ typeflag-6 ] }
- { CHAR: 7 [ typeflag-7 ] }
+ ! { CHAR: 6 [ typeflag-6 ] }
+ ! { CHAR: 7 [ typeflag-7 ] }
{ CHAR: g [ typeflag-g ] }
- { CHAR: x [ typeflag-x ] }
- { CHAR: A [ typeflag-A ] }
- { CHAR: D [ typeflag-D ] }
- { CHAR: E [ typeflag-E ] }
- { CHAR: I [ typeflag-I ] }
- { CHAR: K [ typeflag-K ] }
- { CHAR: L [ typeflag-L ] }
- { CHAR: M [ typeflag-M ] }
- { CHAR: N [ typeflag-N ] }
- { CHAR: S [ typeflag-S ] }
- { CHAR: V [ typeflag-V ] }
- { CHAR: X [ typeflag-X ] }
- [ unknown-typeflag ]
- } case
- ! dup tar-header-size zero? [
- ! out-stream get [ dispose ] when
- ! out-stream off
- ! 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* ;
+ ! { CHAR: x [ typeflag-x ] }
+ ! { CHAR: A [ typeflag-A ] }
+ ! { CHAR: D [ typeflag-D ] }
+ ! { CHAR: E [ typeflag-E ] }
+ ! { CHAR: I [ typeflag-I ] }
+ ! { CHAR: K [ typeflag-K ] }
+ ! { CHAR: L [ typeflag-L ] }
+ ! { CHAR: M [ typeflag-M ] }
+ ! { CHAR: N [ typeflag-N ] }
+ ! { CHAR: S [ typeflag-S ] }
+ ! { CHAR: V [ typeflag-V ] }
+ ! { CHAR: X [ typeflag-X ] }
+ { f [ drop ] }
+ } case (parse-tar)
+ ] [
+ drop
+ ] if ;
-: parse-tar ( path -- obj )
- binary [
- "resource:tar-test" base-dir set
- global [ nl nl nl "Starting to parse .tar..." print flush ] bind
- global [ "Expanding to: " write base-dir get . flush ] bind
- (parse-tar)
- ] with-file-writer ;
+: parse-tar ( path -- )
+ normalize-path dup parent-directory base-dir [
+ binary [ (parse-tar) ] with-file-reader
+ ] with-variable ;
From 709e35a392a9214888e448f419efc4f34e00fe28 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 05:40:00 -0500
Subject: [PATCH 02/14] Add the 'unix-system-call' macro
---
extra/unix/system-call/system-call.factor | 15 +++++++++++++++
1 file changed, 15 insertions(+)
create mode 100644 extra/unix/system-call/system-call.factor
diff --git a/extra/unix/system-call/system-call.factor b/extra/unix/system-call/system-call.factor
new file mode 100644
index 0000000000..5a77693ed7
--- /dev/null
+++ b/extra/unix/system-call/system-call.factor
@@ -0,0 +1,15 @@
+
+USING: kernel continuations sequences math accessors inference macros
+ fry arrays.lib unix ;
+
+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
+ ] ;
From 8e341475fe4f562919e73bee6e5f360a86409c5d Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 05:41:00 -0500
Subject: [PATCH 03/14] unix: Convert a couple of words to the
'unix-system-call' macro
---
extra/unix/unix.factor | 16 ++++------------
1 file changed, 4 insertions(+), 12 deletions(-)
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index fcbd96177b..ad8b5711b8 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel libc structs
- math namespaces system combinators vocabs.loader unix.ffi unix.types
- qualified ;
+ math namespaces system combinators vocabs.loader qualified
+ unix.ffi unix.types unix.system-call ;
QUALIFIED: unix.ffi
@@ -80,17 +80,9 @@ FUNCTION: uint ntohl ( uint 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 )
- 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 ;
+: utime ( path buf -- ) [ unix.ffi:utime ] unix-system-call drop ;
FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ;
From 6da3e88de5b8c01135c23b4ba418296829207e02 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 06:12:54 -0500
Subject: [PATCH 04/14] Move error words from unix to unix.ffi
---
extra/unix/ffi/ffi.factor | 5 ++++-
extra/unix/unix.factor | 4 ++--
2 files changed, 6 insertions(+), 3 deletions(-)
diff --git a/extra/unix/ffi/ffi.factor b/extra/unix/ffi/ffi.factor
index ec3daab880..e39d95dfa3 100644
--- a/extra/unix/ffi/ffi.factor
+++ b/extra/unix/ffi/ffi.factor
@@ -9,4 +9,7 @@ C-STRUCT: utimbuf
{ "time_t" "actime" }
{ "time_t" "modtime" } ;
-FUNCTION: int utime ( char* path, utimebuf* buf ) ;
\ No newline at end of file
+FUNCTION: int utime ( char* path, utimebuf* buf ) ;
+
+FUNCTION: int err_no ( ) ;
+FUNCTION: char* strerror ( int errno ) ;
\ No newline at end of file
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index ad8b5711b8..96c5c7bf66 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -29,7 +29,7 @@ TYPEDEF: ulong size_t
! ! ! Unix functions
LIBRARY: factor
-FUNCTION: int err_no ( ) ;
+! FUNCTION: int err_no ( ) ;
FUNCTION: void clear_err_no ( ) ;
LIBRARY: libc
@@ -78,7 +78,7 @@ FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_
FUNCTION: int munmap ( void* addr, size_t len ) ;
FUNCTION: uint ntohl ( uint n ) ;
FUNCTION: ushort ntohs ( ushort n ) ;
-FUNCTION: char* strerror ( int errno ) ;
+! FUNCTION: char* strerror ( int errno ) ;
: open ( path flags prot -- int ) [ unix.ffi:open ] unix-system-call ;
From 4aacf9b3e9dc423e198e929f1b60168e3d257281 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 06:13:44 -0500
Subject: [PATCH 05/14] Update USING:
---
extra/io/unix/backend/backend.factor | 2 +-
extra/io/unix/sockets/sockets.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor
index 08ff526f14..902af8fe0d 100644
--- a/extra/io/unix/backend/backend.factor
+++ b/extra/io/unix/backend/backend.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
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
continuations system libc qualified namespaces io.timeouts
io.encodings.utf8 accessors ;
diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor
index b60cb5760e..71edbc5500 100755
--- a/extra/io/unix/sockets/sockets.factor
+++ b/extra/io/unix/sockets/sockets.factor
@@ -5,7 +5,7 @@ namespaces threads sequences byte-arrays io.nonblocking
io.binary io.unix.backend io.streams.duplex io.sockets.impl
io.backend io.files io.files.private io.encodings.utf8
math.parser continuations libc combinators system accessors
-qualified unix ;
+qualified unix.ffi unix ;
EXCLUDE: io => read write close ;
EXCLUDE: io.sockets => accept ;
From 0c1801d213c30db6ab7a6a71c95e87acbfcf036a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 06:14:08 -0500
Subject: [PATCH 06/14] unix.system-call: Fix circularity
---
extra/unix/system-call/system-call.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/unix/system-call/system-call.factor b/extra/unix/system-call/system-call.factor
index 5a77693ed7..f1a6f8811e 100644
--- a/extra/unix/system-call/system-call.factor
+++ b/extra/unix/system-call/system-call.factor
@@ -1,6 +1,6 @@
USING: kernel continuations sequences math accessors inference macros
- fry arrays.lib unix ;
+ fry arrays.lib unix.ffi ;
IN: unix.system-call
From d1775f9bfa02d81aaf4f59d2b0c64a46ff873584 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 06:36:43 -0500
Subject: [PATCH 07/14] io.unix.kqueue: Fix using
---
extra/io/unix/kqueue/kqueue.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 extra/io/unix/kqueue/kqueue.factor
diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor
old mode 100644
new mode 100755
index 8e8fb0ec74..ec82a426d3
--- a/extra/io/unix/kqueue/kqueue.factor
+++ b/extra/io/unix/kqueue/kqueue.factor
@@ -3,7 +3,7 @@
USING: alien.c-types kernel math math.bitfields namespaces
locals accessors combinators threads vectors hashtables
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.monitors ;
IN: io.unix.kqueue
From a9bc2309ea0ffaff763b7ede8e9ebca90d319452 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 10 May 2008 09:10:16 -0500
Subject: [PATCH 08/14] unix: Minor cleanups
---
extra/unix/system-call/system-call.factor | 12 ++++++------
extra/unix/unix.factor | 2 --
2 files changed, 6 insertions(+), 8 deletions(-)
diff --git a/extra/unix/system-call/system-call.factor b/extra/unix/system-call/system-call.factor
index f1a6f8811e..bfcb9ae6ea 100644
--- a/extra/unix/system-call/system-call.factor
+++ b/extra/unix/system-call/system-call.factor
@@ -7,9 +7,9 @@ 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
- ] ;
+ [ ] [ infer in>> ] [ first ] tri
+ '[
+ [ @ dup 0 < [ dup throw ] [ ] if ]
+ [ drop , narray , swap err_no strerror unix-system-call-error ]
+ recover
+ ] ;
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index 96c5c7bf66..e00a2e068a 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -29,7 +29,6 @@ TYPEDEF: ulong size_t
! ! ! Unix functions
LIBRARY: factor
-! FUNCTION: int err_no ( ) ;
FUNCTION: void clear_err_no ( ) ;
LIBRARY: libc
@@ -78,7 +77,6 @@ FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_
FUNCTION: int munmap ( void* addr, size_t len ) ;
FUNCTION: uint ntohl ( uint n ) ;
FUNCTION: ushort ntohs ( ushort n ) ;
-! FUNCTION: char* strerror ( int errno ) ;
: open ( path flags prot -- int ) [ unix.ffi:open ] unix-system-call ;
From ef1f7d45affe961735e53322555fffb35b350f11 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 10 May 2008 12:21:38 -0500
Subject: [PATCH 09/14] add more bindings to unix/
---
extra/unix/stat/macosx/macosx.factor | 4 ----
extra/unix/unix.factor | 22 ++++++++++++++++++++++
2 files changed, 22 insertions(+), 4 deletions(-)
diff --git a/extra/unix/stat/macosx/macosx.factor b/extra/unix/stat/macosx/macosx.factor
index 3741a22413..1cb3994708 100644
--- a/extra/unix/stat/macosx/macosx.factor
+++ b/extra/unix/stat/macosx/macosx.factor
@@ -27,7 +27,3 @@ C-STRUCT: stat
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
-
-: stat-st_atim stat-st_atimespec ;
-: stat-st_mtim stat-st_mtimespec ;
-: stat-st_ctim stat-st_ctimespec ;
\ No newline at end of file
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index fcbd96177b..f1450a73ae 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -27,6 +27,25 @@ TYPEDEF: ulong size_t
: ESRCH 3 ; 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
LIBRARY: factor
FUNCTION: int err_no ( ) ;
@@ -64,6 +83,9 @@ FUNCTION: int getdtablesize ;
FUNCTION: gid_t getegid ;
FUNCTION: uid_t geteuid ;
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 gethostname ( char* name, int len ) ;
FUNCTION: uid_t getuid ;
From 4f1e5241420bd7bb8ddf8a5799ca701333469b62 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 10 May 2008 12:36:57 -0500
Subject: [PATCH 10/14] oops, add back some "dead code"
---
extra/unix/stat/macosx/macosx.factor | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/extra/unix/stat/macosx/macosx.factor b/extra/unix/stat/macosx/macosx.factor
index 1cb3994708..552547442a 100644
--- a/extra/unix/stat/macosx/macosx.factor
+++ b/extra/unix/stat/macosx/macosx.factor
@@ -27,3 +27,7 @@ C-STRUCT: stat
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
+
+: stat-st_atim stat-st_atimespec ;
+: stat-st_mtim stat-st_mtimespec ;
+: stat-st_ctim stat-st_ctimespec ;
From 9da8bed8f937f05bbb1eaaad8f150991ae06dacb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 10 May 2008 13:06:40 -0500
Subject: [PATCH 11/14] refactor miller-rabin a bit still uses too many locals,
but at least they're not symbols
---
extra/math/miller-rabin/miller-rabin.factor | 58 ++++++++-------------
1 file changed, 21 insertions(+), 37 deletions(-)
diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor
index c668806fc2..2e83fe5ab0 100755
--- a/extra/math/miller-rabin/miller-rabin.factor
+++ b/extra/math/miller-rabin/miller-rabin.factor
@@ -3,21 +3,9 @@ math.functions math.ranges namespaces random sequences
hashtables sets ;
IN: math.miller-rabin
-SYMBOL: a
-SYMBOL: n
-SYMBOL: r
-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 ;
+: >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 ;
@@ -28,34 +16,30 @@ TUPLE: positive-even-expected n ;
#! factor an integer into s * 2^r
0 swap (factor-2s) ;
-:: (miller-rabin) ( n prime?! -- ? )
- n 1- factor-2s s set r set
- trials get [
- n 1- [1,b] random a set
- a get s get n ^mod 1 = [
- 0 count set
- r get [
- 2^ s get * a get swap n ^mod n - -1 = [
- count [ 1+ ] change
- r get +
- ] when
- ] each
- count get zero? [
- f prime?!
- trials get +
- ] when
- ] unless
- drop
- ] each prime? ;
-
-TUPLE: miller-rabin-bounds ;
+:: (miller-rabin) ( n trials -- ? )
+ [let | r [ n 1- factor-2s drop ]
+ s [ n 1- factor-2s nip ]
+ prime?! [ t ]
+ a! [ 0 ]
+ count! [ 0 ] |
+ trials [
+ n 1- [1,b] random a!
+ a s n ^mod 1 = [
+ 0 count!
+ r [
+ 2^ s * a swap n ^mod n - -1 =
+ [ count 1+ count! r + ] when
+ ] each
+ count zero? [ f prime?! trials + ] when
+ ] unless drop
+ ] each prime? ] ;
: miller-rabin* ( n numtrials -- ? )
over {
{ [ dup 1 <= ] [ 3drop f ] }
{ [ dup 2 = ] [ 3drop t ] }
{ [ dup even? ] [ 3drop f ] }
- [ [ drop trials set t (miller-rabin) ] with-scope ]
+ [ [ drop (miller-rabin) ] with-scope ]
} cond ;
: miller-rabin ( n -- ? ) 10 miller-rabin* ;
From d33b57506a197cdf1ed59ffa16b20bcc46bc0e80 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 10 May 2008 13:18:13 -0500
Subject: [PATCH 12/14] find-relative-prime didn't handle numbers <= 1
correctly
---
extra/math/miller-rabin/miller-rabin.factor | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor
index 2e83fe5ab0..f1953340db 100755
--- a/extra/math/miller-rabin/miller-rabin.factor
+++ b/extra/math/miller-rabin/miller-rabin.factor
@@ -50,7 +50,11 @@ TUPLE: positive-even-expected n ;
: random-prime ( numbits -- p )
random-bits next-prime ;
+ERROR: no-relative-prime n ;
+
: (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 ;
: find-relative-prime* ( n guess -- p )
From 4a9a1ba2b520b121f8cae749dc9b971aab5acb12 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Sat, 10 May 2008 15:22:38 -0500
Subject: [PATCH 13/14] Fix and clean up Windows deployment
---
core/io/files/files-tests.factor | 3 +++
core/io/files/files.factor | 4 ++-
extra/tools/deploy/backend/backend.factor | 12 ++++-----
.../tools/deploy/windows/windows-tests.factor | 7 +++++
extra/tools/deploy/windows/windows.factor | 27 ++++++++++++-------
5 files changed, 36 insertions(+), 17 deletions(-)
create mode 100755 extra/tools/deploy/windows/windows-tests.factor
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 84b0bd3e09..2c9d883695 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -66,6 +66,9 @@ strings accessors io.encodings.utf8 math ;
[ "awk" ] [ "/usr/libexec/awk///" 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." }
"test-foo.txt" temp-file ascii set-file-lines
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 76c7b144d0..2b4bb170ea 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -142,7 +142,9 @@ PRIVATE>
: file-name ( path -- string )
dup root-directory? [
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 ;
! File info
diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor
index 6dff511238..59dbe9b753 100755
--- a/extra/tools/deploy/backend/backend.factor
+++ b/extra/tools/deploy/backend/backend.factor
@@ -8,14 +8,14 @@ debugger io.streams.c io.files io.backend
quotations io.launcher words.private tools.deploy.config
bootstrap.image io.encodings.utf8 accessors ;
IN: tools.deploy.backend
-
+
: copy-vm ( executable bundle-name extension -- vm )
[ prepend-path ] dip append vm over copy-file ;
-
-: copy-fonts ( name dir -- )
- append-path "fonts/" resource-path swap copy-tree-into ;
-
-: image-name ( vocab bundle-name -- str )
+
+: copy-fonts ( name dir -- )
+ append-path "resource:fonts/" swap copy-tree-into ;
+
+: image-name ( vocab bundle-name -- str )
prepend-path ".image" append ;
: (copy-lines) ( stream -- )
diff --git a/extra/tools/deploy/windows/windows-tests.factor b/extra/tools/deploy/windows/windows-tests.factor
new file mode 100755
index 0000000000..cfc9f6af90
--- /dev/null
+++ b/extra/tools/deploy/windows/windows-tests.factor
@@ -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
diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor
index 5af3062e39..e0ce2c268a 100755
--- a/extra/tools/deploy/windows/windows.factor
+++ b/extra/tools/deploy/windows/windows.factor
@@ -2,12 +2,15 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files kernel namespaces sequences system
tools.deploy.backend tools.deploy.config assocs hashtables
-prettyprint windows.shell32 windows.user32 ;
+prettyprint combinators windows.shell32 windows.user32 ;
IN: tools.deploy.windows
: 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 )
dup copy-dlls
@@ -15,11 +18,15 @@ IN: tools.deploy.windows
".exe" copy-vm ;
M: winnt deploy*
- "." resource-path [
- dup deploy-config [
- [ deploy-name get create-exe-dir ] keep
- [ deploy-name get image-name ] keep
- [ namespace make-deploy-image ] keep
- open-in-explorer
- ] bind
+ "resource:" [
+ deploy-name over deploy-config at
+ [
+ {
+ [ create-exe-dir ]
+ [ image-name ]
+ [ drop ]
+ [ drop deploy-config ]
+ } 2cleave make-deploy-image
+ ]
+ [ nip open-in-explorer ] 2bi
] with-directory ;
From 2ef23e1fef52ea71cd81f07231b5ad744404b3d0 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Sat, 10 May 2008 15:23:49 -0500
Subject: [PATCH 14/14] Fix typo
---
extra/tools/time/time-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 extra/tools/time/time-docs.factor
diff --git a/extra/tools/time/time-docs.factor b/extra/tools/time/time-docs.factor
old mode 100644
new mode 100755
index 5fedba1700..fe3d709f78
--- a/extra/tools/time/time-docs.factor
+++ b/extra/tools/time/time-docs.factor
@@ -16,7 +16,7 @@ ABOUT: "timing"
HELP: benchmark
{ $values { "quot" "a quotation" }
{ "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 } "." } ;
HELP: time