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

build-support/grovel.c

@@ -12,12 +12,18 @@
 	#define UNIX
 #endif
 
-#if (__OpenBSD__)
+#if defined(__OpenBSD__)
 	#define BSD
 	#define OPENBSD
 	#define UNIX
 #endif
 
+#if defined(__APPLE__)
+	#define BSD
+	#define MACOSX
+	#define UNIX
+#endif
+
 #if defined(linux)
 	#define LINUX
 	#define UNIX
@@ -34,6 +40,7 @@
 	#include <sys/stat.h>
 	#include <sys/socket.h>
 	#include <sys/errno.h>
+    #include <sys/mman.h>
 	#include <fcntl.h>
 	#include <unistd.h>
 #endif
@@ -134,6 +141,10 @@ void unix_constants()
 	constant(EINTR);
 	constant(EAGAIN);
 	constant(EINPROGRESS);
+    constant(PROT_READ);
+	constant(PROT_WRITE);
+	constant(MAP_FILE);
+	constant(MAP_SHARED);
 }
 	
 int main() {

extra/io/paths/paths.factor

@@ -44,7 +44,7 @@ TUPLE: directory-iterator path bfs queue ;
 
 : find-all-files ( path bfs? quot -- paths )
     >r <directory-iterator> r>
-    pusher >r iterate-directory drop r> ; inline
+    pusher >r [ f ] compose iterate-directory drop r> ; inline
 
 : recursive-directory ( path bfs? -- paths )
     [ ] accumulator >r each-file r> ;

extra/io/priority/priority.factor

@@ -1,5 +0,0 @@
-USING: io.backend kernel ;
-IN: io.priority
-
-HOOK: get-priority io-backend ( -- n )
-HOOK: set-priority io-backend ( n -- )

extra/io/process/process.factor

@@ -0,0 +1,17 @@
+USING: io.backend kernel ;
+IN: io.priority
+
+SYMBOL: +lowest-priority+
+SYMBOL: +low-priority+
+SYMBOL: +normal-priority+
+SYMBOL: +high-priority+
+SYMBOL: +highest-priority+
+
+HOOK: current-priority io-backend ( -- symbol )
+HOOK: set-current-priority io-backend ( symbol -- )
+HOOK: priority-values ( -- assoc )
+
+: lookup-priority ( symbol -- n )
+    priority-values at ;
+
+HOOK: get-process-list io-backend ( -- assoc )

extra/io/unix/priority/priority.factor

@@ -1,21 +0,0 @@
-USING: alien.syntax kernel io.priority io.unix.backend
-unix ;
-IN: io.unix.priority
-
-: PRIO_PROCESS 0 ; inline
-: PRIO_PGRP 1 ; inline
-: PRIO_USER 2 ; inline
-
-: PRIO_MIN -20 ; inline
-: PRIO_MAX 20 ; inline
-
-! which/who = 0 for current process
-FUNCTION: int getpriority ( int which, int who ) ;
-FUNCTION: int setpriority ( int which, int who, int prio ) ;
-
-M: unix-io get-priority ( -- n )
-    clear_err_no
-    0 0 getpriority dup -1 = [ check-errno ] when ;
-
-M: unix-io set-priority ( n -- )
-    0 0 rot setpriority io-error ;

extra/io/unix/process/process.factor

@@ -0,0 +1,19 @@
+USING: alien.syntax kernel io.process io.unix.backend
+unix ;
+IN: io.unix.process
+
+M: unix-io current-priority ( -- n )
+    clear_err_no
+    0 0 getpriority dup -1 = [ check-errno ] when ;
+
+M: unix-io set-current-priority ( n -- )
+    0 0 rot setpriority io-error ;
+
+M: unix-io priority-values ( -- assoc )
+    {
+        { +lowest-priority+ 20 }
+        { +low-priority+ 10 }
+        { +normal-priority+ 0 }
+        { +high-priority+ -10 }
+        { +highest-priority+ -20 }
+    } ;

extra/io/unix/unix.factor

@@ -1,5 +1,5 @@
 USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
-io.unix.launcher io.unix.mmap io.backend io.unix.priority
+io.unix.launcher io.unix.mmap io.backend io.unix.process
 combinators namespaces system vocabs.loader sequences ;
 
 "io.unix." os append require

extra/io/windows/process/process.factor

@@ -0,0 +1,8 @@
+USING: kernel ;
+IN: io.windows.process
+
+M: windows-io current-priority ( -- n )
+    ;
+
+M: windows-io set-current-priority ( n -- )
+    ;

extra/new-effects/new-effects.factor

@@ -0,0 +1,17 @@
+USING: assocs kernel sequences ;
+IN: new-effects
+
+: new-nth ( seq n -- elt )
+    swap nth ; inline
+
+: new-set-nth ( seq obj n -- seq )
+    pick set-nth ; inline
+
+: new-at ( assoc key -- elt )
+    swap at ; inline
+
+: new-at* ( assoc key -- elt ? )
+    swap at* ; inline
+
+: new-set-at ( assoc value key -- assoc )
+    pick set-at ; inline

extra/random/mersenne-twister/mersenne-twister.factor

@@ -4,14 +4,11 @@
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
 
 USING: arrays kernel math namespaces sequences system init
-accessors math.ranges combinators.cleave random ;
+accessors math.ranges combinators.cleave random new-effects ;
 IN: random.mersenne-twister
 
 <PRIVATE
 
-: new-nth ( seq i -- elt ) swap nth ; inline
-: new-set-nth ( seq obj n -- seq ) pick set-nth ; inline
-
 TUPLE: mersenne-twister seq i ;
 
 : mt-n 624 ; inline

extra/sequences/lib/lib.factor

@@ -225,3 +225,6 @@ PRIVATE>
 
 : replace ( str oldseq newseq -- str' )
     H{ } 2seq>assoc substitute ;
+
+: remove-nth ( seq n -- seq' )
+    cut-slice 1 tail-slice append ;

extra/unix/unix.factor

@@ -102,6 +102,17 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ;
 
 FUNCTION: int kill ( pid_t pid, int sig ) ;
 
+: PRIO_PROCESS 0 ; inline
+: PRIO_PGRP 1 ; inline
+: PRIO_USER 2 ; inline
+
+: PRIO_MIN -20 ; inline
+: PRIO_MAX 20 ; inline
+
+! which/who = 0 for current process
+FUNCTION: int getpriority ( int which, int who ) ;
+FUNCTION: int setpriority ( int which, int who, int prio ) ;
+
 ! Flags for waitpid
 
 : WNOHANG   1 ; inline

extra/windows/kernel32/kernel32.factor

@@ -189,6 +189,16 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
 : FILE_MAP_WRITE  2 ;
 : FILE_MAP_COPY   1 ;
 
+: THREAD_MODE_BACKGROUND_BEGIN HEX: 10000 ; inline
+: THREAD_MODE_BACKGROUND_END   HEX: 20000 ; inline
+: THREAD_PRIORITY_ABOVE_NORMAL 1 ; inline
+: THREAD_PRIORITY_BELOW_NORMAL -1 ; inline
+: THREAD_PRIORITY_HIGHEST 2 ; inline
+: THREAD_PRIORITY_IDLE -15 ; inline
+: THREAD_PRIORITY_LOWEST -2 ; inline
+: THREAD_PRIORITY_NORMAL 0 ; inline
+: THREAD_PRIORITY_TIME_CRITICAL 15 ; inline
+
 C-STRUCT: OVERLAPPED
     { "int" "internal" }
     { "int" "internal-high" }
@@ -998,7 +1008,7 @@ FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ;
 ! FUNCTION: GetNumberOfConsoleMouseButtons
 ! FUNCTION: GetOEMCP
 FUNCTION: BOOL GetOverlappedResult ( HANDLE hFile, LPOVERLAPPED lpOverlapped, LPDWORD lpNumberOfBytesTransferred, BOOL bWait ) ;
-! FUNCTION: GetPriorityClass
+FUNCTION: DWORD GetPriorityClass ( HANDLE hProcess ) ;
 ! FUNCTION: GetPrivateProfileIntA
 ! FUNCTION: GetPrivateProfileIntW
 ! FUNCTION: GetPrivateProfileSectionA
@@ -1065,8 +1075,8 @@ FUNCTION: UINT GetSystemWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ;
 ! FUNCTION: GetThreadContext
 ! FUNCTION: GetThreadIOPendingFlag
 ! FUNCTION: GetThreadLocale
-! FUNCTION: GetThreadPriority
+FUNCTION: int GetThreadPriority ( HANDLE hThread ) ;
-! FUNCTION: GetThreadPriorityBoost
+FUNCTION: BOOL GetThreadPriorityBoost ( HANDLE hThread, PBOOL pDisablePriorityBoost ) ;
 ! FUNCTION: GetThreadSelectorEntry
 ! FUNCTION: GetThreadTimes
 ! FUNCTION: GetTickCount
@@ -1437,9 +1447,9 @@ FUNCTION: BOOL SetHandleInformation ( HANDLE hObject, DWORD dwMask, DWORD dwFlag
 ! FUNCTION: SetMailslotInfo
 ! FUNCTION: SetMessageWaitingIndicator
 ! FUNCTION: SetNamedPipeHandleState
-! FUNCTION: SetPriorityClass
+FUNCTION: BOOL SetPriorityClass ( HANDLE hProcess, DWORD dwPriorityClass ) ;
 ! FUNCTION: SetProcessAffinityMask
-! FUNCTION: SetProcessPriorityBoost
+FUNCTION: BOOL SetProcessPriorityBoost ( HANDLE hProcess, BOOL disablePriorityBoost ) ;
 ! FUNCTION: SetProcessShutdownParameters
 ! FUNCTION: SetProcessWorkingSetSize
 ! FUNCTION: SetStdHandle
@@ -1454,8 +1464,8 @@ FUNCTION: BOOL SetHandleInformation ( HANDLE hObject, DWORD dwMask, DWORD dwFlag
 ! FUNCTION: SetThreadExecutionState
 ! FUNCTION: SetThreadIdealProcessor
 ! FUNCTION: SetThreadLocale
-! FUNCTION: SetThreadPriority
+FUNCTION: BOOL SetThreadPriority ( HANDLE hThread, int nPriority ) ;
-! FUNCTION: SetThreadPriorityBoost
+FUNCTION: BOOL SetThreadPriorityBoost ( HANDLE hThread, BOOL disablePriorityBoost ) ;
 ! FUNCTION: SetThreadUILanguage
 ! FUNCTION: SetTimerQueueTimer
 ! FUNCTION: SetTimeZoneInformation