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

db4
Daniel Ehrenberg 2010-05-03 17:51:30 -05:00
commit 05f0470556
3 changed files with 21 additions and 15 deletions

View File

@ -30,7 +30,7 @@ MACRO: map-index-compose ( seq quot -- seq )
XINPUT_GAMEPAD_B XINPUT_GAMEPAD_B
XINPUT_GAMEPAD_X XINPUT_GAMEPAD_X
XINPUT_GAMEPAD_Y } XINPUT_GAMEPAD_Y }
[ [ bitand ] dip swap 0 = [ 2drop ] [ 1.0 -rot swap set-nth ] if ] [ [ bitand ] dip swap 0 = [ 2drop ] [ [ 1.0 ] 2dip swap set-nth ] if ]
map-index-compose 2cleave ; map-index-compose 2cleave ;
: >pov ( byte -- symbol ) : >pov ( byte -- symbol )

View File

@ -1,8 +1,10 @@
USING: alien alien.c-types alien.data alien.syntax arrays continuations USING: alien alien.c-types alien.data alien.syntax arrays
destructors generic io.mmap io.ports io.backend.windows io.files.windows continuations destructors generic io.mmap io.ports
kernel libc locals math math.bitwise namespaces quotations sequences windows io.backend.windows io.files.windows kernel libc fry locals math
windows.advapi32 windows.kernel32 windows.types io.backend system accessors math.bitwise namespaces quotations sequences windows
io.backend.windows.privileges classes.struct windows.errors literals ; windows.advapi32 windows.kernel32 windows.types io.backend
system accessors io.backend.windows.privileges classes.struct
windows.errors literals ;
IN: io.backend.windows.nt.privileges IN: io.backend.windows.nt.privileges
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
@ -37,7 +39,11 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
>>Privileges ; >>Privileges ;
M: winnt set-privilege ( name ? -- ) M: winnt set-privilege ( name ? -- )
[ '[
-rot 0 -rot make-token-privileges 0
dup byte-length f f AdjustTokenPrivileges win32-error=0/f _ _ make-token-privileges
dup byte-length
f
f
AdjustTokenPrivileges win32-error=0/f
] with-process-token ; ] with-process-token ;

View File

@ -137,7 +137,7 @@ M: blas-matrix-base clone
: <empty-matrix> ( rows cols exemplar -- matrix ) : <empty-matrix> ( rows cols exemplar -- matrix )
[ element-type heap-size * * <byte-array> ] [ element-type heap-size * * <byte-array> ]
[ 2drop ] [ 2drop ]
[ f swap (blas-matrix-like) ] 3tri ; [ [ f ] dip (blas-matrix-like) ] 3tri ;
: n*M.V+n*V ( alpha A x beta y -- alpha*A.x+b*y ) : n*M.V+n*V ( alpha A x beta y -- alpha*A.x+b*y )
clone n*M.V+n*V! ; clone n*M.V+n*V! ;
@ -153,7 +153,7 @@ M: blas-matrix-base clone
n*M.V+n*V! ; inline n*M.V+n*V! ; inline
: M.V ( A x -- A.x ) : M.V ( A x -- A.x )
1.0 -rot n*M.V ; inline [ 1.0 ] 2dip n*M.V ; inline
: n*V(*)V ( alpha x y -- alpha*x(*)y ) : n*V(*)V ( alpha x y -- alpha*x(*)y )
2dup [ length>> ] bi@ pick <empty-matrix> 2dup [ length>> ] bi@ pick <empty-matrix>
@ -163,16 +163,16 @@ M: blas-matrix-base clone
n*V(*)Vconj+M! ; n*V(*)Vconj+M! ;
: V(*) ( x y -- x(*)y ) : V(*) ( x y -- x(*)y )
1.0 -rot n*V(*)V ; inline [ 1.0 ] 2dip n*V(*)V ; inline
: V(*)conj ( x y -- x(*)yconj ) : V(*)conj ( x y -- x(*)yconj )
1.0 -rot n*V(*)Vconj ; inline [ 1.0 ] 2dip n*V(*)Vconj ; inline
: n*M.M ( alpha A B -- alpha*A.B ) : n*M.M ( alpha A B -- alpha*A.B )
2dup [ Mheight ] [ Mwidth ] bi* pick <empty-matrix> 2dup [ Mheight ] [ Mwidth ] bi* pick <empty-matrix>
1.0 swap n*M.M+n*M! ; [ 1.0 ] dip n*M.M+n*M! ;
: M. ( A B -- A.B ) : M. ( A B -- A.B )
1.0 -rot n*M.M ; inline [ 1.0 ] 2dip n*M.M ; inline
:: (Msub) ( matrix row col height width -- data ld rows cols ) :: (Msub) ( matrix row col height width -- data ld rows cols )
matrix ld>> col * row + matrix element-type heap-size * matrix ld>> col * row + matrix element-type heap-size *