From e61f63b2c9a6e9e4487949a69d5ab0db001c596d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 07:21:12 -0500 Subject: [PATCH 01/10] More kqueue changes --- extra/unix/kqueue/freebsd/freebsd.factor | 10 ++++++++++ extra/unix/kqueue/kqueue.factor | 10 ---------- extra/unix/kqueue/macosx/macosx.factor | 10 ++++++++++ extra/unix/kqueue/netbsd/netbsd.factor | 8 ++++++++ extra/unix/kqueue/openbsd/openbsd.factor | 7 +++++++ 5 files changed, 35 insertions(+), 10 deletions(-) diff --git a/extra/unix/kqueue/freebsd/freebsd.factor b/extra/unix/kqueue/freebsd/freebsd.factor index 4cc539daa3..edddae2c16 100644 --- a/extra/unix/kqueue/freebsd/freebsd.factor +++ b/extra/unix/kqueue/freebsd/freebsd.factor @@ -11,3 +11,13 @@ C-STRUCT: kevent ; FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; + +: EVFILT_READ -1 ; inline +: EVFILT_WRITE -2 ; inline +: EVFILT_AIO -3 ; inline ! attached to aio requests +: EVFILT_VNODE -4 ; inline ! attached to vnodes +: EVFILT_PROC -5 ; inline ! attached to struct proc +: EVFILT_SIGNAL -6 ; inline ! attached to struct proc +: EVFILT_TIMER -7 ; inline ! timers +: EVFILT_NETDEV -8 ; inline ! Mach ports +: EVFILT_FS -9 ; inline ! Filesystem events diff --git a/extra/unix/kqueue/kqueue.factor b/extra/unix/kqueue/kqueue.factor index 8166052b01..55b53bd6d0 100644 --- a/extra/unix/kqueue/kqueue.factor +++ b/extra/unix/kqueue/kqueue.factor @@ -7,16 +7,6 @@ IN: unix.kqueue FUNCTION: int kqueue ( ) ; -: EVFILT_READ -1 ; inline -: EVFILT_WRITE -2 ; inline -: EVFILT_AIO -3 ; inline ! attached to aio requests -: EVFILT_VNODE -4 ; inline ! attached to vnodes -: EVFILT_PROC -5 ; inline ! attached to struct proc -: EVFILT_SIGNAL -6 ; inline ! attached to struct proc -: EVFILT_TIMER -7 ; inline ! timers -: EVFILT_MACHPORT -8 ; inline ! Mach ports -: EVFILT_FS -9 ; inline ! Filesystem events - ! actions : EV_ADD HEX: 1 ; inline ! add event to kq (implies enable) : EV_DELETE HEX: 2 ; inline ! delete event from kq diff --git a/extra/unix/kqueue/macosx/macosx.factor b/extra/unix/kqueue/macosx/macosx.factor index 4cc539daa3..7dc2a79c09 100644 --- a/extra/unix/kqueue/macosx/macosx.factor +++ b/extra/unix/kqueue/macosx/macosx.factor @@ -11,3 +11,13 @@ C-STRUCT: kevent ; FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; + +: EVFILT_READ -1 ; inline +: EVFILT_WRITE -2 ; inline +: EVFILT_AIO -3 ; inline ! attached to aio requests +: EVFILT_VNODE -4 ; inline ! attached to vnodes +: EVFILT_PROC -5 ; inline ! attached to struct proc +: EVFILT_SIGNAL -6 ; inline ! attached to struct proc +: EVFILT_TIMER -7 ; inline ! timers +: EVFILT_MACHPORT -8 ; inline ! Mach ports +: EVFILT_FS -9 ; inline ! Filesystem events diff --git a/extra/unix/kqueue/netbsd/netbsd.factor b/extra/unix/kqueue/netbsd/netbsd.factor index 7e97f3bcff..e3fc11a688 100644 --- a/extra/unix/kqueue/netbsd/netbsd.factor +++ b/extra/unix/kqueue/netbsd/netbsd.factor @@ -12,3 +12,11 @@ C-STRUCT: kevent FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; +: EVFILT_READ 0 ; inline +: EVFILT_WRITE 1 ; inline +: EVFILT_AIO 2 ; inline ! attached to aio requests +: EVFILT_VNODE 3 ; inline ! attached to vnodes +: EVFILT_PROC 4 ; inline ! attached to struct proc +: EVFILT_SIGNAL 5 ; inline ! attached to struct proc +: EVFILT_TIMER 6 ; inline ! timers +: EVFILT_SYSCOUNT 7 ; inline ! Filesystem events diff --git a/extra/unix/kqueue/openbsd/openbsd.factor b/extra/unix/kqueue/openbsd/openbsd.factor index 7e97f3bcff..70b75f42bd 100644 --- a/extra/unix/kqueue/openbsd/openbsd.factor +++ b/extra/unix/kqueue/openbsd/openbsd.factor @@ -12,3 +12,10 @@ C-STRUCT: kevent FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; +: EVFILT_READ -1 ; inline +: EVFILT_WRITE -2 ; inline +: EVFILT_AIO -3 ; inline ! attached to aio requests +: EVFILT_VNODE -4 ; inline ! attached to vnodes +: EVFILT_PROC -5 ; inline ! attached to struct proc +: EVFILT_SIGNAL -6 ; inline ! attached to struct proc +: EVFILT_TIMER -7 ; inline ! timers From 6778362ae74dc1d07734e272ca6bd1e91598f346 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 23 Mar 2008 11:34:48 -0500 Subject: [PATCH 02/10] Fix OpenBSD kqueue --- extra/unix/kqueue/openbsd/openbsd.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/unix/kqueue/openbsd/openbsd.factor b/extra/unix/kqueue/openbsd/openbsd.factor index 70b75f42bd..bc4be88c42 100644 --- a/extra/unix/kqueue/openbsd/openbsd.factor +++ b/extra/unix/kqueue/openbsd/openbsd.factor @@ -2,15 +2,15 @@ USE: alien.syntax IN: unix.kqueue C-STRUCT: kevent - { "ulong" "ident" } ! identifier for this event - { "uint" "filter" } ! filter for event - { "uint" "flags" } ! action flags for kqueue - { "uint" "fflags" } ! filter flag value - { "longlong" "data" } ! filter data value - { "void*" "udata" } ! opaque user data identifier + { "uint" "ident" } ! identifier for this event + { "short" "filter" } ! filter for event + { "ushort" "flags" } ! action flags for kqueue + { "uint" "fflags" } ! filter flag value + { "int" "data" } ! filter data value + { "void*" "udata" } ! opaque user data identifier ; -FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; +FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; : EVFILT_READ -1 ; inline : EVFILT_WRITE -2 ; inline From e20e98133216e31e83f2f8514a5e1e340f2f78b1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 23 Mar 2008 11:38:26 -0500 Subject: [PATCH 03/10] fix temp-file --- core/io/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index cb80f98a50..48098e612d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -278,7 +278,7 @@ DEFER: copy-tree-into prepend-path ; : temp-directory ( -- path ) - "resource:temp" dup make-directories ; + "temp" resource-path dup make-directories ; : temp-file ( name -- path ) temp-directory prepend-path ; From da3e9c2fb64805ad9b4c4ac25344911a15c84d5b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 07:35:29 -0500 Subject: [PATCH 04/10] add constant --- build-support/grovel.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/build-support/grovel.c b/build-support/grovel.c index 1260b29c80..2eee054dab 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -1,4 +1,5 @@ #include +#include #if defined(__FreeBSD__) #define BSD @@ -165,6 +166,8 @@ int main() { //grovel(fflags_t); grovel(ssize_t); + grovel(size_t); + grovel(struct kevent); #ifdef UNIX unix_types(); unix_constants(); From 248c88554edcfc8d3f210f8169b38d9f8cbbdfa1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 27 Mar 2008 22:18:43 -0600 Subject: [PATCH 05/10] builder.release: update 'common-files' --- extra/builder/release/release.factor | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor index bb0d16c9da..d76eda8013 100644 --- a/extra/builder/release/release.factor +++ b/extra/builder/release/release.factor @@ -20,21 +20,15 @@ IN: builder.release "boot.x86.32.image" "boot.x86.64.image" "boot.macosx-ppc.image" + "boot.linux-ppc.image" "vm" "temp" "logs" ".git" ".gitignore" "Makefile" - "cp_dir" "unmaintained" - "misc/target" - "misc/wordsize" - "misc/wordsize.c" - "misc/macos-release.sh" - "misc/source-release.sh" - "misc/windows-release.sh" - "misc/version.sh" + "build-support" } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 0934473b72adf14c3c53f8b78996d70fd8926b98 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 27 Mar 2008 22:22:19 -0600 Subject: [PATCH 06/10] builder: cd changed --- extra/builder/builder.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 19734a3266..461d951209 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -13,6 +13,12 @@ IN: builder ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! : cd ( path -- ) current-directory set ; + +: cd ( path -- ) set-current-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : prepare-build-machine ( -- ) builds make-directory builds cd From bbd1ac71808d72520eed014ab08abfd5e4df2c75 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 01:22:51 -0500 Subject: [PATCH 07/10] Fix launchers --- extra/io/unix/launcher/launcher.factor | 2 +- extra/io/windows/launcher/launcher.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 1292f2cacf..f738bd42c2 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -70,7 +70,7 @@ USE: unix [ setup-priority setup-redirection - current-directory get cd + current-directory get resource-path cd dup pass-environment? [ dup get-environment set-os-envs ] when diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 84f8360840..31247e43c3 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -23,12 +23,12 @@ TUPLE: CreateProcess-args : default-CreateProcess-args ( -- obj ) CreateProcess-args construct-empty - 0 >>dwCreateFlags "STARTUPINFO" "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo "PROCESS_INFORMATION" >>lpProcessInformation TRUE >>bInheritHandles - current-directory get >>lpCurrentDirectory ; + 0 >>dwCreateFlags + current-directory get normalize-pathname >>lpCurrentDirectory ; : call-CreateProcess ( CreateProcess-args -- ) { From 3e2a867c3a743d8d1b8cd03c8ca5f33115ef17ef Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 28 Mar 2008 13:37:05 -0500 Subject: [PATCH 08/10] implement touch-file on windows --- extra/io/windows/files/files.factor | 41 ++++++++++++++++++++++++++++- extra/io/windows/windows.factor | 21 ++++++++++++++- 2 files changed, 60 insertions(+), 2 deletions(-) diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 655b5f9daf..7d88392fdc 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -3,7 +3,8 @@ USING: alien.c-types io.backend io.files io.windows kernel math windows windows.kernel32 combinators.cleave windows.time calendar combinators math.functions -sequences namespaces words symbols ; +sequences namespaces words symbols combinators.lib +io.nonblocking destructors ; IN: io.windows.files SYMBOLS: +read-only+ +hidden+ +system+ @@ -93,3 +94,41 @@ M: windows-nt-io file-info ( path -- info ) M: windows-nt-io link-info ( path -- info ) file-info ; + +: file-times ( path -- timestamp timestamp timestamp ) + [ + normalize-pathname open-existing dup close-always + "FILETIME" + "FILETIME" + "FILETIME" + [ GetFileTime win32-error=0/f ] 3keep + [ FILETIME>timestamp >local-time ] 3apply + ] with-destructors ; + +: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) + [ timestamp>FILETIME ] 3apply + SetFileTime win32-error=0/f ; + +: set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) + #! timestamp order: creation access write + [ + >r >r >r + normalize-pathname open-existing dup close-always + r> r> r> (set-file-times) + ] with-destructors ; + +: set-file-create-time ( path timestamp -- ) + f f set-file-times ; + +: set-file-access-time ( path timestamp -- ) + >r f r> f set-file-times ; + +: set-file-write-time ( path timestamp -- ) + >r f f r> set-file-times ; + +M: windows-nt-io touch-file ( path -- ) + [ + normalize-pathname + maybe-create-file over close-always + [ drop ] [ f now dup (set-file-times) ] if + ] with-destructors ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 635a992777..64c4684e15 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -58,7 +58,8 @@ M: win32-file close-handle ( handle -- ) ] with-destructors ; : open-pipe-r/w ( path -- handle ) - GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ; + { GENERIC_READ GENERIC_WRITE } flags + OPEN_EXISTING 0 open-file ; : open-read ( path -- handle length ) GENERIC_READ OPEN_EXISTING 0 open-file 0 ; @@ -69,6 +70,24 @@ M: win32-file close-handle ( handle -- ) : (open-append) ( path -- handle ) GENERIC_WRITE OPEN_ALWAYS 0 open-file ; +: open-existing ( path -- handle ) + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS + f CreateFileW dup win32-error=0/f ; + +: maybe-create-file ( path -- handle ? ) + #! return true if file was just created + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_ALWAYS + 0 CreateFile-flags + f CreateFileW dup win32-error=0/f + GetLastError ERROR_ALREADY_EXISTS = not ; + : set-file-pointer ( handle length -- ) dupd d>w/w FILE_BEGIN SetFilePointer INVALID_SET_FILE_POINTER = [ From 8cf2fd88a52820650b62cdafeb35575e92127f8a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 28 Mar 2008 13:50:23 -0500 Subject: [PATCH 09/10] allow random-32* or random-bytes* to generate randomness in terms of each other --- .../mersenne-twister/mersenne-twister-tests.factor | 4 ++-- extra/random/mersenne-twister/mersenne-twister.factor | 2 +- extra/random/random.factor | 9 ++++++--- extra/random/windows/cryptographic/cryptographic.factor | 1 - 4 files changed, 9 insertions(+), 7 deletions(-) diff --git a/extra/random/mersenne-twister/mersenne-twister-tests.factor b/extra/random/mersenne-twister/mersenne-twister-tests.factor index 49bf4ad3f3..703a0c16e4 100755 --- a/extra/random/mersenne-twister/mersenne-twister-tests.factor +++ b/extra/random/mersenne-twister/mersenne-twister-tests.factor @@ -16,11 +16,11 @@ IN: random.mersenne-twister.tests [ f ] [ 1234 [ make-100-randoms make-100-randoms = ] test-rng ] unit-test [ 1333075495 ] [ - 0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng + 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng ] unit-test [ 1575309035 ] [ - 0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng + 0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng ] unit-test diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index ed515716e0..53ec91b118 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -67,7 +67,7 @@ PRIVATE> M: mersenne-twister seed-random ( mt seed -- ) init-mt-seq >>seq drop ; -M: mersenne-twister random-32 ( mt -- r ) +M: mersenne-twister random-32* ( mt -- r ) dup [ seq>> ] [ i>> ] bi dup mt-n < [ drop 0 pick mt-generate ] unless new-nth mt-temper diff --git a/extra/random/random.factor b/extra/random/random.factor index b10e05d415..f4d4022ae9 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel math namespaces sequences -io.backend ; +io.backend io.binary ; IN: random SYMBOL: random-generator @@ -12,11 +12,14 @@ HOOK: os-crypto-random-32 io-backend ( -- r ) HOOK: os-random-32 io-backend ( -- r ) GENERIC: seed-random ( tuple seed -- ) -GENERIC: random-32 ( tuple -- r ) +GENERIC: random-32* ( tuple -- r ) GENERIC: random-bytes* ( tuple n -- bytes ) M: object random-bytes* ( tuple n -- byte-array ) - [ drop random-32 ] with map >c-uint-array ; + [ drop random-32* ] with map >c-uint-array ; + +M: object random-32* ( tuple -- n ) + 4 random-bytes* le> ; : random-bytes ( n -- r ) [ diff --git a/extra/random/windows/cryptographic/cryptographic.factor b/extra/random/windows/cryptographic/cryptographic.factor index 158f939af9..3f64209200 100644 --- a/extra/random/windows/cryptographic/cryptographic.factor +++ b/extra/random/windows/cryptographic/cryptographic.factor @@ -26,4 +26,3 @@ M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) dup f f PROV_RSA_AES CRYPT_NEWKEYSET CryptAcquireContextW win32-error=0/f *void* ; - From 482efc9c58e6c0e348faf5ec6033fbf22f6169fd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 28 Mar 2008 15:09:21 -0500 Subject: [PATCH 10/10] fix load errors --- extra/random/blum-blum-shub/blum-blum-shub.factor | 2 +- extra/random/dummy/dummy.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 2e59b625b1..00bf22d2a9 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -32,5 +32,5 @@ IN: crypto ! ! #! Cryptographically secure random number using Blum-Blum-Shub 256 ! [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ; -M: blum-blum-shub random-32 ( bbs -- r ) +M: blum-blum-shub random-32* ( bbs -- r ) ; diff --git a/extra/random/dummy/dummy.factor b/extra/random/dummy/dummy.factor index 12607456ec..9120381955 100755 --- a/extra/random/dummy/dummy.factor +++ b/extra/random/dummy/dummy.factor @@ -7,5 +7,5 @@ C: random-dummy M: random-dummy seed-random ( seed obj -- ) (>>i) ; -M: random-dummy random-32 ( obj -- r ) +M: random-dummy random-32* ( obj -- r ) [ dup 1+ ] change-i drop ;