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

db4
John Benediktsson 2008-12-10 10:13:45 -08:00
commit b2ed2d763c
11 changed files with 72 additions and 59 deletions

View File

@ -10,6 +10,7 @@ IN: bootstrap.x86
: shift-arg ( -- reg ) ECX ; : shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ; : div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ; : mod-arg ( -- reg ) EDX ;
: arg ( -- reg ) EAX ;
: temp0 ( -- reg ) EAX ; : temp0 ( -- reg ) EAX ;
: temp1 ( -- reg ) EDX ; : temp1 ( -- reg ) EDX ;
: temp2 ( -- reg ) ECX ; : temp2 ( -- reg ) ECX ;

View File

@ -5,6 +5,7 @@ cpu.x86.assembler layouts vocabs parser ;
IN: bootstrap.x86 IN: bootstrap.x86
: stack-frame-size ( -- n ) 4 bootstrap-cells ; : stack-frame-size ( -- n ) 4 bootstrap-cells ;
: arg ( -- reg ) RDI ;
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >> << "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
call call

View File

@ -5,6 +5,7 @@ cpu.x86.assembler layouts vocabs parser ;
IN: bootstrap.x86 IN: bootstrap.x86
: stack-frame-size ( -- n ) 8 bootstrap-cells ; : stack-frame-size ( -- n ) 8 bootstrap-cells ;
: arg ( -- reg ) RCX ;
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >> << "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
call call

View File

@ -162,11 +162,11 @@ big-endian off
! Quotations and words ! Quotations and words
[ [
! load from stack ! load from stack
temp0 ds-reg [] MOV arg ds-reg [] MOV
! pop stack ! pop stack
ds-reg bootstrap-cell SUB ds-reg bootstrap-cell SUB
! call quotation ! call quotation
temp0 quot-xt-offset [+] JMP arg quot-xt-offset [+] JMP
] f f f \ (call) define-sub-primitive ] f f f \ (call) define-sub-primitive
[ [

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel io.ports io.unix.backend USING: accessors alien.c-types kernel io.ports io.unix.backend
bit-arrays sequences assocs unix unix.linux.epoll math bit-arrays sequences assocs struct-arrays math namespaces locals
namespaces unix.time ; fry unix unix.linux.epoll unix.time ;
IN: io.unix.epoll IN: io.unix.epoll
TUPLE: epoll-mx < mx events ; TUPLE: epoll-mx < mx events ;
@ -14,47 +14,50 @@ TUPLE: epoll-mx < mx events ;
: <epoll-mx> ( -- mx ) : <epoll-mx> ( -- mx )
epoll-mx new-mx epoll-mx new-mx
max-events epoll_create dup io-error over set-mx-fd max-events epoll_create dup io-error >>fd
max-events "epoll-event" <c-array> over set-epoll-mx-events ; max-events "epoll-event" <struct-array> >>events ;
GENERIC: io-task-events ( task -- n ) : make-event ( fd events -- event )
M: input-task io-task-events drop EPOLLIN ;
M: output-task io-task-events drop EPOLLOUT ;
: make-event ( task -- event )
"epoll-event" <c-object> "epoll-event" <c-object>
over io-task-events over set-epoll-event-events [ set-epoll-event-events ] keep
swap io-task-fd over set-epoll-event-fd ; [ set-epoll-event-fd ] keep ;
: do-epoll-ctl ( task mx what -- ) :: do-epoll-ctl ( fd mx what events -- )
>r mx-fd r> rot dup io-task-fd swap make-event mx fd>> what fd fd events make-event epoll_ctl io-error ;
epoll_ctl io-error ;
M: epoll-mx register-io-task ( task mx -- ) : do-epoll-add ( fd mx events -- )
[ EPOLL_CTL_ADD do-epoll-ctl ] [ call-next-method ] 2bi ; EPOLL_CTL_ADD swap EPOLLONESHOT bitor do-epoll-ctl ;
M: epoll-mx unregister-io-task ( task mx -- ) : do-epoll-del ( fd mx events -- )
[ call-next-method ] [ EPOLL_CTL_DEL do-epoll-ctl ] 2bi ; EPOLL_CTL_DEL swap do-epoll-ctl ;
: wait-event ( mx timeout -- n ) M: epoll-mx add-input-callback ( thread fd mx -- )
>r { mx-fd epoll-mx-events } get-slots max-events [ EPOLLIN do-epoll-add ] [ call-next-method ] 2bi ;
r> epoll_wait dup multiplexer-error ;
: epoll-read-task ( mx fd -- ) M: epoll-mx add-output-callback ( thread fd mx -- )
over mx-reads at* [ perform-io-task ] [ 2drop ] if ; [ EPOLLOUT do-epoll-add ] [ call-next-method ] 2bi ;
: epoll-write-task ( mx fd -- ) M: epoll-mx remove-input-callbacks ( fd mx -- seq )
over mx-writes at* [ perform-io-task ] [ 2drop ] if ; 2dup reads>> key? [
[ call-next-method ] [ EPOLLIN do-epoll-del ] 2bi
] [ 2drop f ] if ;
: handle-event ( mx kevent -- ) M: epoll-mx remove-output-callbacks ( fd mx -- seq )
epoll-event-fd 2dup epoll-read-task epoll-write-task ; 2dup writes>> key? [
[ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi
] [ 2drop f ] if ;
: wait-event ( mx us -- n )
[ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
epoll_wait dup multiplexer-error ;
: handle-event ( event mx -- )
[ epoll-event-fd ] dip
[ EPOLLIN EPOLLOUT bitor do-epoll-del ]
[ input-available ] [ output-available ] 2tri ;
: handle-events ( mx n -- ) : handle-events ( mx n -- )
[ [ dup events>> ] dip head-slice swap '[ _ handle-event ] each ;
over epoll-mx-events epoll-event-nth handle-event
] with each ;
M: epoll-mx wait-for-events ( ms mx -- ) M: epoll-mx wait-for-events ( us mx -- )
dup rot wait-event handle-events ; swap 60000000 or dupd wait-event handle-events ;

View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.backend io.monitors io.unix.backend USING: kernel io.backend io.monitors io.unix.backend
io.unix.select io.unix.linux.monitors system namespaces ; io.unix.epoll io.unix.linux.monitors system namespaces ;
IN: io.unix.linux IN: io.unix.linux
M: linux init-io ( -- ) M: linux init-io ( -- )
<select-mx> mx set-global ; <epoll-mx> mx set-global ;
linux set-io-backend linux set-io-backend

View File

@ -41,9 +41,9 @@ percent-used percent-free ;
: file-system-spec ( file-system-info obj -- str ) : file-system-spec ( file-system-info obj -- str )
{ {
{ device-name [ device-name>> ] } { device-name [ device-name>> [ "" ] unless* ] }
{ mount-point [ mount-point>> ] } { mount-point [ mount-point>> [ "" ] unless* ] }
{ type [ type>> ] } { type [ type>> [ "" ] unless* ] }
{ available-space [ available-space>> [ 0 ] unless* ] } { available-space [ available-space>> [ 0 ] unless* ] }
{ free-space [ free-space>> [ 0 ] unless* ] } { free-space [ free-space>> [ 0 ] unless* ] }
{ used-space [ used-space>> [ 0 ] unless* ] } { used-space [ used-space>> [ 0 ] unless* ] }
@ -63,7 +63,7 @@ percent-used percent-free ;
[ [ unparse ] map ] bi prefix simple-table. ; [ [ unparse ] map ] bi prefix simple-table. ;
: file-systems. ( -- ) : file-systems. ( -- )
{ device-name free-space used-space total-space percent-used } { device-name free-space used-space total-space percent-used mount-point }
print-file-systems ; print-file-systems ;
{ {

View File

@ -28,4 +28,5 @@ FUNCTION: int epoll_wait ( int epfd, epoll_event* events, int maxevents, int tim
: EPOLLMSG HEX: 400 ; inline : EPOLLMSG HEX: 400 ; inline
: EPOLLERR HEX: 008 ; inline : EPOLLERR HEX: 008 ; inline
: EPOLLHUP HEX: 010 ; inline : EPOLLHUP HEX: 010 ; inline
: EPOLLONESHOT 30 2^ ; inline
: EPOLLET 31 2^ ; inline : EPOLLET 31 2^ ; inline

View File

@ -1,7 +1,10 @@
IN: byte-arrays.tests IN: byte-arrays.tests
USING: tools.test byte-arrays ; USING: tools.test byte-arrays sequences kernel ;
[ B{ 1 2 3 0 0 0 } ] [ 6 B{ 1 2 3 } resize-byte-array ] unit-test [ 6 B{ 1 2 3 } ] [
6 B{ 1 2 3 } resize-byte-array
[ length ] [ 3 head ] bi
] unit-test
[ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test [ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test

View File

@ -845,9 +845,10 @@ PRIVATE>
USE: arrays USE: arrays
: array-length ( array -- len ) : array-length ( array -- len )
{ array } declare length>> ; { array } declare length>> ; inline
: array-flip ( matrix -- newmatrix ) : array-flip ( matrix -- newmatrix )
{ array } declare
[ dup first array-length [ array-length min ] reduce ] keep [ dup first array-length [ array-length min ] reduce ] keep
[ [ array-nth ] with { } map-as ] curry { } map-as ; [ [ array-nth ] with { } map-as ] curry { } map-as ;

View File

@ -6,8 +6,10 @@ continuations debugger math ;
IN: benchmark IN: benchmark
: run-benchmark ( vocab -- result ) : run-benchmark ( vocab -- result )
[ "=== " write vocab-name print flush ] [
[ [ require ] [ [ run ] benchmark ] bi ] curry [ [ require ] [ [ run ] benchmark ] bi ] curry
[ error. f ] recover ; [ error. f ] recover
] bi ;
: run-benchmarks ( -- assoc ) : run-benchmarks ( -- assoc )
"benchmark" all-child-vocabs-seq "benchmark" all-child-vocabs-seq