diff --git a/build-support/grovel.c b/build-support/grovel.c index 600865cf39..8422ec197c 100644 --- a/build-support/grovel.c +++ b/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 #include #include + #include #include #include #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() { diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index 6c73669e9f..dad1087022 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -44,7 +44,7 @@ TUPLE: directory-iterator path bfs queue ; : find-all-files ( path bfs? quot -- paths ) >r 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> ; diff --git a/extra/io/priority/priority.factor b/extra/io/priority/priority.factor deleted file mode 100644 index 0790563072..0000000000 --- a/extra/io/priority/priority.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: io.backend kernel ; -IN: io.priority - -HOOK: get-priority io-backend ( -- n ) -HOOK: set-priority io-backend ( n -- ) diff --git a/extra/io/process/process.factor b/extra/io/process/process.factor new file mode 100644 index 0000000000..8a7c5b1a11 --- /dev/null +++ b/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 ) diff --git a/extra/io/unix/priority/priority.factor b/extra/io/unix/priority/priority.factor deleted file mode 100644 index deb801e3cf..0000000000 --- a/extra/io/unix/priority/priority.factor +++ /dev/null @@ -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 ; diff --git a/extra/io/unix/process/process.factor b/extra/io/unix/process/process.factor new file mode 100644 index 0000000000..00df6b6f52 --- /dev/null +++ b/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 } + } ; diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index bd58761a5b..d1c0db72f4 100755 --- a/extra/io/unix/unix.factor +++ b/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 diff --git a/extra/io/windows/process/process.factor b/extra/io/windows/process/process.factor new file mode 100644 index 0000000000..f0ca04fd8a --- /dev/null +++ b/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 -- ) + ; diff --git a/extra/new-effects/new-effects.factor b/extra/new-effects/new-effects.factor new file mode 100644 index 0000000000..f073ccadd3 --- /dev/null +++ b/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 diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index bf2ff78f2d..ed515716e0 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/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 : replace ( str oldseq newseq -- str' ) H{ } 2seq>assoc substitute ; + +: remove-nth ( seq n -- seq' ) + cut-slice 1 tail-slice append ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 09d77fee11..8953b638f6 100755 --- a/extra/unix/unix.factor +++ b/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 diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor index 37b833cae1..22a86818cf 100644 --- a/extra/windows/kernel32/kernel32.factor +++ b/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: GetThreadPriorityBoost +FUNCTION: int GetThreadPriority ( HANDLE hThread ) ; +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: SetThreadPriorityBoost +FUNCTION: BOOL SetThreadPriority ( HANDLE hThread, int nPriority ) ; +FUNCTION: BOOL SetThreadPriorityBoost ( HANDLE hThread, BOOL disablePriorityBoost ) ; ! FUNCTION: SetThreadUILanguage ! FUNCTION: SetTimerQueueTimer ! FUNCTION: SetTimeZoneInformation