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

db4
Doug Coleman 2009-11-21 17:47:54 -06:00
commit f6ff09cc72
12 changed files with 83 additions and 83 deletions

7
basis/alarms/alarms.factor Normal file → Executable file
View File

@ -59,11 +59,8 @@ SYMBOL: alarm-thread
: trigger-alarms ( alarms -- )
nano-count (trigger-alarms) ;
: next-alarm ( alarms -- timestamp/f )
dup heap-empty? [ drop f ] [
heap-peek drop start>>
nano-count swap -
] if ;
: next-alarm ( alarms -- nanos/f )
dup heap-empty? [ drop f ] [ heap-peek drop start>> ] if ;
: alarm-thread-loop ( -- )
alarms get-global

2
basis/editors/editors.factor Normal file → Executable file
View File

@ -49,7 +49,7 @@ M: cannot-find-source error.
: edit-error ( error -- )
[ error-file ] [ error-line ] bi
2dup and [ edit-location ] [ 2drop ] if ;
over [ 1 or edit-location ] [ 2drop ] if ;
: :edit ( -- )
error get edit-error ;

View File

@ -50,12 +50,12 @@ M: winnt add-completion ( win32-handle -- )
} cond
] with-timeout ;
:: wait-for-overlapped ( usec -- bytes-transferred overlapped error? )
:: wait-for-overlapped ( nanos -- bytes-transferred overlapped error? )
master-completion-port get-global
0 <int> :> bytes
f <void*> :> key
f <void*> :> overlapped
usec [ 1000 /i ] [ INFINITE ] if* :> timeout
nanos [ 1,000,000 /i ] [ INFINITE ] if* :> timeout
bytes key overlapped timeout GetQueuedCompletionStatus zero? :> error?
bytes *int
@ -65,7 +65,7 @@ M: winnt add-completion ( win32-handle -- )
: resume-callback ( result overlapped -- )
>c-ptr pending-overlapped get-global delete-at* drop resume-with ;
: handle-overlapped ( us -- ? )
: handle-overlapped ( nanos -- ? )
wait-for-overlapped [
[
[ drop GetLastError 1array ] dip resume-callback t
@ -75,7 +75,7 @@ M: winnt add-completion ( win32-handle -- )
M: win32-handle cancel-operation
[ check-disposed ] [ handle>> CancelIo drop ] bi ;
M: winnt io-multiplex ( us -- )
M: winnt io-multiplex ( nanos -- )
handle-overlapped [ 0 io-multiplex ] when ;
M: winnt init-io ( -- )

View File

@ -2,10 +2,11 @@
! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays math io.backend io.files.info
io.files.windows io.files.windows.nt kernel windows.kernel32
windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
calendar ascii combinators.short-circuit locals classes.struct
windows.time windows.types windows accessors alien.c-types
combinators generalizations system alien.strings
io.encodings.utf16n sequences splitting windows.errors fry
continuations destructors calendar ascii
combinators.short-circuit locals classes.struct
specialized-arrays alien.data ;
SPECIALIZED-ARRAY: ushort
IN: io.files.info.windows

View File

@ -3,10 +3,10 @@
USING: alien.c-types io.binary io.backend io.files
io.files.types io.buffers io.encodings.utf16n io.ports
io.backend.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words system
destructors accessors math.bitwise continuations windows.errors
arrays byte-arrays generalizations alien.data ;
windows windows.kernel32 windows.time windows.types calendar
combinators math.functions sequences namespaces make words
system destructors accessors math.bitwise continuations
windows.errors arrays byte-arrays generalizations alien.data ;
IN: io.files.windows
: open-file ( path access-mode create-mode flags -- handle )

View File

@ -3,7 +3,8 @@ continuations destructors io.ports io.timeouts io.sockets
io.sockets.private io namespaces io.streams.duplex
io.backend.windows io.sockets.windows io.backend.windows.nt
windows.winsock kernel libc math sequences threads system
combinators accessors classes.struct windows.kernel32 ;
combinators accessors classes.struct windows.kernel32
windows.types ;
IN: io.sockets.windows.nt
: malloc-int ( n -- alien )

2
basis/random/windows/windows.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: accessors alien.c-types alien.data byte-arrays
combinators.short-circuit continuations destructors init kernel
locals namespaces random windows.advapi32 windows.errors
windows.kernel32 math.bitwise ;
windows.kernel32 windows.types math.bitwise ;
IN: random.windows
TUPLE: windows-rng provider type ;

4
basis/tools/threads/threads.factor Normal file → Executable file
View File

@ -14,8 +14,8 @@ IN: tools.threads
] with-cell
[
sleep-entry>> [
key>> nano-count 1000 /i [-] number>string write
" us" write
key>> nano-count [-] number>string write
" nanos" write
] when*
] with-cell ;

3
basis/tools/time/time-docs.factor Normal file → Executable file
View File

@ -9,8 +9,7 @@ ARTICLE: "timing" "Timing code and collecting statistics"
{ $subsections dispatch-stats. gc-events. gc-stats. gc-summary. }
"A lower-level word puts timings on the stack, intead of printing:"
{ $subsections benchmark }
"You can also read the system clock directly:"
{ $subsections system-micros }
"You can also read the system clock directly; see " { $link "system" } "."
{ $see-also "profiling" "calendar" } ;
ABOUT: "timing"

114
basis/windows/com/com-tests.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: kernel windows.com windows.com.syntax windows.ole32
alien alien.syntax tools.test libc alien.c-types
alien alien.syntax tools.test libc alien.c-types
namespaces arrays continuations accessors math windows.com.wrapper
windows.com.wrapper.private destructors effects ;
windows.com.wrapper.private destructors effects compiler.units ;
IN: windows.com.tests
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
@ -34,68 +34,70 @@ SYMBOL: +orig-wrapped-objects+
+wrapped-objects+ get-global clone +orig-wrapped-objects+ set-global
TUPLE: test-implementation x ;
C: <test-implementation> test-implementation
C: <test-implementation> test-implementation
{
{ IInherited {
[ drop S_OK ] ! ISimple::returnOK
[ drop E_FAIL ] ! ISimple::returnError
[ x>> ] ! IInherited::getX
[ >>x drop ] ! IInherited::setX
} }
{ IUnrelated {
[ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
[ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
} }
} <com-wrapper>
dup +test-wrapper+ set [
[
{
{ IInherited {
[ drop S_OK ] ! ISimple::returnOK
[ drop E_FAIL ] ! ISimple::returnError
[ x>> ] ! IInherited::getX
[ >>x drop ] ! IInherited::setX
} }
{ IUnrelated {
[ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
[ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
} }
} <com-wrapper>
dup +test-wrapper+ set [
0 <test-implementation> swap com-wrap
dup +guinea-pig-implementation+ set [ drop
0 <test-implementation> swap com-wrap
dup +guinea-pig-implementation+ set [ drop
S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
20 1array [
+guinea-pig-implementation+ get
[ 20 IInherited::setX ]
[ IInherited::getX ] bi
] unit-test
420 1array [
+guinea-pig-implementation+ get
IUnrelated-iid com-query-interface
[ 20 20 IUnrelated::xMulAdd ] with-com-interface
] unit-test
40 1array [
+guinea-pig-implementation+ get
IUnrelated-iid com-query-interface
[ 20 IUnrelated::xPlus ] with-com-interface
] unit-test
S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
20 1array [
+guinea-pig-implementation+ get
[ 20 IInherited::setX ]
[ IInherited::getX ] bi
] unit-test
420 1array [
+guinea-pig-implementation+ get
IUnrelated-iid com-query-interface
[ 20 20 IUnrelated::xMulAdd ] with-com-interface
] unit-test
40 1array [
+guinea-pig-implementation+ get
IUnrelated-iid com-query-interface
[ 20 IUnrelated::xPlus ] with-com-interface
] unit-test
+guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get com-add-ref
] unit-test
+guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get com-add-ref
] unit-test
{ } [ +guinea-pig-implementation+ get com-release ] unit-test
{ } [ +guinea-pig-implementation+ get com-release ] unit-test
+guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get IUnknown-iid com-query-interface
dup com-release
] unit-test
+guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release
] unit-test
void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get
2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface
dup ISimple-iid com-query-interface
over com-release dup com-release
] unit-test
+guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get IUnknown-iid com-query-interface
dup com-release
] unit-test
+guinea-pig-implementation+ get 1array [
+guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release
] unit-test
void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get
2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface
dup ISimple-iid com-query-interface
over com-release dup com-release
] unit-test
] with-com-interface
] with-com-interface
] with-disposal
] with-disposal
] with-compilation-unit
! Ensure that we freed +guinea-pig-implementation
+orig-wrapped-objects+ get-global 1array [ +wrapped-objects+ get-global ] unit-test

4
basis/windows/time/time.factor Normal file → Executable file
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows.errors
windows.kernel32 namespaces calendar math.bitwise accessors
classes.struct ;
windows.kernel32 windows.types namespaces calendar math.bitwise
accessors classes.struct ;
IN: windows.time
: >64bit ( lo hi -- n )

View File

@ -3,4 +3,4 @@ PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
CC = egcc
CPP = eg++
CFLAGS += -export-dynamic
LIBS = -L/usr/local/lib/ -lm -lrt $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread