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

diff --git a/build-support/grovel.c b/build-support/grovel.c
index 2eee054dab0c5675a85082d58ce4b89759c9fcc9..db16aa9bca3493e9e84498f5b0659e5176d5b4ba 100644 (file)
--- 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);
 
 }

diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 48098e612d10cd341cffaf0b752a3da4b2fd3a77..458a9145a67e962fc4e9b8906b70a053bca7d7ac 100755 (executable)
--- 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,17 @@ 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 )
+
+: copy-link ( path1 path2 -- )
+    >r read-link r> make-link ;
+
 SYMBOL: +regular-file+
 SYMBOL: +directory+
 SYMBOL: +character-device+
@@ -218,14 +227,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,13 +267,16 @@ 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
-    ] [
-        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/builder/builder.factor b/extra/builder/builder.factor
index 461d9512095322411912a4467fc00b0e1c6cbefe..75664ce5e522f993a6abe0d7c66013c2644f331c 100644 (file)
--- 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 ;

diff --git a/extra/io/sockets/sockets-tests.factor b/extra/io/sockets/sockets-tests.factor
new file mode 100644 (file)
index 0000000..1810b85
--- /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

diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index b0b0ba456a5ecd6f200def41a547a0639afeb693..c4e506d37f8c264fad79b481152c42005cfbfe4e 100755 (executable)
--- 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
 
@@ -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,11 @@ 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 ;

diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor
index 51574887e3655d826810178eb7aaafd7f97fc689..f3f55007f076eae26b225c93a10f7b568e5d8738 100644 (file)
--- 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

diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
index 479ae9c42c8358995f5d5b58fcf6f68c6d9bb8f5..927f7111fa8fe4708dd1c0501160124a4add25c9 100755 (executable)
--- 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 ;
 

diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor
index cb7b347c20487407855a2aa5b515a33dd2a7ea0e..6cb5d6385b93796b3c2dcb1043b5753873e0cbc1 100755 (executable)
--- 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 94bb708527d082d5971faf35ff0cf0323a3ac10d..f25cbd1537fcfc47f21682756add4a0f2e470f96 100644 (file)
--- 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 3c0617ad17425805e1730f929730cab3a4c04c54..edef2aaa0c90d4bda0d7cbb410bb73572f97c94f 100644 (file)
--- 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 ac18749830fef3ae8afda764b46386e4fb2c5d56..071daa682d67e888a2f72700e30542b4bf1e40c7 100644 (file)
--- 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 3c0617ad17425805e1730f929730cab3a4c04c54..29b44f7da626455565fbe119ade51256793c963e 100644 (file)
--- 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" } ;

diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index bed87ebd0fb9aa78b6c6582df7ed873c221d38c6..ffd102901c91b53e2243a9ca827a1b5071dd5cee 100755 (executable)
--- 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