Merge branch 'master' of git://factorcode.org/git/factor
commit
930f9ac638
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 ]
|
||||||
|
|
|
@ -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>
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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-
|
||||||
|
|
|
@ -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" }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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>
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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" }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue