From f49d26e8d060c745b31dd72454462d0625cef2eb Mon Sep 17 00:00:00 2001
From: erg <erg@ergb.local>
Date: Sun, 30 Mar 2008 01:13:29 -0500
Subject: [PATCH 1/8] make copy-tree and delete-tree symlink aware
---
core/io/files/files.factor | 30 ++++++++++++++++++------------
extra/io/unix/files/files.factor | 19 +++++++++++++++----
extra/unix/unix.factor | 4 ++++
3 files changed, 37 insertions(+), 16 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 48098e612d..4dbbb869c4 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -3,7 +3,7 @@
USING: io.backend io.files.private io hashtables kernel math
memory namespaces sequences strings assocs arrays definitions
system combinators splitting sbufs continuations io.encodings
-io.encodings.binary init ;
+io.encodings.binary init accessors ;
IN: io.files
HOOK: (file-reader) io-backend ( path -- stream )
@@ -145,8 +145,14 @@ PRIVATE>
TUPLE: file-info type size permissions modified ;
HOOK: file-info io-backend ( path -- info )
+
+! Symlinks
HOOK: link-info io-backend ( path -- info )
+HOOK: make-link io-backend ( path1 path2 -- )
+
+HOOK: read-link io-backend ( path -- info )
+
SYMBOL: +regular-file+
SYMBOL: +directory+
SYMBOL: +character-device+
@@ -218,14 +224,14 @@ HOOK: delete-file io-backend ( path -- )
HOOK: delete-directory io-backend ( path -- )
-: (delete-tree) ( path dir? -- )
- [
- dup directory* [ (delete-tree) ] assoc-each
- delete-directory
- ] [ delete-file ] if ;
-
: delete-tree ( path -- )
- dup directory? (delete-tree) ;
+ dup link-info type>> +directory+ = [
+ dup directory over [
+ [ first delete-tree ] each
+ ] with-directory delete-directory
+ ] [
+ delete-file
+ ] if ;
: to-directory over file-name append-path ;
@@ -258,10 +264,10 @@ M: object copy-file
DEFER: copy-tree-into
: copy-tree ( from to -- )
- over directory? [
- >r dup directory swap r> [
- >r swap first append-path r> copy-tree-into
- ] 2curry each
+ over link-info type>> +directory+ = [
+ >r dup directory r> rot [
+ [ >r first r> copy-tree-into ] curry each
+ ] with-directory
] [
copy-file
] if ;
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 3b493d2fe4..759ac2bec1 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -3,7 +3,7 @@
USING: io.backend io.nonblocking io.unix.backend io.files io
unix unix.stat unix.time kernel math continuations
math.bitfields byte-arrays alien combinators calendar
-io.encodings.binary ;
+io.encodings.binary accessors sequences strings ;
IN: io.unix.files
@@ -49,7 +49,7 @@ M: unix-io touch-file ( path -- )
close ;
M: unix-io move-file ( from to -- )
- [ normalize-pathname ] 2apply rename io-error ;
+ [ normalize-pathname ] bi@ rename io-error ;
M: unix-io delete-file ( path -- )
normalize-pathname unlink io-error ;
@@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- )
] with-disposal ;
M: unix-io copy-file ( from to -- )
- [ normalize-pathname ] 2apply
+ [ normalize-pathname ] bi@
[ (copy-file) ]
[ swap file-info file-info-permissions chmod io-error ]
2bi ;
@@ -84,7 +84,7 @@ M: unix-io copy-file ( from to -- )
{ [ dup S_ISLNK ] [ +symbolic-link+ ] }
{ [ dup S_ISSOCK ] [ +socket+ ] }
{ [ t ] [ +unknown+ ] }
- } cond nip ;
+ } cond nip ;
: stat>file-info ( stat -- info )
{
@@ -100,3 +100,14 @@ M: unix-io file-info ( path -- info )
M: unix-io link-info ( path -- info )
normalize-pathname lstat* stat>file-info ;
+
+M: unix-io make-link ( path1 path2 -- )
+ normalize-pathname symlink io-error ;
+
+M: unix-io read-link ( path -- path' )
+ normalize-pathname
+ PATH_MAX [ <byte-array> tuck ] [ ] bi readlink
+ dup io-error head-slice >string ;
+
+: copy-link ( path1 path2 -- )
+ >r read-link r> make-link ;
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index bed87ebd0f..ffd102901c 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -77,6 +77,7 @@ FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ;
FUNCTION: void* popen ( char* command, char* type ) ;
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
+FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ;
FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ;
FUNCTION: int rename ( char* from, char* to ) ;
@@ -93,6 +94,7 @@ FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_
FUNCTION: int setuid ( uid_t uid ) ;
FUNCTION: int socket ( int domain, int type, int protocol ) ;
FUNCTION: char* strerror ( int errno ) ;
+FUNCTION: int symlink ( char* path1, char* path2 ) ;
FUNCTION: int system ( char* command ) ;
FUNCTION: int unlink ( char* path ) ;
FUNCTION: int utimes ( char* path, timeval[2] times ) ;
@@ -102,6 +104,8 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ;
FUNCTION: int kill ( pid_t pid, int sig ) ;
+: PATH_MAX 1024 ; inline
+
: PRIO_PROCESS 0 ; inline
: PRIO_PGRP 1 ; inline
: PRIO_USER 2 ; inline
From b4d2a0b1051061b37a68e80a92bd8673eaa30fb5 Mon Sep 17 00:00:00 2001
From: erg <erg@ergb.local>
Date: Sun, 30 Mar 2008 01:14:28 -0500
Subject: [PATCH 2/8] add constant to grovel
---
build-support/grovel.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/build-support/grovel.c b/build-support/grovel.c
index 2eee054dab..db16aa9bca 100644
--- a/build-support/grovel.c
+++ b/build-support/grovel.c
@@ -42,6 +42,7 @@
#include <sys/socket.h>
#include <sys/errno.h>
#include <sys/mman.h>
+ #include <sys/syslimits.h>
#include <fcntl.h>
#include <unistd.h>
#endif
@@ -146,6 +147,7 @@ void unix_constants()
constant(PROT_WRITE);
constant(MAP_FILE);
constant(MAP_SHARED);
+ constant(PATH_MAX);
grovel(pid_t);
}
From 883c54e07765773cf3a30d9478c7f45e14747f39 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 30 Mar 2008 06:45:38 -0500
Subject: [PATCH 3/8] use srandom and prandom on openbsd /dev/random is
reserved for hardware rngs..
---
extra/random/unix/unix.factor | 17 ++++++++++++-----
1 file changed, 12 insertions(+), 5 deletions(-)
diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor
index 51574887e3..f3f55007f0 100644
--- a/extra/random/unix/unix.factor
+++ b/extra/random/unix/unix.factor
@@ -1,6 +1,6 @@
USING: alien.c-types io io.files io.nonblocking kernel
namespaces random io.encodings.binary singleton init
-accessors ;
+accessors system ;
IN: random.unix
TUPLE: unix-random path ;
@@ -15,7 +15,14 @@ C: <unix-random> unix-random
M: unix-random random-bytes* ( n tuple -- byte-array )
path>> file-read-unbuffered ;
-[
- "/dev/random" <unix-random> secure-random-generator set-global
- "/dev/urandom" <unix-random> insecure-random-generator set-global
-] "random.unix" add-init-hook
+os "openbsd" = [
+ [
+ "/dev/srandom" <unix-random> secure-random-generator set-global
+ "/dev/prandom" <unix-random> insecure-random-generator set-global
+ ] "random.unix" add-init-hook
+] [
+ [
+ "/dev/random" <unix-random> secure-random-generator set-global
+ "/dev/urandom" <unix-random> insecure-random-generator set-global
+ ] "random.unix" add-init-hook
+] if
From 6ece2fbde270b4b1c725f84e09e701fc66723642 Mon Sep 17 00:00:00 2001
From: erg <erg@ergb.local>
Date: Sun, 30 Mar 2008 14:48:49 -0500
Subject: [PATCH 4/8] fix copy-tree
---
core/io/files/files.factor | 20 +++++++++++++-------
extra/io/unix/files/files.factor | 3 ---
2 files changed, 13 insertions(+), 10 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 4dbbb869c4..458a9145a6 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -153,6 +153,9 @@ HOOK: make-link io-backend ( path1 path2 -- )
HOOK: read-link io-backend ( path -- info )
+: copy-link ( path1 path2 -- )
+ >r read-link r> make-link ;
+
SYMBOL: +regular-file+
SYMBOL: +directory+
SYMBOL: +character-device+
@@ -264,13 +267,16 @@ M: object copy-file
DEFER: copy-tree-into
: copy-tree ( from to -- )
- over link-info type>> +directory+ = [
- >r dup directory r> rot [
- [ >r first r> copy-tree-into ] curry each
- ] with-directory
- ] [
- copy-file
- ] if ;
+ over link-info type>>
+ {
+ { +symbolic-link+ [ copy-link ] }
+ { +directory+ [
+ >r dup directory r> rot [
+ [ >r first r> copy-tree-into ] curry each
+ ] with-directory
+ ] }
+ [ drop copy-file ]
+ } case ;
: copy-tree-into ( from to -- )
to-directory copy-tree ;
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 759ac2bec1..c4e506d37f 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -108,6 +108,3 @@ M: unix-io read-link ( path -- path' )
normalize-pathname
PATH_MAX [ <byte-array> tuck ] [ ] bi readlink
dup io-error head-slice >string ;
-
-: copy-link ( path1 path2 -- )
- >r read-link r> make-link ;
From 2d80153b073bca7332f38c15e928c396aa028d7b Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 30 Mar 2008 14:39:13 -0600
Subject: [PATCH 5/8] builder: Add support for gmake
---
extra/builder/builder.factor | 24 ++++++++++++++++++++----
1 file changed, 20 insertions(+), 4 deletions(-)
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
index 461d951209..75664ce5e5 100644
--- a/extra/builder/builder.factor
+++ b/extra/builder/builder.factor
@@ -48,15 +48,31 @@ IN: builder
: record-git-id ( -- ) git-id "../git-id" utf8 [ . ] with-file-writer ;
-: do-make-clean ( -- ) { "make" "clean" } try-process ;
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: gnu-make ( -- string )
+ os { "freebsd" "openbsd" "netbsd" } member?
+ [ "gmake" ]
+ [ "make" ]
+ if ;
+
+! : do-make-clean ( -- ) { "make" "clean" } try-process ;
+
+: do-make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! : make-vm ( -- desc )
+! <process>
+! { "make" } >>command
+! "../compile-log" >>stdout
+! +stdout+ >>stderr ;
+
: make-vm ( -- desc )
<process>
- { "make" } >>command
- "../compile-log" >>stdout
- +stdout+ >>stderr ;
+ { gnu-make } to-strings >>command
+ "../compile-log" >>stdout
+ +stdout+ >>stderr ;
: do-make-vm ( -- )
make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail ;
From 856173f54e20f82ab8eb78e99f58e0c4234b930f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 30 Mar 2008 10:46:07 -0500
Subject: [PATCH 6/8] Add unit test
---
extra/io/sockets/sockets-tests.factor | 4 ++++
1 file changed, 4 insertions(+)
create mode 100644 extra/io/sockets/sockets-tests.factor
diff --git a/extra/io/sockets/sockets-tests.factor b/extra/io/sockets/sockets-tests.factor
new file mode 100644
index 0000000000..1810b8587b
--- /dev/null
+++ b/extra/io/sockets/sockets-tests.factor
@@ -0,0 +1,4 @@
+IN: io.sockets.tests
+USING: io.sockets sequences math tools.test ;
+
+[ t ] [ "localhost" 80 f resolve-host length 1 >= ] unit-test
From cb7d655639a412581b8c7036c68ae8141d900f17 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 30 Mar 2008 10:55:47 -0500
Subject: [PATCH 7/8] move addrinfo into *bsd files
---
extra/unix/bsd/bsd.factor | 10 ----------
extra/unix/bsd/freebsd/freebsd.factor | 11 +++++++++++
extra/unix/bsd/macosx/macosx.factor | 11 +++++++++++
extra/unix/bsd/netbsd/netbsd.factor | 11 +++++++++++
extra/unix/bsd/openbsd/openbsd.factor | 11 +++++++++++
5 files changed, 44 insertions(+), 10 deletions(-)
diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor
index cb7b347c20..6cb5d6385b 100755
--- a/extra/unix/bsd/bsd.factor
+++ b/extra/unix/bsd/bsd.factor
@@ -24,16 +24,6 @@ IN: unix
: F_SETFL 4 ; inline
: O_NONBLOCK 4 ; inline
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "socklen_t" "addrlen" }
- { "char*" "canonname" }
- { "void*" "addr" }
- { "addrinfo*" "next" } ;
-
C-STRUCT: sockaddr-in
{ "uchar" "len" }
{ "uchar" "family" }
diff --git a/extra/unix/bsd/freebsd/freebsd.factor b/extra/unix/bsd/freebsd/freebsd.factor
index 94bb708527..f25cbd1537 100644
--- a/extra/unix/bsd/freebsd/freebsd.factor
+++ b/extra/unix/bsd/freebsd/freebsd.factor
@@ -1,3 +1,14 @@
+USING: alien.syntax ;
IN: unix
: FD_SETSIZE 1024 ;
+
+C-STRUCT: addrinfo
+ { "int" "flags" }
+ { "int" "family" }
+ { "int" "socktype" }
+ { "int" "protocol" }
+ { "socklen_t" "addrlen" }
+ { "char*" "canonname" }
+ { "void*" "addr" }
+ { "addrinfo*" "next" } ;
diff --git a/extra/unix/bsd/macosx/macosx.factor b/extra/unix/bsd/macosx/macosx.factor
index 3c0617ad17..edef2aaa0c 100644
--- a/extra/unix/bsd/macosx/macosx.factor
+++ b/extra/unix/bsd/macosx/macosx.factor
@@ -1,3 +1,14 @@
+USING: alien.syntax ;
IN: unix
: FD_SETSIZE 1024 ; inline
+
+C-STRUCT: addrinfo
+ { "int" "flags" }
+ { "int" "family" }
+ { "int" "socktype" }
+ { "int" "protocol" }
+ { "socklen_t" "addrlen" }
+ { "char*" "canonname" }
+ { "void*" "addr" }
+ { "addrinfo*" "next" } ;
diff --git a/extra/unix/bsd/netbsd/netbsd.factor b/extra/unix/bsd/netbsd/netbsd.factor
index ac18749830..071daa682d 100644
--- a/extra/unix/bsd/netbsd/netbsd.factor
+++ b/extra/unix/bsd/netbsd/netbsd.factor
@@ -1,3 +1,14 @@
+USING: alien.syntax ;
IN: unix
: FD_SETSIZE 256 ; inline
+
+C-STRUCT: addrinfo
+ { "int" "flags" }
+ { "int" "family" }
+ { "int" "socktype" }
+ { "int" "protocol" }
+ { "socklen_t" "addrlen" }
+ { "char*" "canonname" }
+ { "void*" "addr" }
+ { "addrinfo*" "next" } ;
diff --git a/extra/unix/bsd/openbsd/openbsd.factor b/extra/unix/bsd/openbsd/openbsd.factor
index 3c0617ad17..29b44f7da6 100644
--- a/extra/unix/bsd/openbsd/openbsd.factor
+++ b/extra/unix/bsd/openbsd/openbsd.factor
@@ -1,3 +1,14 @@
+USING: alien.syntax ;
IN: unix
: FD_SETSIZE 1024 ; inline
+
+C-STRUCT: addrinfo
+ { "int" "flags" }
+ { "int" "family" }
+ { "int" "socktype" }
+ { "int" "protocol" }
+ { "socklen_t" "addrlen" }
+ { "void*" "addr" }
+ { "char*" "canonname" }
+ { "addrinfo*" "next" } ;
From d367dc8462397b6de8f162098516d57b18533959 Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@forth.internal.stack-effects.com>
Date: Sun, 30 Mar 2008 12:21:44 -0500
Subject: [PATCH 8/8] fix gdb on freebsd
---
extra/tools/disassembler/disassembler.factor | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
index 479ae9c42c..927f7111fa 100755
--- a/extra/tools/disassembler/disassembler.factor
+++ b/extra/tools/disassembler/disassembler.factor
@@ -26,11 +26,14 @@ M: pair make-disassemble-cmd
M: method-spec make-disassemble-cmd
first2 method make-disassemble-cmd ;
+: gdb-binary ( -- string )
+ os "freebsd" = "gdb66" "gdb" ? ;
+
: run-gdb ( -- lines )
<process>
+closed+ >>stdin
out-file >>stdout
- [ "gdb" , "-x" , in-file , "-batch" , ] { } make >>command
+ [ gdb-binary , "-x" , in-file , "-batch" , ] { } make >>command
try-process
out-file ascii file-lines ;