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_X
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 ;
: >pov ( byte -- symbol )

View File

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

View File

@ -137,7 +137,7 @@ M: blas-matrix-base clone
: <empty-matrix> ( rows cols exemplar -- matrix )
[ element-type heap-size * * <byte-array> ]
[ 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 )
clone n*M.V+n*V! ;
@ -153,7 +153,7 @@ M: blas-matrix-base clone
n*M.V+n*V! ; inline
: 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 )
2dup [ length>> ] bi@ pick <empty-matrix>
@ -163,16 +163,16 @@ M: blas-matrix-base clone
n*V(*)Vconj+M! ;
: 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 )
1.0 -rot n*V(*)Vconj ; inline
[ 1.0 ] 2dip n*V(*)Vconj ; inline
: n*M.M ( alpha A B -- alpha*A.B )
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 )
1.0 -rot n*M.M ; inline
[ 1.0 ] 2dip n*M.M ; inline
:: (Msub) ( matrix row col height width -- data ld rows cols )
matrix ld>> col * row + matrix element-type heap-size *