steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2008-03-28 20:28:55 -05:00
parent a0975b5c46 482efc9c58
commit b6fdf66f29
19 changed files with 128 additions and 40 deletions

3
build-support/grovel.c
View File

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

2
core/io/files/files.factor
View File

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

6
extra/builder/builder.factor
View File

@ -13,6 +13,12 @@ IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! : cd ( path -- ) current-directory set ;
: cd ( path -- ) set-current-directory ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: prepare-build-machine ( -- )
builds make-directory
builds cd

10
extra/builder/release/release.factor
View File

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

2
extra/io/unix/launcher/launcher.factor
View File

@ -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

41
extra/io/windows/files/files.factor
View File

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

4
extra/io/windows/launcher/launcher.factor
View File

@ -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 -- )
{

21
extra/io/windows/windows.factor
View File

@ -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 = [

2
extra/random/blum-blum-shub/blum-blum-shub.factor
View File

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

2
extra/random/dummy/dummy.factor
View File

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

4
extra/random/mersenne-twister/mersenne-twister-tests.factor
View File

@ -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

2
extra/random/mersenne-twister/mersenne-twister.factor
View File

@ -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

9
extra/random/random.factor
View File

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

1
extra/random/windows/cryptographic/cryptographic.factor
View File

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

10
extra/unix/kqueue/freebsd/freebsd.factor
View File

@ -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

10
extra/unix/kqueue/kqueue.factor
View File

@ -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

10
extra/unix/kqueue/macosx/macosx.factor
View File

@ -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

8
extra/unix/kqueue/netbsd/netbsd.factor
View File

@ -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

21
extra/unix/kqueue/openbsd/openbsd.factor
View File

@ -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