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

build-support/grovel.c

@@ -1,4 +1,5 @@
 #include <stdio.h>
+#include <sys/event.h>
 
 #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();

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 ;

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

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"
   } ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

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" <c-object>
+        "FILETIME" <c-object>
+        "FILETIME" <c-object>
+        [ 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 ;

extra/io/windows/launcher/launcher.factor

@@ -23,12 +23,12 @@ TUPLE: CreateProcess-args
 
 : default-CreateProcess-args ( -- obj )
     CreateProcess-args construct-empty
-    0 >>dwCreateFlags
     "STARTUPINFO" <c-object>
     "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
     "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
     TRUE >>bInheritHandles
-    current-directory get >>lpCurrentDirectory ;
+    0 >>dwCreateFlags
+    current-directory get normalize-pathname >>lpCurrentDirectory ;
 
 : call-CreateProcess ( CreateProcess-args -- )
     {

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 <uint> FILE_BEGIN SetFilePointer
     INVALID_SET_FILE_POINTER = [

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 )
     ;

extra/random/dummy/dummy.factor

@@ -7,5 +7,5 @@ C: <random-dummy> 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 ;

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
 
 

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

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 )
     [

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*
     <windows-crypto-context> ;
-

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

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

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

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

extra/unix/kqueue/openbsd/openbsd.factor

@@ -2,13 +2,20 @@ 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
+: 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