From f50821af6e14025dcd049601645dfaf17a62e014 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Wed, 12 Mar 2008 02:11:03 -0700 Subject: [PATCH 01/10] Implement sequence matching in extra/match. --- extra/match/match.factor | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/extra/match/match.factor b/extra/match/match.factor index 722c330a32..36af5c990a 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -65,3 +65,26 @@ MACRO: match-cond ( assoc -- ) -rot match [ "Pattern does not match" throw ] unless* [ replace-patterns ] bind ; + +: ?1-tail ( seq -- tail/f ) + dup length zero? not [ 1 tail ] [ drop f ] if ; + +: (match-first) ( seq pattern-seq -- bindings leftover/f ) + 2dup [ length ] 2apply < [ 2drop f f ] + [ + 2dup length head over match + [ nip swap ?1-tail ] [ >r 1 tail r> (match-first) ] if* + ] if ; + +: match-first ( seq pattern-seq -- bindings ) + (match-first) drop ; + +: (match-all) ( seq pattern-seq -- ) + tuck (match-first) swap + [ + , [ swap (match-all) ] [ drop ] if* + ] [ 2drop ] if* ; + +: match-all ( seq pattern-seq -- bindings-seq ) + [ (match-all) ] { } make ; + From f49d26e8d060c745b31dd72454462d0625cef2eb Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 01:13:29 -0500 Subject: [PATCH 02/10] 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 [ 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 Date: Sun, 30 Mar 2008 01:14:28 -0500 Subject: [PATCH 03/10] 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 #include #include + #include #include #include #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 Date: Sun, 30 Mar 2008 06:45:38 -0500 Subject: [PATCH 04/10] 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 M: unix-random random-bytes* ( n tuple -- byte-array ) path>> file-read-unbuffered ; -[ - "/dev/random" secure-random-generator set-global - "/dev/urandom" insecure-random-generator set-global -] "random.unix" add-init-hook +os "openbsd" = [ + [ + "/dev/srandom" secure-random-generator set-global + "/dev/prandom" insecure-random-generator set-global + ] "random.unix" add-init-hook +] [ + [ + "/dev/random" secure-random-generator set-global + "/dev/urandom" insecure-random-generator set-global + ] "random.unix" add-init-hook +] if From 6ece2fbde270b4b1c725f84e09e701fc66723642 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 14:48:49 -0500 Subject: [PATCH 05/10] 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 [ 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 Date: Sun, 30 Mar 2008 14:39:13 -0600 Subject: [PATCH 06/10] 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 ) +! +! { "make" } >>command +! "../compile-log" >>stdout +! +stdout+ >>stderr ; + : make-vm ( -- desc ) - { "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 Date: Sun, 30 Mar 2008 10:46:07 -0500 Subject: [PATCH 07/10] 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 Date: Sun, 30 Mar 2008 10:55:47 -0500 Subject: [PATCH 08/10] 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 Date: Sun, 30 Mar 2008 12:21:44 -0500 Subject: [PATCH 09/10] 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 ) +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 ; From a098790634503dfc03eb24969a4fbaff7f7512f5 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sun, 30 Mar 2008 17:58:47 -0700 Subject: [PATCH 10/10] Updated extra/match to use bi@ instead of 2apply. Ran "peg" test for testing. --- extra/match/match.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/match/match.factor b/extra/match/match.factor index dbc42f53e3..825d58c7c2 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -70,7 +70,7 @@ MACRO: match-cond ( assoc -- ) dup length zero? not [ 1 tail ] [ drop f ] if ; : (match-first) ( seq pattern-seq -- bindings leftover/f ) - 2dup [ length ] 2apply < [ 2drop f f ] + 2dup [ length ] bi@ < [ 2drop f f ] [ 2dup length head over match [ nip swap ?1-tail ] [ >r 1 tail r> (match-first) ] if*