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

db4
Doug Coleman 2008-12-15 22:44:20 -06:00
commit 930f9ac638
15 changed files with 48 additions and 45 deletions

View File

@ -211,7 +211,7 @@ M: real +minute ( timestamp n -- timestamp )
M: number +second ( timestamp n -- timestamp ) M: number +second ( timestamp n -- timestamp )
[ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ; [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ;
: (time+) ( timestamp duration -- timestamp' ) : (time+) ( timestamp duration -- timestamp' duration )
[ second>> +second ] keep [ second>> +second ] keep
[ minute>> +minute ] keep [ minute>> +minute ] keep
[ hour>> +hour ] keep [ hour>> +hour ] keep

View File

@ -37,7 +37,7 @@ M: insn linearize-insn , drop ;
M: ##branch linearize-insn M: ##branch linearize-insn
drop dup successors>> first emit-branch ; drop dup successors>> first emit-branch ;
: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc -- ) : (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc )
[ dup successors>> first2 ] [ dup successors>> first2 ]
[ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline

View File

@ -95,7 +95,7 @@ M: ##dispatch-label generate-insn label>> %dispatch-label ;
M: ##dispatch generate-insn M: ##dispatch generate-insn
[ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ; [ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ;
: >slot< : >slot< ( insn -- dst obj slot tag )
{ {
[ dst>> register ] [ dst>> register ]
[ obj>> register ] [ obj>> register ]

3
basis/concurrency/combinators/combinators.factor Normal file → Executable file
View File

@ -28,7 +28,8 @@ PRIVATE>
: [future] ( quot -- quot' ) '[ _ curry future ] ; inline : [future] ( quot -- quot' ) '[ _ curry future ] ; inline
: future-values dup [ ?future ] change-each ; inline : future-values ( futures -- futures )
dup [ ?future ] change-each ; inline
PRIVATE> PRIVATE>

View File

@ -37,7 +37,7 @@ M:: x86.64 %dispatch ( src temp offset -- )
M: x86.64 param-reg-1 int-regs param-regs first ; M: x86.64 param-reg-1 int-regs param-regs first ;
M: x86.64 param-reg-2 int-regs param-regs second ; M: x86.64 param-reg-2 int-regs param-regs second ;
: param-reg-3 int-regs param-regs third ; inline : param-reg-3 ( -- reg ) int-regs param-regs third ; inline
M: int-regs return-reg drop RAX ; M: int-regs return-reg drop RAX ;
M: float-regs return-reg drop XMM0 ; M: float-regs return-reg drop XMM0 ;

View File

@ -21,6 +21,9 @@ C: <io-callback> io-callback
[ (make-overlapped) ] dip [ (make-overlapped) ] dip
handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ; handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
M: winnt FileArgs-overlapped ( port -- overlapped )
make-overlapped ;
: <completion-port> ( handle existing -- handle ) : <completion-port> ( handle existing -- handle )
f 1 CreateIoCompletionPort dup win32-error=0/f ; f 1 CreateIoCompletionPort dup win32-error=0/f ;

View File

@ -1,10 +1,10 @@
USING: continuations destructors io.buffers io.files io.backend USING: continuations destructors io.buffers io.files io.backend
io.timeouts io.ports io.pathnames io.files.private io.backend.windows io.timeouts io.ports io.pathnames io.files.private
io.files.windows io.backend.windows.nt io.encodings.utf16n io.backend.windows io.files.windows io.encodings.utf16n windows
windows windows.kernel32 kernel libc math threads system windows.kernel32 kernel libc math threads system environment
environment alien.c-types alien.arrays alien.strings sequences alien.c-types alien.arrays alien.strings sequences combinators
combinators combinators.short-circuit ascii splitting alien combinators.short-circuit ascii splitting alien strings assocs
strings assocs namespaces make accessors tr ; namespaces make accessors tr ;
IN: io.files.windows.nt IN: io.files.windows.nt
M: winnt cwd M: winnt cwd
@ -44,9 +44,6 @@ M: winnt normalize-path ( string -- string' )
M: winnt CreateFile-flags ( DWORD -- DWORD ) M: winnt CreateFile-flags ( DWORD -- DWORD )
FILE_FLAG_OVERLAPPED bitor ; FILE_FLAG_OVERLAPPED bitor ;
M: winnt FileArgs-overlapped ( port -- overlapped )
make-overlapped ;
M: winnt open-append M: winnt open-append
0 ! [ dup file-info size>> ] [ drop 0 ] recover 0 ! [ dup file-info size>> ] [ drop 0 ] recover
[ (open-append) ] dip >>ptr ; [ (open-append) ] dip >>ptr ;

2
basis/math/bitwise/bitwise.factor Normal file → Executable file
View File

@ -67,7 +67,7 @@ DEFER: byte-bit-count
256 [ 256 [
0 swap [ [ 1+ ] when ] each-bit 0 swap [ [ 1+ ] when ] each-bit
] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] ] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
(( -- table )) define-declared (( byte -- table )) define-declared
\ byte-bit-count make-inline \ byte-bit-count make-inline

View File

@ -3,7 +3,8 @@ IN: sequences.next
<PRIVATE <PRIVATE
: iterate-seq [ dup length swap ] dip ; inline : iterate-seq ( seq quot -- i seq quot )
[ [ length ] keep ] dip ; inline
: (map-next) ( i seq quot -- ) : (map-next) ( i seq quot -- )
! this uses O(n) more bounds checks than is really necessary ! this uses O(n) more bounds checks than is really necessary

View File

@ -11,7 +11,7 @@ C: <grid-lines> grid-lines
SYMBOL: grid-dim SYMBOL: grid-dim
: half-gap grid get gap>> [ 2/ ] map ; inline : half-gap ( -- gap ) grid get gap>> [ 2/ ] map ; inline
: grid-line-from/to ( orientation point -- from to ) : grid-line-from/to ( orientation point -- from to )
half-gap v- half-gap v-

View File

@ -4,31 +4,31 @@ USING: alien alien.c-types alien.syntax kernel libc
sequences continuations byte-arrays strings math namespaces sequences continuations byte-arrays strings math namespaces
system combinators vocabs.loader qualified accessors system combinators vocabs.loader qualified accessors
stack-checker macros locals generalizations unix.types stack-checker macros locals generalizations unix.types
io vocabs vocabs.loader ; io vocabs vocabs.loader constants ;
IN: unix IN: unix
: PROT_NONE 0 ; inline CONSTANT: PROT_NONE 0
: PROT_READ 1 ; inline CONSTANT: PROT_READ 1
: PROT_WRITE 2 ; inline CONSTANT: PROT_WRITE 2
: PROT_EXEC 4 ; inline CONSTANT: PROT_EXEC 4
CONSTANT: MAP_FILE 0
CONSTANT: MAP_SHARED 1
CONSTANT: MAP_PRIVATE 2
: MAP_FILE 0 ; inline : MAP_FAILED ( -- alien ) -1 <alien> ; inline
: MAP_SHARED 1 ; inline
: MAP_PRIVATE 2 ; inline
: MAP_FAILED -1 <alien> ; inline CONSTANT: NGROUPS_MAX 16
: NGROUPS_MAX 16 ; inline CONSTANT: DT_UNKNOWN 0
CONSTANT: DT_FIFO 1
: DT_UNKNOWN 0 ; inline CONSTANT: DT_CHR 2
: DT_FIFO 1 ; inline CONSTANT: DT_DIR 4
: DT_CHR 2 ; inline CONSTANT: DT_BLK 6
: DT_DIR 4 ; inline CONSTANT: DT_REG 8
: DT_BLK 6 ; inline CONSTANT: DT_LNK 10
: DT_REG 8 ; inline CONSTANT: DT_SOCK 12
: DT_LNK 10 ; inline CONSTANT: DT_WHT 14
: DT_SOCK 12 ; inline
: DT_WHT 14 ; inline
C-STRUCT: group C-STRUCT: group
{ "char*" "gr_name" } { "char*" "gr_name" }

View File

@ -180,6 +180,7 @@ HELP: 1-
} ; } ;
HELP: ?1+ HELP: ?1+
{ $values { "x" { $maybe number } } { "y" number } }
{ $description "If the input is not " { $link f } ", adds one. Otherwise, outputs a " { $snippet "0" } "." } ; { $description "If the input is not " { $link f } ", adds one. Otherwise, outputs a " { $snippet "0" } "." } ;
HELP: sq HELP: sq

8
core/math/math.factor Normal file → Executable file
View File

@ -64,7 +64,7 @@ PRIVATE>
: recip ( x -- y ) 1 swap / ; inline : recip ( x -- y ) 1 swap / ; inline
: sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline : sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline
: ?1+ [ 1+ ] [ 0 ] if* ; inline : ?1+ ( x -- y ) [ 1+ ] [ 0 ] if* ; inline
: rem ( x y -- z ) abs tuck mod over + swap mod ; foldable : rem ( x y -- z ) abs tuck mod over + swap mod ; foldable
@ -114,15 +114,15 @@ M: float fp-infinity? ( float -- ? )
<PRIVATE <PRIVATE
: iterate-prep 0 -rot ; inline : iterate-prep ( n quot -- i n quot ) 0 -rot ; inline
: if-iterate? [ 2over < ] 2dip if ; inline : if-iterate? ( i n true false -- ) [ 2over < ] 2dip if ; inline
: iterate-step ( i n quot -- i n quot ) : iterate-step ( i n quot -- i n quot )
#! Apply quot to i, keep i and quot, hide n. #! Apply quot to i, keep i and quot, hide n.
swap [ 2dup 2slip ] dip swap ; inline swap [ 2dup 2slip ] dip swap ; inline
: iterate-next [ 1+ ] 2dip ; inline : iterate-next ( i n quot -- i' n quot ) [ 1+ ] 2dip ; inline
PRIVATE> PRIVATE>

View File

@ -121,7 +121,7 @@ INSTANCE: integer immutable-sequence
: (tail) ( seq n -- from to seq ) over length rot ; inline : (tail) ( seq n -- from to seq ) over length rot ; inline
: from-end [ dup length ] dip - ; inline : from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
: (2sequence) ( obj1 obj2 seq -- seq ) : (2sequence) ( obj1 obj2 seq -- seq )
tuck 1 swap set-nth-unsafe tuck 1 swap set-nth-unsafe

View File

@ -111,9 +111,9 @@ HELP: strftime
} }
} }
{ $examples { $examples
{ $example { $unchecked-example
"USING: calendar formatting ;" "USING: calendar formatting io ;"
"now \"%c\" strftime" "now \"%c\" strftime print"
"Mon Dec 15 14:40:43 2008" } "Mon Dec 15 14:40:43 2008" }
} ; } ;