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 )
|
||||
[ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ;
|
||||
|
||||
: (time+) ( timestamp duration -- timestamp' )
|
||||
: (time+) ( timestamp duration -- timestamp' duration )
|
||||
[ second>> +second ] keep
|
||||
[ minute>> +minute ] keep
|
||||
[ hour>> +hour ] keep
|
||||
|
|
|
@ -37,7 +37,7 @@ M: insn linearize-insn , drop ;
|
|||
M: ##branch linearize-insn
|
||||
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 ]
|
||||
[ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
|
||||
|
||||
|
|
|
@ -95,7 +95,7 @@ M: ##dispatch-label generate-insn label>> %dispatch-label ;
|
|||
M: ##dispatch generate-insn
|
||||
[ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ;
|
||||
|
||||
: >slot<
|
||||
: >slot< ( insn -- dst obj slot tag )
|
||||
{
|
||||
[ dst>> register ]
|
||||
[ obj>> register ]
|
||||
|
|
|
@ -28,7 +28,8 @@ PRIVATE>
|
|||
|
||||
: [future] ( quot -- quot' ) '[ _ curry future ] ; inline
|
||||
|
||||
: future-values dup [ ?future ] change-each ; inline
|
||||
: future-values ( futures -- futures )
|
||||
dup [ ?future ] change-each ; inline
|
||||
|
||||
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-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: float-regs return-reg drop XMM0 ;
|
||||
|
|
|
@ -21,6 +21,9 @@ C: <io-callback> io-callback
|
|||
[ (make-overlapped) ] dip
|
||||
handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
|
||||
|
||||
M: winnt FileArgs-overlapped ( port -- overlapped )
|
||||
make-overlapped ;
|
||||
|
||||
: <completion-port> ( handle existing -- handle )
|
||||
f 1 CreateIoCompletionPort dup win32-error=0/f ;
|
||||
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
USING: continuations destructors io.buffers io.files io.backend
|
||||
io.timeouts io.ports io.pathnames io.files.private io.backend.windows
|
||||
io.files.windows io.backend.windows.nt io.encodings.utf16n
|
||||
windows windows.kernel32 kernel libc math threads system
|
||||
environment alien.c-types alien.arrays alien.strings sequences
|
||||
combinators combinators.short-circuit ascii splitting alien
|
||||
strings assocs namespaces make accessors tr ;
|
||||
io.timeouts io.ports io.pathnames io.files.private
|
||||
io.backend.windows io.files.windows io.encodings.utf16n windows
|
||||
windows.kernel32 kernel libc math threads system environment
|
||||
alien.c-types alien.arrays alien.strings sequences combinators
|
||||
combinators.short-circuit ascii splitting alien strings assocs
|
||||
namespaces make accessors tr ;
|
||||
IN: io.files.windows.nt
|
||||
|
||||
M: winnt cwd
|
||||
|
@ -44,9 +44,6 @@ M: winnt normalize-path ( string -- string' )
|
|||
M: winnt CreateFile-flags ( DWORD -- DWORD )
|
||||
FILE_FLAG_OVERLAPPED bitor ;
|
||||
|
||||
M: winnt FileArgs-overlapped ( port -- overlapped )
|
||||
make-overlapped ;
|
||||
|
||||
M: winnt open-append
|
||||
0 ! [ dup file-info size>> ] [ drop 0 ] recover
|
||||
[ (open-append) ] dip >>ptr ;
|
||||
|
|
|
@ -67,7 +67,7 @@ DEFER: byte-bit-count
|
|||
256 [
|
||||
0 swap [ [ 1+ ] when ] each-bit
|
||||
] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
|
||||
(( -- table )) define-declared
|
||||
(( byte -- table )) define-declared
|
||||
|
||||
\ byte-bit-count make-inline
|
||||
|
||||
|
|
|
@ -3,7 +3,8 @@ IN: sequences.next
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: iterate-seq [ dup length swap ] dip ; inline
|
||||
: iterate-seq ( seq quot -- i seq quot )
|
||||
[ [ length ] keep ] dip ; inline
|
||||
|
||||
: (map-next) ( i seq quot -- )
|
||||
! this uses O(n) more bounds checks than is really necessary
|
||||
|
|
|
@ -11,7 +11,7 @@ C: <grid-lines> grid-lines
|
|||
|
||||
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 )
|
||||
half-gap v-
|
||||
|
|
|
@ -4,31 +4,31 @@ USING: alien alien.c-types alien.syntax kernel libc
|
|||
sequences continuations byte-arrays strings math namespaces
|
||||
system combinators vocabs.loader qualified accessors
|
||||
stack-checker macros locals generalizations unix.types
|
||||
io vocabs vocabs.loader ;
|
||||
io vocabs vocabs.loader constants ;
|
||||
IN: unix
|
||||
|
||||
: PROT_NONE 0 ; inline
|
||||
: PROT_READ 1 ; inline
|
||||
: PROT_WRITE 2 ; inline
|
||||
: PROT_EXEC 4 ; inline
|
||||
CONSTANT: PROT_NONE 0
|
||||
CONSTANT: PROT_READ 1
|
||||
CONSTANT: PROT_WRITE 2
|
||||
CONSTANT: PROT_EXEC 4
|
||||
|
||||
CONSTANT: MAP_FILE 0
|
||||
CONSTANT: MAP_SHARED 1
|
||||
CONSTANT: MAP_PRIVATE 2
|
||||
|
||||
: MAP_FILE 0 ; inline
|
||||
: MAP_SHARED 1 ; inline
|
||||
: MAP_PRIVATE 2 ; inline
|
||||
: MAP_FAILED ( -- alien ) -1 <alien> ; inline
|
||||
|
||||
: MAP_FAILED -1 <alien> ; inline
|
||||
CONSTANT: NGROUPS_MAX 16
|
||||
|
||||
: NGROUPS_MAX 16 ; inline
|
||||
|
||||
: DT_UNKNOWN 0 ; inline
|
||||
: DT_FIFO 1 ; inline
|
||||
: DT_CHR 2 ; inline
|
||||
: DT_DIR 4 ; inline
|
||||
: DT_BLK 6 ; inline
|
||||
: DT_REG 8 ; inline
|
||||
: DT_LNK 10 ; inline
|
||||
: DT_SOCK 12 ; inline
|
||||
: DT_WHT 14 ; inline
|
||||
CONSTANT: DT_UNKNOWN 0
|
||||
CONSTANT: DT_FIFO 1
|
||||
CONSTANT: DT_CHR 2
|
||||
CONSTANT: DT_DIR 4
|
||||
CONSTANT: DT_BLK 6
|
||||
CONSTANT: DT_REG 8
|
||||
CONSTANT: DT_LNK 10
|
||||
CONSTANT: DT_SOCK 12
|
||||
CONSTANT: DT_WHT 14
|
||||
|
||||
C-STRUCT: group
|
||||
{ "char*" "gr_name" }
|
||||
|
|
|
@ -180,6 +180,7 @@ 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" } "." } ;
|
||||
|
||||
HELP: sq
|
||||
|
|
|
@ -64,7 +64,7 @@ PRIVATE>
|
|||
: recip ( x -- y ) 1 swap / ; 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
|
||||
|
||||
|
@ -114,15 +114,15 @@ M: float fp-infinity? ( float -- ? )
|
|||
|
||||
<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 )
|
||||
#! Apply quot to i, keep i and quot, hide n.
|
||||
swap [ 2dup 2slip ] dip swap ; inline
|
||||
|
||||
: iterate-next [ 1+ ] 2dip ; inline
|
||||
: iterate-next ( i n quot -- i' n quot ) [ 1+ ] 2dip ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
@ -121,7 +121,7 @@ INSTANCE: integer immutable-sequence
|
|||
|
||||
: (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 )
|
||||
tuck 1 swap set-nth-unsafe
|
||||
|
|
|
@ -111,9 +111,9 @@ HELP: strftime
|
|||
}
|
||||
}
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: calendar formatting ;"
|
||||
"now \"%c\" strftime"
|
||||
{ $unchecked-example
|
||||
"USING: calendar formatting io ;"
|
||||
"now \"%c\" strftime print"
|
||||
"Mon Dec 15 14:40:43 2008" }
|
||||
} ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue