Merge branch 'master' of git://factorcode.org/git/factor
commit
9b2dd5de1a
|
@ -5,7 +5,8 @@ hashtables kernel math namespaces sequences words
|
||||||
inference.backend inference.dataflow system
|
inference.backend inference.dataflow system
|
||||||
math.parser classes alien.arrays alien.c-types alien.structs
|
math.parser classes alien.arrays alien.c-types alien.structs
|
||||||
alien.syntax cpu.architecture alien inspector quotations assocs
|
alien.syntax cpu.architecture alien inspector quotations assocs
|
||||||
kernel.private threads continuations.private libc combinators ;
|
kernel.private threads continuations.private libc combinators
|
||||||
|
init ;
|
||||||
IN: alien.compiler
|
IN: alien.compiler
|
||||||
|
|
||||||
! Common protocol for alien-invoke/alien-callback/alien-indirect
|
! Common protocol for alien-invoke/alien-callback/alien-indirect
|
||||||
|
@ -301,7 +302,7 @@ M: alien-indirect generate-node
|
||||||
! this hashtable, they will all be blown away by code GC, beware
|
! this hashtable, they will all be blown away by code GC, beware
|
||||||
SYMBOL: callbacks
|
SYMBOL: callbacks
|
||||||
|
|
||||||
H{ } clone callbacks set-global
|
[ H{ } clone callbacks set-global ] "alien.compiler" add-init-hook
|
||||||
|
|
||||||
: register-callback ( word -- ) dup callbacks get set-at ;
|
: register-callback ( word -- ) dup callbacks get set-at ;
|
||||||
|
|
||||||
|
|
|
@ -38,9 +38,7 @@ TUPLE: no-case ;
|
||||||
pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline
|
pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline
|
||||||
|
|
||||||
M: sequence hashcode*
|
M: sequence hashcode*
|
||||||
[
|
[ sequence-hashcode ] recursive-hashcode ;
|
||||||
0 -rot [ hashcode* bitxor ] curry* each
|
|
||||||
] recursive-hashcode ;
|
|
||||||
|
|
||||||
: alist>quot ( default assoc -- quot )
|
: alist>quot ( default assoc -- quot )
|
||||||
[ rot \ if 3array append [ ] like ] assoc-each ;
|
[ rot \ if 3array append [ ] like ] assoc-each ;
|
||||||
|
|
|
@ -41,6 +41,14 @@ unit-test
|
||||||
4 swap stream-read
|
4 swap stream-read
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
"1234"
|
||||||
|
] [
|
||||||
|
"Hello world\r\n1234" <string-reader>
|
||||||
|
dup stream-readln drop
|
||||||
|
4 swap stream-read-partial
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[
|
[
|
||||||
CHAR: 1
|
CHAR: 1
|
||||||
] [
|
] [
|
||||||
|
|
|
@ -32,15 +32,26 @@ M: line-reader stream-readln ( stream -- str )
|
||||||
"\r\n" over delegate stream-read-until handle-readln ;
|
"\r\n" over delegate stream-read-until handle-readln ;
|
||||||
|
|
||||||
: fix-read ( stream string -- string )
|
: fix-read ( stream string -- string )
|
||||||
"\n" ?head [ swap stream-read1 [ add ] when* ] [ nip ] if ;
|
over line-reader-cr [
|
||||||
|
over cr-
|
||||||
|
"\n" ?head [
|
||||||
|
swap stream-read1 [ add ] when*
|
||||||
|
] [ nip ] if
|
||||||
|
] [ nip ] if ;
|
||||||
|
|
||||||
M: line-reader stream-read
|
M: line-reader stream-read
|
||||||
tuck delegate stream-read
|
tuck delegate stream-read fix-read ;
|
||||||
over line-reader-cr [ over cr- fix-read ] [ nip ] if ;
|
|
||||||
|
M: line-reader stream-read-partial
|
||||||
|
tuck delegate stream-read-partial fix-read ;
|
||||||
|
|
||||||
: fix-read1 ( stream char -- char )
|
: fix-read1 ( stream char -- char )
|
||||||
dup CHAR: \n = [ drop stream-read1 ] [ nip ] if ;
|
over line-reader-cr [
|
||||||
|
over cr-
|
||||||
|
dup CHAR: \n = [
|
||||||
|
drop stream-read1
|
||||||
|
] [ nip ] if
|
||||||
|
] [ nip ] if ;
|
||||||
|
|
||||||
M: line-reader stream-read1 ( stream -- char )
|
M: line-reader stream-read1 ( stream -- char )
|
||||||
dup delegate stream-read1
|
dup delegate stream-read1 fix-read1 ;
|
||||||
over line-reader-cr [ over cr- fix-read1 ] [ nip ] if ;
|
|
||||||
|
|
|
@ -44,7 +44,7 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ;
|
||||||
TUPLE: bounds-error index seq ;
|
TUPLE: bounds-error index seq ;
|
||||||
|
|
||||||
: bounds-error ( n seq -- * )
|
: bounds-error ( n seq -- * )
|
||||||
\ bounds-error construct-boa throw ;
|
die \ bounds-error construct-boa throw ;
|
||||||
|
|
||||||
: bounds-check ( n seq -- n seq )
|
: bounds-check ( n seq -- n seq )
|
||||||
2dup bounds-check? [ bounds-error ] unless ; inline
|
2dup bounds-check? [ bounds-error ] unless ; inline
|
||||||
|
@ -666,3 +666,8 @@ PRIVATE>
|
||||||
|
|
||||||
: infimum ( seq -- n ) dup first [ min ] reduce ;
|
: infimum ( seq -- n ) dup first [ min ] reduce ;
|
||||||
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
||||||
|
|
||||||
|
: sequence-hashcode ( n seq -- x )
|
||||||
|
0 -rot [
|
||||||
|
hashcode* >fixnum swap 31 fixnum*fast fixnum+fast
|
||||||
|
] curry* each ; inline
|
||||||
|
|
|
@ -13,8 +13,7 @@ IN: strings
|
||||||
: reset-string-hashcode f swap set-string-hashcode ; inline
|
: reset-string-hashcode f swap set-string-hashcode ; inline
|
||||||
|
|
||||||
: rehash-string ( str -- )
|
: rehash-string ( str -- )
|
||||||
dup 0 [ swap 31 fixnum*fast fixnum+fast ] reduce
|
1 over sequence-hashcode swap set-string-hashcode ; inline
|
||||||
swap set-string-hashcode ; inline
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -59,3 +59,4 @@ HOOK: process-stream* io-backend ( desc -- stream )
|
||||||
|
|
||||||
USE-IF: unix? io.unix.launcher
|
USE-IF: unix? io.unix.launcher
|
||||||
USE-IF: windows? io.windows.launcher
|
USE-IF: windows? io.windows.launcher
|
||||||
|
USE-IF: winnt? io.windows.nt.launcher
|
||||||
|
|
|
@ -13,7 +13,7 @@ M: windows-ce-io add-completion ( port -- ) drop ;
|
||||||
GENERIC: wince-read ( port port-handle -- )
|
GENERIC: wince-read ( port port-handle -- )
|
||||||
|
|
||||||
M: input-port (wait-to-read) ( port -- )
|
M: input-port (wait-to-read) ( port -- )
|
||||||
dup port-handle wince-read ;
|
dup dup port-handle wince-read pending-error ;
|
||||||
|
|
||||||
GENERIC: wince-write ( port port-handle -- )
|
GENERIC: wince-write ( port port-handle -- )
|
||||||
|
|
||||||
|
@ -41,7 +41,5 @@ M: windows-ce-io init-stdio ( -- )
|
||||||
] [
|
] [
|
||||||
0 _getstdfilex _fileno
|
0 _getstdfilex _fileno
|
||||||
1 _getstdfilex _fileno
|
1 _getstdfilex _fileno
|
||||||
] if
|
] if <win32-duplex-stream>
|
||||||
>r f <win32-file> <reader>
|
] with-variable stdio set ;
|
||||||
r> f <win32-file> <writer>
|
|
||||||
] with-variable <duplex-stream> stdio set ;
|
|
||||||
|
|
|
@ -10,12 +10,16 @@ IN: windows.ce.files
|
||||||
M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ;
|
M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ;
|
||||||
M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
|
M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
|
||||||
|
|
||||||
|
: finish-read ( port status bytes-ret -- )
|
||||||
|
swap [ drop port-errored ] [ swap n>buffer ] if ;
|
||||||
|
|
||||||
M: win32-file wince-read
|
M: win32-file wince-read
|
||||||
drop dup make-FileArgs dup setup-read ReadFile zero? [
|
drop
|
||||||
drop port-errored
|
dup make-FileArgs dup setup-read ReadFile zero?
|
||||||
|
swap FileArgs-lpNumberOfBytesRet *uint dup zero? [
|
||||||
|
2drop t swap set-port-eof?
|
||||||
] [
|
] [
|
||||||
FileArgs-lpNumberOfBytesRet *uint dup zero?
|
finish-read
|
||||||
[ drop t swap set-port-eof? ] [ swap n>buffer ] if
|
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: win32-file wince-write ( port port-handle -- )
|
M: win32-file wince-write ( port port-handle -- )
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
|
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types arrays continuations destructors io
|
USING: alien alien.c-types arrays continuations destructors io
|
||||||
io.windows libc io.nonblocking io.streams.duplex windows.types
|
io.windows libc io.nonblocking io.streams.duplex windows.types
|
||||||
math windows.kernel32 windows namespaces io.launcher kernel
|
math windows.kernel32 windows namespaces io.launcher kernel
|
||||||
sequences windows.errors assocs splitting system ;
|
sequences windows.errors assocs splitting system ;
|
||||||
IN: io.windows.launcher
|
IN: io.windows.launcher
|
||||||
|
|
||||||
! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed."
|
|
||||||
|
|
||||||
TUPLE: CreateProcess-args
|
TUPLE: CreateProcess-args
|
||||||
lpApplicationName
|
lpApplicationName
|
||||||
lpCommandLine
|
lpCommandLine
|
||||||
|
@ -20,6 +20,8 @@ TUPLE: CreateProcess-args
|
||||||
stdout-pipe stdin-pipe ;
|
stdout-pipe stdin-pipe ;
|
||||||
|
|
||||||
: dispose-CreateProcess-args ( args -- )
|
: dispose-CreateProcess-args ( args -- )
|
||||||
|
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed
|
||||||
|
#! with CloseHandle when they are no longer needed."
|
||||||
CreateProcess-args-lpProcessInformation dup
|
CreateProcess-args-lpProcessInformation dup
|
||||||
PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
|
PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
|
||||||
PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
|
PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
|
||||||
|
@ -75,7 +77,7 @@ TUPLE: CreateProcess-args
|
||||||
: fill-dwCreateFlags
|
: fill-dwCreateFlags
|
||||||
0
|
0
|
||||||
pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
|
pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
|
||||||
+detached+ get [ DETACHED_PROCESS bitor ] when
|
+detached+ get winnt? and [ DETACHED_PROCESS bitor ] when
|
||||||
over set-CreateProcess-args-dwCreateFlags ;
|
over set-CreateProcess-args-dwCreateFlags ;
|
||||||
|
|
||||||
: fill-lpEnvironment
|
: fill-lpEnvironment
|
||||||
|
@ -93,137 +95,16 @@ TUPLE: CreateProcess-args
|
||||||
PROCESS_INFORMATION-hProcess INFINITE
|
PROCESS_INFORMATION-hProcess INFINITE
|
||||||
WaitForSingleObject drop ;
|
WaitForSingleObject drop ;
|
||||||
|
|
||||||
|
: make-CreateProcess-args ( -- args )
|
||||||
|
default-CreateProcess-args
|
||||||
|
wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if
|
||||||
|
fill-dwCreateFlags
|
||||||
|
fill-lpEnvironment ;
|
||||||
|
|
||||||
M: windows-io run-process* ( desc -- )
|
M: windows-io run-process* ( desc -- )
|
||||||
[
|
[
|
||||||
default-CreateProcess-args
|
make-CreateProcess-args
|
||||||
wince? [
|
|
||||||
fill-lpApplicationName
|
|
||||||
] [
|
|
||||||
fill-lpCommandLine
|
|
||||||
] if
|
|
||||||
fill-dwCreateFlags
|
|
||||||
fill-lpEnvironment
|
|
||||||
dup call-CreateProcess
|
dup call-CreateProcess
|
||||||
+detached+ get [ dup wait-for-process ] unless
|
+detached+ get [ dup wait-for-process ] unless
|
||||||
dispose-CreateProcess-args
|
dispose-CreateProcess-args
|
||||||
] with-descriptor ;
|
] with-descriptor ;
|
||||||
|
|
||||||
! : default-security-attributes ( -- obj )
|
|
||||||
! "SECURITY_ATTRIBUTES" <c-object>
|
|
||||||
! "SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
|
|
||||||
!
|
|
||||||
! : security-attributes-inherit ( -- obj )
|
|
||||||
! default-security-attributes
|
|
||||||
! TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ;
|
|
||||||
!
|
|
||||||
! : set-inherit ( handle ? -- )
|
|
||||||
! >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
|
|
||||||
!
|
|
||||||
! ! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
|
|
||||||
!
|
|
||||||
! TUPLE: pipe hRead hWrite ;
|
|
||||||
!
|
|
||||||
! C: <pipe> pipe
|
|
||||||
!
|
|
||||||
! : factor-pipe-name
|
|
||||||
! "\\\\.\\pipe\\Factor" ;
|
|
||||||
!
|
|
||||||
! : create-named-pipe ( str -- handle )
|
|
||||||
! PIPE_ACCESS_DUPLEX FILE_FLAG_OVERLAPPED bitor
|
|
||||||
! PIPE_TYPE_BYTE PIPE_READMODE_BYTE PIPE_NOWAIT bitor bitor
|
|
||||||
! PIPE_UNLIMITED_INSTANCES
|
|
||||||
! default-buffer-size get
|
|
||||||
! default-buffer-size get
|
|
||||||
! 0
|
|
||||||
! security-attributes-inherit
|
|
||||||
! CreateNamedPipe dup invalid-handle? ;
|
|
||||||
!
|
|
||||||
! : ERROR_PIPE_CONNECT 535 ; inline
|
|
||||||
!
|
|
||||||
! : pipe-connect-error? ( n -- ? )
|
|
||||||
! ERROR_SUCCESS ERROR_PIPE_CONNECT 2array member? not ;
|
|
||||||
!
|
|
||||||
! clear "ls" <process-stream> contents
|
|
||||||
! M: windows-nt-io <process-stream> ( command -- stream )
|
|
||||||
! [
|
|
||||||
! [
|
|
||||||
! default-CreateProcess-args
|
|
||||||
! fill-lpCommandLine
|
|
||||||
! TRUE over set-CreateProcess-args-bInheritHandles
|
|
||||||
!
|
|
||||||
! dup CreateProcess-args-lpStartupInfo
|
|
||||||
! STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
|
|
||||||
!
|
|
||||||
! factor-pipe-name create-named-pipe
|
|
||||||
! global [ "Named pipe: " write dup . ] bind
|
|
||||||
! dup t set-inherit
|
|
||||||
! [ add-completion ] keep
|
|
||||||
!
|
|
||||||
! ! CreateFile
|
|
||||||
! ! factor-pipe-name open-pipe-r/w
|
|
||||||
! factor-pipe-name GENERIC_READ GENERIC_WRITE bitor
|
|
||||||
! 0 f OPEN_EXISTING FILE_FLAG_OVERLAPPED f
|
|
||||||
! CreateFile
|
|
||||||
! global [ "Created File: " write dup . ] bind
|
|
||||||
! dup invalid-handle? dup close-later
|
|
||||||
! dup add-completion
|
|
||||||
!
|
|
||||||
! swap (make-overlapped) ConnectNamedPipe zero? [
|
|
||||||
! GetLastError pipe-connect-error? [
|
|
||||||
! win32-error-string throw
|
|
||||||
! ] when
|
|
||||||
! ] when
|
|
||||||
! dup t set-inherit
|
|
||||||
!
|
|
||||||
! ! ERROR_PIPE_CONNECTED
|
|
||||||
! [ pick set-CreateProcess-args-stdin-pipe ] keep
|
|
||||||
! global [ "Setting the stdios to: " write dup . ] bind
|
|
||||||
! [ over set-STARTUPINFO-hStdOutput ] keep
|
|
||||||
! [ over set-STARTUPINFO-hStdInput ] keep
|
|
||||||
! swap set-STARTUPINFO-hStdError
|
|
||||||
! !
|
|
||||||
! [ call-CreateProcess ] keep
|
|
||||||
! [ CreateProcess-args-stdin-pipe f <win32-file> dup handle>duplex-stream ] keep
|
|
||||||
! drop ! TODO: close handles instead of drop
|
|
||||||
! ] with-destructors
|
|
||||||
! ] with-descriptor ;
|
|
||||||
!
|
|
||||||
! : create-pipe ( -- pipe )
|
|
||||||
! "HANDLE" <c-object>
|
|
||||||
! "HANDLE" <c-object>
|
|
||||||
! [
|
|
||||||
! security-attributes-inherit
|
|
||||||
! 0
|
|
||||||
! CreatePipe win32-error=0/f
|
|
||||||
! ] 2keep
|
|
||||||
! [ *void* dup close-later ] 2apply <pipe> ;
|
|
||||||
!
|
|
||||||
! M: windows-ce-io process-stream*
|
|
||||||
! [
|
|
||||||
! default-CreateProcess-args
|
|
||||||
! TRUE over set-CreateProcess-args-bInheritHandles
|
|
||||||
!
|
|
||||||
! create-pipe ! for child's STDOUT
|
|
||||||
! dup pipe-hRead f set-inherit
|
|
||||||
! over set-CreateProcess-args-stdout-pipe
|
|
||||||
!
|
|
||||||
! create-pipe ! for child's STDIN
|
|
||||||
! dup pipe-hWrite f set-inherit
|
|
||||||
! over set-CreateProcess-args-stdin-pipe
|
|
||||||
!
|
|
||||||
! dup CreateProcess-args-lpStartupInfo
|
|
||||||
! STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
|
|
||||||
!
|
|
||||||
! over CreateProcess-args-stdout-pipe
|
|
||||||
! pipe-hWrite over set-STARTUPINFO-hStdOutput
|
|
||||||
! over CreateProcess-args-stdout-pipe
|
|
||||||
! pipe-hWrite over set-STARTUPINFO-hStdError
|
|
||||||
! over CreateProcess-args-stdin-pipe
|
|
||||||
! pipe-hRead swap set-STARTUPINFO-hStdInput
|
|
||||||
!
|
|
||||||
! [ call-CreateProcess ] keep
|
|
||||||
! [ CreateProcess-args-stdin-pipe pipe-hRead f <win32-file> <reader> ] keep
|
|
||||||
! [ CreateProcess-args-stdout-pipe pipe-hWrite f <win32-file> <writer> <duplex-stream> ] keep
|
|
||||||
! drop ! TODO: close handles instead of drop
|
|
||||||
! ] with-destructors ;
|
|
||||||
!
|
|
||||||
|
|
|
@ -78,7 +78,7 @@ M: windows-io <mapped-file> ( path length -- mmap )
|
||||||
PAGE_READWRITE SEC_COMMIT bitor
|
PAGE_READWRITE SEC_COMMIT bitor
|
||||||
FILE_MAP_ALL_ACCESS mmap-open
|
FILE_MAP_ALL_ACCESS mmap-open
|
||||||
-rot 2array
|
-rot 2array
|
||||||
\ mapped-file construct-boa
|
f \ mapped-file construct-boa
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
M: windows-io (close-mapped-file) ( mapped-file -- )
|
M: windows-io (close-mapped-file) ( mapped-file -- )
|
||||||
|
|
|
@ -42,7 +42,8 @@ M: windows-nt-io normalize-pathname ( string -- string )
|
||||||
|
|
||||||
SYMBOL: io-hash
|
SYMBOL: io-hash
|
||||||
|
|
||||||
TUPLE: io-callback port continuation ;
|
TUPLE: io-callback continuation port ;
|
||||||
|
|
||||||
C: <io-callback> io-callback
|
C: <io-callback> io-callback
|
||||||
|
|
||||||
: (make-overlapped) ( -- overlapped-ext )
|
: (make-overlapped) ( -- overlapped-ext )
|
||||||
|
@ -74,53 +75,55 @@ SYMBOL: master-completion-port
|
||||||
M: windows-nt-io add-completion ( handle -- )
|
M: windows-nt-io add-completion ( handle -- )
|
||||||
master-completion-port get-global <completion-port> drop ;
|
master-completion-port get-global <completion-port> drop ;
|
||||||
|
|
||||||
TUPLE: GetOverlappedResult-args hFile* lpOverlapped* lpNumberOfBytesTransferred* bWait* port ;
|
: eof? ( error -- ? )
|
||||||
|
dup ERROR_HANDLE_EOF = swap ERROR_BROKEN_PIPE = or ;
|
||||||
|
|
||||||
C: <GetOverlappedResult-args> GetOverlappedResult-args
|
: overlapped-error? ( port n -- ? )
|
||||||
|
zero? [
|
||||||
|
GetLastError {
|
||||||
|
{ [ dup expected-io-error? ] [ 2drop t ] }
|
||||||
|
{ [ dup eof? ] [ drop t swap set-port-eof? f ] }
|
||||||
|
{ [ t ] [ (win32-error-string) throw ] }
|
||||||
|
} cond
|
||||||
|
] [
|
||||||
|
drop t
|
||||||
|
] if ;
|
||||||
|
|
||||||
: get-overlapped-result ( port -- n )
|
: get-overlapped-result ( port -- bytes-transferred )
|
||||||
[
|
dup
|
||||||
port-handle dup win32-file-handle
|
port-handle
|
||||||
swap win32-file-overlapped 0 <int> 0
|
dup win32-file-handle
|
||||||
] keep <GetOverlappedResult-args> [
|
swap win32-file-overlapped
|
||||||
\ GetOverlappedResult-args >tuple<
|
0 <uint> [
|
||||||
>r GetOverlappedResult r> swap overlapped-error? drop
|
0
|
||||||
] keep GetOverlappedResult-args-lpNumberOfBytesTransferred* *int ;
|
GetOverlappedResult overlapped-error? drop
|
||||||
|
] keep *uint ;
|
||||||
: (save-callback) ( io-callback -- )
|
|
||||||
dup io-callback-port port-handle win32-file-overlapped
|
|
||||||
io-hash get-global set-at ;
|
|
||||||
|
|
||||||
: save-callback ( port -- )
|
: save-callback ( port -- )
|
||||||
[
|
[
|
||||||
<io-callback> (save-callback) stop
|
[ <io-callback> ] keep port-handle win32-file-overlapped
|
||||||
] callcc0 drop ;
|
io-hash get-global set-at stop
|
||||||
|
] curry callcc0 ;
|
||||||
|
|
||||||
TUPLE: GetQueuedCompletionStatusParams hCompletionPort* lpNumberOfBytes* lpCompletionKey* lpOverlapped* dwMilliseconds* ;
|
: wait-for-overlapped ( ms -- overlapped ? )
|
||||||
|
>r master-completion-port get-global r> ! port ms
|
||||||
C: <GetQueuedCompletionStatusParams> GetQueuedCompletionStatusParams
|
0 <int> ! bytes
|
||||||
|
f <void*> ! key
|
||||||
: wait-for-overlapped ( ms -- GetQueuedCompletionStatus-Params ret )
|
f <void*> ! overlapped
|
||||||
>r master-completion-port get-global 0 <int> 0 <int> 0 <int>
|
[ roll GetQueuedCompletionStatus ] keep *void* swap zero? ;
|
||||||
r> <GetQueuedCompletionStatusParams> [
|
|
||||||
GetQueuedCompletionStatusParams >tuple*<
|
|
||||||
GetQueuedCompletionStatus
|
|
||||||
] keep swap ;
|
|
||||||
|
|
||||||
: lookup-callback ( GetQueuedCompletion-args -- callback )
|
: lookup-callback ( GetQueuedCompletion-args -- callback )
|
||||||
GetQueuedCompletionStatusParams-lpOverlapped* *void*
|
|
||||||
io-hash get-global delete-at* drop ;
|
io-hash get-global delete-at* drop ;
|
||||||
|
|
||||||
: wait-for-io ( timeout -- continuation/f )
|
: wait-for-io ( timeout -- continuation/f )
|
||||||
wait-for-overlapped
|
wait-for-overlapped [
|
||||||
zero? [
|
GetLastError dup expected-io-error? [
|
||||||
GetLastError dup (expected-io-error?) [
|
|
||||||
2drop f
|
2drop f
|
||||||
] [
|
] [
|
||||||
dup ERROR_HANDLE_EOF = [
|
dup eof? [
|
||||||
drop lookup-callback [
|
drop lookup-callback
|
||||||
io-callback-port t swap set-port-eof?
|
dup io-callback-port t swap set-port-eof?
|
||||||
] keep io-callback-continuation
|
io-callback-continuation
|
||||||
] [
|
] [
|
||||||
(win32-error-string) swap lookup-callback
|
(win32-error-string) swap lookup-callback
|
||||||
[ io-callback-port set-port-error ] keep
|
[ io-callback-port set-port-error ] keep
|
||||||
|
@ -146,10 +149,6 @@ M: windows-nt-io io-multiplex ( ms -- )
|
||||||
cancel-timeout wait-for-io [ schedule-thread ] when* ;
|
cancel-timeout wait-for-io [ schedule-thread ] when* ;
|
||||||
|
|
||||||
M: windows-nt-io init-io ( -- )
|
M: windows-nt-io init-io ( -- )
|
||||||
#! Should only be called on startup. Calling this at any
|
<master-completion-port> master-completion-port set-global
|
||||||
#! other time can have unintended consequences.
|
H{ } clone io-hash set-global
|
||||||
global [
|
windows.winsock:init-winsock ;
|
||||||
<master-completion-port> master-completion-port set
|
|
||||||
H{ } clone io-hash set
|
|
||||||
windows.winsock:init-winsock
|
|
||||||
] bind ;
|
|
||||||
|
|
|
@ -0,0 +1,64 @@
|
||||||
|
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: alien alien.c-types arrays continuations destructors io
|
||||||
|
io.windows libc io.nonblocking io.streams.duplex windows.types
|
||||||
|
math windows.kernel32 windows namespaces io.launcher kernel
|
||||||
|
sequences windows.errors assocs splitting system
|
||||||
|
io.windows.launcher io.windows.nt.pipes ;
|
||||||
|
IN: io.windows.nt.launcher
|
||||||
|
|
||||||
|
! The below code is based on the example given in
|
||||||
|
! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
|
||||||
|
|
||||||
|
: set-inherit ( handle ? -- )
|
||||||
|
>r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
|
||||||
|
|
||||||
|
: add-pipe-dtors ( pipe -- )
|
||||||
|
dup
|
||||||
|
pipe-in close-later
|
||||||
|
pipe-out close-later ;
|
||||||
|
|
||||||
|
: fill-stdout-pipe
|
||||||
|
<unique-incoming-pipe>
|
||||||
|
dup add-pipe-dtors
|
||||||
|
dup pipe-in f set-inherit
|
||||||
|
over set-CreateProcess-args-stdout-pipe ;
|
||||||
|
|
||||||
|
: fill-stdin-pipe
|
||||||
|
<unique-outgoing-pipe>
|
||||||
|
dup add-pipe-dtors
|
||||||
|
dup pipe-out f set-inherit
|
||||||
|
over set-CreateProcess-args-stdin-pipe ;
|
||||||
|
|
||||||
|
: fill-startup-info
|
||||||
|
dup CreateProcess-args-lpStartupInfo
|
||||||
|
STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
|
||||||
|
|
||||||
|
over CreateProcess-args-stdout-pipe
|
||||||
|
pipe-out over set-STARTUPINFO-hStdOutput
|
||||||
|
over CreateProcess-args-stdout-pipe
|
||||||
|
pipe-out over set-STARTUPINFO-hStdError
|
||||||
|
over CreateProcess-args-stdin-pipe
|
||||||
|
pipe-in swap set-STARTUPINFO-hStdInput ;
|
||||||
|
|
||||||
|
M: windows-io process-stream*
|
||||||
|
[
|
||||||
|
[
|
||||||
|
make-CreateProcess-args
|
||||||
|
TRUE over set-CreateProcess-args-bInheritHandles
|
||||||
|
|
||||||
|
fill-stdout-pipe
|
||||||
|
fill-stdin-pipe
|
||||||
|
fill-startup-info
|
||||||
|
|
||||||
|
dup call-CreateProcess
|
||||||
|
|
||||||
|
dup CreateProcess-args-stdin-pipe pipe-in CloseHandle drop
|
||||||
|
dup CreateProcess-args-stdout-pipe pipe-out CloseHandle drop
|
||||||
|
|
||||||
|
dup CreateProcess-args-stdout-pipe pipe-in
|
||||||
|
over CreateProcess-args-stdin-pipe pipe-out <win32-duplex-stream>
|
||||||
|
|
||||||
|
swap dispose-CreateProcess-args
|
||||||
|
] with-destructors
|
||||||
|
] with-descriptor ;
|
|
@ -0,0 +1,75 @@
|
||||||
|
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: alien alien.c-types arrays destructors io io.windows libc
|
||||||
|
windows.types math windows.kernel32 windows namespaces kernel
|
||||||
|
sequences windows.errors assocs math.parser system random ;
|
||||||
|
IN: io.windows.nt.pipes
|
||||||
|
|
||||||
|
! This code is based on
|
||||||
|
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
|
||||||
|
|
||||||
|
: default-security-attributes ( -- obj )
|
||||||
|
"SECURITY_ATTRIBUTES" <c-object>
|
||||||
|
"SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
|
||||||
|
|
||||||
|
: security-attributes-inherit ( -- obj )
|
||||||
|
default-security-attributes
|
||||||
|
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
|
||||||
|
|
||||||
|
: create-named-pipe ( name mode -- handle )
|
||||||
|
FILE_FLAG_OVERLAPPED bitor
|
||||||
|
PIPE_TYPE_BYTE
|
||||||
|
1
|
||||||
|
4096
|
||||||
|
4096
|
||||||
|
0
|
||||||
|
security-attributes-inherit
|
||||||
|
CreateNamedPipe
|
||||||
|
dup win32-error=0/f
|
||||||
|
dup add-completion ;
|
||||||
|
|
||||||
|
: open-other-end ( name mode -- handle )
|
||||||
|
FILE_SHARE_READ FILE_SHARE_WRITE bitor
|
||||||
|
security-attributes-inherit
|
||||||
|
OPEN_EXISTING
|
||||||
|
FILE_FLAG_OVERLAPPED
|
||||||
|
f
|
||||||
|
CreateFile
|
||||||
|
dup win32-error=0/f
|
||||||
|
dup add-completion ;
|
||||||
|
|
||||||
|
TUPLE: pipe in out ;
|
||||||
|
|
||||||
|
: <pipe> ( name in-mode out-mode -- pipe )
|
||||||
|
[
|
||||||
|
>r over >r create-named-pipe dup close-later
|
||||||
|
r> r> open-other-end dup close-later
|
||||||
|
pipe construct-boa
|
||||||
|
] with-destructors ;
|
||||||
|
|
||||||
|
: close-pipe ( pipe -- )
|
||||||
|
dup
|
||||||
|
pipe-in CloseHandle drop
|
||||||
|
pipe-out CloseHandle drop ;
|
||||||
|
|
||||||
|
: <incoming-pipe> ( name -- pipe )
|
||||||
|
PIPE_ACCESS_INBOUND GENERIC_WRITE <pipe> ;
|
||||||
|
|
||||||
|
: <outgoing-pipe> ( name -- pipe )
|
||||||
|
PIPE_ACCESS_DUPLEX GENERIC_READ <pipe> ;
|
||||||
|
|
||||||
|
: unique-pipe-name ( -- string )
|
||||||
|
[
|
||||||
|
"\\\\.\\pipe\\factor-" %
|
||||||
|
pipe counter #
|
||||||
|
"-" %
|
||||||
|
(random) #
|
||||||
|
"-" %
|
||||||
|
millis #
|
||||||
|
] "" make ;
|
||||||
|
|
||||||
|
: <unique-incoming-pipe> ( -- pipe )
|
||||||
|
unique-pipe-name <incoming-pipe> ;
|
||||||
|
|
||||||
|
: <unique-outgoing-pipe> ( -- pipe )
|
||||||
|
unique-pipe-name <outgoing-pipe> ;
|
|
@ -1,16 +0,0 @@
|
||||||
USING: io.files kernel tools.test ;
|
|
||||||
IN: temporary
|
|
||||||
|
|
||||||
[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
|
|
||||||
[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
|
|
||||||
[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test
|
|
||||||
! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing
|
|
||||||
[ "c:\\" ] [ "c:\\" parent-directory ] unit-test
|
|
||||||
[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test
|
|
||||||
[ "c:" ] [ "c:" parent-directory ] unit-test
|
|
||||||
[ "Z:" ] [ "Z:" parent-directory ] unit-test
|
|
||||||
[ t ] [ "c:\\" root-directory? ] unit-test
|
|
||||||
[ t ] [ "Z:\\" root-directory? ] unit-test
|
|
||||||
[ f ] [ "c:\\foo" root-directory? ] unit-test
|
|
||||||
[ f ] [ "." root-directory? ] unit-test
|
|
||||||
[ f ] [ ".." root-directory? ] unit-test
|
|
|
@ -20,6 +20,9 @@ TUPLE: win32-file handle ptr overlapped ;
|
||||||
: <win32-file> ( handle ptr -- obj )
|
: <win32-file> ( handle ptr -- obj )
|
||||||
f win32-file construct-boa ;
|
f win32-file construct-boa ;
|
||||||
|
|
||||||
|
: <win32-duplex-stream> ( in out -- stream )
|
||||||
|
>r f <win32-file> r> f <win32-file> handle>duplex-stream ;
|
||||||
|
|
||||||
HOOK: CreateFile-flags io-backend ( -- DWORD )
|
HOOK: CreateFile-flags io-backend ( -- DWORD )
|
||||||
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
|
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
|
||||||
HOOK: add-completion io-backend ( port -- )
|
HOOK: add-completion io-backend ( port -- )
|
||||||
|
|
|
@ -24,7 +24,6 @@ IN: tools.deploy.shaker
|
||||||
"Stripping debugger" show
|
"Stripping debugger" show
|
||||||
"resource:extra/tools/deploy/shaker/strip-debugger.factor"
|
"resource:extra/tools/deploy/shaker/strip-debugger.factor"
|
||||||
run-file
|
run-file
|
||||||
do-parse-hook
|
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: strip-libc ( -- )
|
: strip-libc ( -- )
|
||||||
|
@ -32,7 +31,6 @@ IN: tools.deploy.shaker
|
||||||
"Stripping manual memory management debug code" show
|
"Stripping manual memory management debug code" show
|
||||||
"resource:extra/tools/deploy/shaker/strip-libc.factor"
|
"resource:extra/tools/deploy/shaker/strip-libc.factor"
|
||||||
run-file
|
run-file
|
||||||
do-parse-hook
|
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: strip-cocoa ( -- )
|
: strip-cocoa ( -- )
|
||||||
|
@ -40,7 +38,6 @@ IN: tools.deploy.shaker
|
||||||
"Stripping unused Cocoa methods" show
|
"Stripping unused Cocoa methods" show
|
||||||
"resource:extra/tools/deploy/shaker/strip-cocoa.factor"
|
"resource:extra/tools/deploy/shaker/strip-cocoa.factor"
|
||||||
run-file
|
run-file
|
||||||
do-parse-hook
|
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: strip-assoc ( retained-keys assoc -- newassoc )
|
: strip-assoc ( retained-keys assoc -- newassoc )
|
||||||
|
@ -116,7 +113,6 @@ SYMBOL: deploy-vocab
|
||||||
|
|
||||||
strip-dictionary? [
|
strip-dictionary? [
|
||||||
{
|
{
|
||||||
builtins
|
|
||||||
dictionary
|
dictionary
|
||||||
inspector-hook
|
inspector-hook
|
||||||
lexer-factory
|
lexer-factory
|
||||||
|
@ -142,6 +138,10 @@ SYMBOL: deploy-vocab
|
||||||
"c-types" "alien.c-types" lookup ,
|
"c-types" "alien.c-types" lookup ,
|
||||||
] when
|
] when
|
||||||
|
|
||||||
|
native-io? [
|
||||||
|
"default-buffer-size" "io.nonblocking" lookup ,
|
||||||
|
] when
|
||||||
|
|
||||||
deploy-ui? get [
|
deploy-ui? get [
|
||||||
"ui" child-vocabs
|
"ui" child-vocabs
|
||||||
"cocoa" child-vocabs
|
"cocoa" child-vocabs
|
||||||
|
@ -152,10 +152,11 @@ SYMBOL: deploy-vocab
|
||||||
] when
|
] when
|
||||||
] { } make dup . ;
|
] { } make dup . ;
|
||||||
|
|
||||||
: strip ( -- )
|
: strip ( hook -- )
|
||||||
strip-libc
|
>r strip-libc
|
||||||
strip-cocoa
|
strip-cocoa
|
||||||
strip-debugger
|
strip-debugger
|
||||||
|
r> [ call ] when*
|
||||||
strip-init-hooks
|
strip-init-hooks
|
||||||
deploy-vocab get vocab-main set-boot-quot*
|
deploy-vocab get vocab-main set-boot-quot*
|
||||||
retained-props >r
|
retained-props >r
|
||||||
|
@ -168,10 +169,9 @@ SYMBOL: deploy-vocab
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
deploy-vocab set
|
deploy-vocab set
|
||||||
parse-hook get >r
|
parse-hook get
|
||||||
parse-hook off
|
parse-hook off
|
||||||
deploy-vocab get require
|
deploy-vocab get require
|
||||||
r> [ call ] when*
|
|
||||||
strip
|
strip
|
||||||
finish-deploy
|
finish-deploy
|
||||||
] [
|
] [
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: ui.gadgets.editors tools.test kernel io io.streams.plain
|
USING: ui.gadgets.editors tools.test kernel io io.streams.plain
|
||||||
definitions namespaces ui.gadgets
|
definitions namespaces ui.gadgets
|
||||||
ui.gadgets.grids prettyprint documents ui.gestures
|
ui.gadgets.grids prettyprint documents ui.gestures
|
||||||
tools.test.inference tools.test.ui ;
|
tools.test.inference tools.test.ui models ;
|
||||||
|
|
||||||
[ "foo bar" ] [
|
[ "foo bar" ] [
|
||||||
<editor> "editor" set
|
<editor> "editor" set
|
||||||
|
@ -31,3 +31,9 @@ tools.test.inference tools.test.ui ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ 0 1 } [ <editor> ] unit-test-effect
|
{ 0 1 } [ <editor> ] unit-test-effect
|
||||||
|
|
||||||
|
"hello" <model> <field> "field" set
|
||||||
|
|
||||||
|
"field" get [
|
||||||
|
[ "hello" ] [ "field" get field-model model-value ] unit-test
|
||||||
|
] with-grafted-gadget
|
||||||
|
|
|
@ -70,8 +70,12 @@ M: gadget model-changed 2drop ;
|
||||||
>r <gadget> r> construct-delegate ; inline
|
>r <gadget> r> construct-delegate ; inline
|
||||||
|
|
||||||
: activate-control ( gadget -- )
|
: activate-control ( gadget -- )
|
||||||
dup gadget-model dup [ 2dup add-connection ] when drop
|
dup gadget-model dup [
|
||||||
dup gadget-model swap model-changed ;
|
2dup add-connection
|
||||||
|
swap model-changed
|
||||||
|
] [
|
||||||
|
2drop
|
||||||
|
] if ;
|
||||||
|
|
||||||
: deactivate-control ( gadget -- )
|
: deactivate-control ( gadget -- )
|
||||||
dup gadget-model dup [ 2dup remove-connection ] when 2drop ;
|
dup gadget-model dup [ 2dup remove-connection ] when 2drop ;
|
||||||
|
|
|
@ -280,10 +280,13 @@ SYMBOL: hWnd
|
||||||
mouse-captured? [ release-capture ] when
|
mouse-captured? [ release-capture ] when
|
||||||
prepare-mouse send-button-up ;
|
prepare-mouse send-button-up ;
|
||||||
|
|
||||||
|
: make-TRACKMOUSEEVENT ( hWnd -- alien )
|
||||||
|
"TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
|
||||||
|
"TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ;
|
||||||
|
|
||||||
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
||||||
2nip
|
2nip
|
||||||
over "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
|
over make-TRACKMOUSEEVENT
|
||||||
"TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize
|
|
||||||
TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
|
TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
|
||||||
0 over set-TRACKMOUSEEVENT-dwHoverTime
|
0 over set-TRACKMOUSEEVENT-dwHoverTime
|
||||||
TrackMouseEvent drop
|
TrackMouseEvent drop
|
||||||
|
@ -387,10 +390,10 @@ SYMBOL: hWnd
|
||||||
dup SetForegroundWindow drop
|
dup SetForegroundWindow drop
|
||||||
SetFocus drop ;
|
SetFocus drop ;
|
||||||
|
|
||||||
: init-win32-ui
|
: init-win32-ui ( -- )
|
||||||
"MSG" <c-object> msg-obj set
|
"MSG" <c-object> msg-obj set
|
||||||
"Factor-window" malloc-u16-string class-name-ptr set-global
|
"Factor-window" malloc-u16-string class-name-ptr set-global
|
||||||
register-wndclassex
|
register-wndclassex drop
|
||||||
GetDoubleClickTime double-click-timeout set-global ;
|
GetDoubleClickTime double-click-timeout set-global ;
|
||||||
|
|
||||||
: cleanup-win32-ui ( -- )
|
: cleanup-win32-ui ( -- )
|
||||||
|
|
|
@ -3,6 +3,7 @@ IN: windows.errors
|
||||||
|
|
||||||
: ERROR_SUCCESS 0 ; inline
|
: ERROR_SUCCESS 0 ; inline
|
||||||
: ERROR_HANDLE_EOF 38 ; inline
|
: ERROR_HANDLE_EOF 38 ; inline
|
||||||
|
: ERROR_BROKEN_PIPE 109 ; inline
|
||||||
: ERROR_IO_INCOMPLETE 996 ; inline
|
: ERROR_IO_INCOMPLETE 996 ; inline
|
||||||
: ERROR_IO_PENDING 997 ; inline
|
: ERROR_IO_PENDING 997 ; inline
|
||||||
|
|
||||||
|
|
|
@ -39,30 +39,21 @@ FUNCTION: void* error_message ( DWORD id ) ;
|
||||||
win32-error-string throw
|
win32-error-string throw
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: (expected-io-error?) ( error-code -- ? )
|
: expected-io-errors
|
||||||
ERROR_SUCCESS
|
ERROR_SUCCESS
|
||||||
ERROR_IO_INCOMPLETE
|
ERROR_IO_INCOMPLETE
|
||||||
ERROR_IO_PENDING
|
ERROR_IO_PENDING
|
||||||
WAIT_TIMEOUT 4array member? ;
|
WAIT_TIMEOUT 4array ; foldable
|
||||||
|
|
||||||
: expected-io-error? ( error-code -- )
|
: expected-io-error? ( error-code -- ? )
|
||||||
dup (expected-io-error?) [
|
expected-io-errors member? ;
|
||||||
|
|
||||||
|
: expected-io-error ( error-code -- )
|
||||||
|
dup expected-io-error? [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
(win32-error-string) throw
|
(win32-error-string) throw
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: io-error ( return-value -- )
|
: io-error ( return-value -- )
|
||||||
{ 0 f } member? [ GetLastError expected-io-error? ] when ;
|
{ 0 f } member? [ GetLastError expected-io-error ] when ;
|
||||||
|
|
||||||
: overlapped-error? ( port n -- ? )
|
|
||||||
zero? [
|
|
||||||
GetLastError
|
|
||||||
{
|
|
||||||
{ [ dup (expected-io-error?) ] [ 2drop t ] }
|
|
||||||
{ [ dup ERROR_HANDLE_EOF = ] [ drop t swap set-port-eof? f ] }
|
|
||||||
{ [ t ] [ (win32-error-string) throw ] }
|
|
||||||
} cond
|
|
||||||
] [
|
|
||||||
drop t
|
|
||||||
] if ;
|
|
||||||
|
|
Loading…
Reference in New Issue