steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Joe Groff 2009-08-30 19:05:43 -05:00
parent 0df9884ee5 bd629c1262
commit c9e83ba3c3
66 changed files with 885 additions and 695 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/calendar/unix/unix.factor
View File

@ -1,28 +1,27 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax arrays calendar
kernel math unix unix.time unix.types namespaces system ;
kernel math unix unix.time unix.types namespaces system
accessors classes.struct ;
IN: calendar.unix
: timeval>seconds ( timeval -- seconds )
[ timeval-sec seconds ] [ timeval-usec microseconds ] bi
time+ ;
[ sec>> seconds ] [ usec>> microseconds ] bi time+ ;
: timeval>unix-time ( timeval -- timestamp )
timeval>seconds since-1970 ;
: timespec>seconds ( timespec -- seconds )
[ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi
time+ ;
[ sec>> seconds ] [ nsec>> nanoseconds ] bi time+ ;
: timespec>unix-time ( timespec -- timestamp )
timespec>seconds since-1970 ;
: get-time ( -- alien )
f time <time_t> localtime ;
f time <time_t> localtime tm memory>struct ;
: timezone-name ( -- string )
get-time tm-zone ;
get-time zone>> ;
M: unix gmt-offset ( -- hours minutes seconds )
get-time tm-gmtoff 3600 /mod 60 /mod ;
get-time gmtoff>> 3600 /mod 60 /mod ;

13
basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
View File

@ -14,13 +14,12 @@ GENERIC: compute-stack-frame* ( insn -- )
frame-required? on
stack-frame [ max-stack-frame ] change ;
M: ##alien-invoke compute-stack-frame*
stack-frame>> request-stack-frame ;
UNION: stack-frame-insn
##alien-invoke
##alien-indirect
##alien-callback ;
M: ##alien-indirect compute-stack-frame*
stack-frame>> request-stack-frame ;
M: ##alien-callback compute-stack-frame*
M: stack-frame-insn compute-stack-frame*
stack-frame>> request-stack-frame ;
M: ##call compute-stack-frame*
@ -40,6 +39,8 @@ M: insn compute-stack-frame*
] when ;
\ _spill t frame-required? set-word-prop
\ ##unary-float-function t frame-required? set-word-prop
\ ##binary-float-function t frame-required? set-word-prop
: compute-stack-frame ( insns -- )
frame-required? off

2
basis/compiler/cfg/def-use/def-use.factor
View File

@ -21,7 +21,7 @@ M: ##slot temp-vregs temp>> 1array ;
M: ##set-slot temp-vregs temp>> 1array ;
M: ##string-nth temp-vregs temp>> 1array ;
M: ##set-string-nth-fast temp-vregs temp>> 1array ;
M: ##box-displaced-alien temp-vregs temp>> 1array ;
M: ##box-displaced-alien temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
M: ##compare temp-vregs temp>> 1array ;
M: ##compare-imm temp-vregs temp>> 1array ;
M: ##compare-float temp-vregs temp>> 1array ;

4
basis/compiler/cfg/hats/hats.factor
View File

@ -47,6 +47,8 @@ IN: compiler.cfg.hats
: ^^div-float ( src1 src2 -- dst ) ^^r2 ##div-float ; inline
: ^^max-float ( src1 src2 -- dst ) ^^r2 ##max-float ; inline
: ^^min-float ( src1 src2 -- dst ) ^^r2 ##min-float ; inline
: ^^unary-float-function ( src func -- dst ) ^^r2 ##unary-float-function ; inline
: ^^binary-float-function ( src1 src2 func -- dst ) ^^r3 ##binary-float-function ; inline
: ^^sqrt ( src -- dst ) ^^r1 ##sqrt ; inline
: ^^float>integer ( src -- dst ) ^^r1 ##float>integer ; inline
: ^^integer>float ( src -- dst ) ^^r1 ##integer>float ; inline
@ -56,7 +58,7 @@ IN: compiler.cfg.hats
: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
: ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline
: ^^box-displaced-alien ( base displacement base-class -- dst )
^^r3 [ next-vreg ] dip ##box-displaced-alien ; inline
^^r3 [ next-vreg next-vreg ] dip ##box-displaced-alien ; inline
: ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline
: ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ;
: ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline

15
basis/compiler/cfg/instructions/instructions.factor
View File

@ -112,6 +112,10 @@ INSN: ##min-float < ##binary ;
INSN: ##max-float < ##binary ;
INSN: ##sqrt < ##unary ;
! libc intrinsics
INSN: ##unary-float-function < ##unary func ;
INSN: ##binary-float-function < ##binary func ;
! Float/integer conversion
INSN: ##float>integer < ##unary ;
INSN: ##integer>float < ##unary ;
@ -122,7 +126,7 @@ INSN: ##unbox-float < ##unary ;
INSN: ##unbox-any-c-ptr < ##unary/temp ;
INSN: ##box-float < ##unary/temp ;
INSN: ##box-alien < ##unary/temp ;
INSN: ##box-displaced-alien < ##binary temp base-class ;
INSN: ##box-displaced-alien < ##binary temp1 temp2 base-class ;
: ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
: ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;
@ -252,6 +256,11 @@ UNION: vreg-insn
_compare-imm-branch
_dispatch ;
! Instructions that kill all live vregs but cannot trigger GC
UNION: partial-sync-insn
##unary-float-function
##binary-float-function ;
! Instructions that kill all live vregs
UNION: kill-vreg-insn
##call
@ -270,6 +279,8 @@ UNION: output-float-insn
##min-float
##max-float
##sqrt
##unary-float-function
##binary-float-function
##integer>float
##unbox-float
##alien-float
@ -284,6 +295,8 @@ UNION: input-float-insn
##min-float
##max-float
##sqrt
##unary-float-function
##binary-float-function
##float>integer
##box-float
##set-alien-float

6
basis/compiler/cfg/intrinsics/float/float.factor
View File

@ -18,3 +18,9 @@ IN: compiler.cfg.intrinsics.float
: emit-fsqrt ( -- )
ds-pop ^^sqrt ds-push ;
: emit-unary-float-function ( func -- )
[ ds-pop ] dip ^^unary-float-function ds-push ;
: emit-binary-float-function ( func -- )
[ 2inputs ] dip ^^binary-float-function ds-push ;

37
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -108,6 +108,27 @@ IN: compiler.cfg.intrinsics
math.floats.private:float-max
} enable-intrinsics ;
: enable-float-functions ( -- )
! Everything except for fsqrt
{
math.libm:facos
math.libm:fasin
math.libm:fatan
math.libm:fatan2
math.libm:fcos
math.libm:fsin
math.libm:ftan
math.libm:fcosh
math.libm:fsinh
math.libm:ftanh
math.libm:fexp
math.libm:flog
math.libm:fpow
math.libm:facosh
math.libm:fasinh
math.libm:fatanh
} enable-intrinsics ;
: enable-min/max ( -- )
{
math.integers.private:fixnum-min
@ -157,6 +178,22 @@ IN: compiler.cfg.intrinsics
{ \ math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
{ \ math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
{ \ math.libm:fsqrt [ drop emit-fsqrt ] }
{ \ math.libm:facos [ drop "acos" emit-unary-float-function ] }
{ \ math.libm:fasin [ drop "asin" emit-unary-float-function ] }
{ \ math.libm:fatan [ drop "atan" emit-unary-float-function ] }
{ \ math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] }
{ \ math.libm:fcos [ drop "cos" emit-unary-float-function ] }
{ \ math.libm:fsin [ drop "sin" emit-unary-float-function ] }
{ \ math.libm:ftan [ drop "tan" emit-unary-float-function ] }
{ \ math.libm:fcosh [ drop "cosh" emit-unary-float-function ] }
{ \ math.libm:fsinh [ drop "sinh" emit-unary-float-function ] }
{ \ math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
{ \ math.libm:fexp [ drop "exp" emit-unary-float-function ] }
{ \ math.libm:flog [ drop "log" emit-unary-float-function ] }
{ \ math.libm:fpow [ drop "pow" emit-binary-float-function ] }
{ \ math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
{ \ math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }
{ \ math.libm:fatanh [ drop "atanh" emit-unary-float-function ] }
{ \ slots.private:slot [ emit-slot ] }
{ \ slots.private:set-slot [ emit-set-slot ] }
{ \ strings.private:string-nth [ drop emit-string-nth ] }

42
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel namespaces sequences fry math
math.order combinators arrays sorting compiler.utilities
math.order combinators arrays sorting compiler.utilities locals
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
@ -34,22 +34,48 @@ IN: compiler.cfg.linear-scan.allocation
[ drop assign-blocked-register ]
} cond ;
: handle-interval ( live-interval -- )
[
start>>
: handle-sync-point ( n -- )
[ active-intervals get values ] dip
[ '[ [ _ spill ] each ] each ]
[ drop [ delete-all ] each ]
2bi ;
:: handle-progress ( n sync? -- )
n {
[ progress set ]
[ deactivate-intervals ]
[ activate-intervals ] tri
] [ assign-register ] bi ;
[ sync? [ handle-sync-point ] [ drop ] if ]
[ activate-intervals ]
} cleave ;
GENERIC: handle ( obj -- )
M: live-interval handle ( live-interval -- )
[ start>> f handle-progress ] [ assign-register ] bi ;
M: sync-point handle ( sync-point -- )
n>> t handle-progress ;
: smallest-heap ( heap1 heap2 -- heap )
! If heap1 and heap2 have the same key, favors heap1.
[ [ heap-peek nip ] bi@ <= ] most ;
: (allocate-registers) ( -- )
unhandled-intervals get [ handle-interval ] slurp-heap ;
{
{ [ unhandled-intervals get heap-empty? ] [ unhandled-sync-points get ] }
{ [ unhandled-sync-points get heap-empty? ] [ unhandled-intervals get ] }
! If a live interval begins at the same location as a sync point,
! process the sync point before the live interval. This ensures that the
! return value of C function calls doesn't get spilled and reloaded
! unnecessarily.
[ unhandled-sync-points get unhandled-intervals get smallest-heap ]
} cond dup heap-empty? [ drop ] [ heap-pop drop handle (allocate-registers) ] if ;
: finish-allocation ( -- )
active-intervals inactive-intervals
[ get values [ handled-intervals get push-all ] each ] bi@ ;
: allocate-registers ( live-intervals machine-registers -- live-intervals )
: allocate-registers ( live-intervals sync-point machine-registers -- live-intervals )
init-allocator
init-unhandled
(allocate-registers)

4
basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
View File

@ -29,7 +29,7 @@ ERROR: bad-live-ranges interval ;
2bi ;
: assign-spill ( live-interval -- )
dup vreg>> assign-spill-slot >>spill-to drop ;
dup vreg>> vreg-spill-slot >>spill-to drop ;
: spill-before ( before -- before/f )
! If the interval does not have any usages before the spill location,
@ -46,7 +46,7 @@ ERROR: bad-live-ranges interval ;
] if ;
: assign-reload ( live-interval -- )
dup vreg>> assign-spill-slot >>reload-from drop ;
dup vreg>> vreg-spill-slot >>reload-from drop ;
: spill-after ( after -- after/f )
! If the interval has no more usages after the spill location,

13
basis/compiler/cfg/linear-scan/allocation/state/state.factor
View File

@ -120,15 +120,19 @@ SYMBOL: unhandled-intervals
rep-size cfg get
[ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ;
! Minheap of sync points which still need to be processed
SYMBOL: unhandled-sync-points
! Mapping from vregs to spill slots
SYMBOL: spill-slots
: assign-spill-slot ( vreg -- n )
: vreg-spill-slot ( vreg -- n )
spill-slots get [ rep-of next-spill-slot ] cache ;
: init-allocator ( registers -- )
registers set
<min-heap> unhandled-intervals set
<min-heap> unhandled-sync-points set
[ V{ } clone ] reg-class-assoc active-intervals set
[ V{ } clone ] reg-class-assoc inactive-intervals set
V{ } clone handled-intervals set
@ -136,9 +140,10 @@ SYMBOL: spill-slots
H{ } clone spill-slots set
-1 progress set ;
: init-unhandled ( live-intervals -- )
[ [ start>> ] keep ] { } map>assoc
unhandled-intervals get heap-push-all ;
: init-unhandled ( live-intervals sync-points -- )
[ [ [ start>> ] keep ] { } map>assoc unhandled-intervals get heap-push-all ]
[ [ [ n>> ] keep ] { } map>assoc unhandled-sync-points get heap-push-all ]
bi* ;
! A utility used by register-status and spill-status words
: free-positions ( new -- assoc )

32
basis/compiler/cfg/linear-scan/assignment/assignment.factor
View File

@ -28,6 +28,20 @@ SYMBOL: pending-interval-assoc
: remove-pending ( live-interval -- )
vreg>> pending-interval-assoc get delete-at ;
: (vreg>reg) ( vreg pending -- reg )
! If a live vreg is not in the pending set, then it must
! have been spilled.
?at [ spill-slots get at <spill-slot> ] unless ;
: vreg>reg ( vreg -- reg )
pending-interval-assoc get (vreg>reg) ;
: vregs>regs ( vregs -- assoc )
dup assoc-empty? [
pending-interval-assoc get
'[ _ (vreg>reg) ] assoc-map
] unless ;
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
@ -96,8 +110,6 @@ SYMBOL: register-live-outs
GENERIC: assign-registers-in-insn ( insn -- )
: vreg>reg ( vreg -- reg ) pending-interval-assoc get at ;
RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
M: vreg-insn assign-registers-in-insn
@ -123,7 +135,7 @@ M: vreg-insn assign-registers-in-insn
[
[
2dup spill-on-gc?
[ swap [ assign-spill-slot ] [ rep-of ] bi 3array , ] [ 2drop ] if
[ swap [ vreg-spill-slot ] [ rep-of ] bi 3array , ] [ 2drop ] if
] assoc-each
] { } make ;
@ -137,23 +149,13 @@ M: ##gc assign-registers-in-insn
M: insn assign-registers-in-insn drop ;
: compute-live-values ( vregs -- assoc )
! If a live vreg is not in active or inactive, then it must have been
! spilled.
dup assoc-empty? [
pending-interval-assoc get
'[ _ ?at [ ] [ spill-slots get at <spill-slot> ] if ] assoc-map
] unless ;
: begin-block ( bb -- )
dup basic-block set
dup block-from activate-new-intervals
[ live-in compute-live-values ] keep
register-live-ins get set-at ;
[ live-in vregs>regs ] keep register-live-ins get set-at ;
: end-block ( bb -- )
[ live-out compute-live-values ] keep
register-live-outs get set-at ;
[ live-out vregs>regs ] keep register-live-outs get set-at ;
ERROR: bad-vreg vreg ;

1
basis/compiler/cfg/linear-scan/debugger/debugger.factor
View File

@ -9,6 +9,7 @@ IN: compiler.cfg.linear-scan.debugger
[
[ clone ] map dup [ [ vreg>> ] keep ] H{ } map>assoc
live-intervals set
f
] dip
allocate-registers drop ;

100
basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
View File

@ -30,11 +30,12 @@ M: live-interval covers? ( insn# live-interval -- ? )
covers?
] if ;
ERROR: dead-value-error vreg ;
: add-new-range ( from to live-interval -- )
[ <live-range> ] dip ranges>> push ;
: shorten-range ( n live-interval -- )
dup ranges>> empty?
[ vreg>> dead-value-error ] [ ranges>> last (>>from) ] if ;
[ dupd add-new-range ] [ ranges>> last (>>from) ] if ;
: extend-range ( from to live-range -- )
ranges>> last
@ -42,9 +43,6 @@ ERROR: dead-value-error vreg ;
[ min ] change-from
drop ;
: add-new-range ( from to live-interval -- )
[ <live-range> ] dip ranges>> push ;
: extend-range? ( to live-interval -- ? )
ranges>> [ drop f ] [ last from>> >= ] if-empty ;
@ -52,8 +50,18 @@ ERROR: dead-value-error vreg ;
2dup extend-range?
[ extend-range ] [ add-new-range ] if ;
: add-use ( n live-interval -- )
uses>> push ;
GENERIC: operands-in-registers? ( insn -- ? )
M: vreg-insn operands-in-registers? drop t ;
M: partial-sync-insn operands-in-registers? drop f ;
: add-def ( insn live-interval -- )
[ insn#>> ] [ uses>> ] bi* push ;
: add-use ( insn live-interval -- )
! Every use is a potential def, no SSA here baby!
over operands-in-registers? [ add-def ] [ 2drop ] if ;
: <live-interval> ( vreg -- live-interval )
\ live-interval new
@ -68,51 +76,68 @@ ERROR: dead-value-error vreg ;
M: live-interval hashcode*
nip [ start>> ] [ end>> 1000 * ] bi + ;
M: live-interval clone
call-next-method [ clone ] change-uses ;
! Mapping from vreg to live-interval
SYMBOL: live-intervals
: live-interval ( vreg live-intervals -- live-interval )
[ <live-interval> ] cache ;
: live-interval ( vreg -- live-interval )
live-intervals get [ <live-interval> ] cache ;
GENERIC: compute-live-intervals* ( insn -- )
M: insn compute-live-intervals* drop ;
: handle-output ( n vreg live-intervals -- )
: handle-output ( insn vreg -- )
live-interval
[ add-use ] [ shorten-range ] 2bi ;
[ [ insn#>> ] dip shorten-range ] [ add-def ] 2bi ;
: handle-input ( n vreg live-intervals -- )
: handle-input ( insn vreg -- )
live-interval
[ [ basic-block get block-from ] 2dip add-range ] [ add-use ] 2bi ;
[ [ [ basic-block get block-from ] dip insn#>> ] dip add-range ] [ add-use ] 2bi ;
: handle-temp ( n vreg live-intervals -- )
: handle-temp ( insn vreg -- )
live-interval
[ dupd add-range ] [ add-use ] 2bi ;
[ [ insn#>> dup ] dip add-range ] [ add-use ] 2bi ;
M: vreg-insn compute-live-intervals*
dup insn#>>
live-intervals get
[ [ defs-vreg ] 2dip '[ [ _ ] dip _ handle-output ] when* ]
[ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ]
[ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
3tri ;
[ dup defs-vreg [ handle-output ] with when* ]
[ dup uses-vregs [ handle-input ] with each ]
[ dup temp-vregs [ handle-temp ] with each ]
tri ;
: handle-live-out ( bb -- )
live-out keys
basic-block get [ block-from ] [ block-to ] bi
live-intervals get '[
[ _ _ ] dip _ live-interval add-range
] each ;
[ block-from ] [ block-to ] [ live-out keys ] tri
[ live-interval add-range ] with with each ;
! A location where all registers have to be spilled
TUPLE: sync-point n ;
C: <sync-point> sync-point
! Sequence of sync points
SYMBOL: sync-points
GENERIC: compute-sync-points* ( insn -- )
M: partial-sync-insn compute-sync-points*
insn#>> <sync-point> sync-points get push ;
M: insn compute-sync-points* drop ;
: compute-live-intervals-step ( bb -- )
[ basic-block set ]
[ handle-live-out ]
[ instructions>> <reversed> [ compute-live-intervals* ] each ] tri ;
[
instructions>> <reversed> [
[ compute-live-intervals* ]
[ compute-sync-points* ]
bi
] each
] tri ;
: init-live-intervals ( -- )
H{ } clone live-intervals set
V{ } clone sync-points set ;
: compute-start/end ( live-interval -- )
dup ranges>> [ first from>> ] [ last to>> ] bi
[ >>start ] [ >>end ] bi* drop ;
@ -122,10 +147,10 @@ ERROR: bad-live-interval live-interval ;
: check-start ( live-interval -- )
dup start>> -1 = [ bad-live-interval ] [ drop ] if ;
: finish-live-intervals ( live-intervals -- )
: finish-live-intervals ( live-intervals -- seq )
! Since live intervals are computed in a backward order, we have
! to reverse some sequences, and compute the start and end.
[
values dup [
{
[ ranges>> reverse-here ]
[ uses>> reverse-here ]
@ -134,12 +159,11 @@ ERROR: bad-live-interval live-interval ;
} cleave
] each ;
: compute-live-intervals ( cfg -- live-intervals )
H{ } clone [
live-intervals set
linearization-order <reversed>
[ compute-live-intervals-step ] each
] keep values dup finish-live-intervals ;
: compute-live-intervals ( cfg -- live-intervals sync-points )
init-live-intervals
linearization-order <reversed> [ compute-live-intervals-step ] each
live-intervals get finish-live-intervals
sync-points get ;
: relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
[ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;

4
basis/compiler/cfg/renaming/functor/functor.factor
View File

@ -141,7 +141,9 @@ M: ##set-string-nth-fast rename-insn-temps
TEMP-QUOT change-temp drop ;
M: ##box-displaced-alien rename-insn-temps
TEMP-QUOT change-temp drop ;
TEMP-QUOT change-temp1
TEMP-QUOT change-temp2
drop ;
M: ##compare rename-insn-temps
TEMP-QUOT change-temp drop ;

2
basis/compiler/cfg/representations/preferred/preferred.factor
View File

@ -25,7 +25,7 @@ M: ##slot temp-vreg-reps drop { int-rep } ;
M: ##set-slot temp-vreg-reps drop { int-rep } ;
M: ##string-nth temp-vreg-reps drop { int-rep } ;
M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ;
M: ##box-displaced-alien temp-vreg-reps drop { int-rep } ;
M: ##box-displaced-alien temp-vreg-reps drop { int-rep int-rep } ;
M: ##compare temp-vreg-reps drop { int-rep } ;
M: ##compare-imm temp-vreg-reps drop { int-rep } ;
M: ##compare-float temp-vreg-reps drop { int-rep } ;

15
basis/compiler/cfg/value-numbering/expressions/expressions.factor
View File

@ -12,6 +12,8 @@ TUPLE: commutative-expr < binary-expr ;
TUPLE: compare-expr < binary-expr cc ;
TUPLE: constant-expr < expr value ;
TUPLE: reference-expr < expr value ;
TUPLE: unary-float-function-expr < expr in func ;
TUPLE: binary-float-function-expr < expr in1 in2 func ;
TUPLE: box-displaced-alien-expr < expr displacement base base-class ;
: <constant> ( constant -- expr )
@ -94,6 +96,19 @@ M: ##box-displaced-alien >expr
[ base-class>> ]
} cleave box-displaced-alien-expr boa ;
M: ##unary-float-function >expr
[ class ] [ src>> vreg>vn ] [ func>> ] tri
unary-float-function-expr boa ;
M: ##binary-float-function >expr
{
[ class ]
[ src1>> vreg>vn ]
[ src2>> vreg>vn ]
[ func>> ]
} cleave
binary-float-function-expr boa ;
M: ##flushable >expr drop next-input-expr ;
: init-expressions ( -- )

8
basis/compiler/codegen/codegen.factor
View File

@ -176,6 +176,12 @@ M: ##max-float generate-insn dst/src1/src2 %max-float ;
M: ##sqrt generate-insn dst/src %sqrt ;
M: ##unary-float-function generate-insn
[ dst/src ] [ func>> ] bi %unary-float-function ;
M: ##binary-float-function generate-insn
[ dst/src1/src2 ] [ func>> ] bi %binary-float-function ;
M: ##integer>float generate-insn dst/src %integer>float ;
M: ##float>integer generate-insn dst/src %float>integer ;
@ -187,7 +193,7 @@ M: ##box-float generate-insn dst/src/temp %box-float ;
M: ##box-alien generate-insn dst/src/temp %box-alien ;
M: ##box-displaced-alien generate-insn
[ dst/src1/src2 ] [ temp>> ] bi %box-displaced-alien ;
[ dst/src1/src2 ] [ temp1>> ] [ temp2>> ] tri %box-displaced-alien ;
M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ;
M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;

9
basis/compiler/tests/codegen.factor
View File

@ -3,7 +3,7 @@ math hashtables.private math.private namespaces sequences tools.test
namespaces.private slots.private sequences.private byte-arrays alien
alien.accessors layouts words definitions compiler.units io
combinators vectors grouping make alien.c-types combinators.short-circuit
math.order ;
math.order math.libm math.parser ;
QUALIFIED: namespaces.private
IN: compiler.tests.codegen
@ -407,4 +407,9 @@ cell 4 = [
: missing-gc-check-1 ( a -- b ) { fixnum } declare <alien> ;
: missing-gc-check-2 ( -- ) 10000000 [ missing-gc-check-1 drop ] each-integer ;
[ ] [ missing-gc-check-2 ] unit-test
[ ] [ missing-gc-check-2 ] unit-test
[ 1 "0.169967142900241" ] [ 1.4 [ 1 swap fcos ] compile-call number>string ] unit-test
[ 1 "0.169967142900241" ] [ 1.4 1 [ swap fcos ] compile-call number>string ] unit-test
[ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
[ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test

8
basis/compiler/tests/intrinsics.factor
View File

@ -519,6 +519,14 @@ cell 8 = [
underlying>>
] unit-test
[ ALIEN: 1234 ALIEN: 2234 ] [
ALIEN: 234 [
{ c-ptr } declare
[ 1000 swap <displaced-alien> ]
[ 2000 swap <displaced-alien> ] bi
] compile-call
] unit-test
[
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
] must-fail

4
basis/cpu/architecture/architecture.factor
View File

@ -115,6 +115,8 @@ HOOK: %div-float cpu ( dst src1 src2 -- )
HOOK: %min-float cpu ( dst src1 src2 -- )
HOOK: %max-float cpu ( dst src1 src2 -- )
HOOK: %sqrt cpu ( dst src -- )
HOOK: %unary-float-function cpu ( dst src func -- )
HOOK: %binary-float-function cpu ( dst src1 src2 func -- )
HOOK: %integer>float cpu ( dst src -- )
HOOK: %float>integer cpu ( dst src -- )
@ -124,7 +126,7 @@ HOOK: %unbox-float cpu ( dst src -- )
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
HOOK: %box-float cpu ( dst src temp -- )
HOOK: %box-alien cpu ( dst src temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp1 temp2 -- )
HOOK: %alien-unsigned-1 cpu ( dst src -- )
HOOK: %alien-unsigned-2 cpu ( dst src -- )

19
basis/cpu/ppc/ppc.factor
View File

@ -335,7 +335,7 @@ M:: ppc %box-alien ( dst src temp -- )
"f" resolve-label
] with-scope ;
M:: ppc %box-displaced-alien ( dst displacement base temp -- )
M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
[
"end" define-label
"ok" define-label
@ -343,7 +343,12 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- )
dst base MR
0 displacement 0 CMPI
"end" get BEQ
! Quickly use displacement' before its needed for real, as allot temporary
displacement' :> temp
dst 4 cells alien temp %allot
! If base is already a displaced alien, unpack it
base' base MR
displacement' displacement MR
0 base \ f tag-number CMPI
"ok" get BEQ
temp base header-offset LWZ
@ -351,11 +356,17 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- )
"ok" get BNE
! displacement += base.displacement
temp base 3 alien@ LWZ
displacement displacement temp ADD
displacement' displacement temp ADD
! base = base.base
base base 1 alien@ LWZ
base' base 1 alien@ LWZ
"ok" resolve-label
dst displacement base temp %allot-alien
! Store underlying-alien slot
base' dst 1 alien@ STW
! Store offset
displacement' dst 3 alien@ STW
! Store expired slot (its ok to clobber displacement')
temp \ f tag-number %load-immediate
temp dst 2 alien@ STW
"end" resolve-label
] with-scope ;

20
basis/cpu/x86/64/64.factor
View File

@ -197,6 +197,23 @@ M: x86.64 %callback-value ( ctype -- )
! Unbox former top of data stack to return registers
unbox-return ;
: float-function-param ( i spill-slot -- )
[ float-regs param-regs nth ] [ n>> spill@ ] bi* MOVSD ;
: float-function-return ( reg -- )
float-regs return-reg double-float-rep copy-register ;
M:: x86.64 %unary-float-function ( dst src func -- )
0 src float-function-param
func f %alien-invoke
dst float-function-return ;
M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
0 src1 float-function-param
1 src2 float-function-param
func f %alien-invoke
dst float-function-return ;
! The result of reading 4 bytes from memory is a fixnum on
! x86-64.
enable-alien-4-intrinsics
@ -204,6 +221,9 @@ enable-alien-4-intrinsics
! SSE2 is always available on x86-64.
enable-sse2
! Enable fast calling of libc math functions
enable-float-functions
USE: vocabs.loader
{

14
basis/cpu/x86/x86.factor
View File

@ -278,7 +278,7 @@ M:: x86 %box-alien ( dst src temp -- )
"end" resolve-label
] with-scope ;
M:: x86 %box-displaced-alien ( dst displacement base temp -- )
M:: x86 %box-displaced-alien ( dst displacement base displacement' base' -- )
[
"end" define-label
"ok" define-label
@ -286,17 +286,23 @@ M:: x86 %box-displaced-alien ( dst displacement base temp -- )
dst base MOV
displacement 0 CMP
"end" get JE
! Quickly use displacement' before its needed for real, as allot temporary
dst 4 cells alien displacement' %allot
! If base is already a displaced alien, unpack it
base' base MOV
displacement' displacement MOV
base \ f tag-number CMP
"ok" get JE
base header-offset [+] alien type-number tag-fixnum CMP
"ok" get JNE
! displacement += base.displacement
displacement base 3 alien@ ADD
displacement' base 3 alien@ ADD
! base = base.base
base base 1 alien@ MOV
base' base 1 alien@ MOV
"ok" resolve-label
dst displacement base temp %allot-alien
dst 1 alien@ base' MOV ! alien
dst 2 alien@ \ f tag-number MOV ! expired
dst 3 alien@ displacement' MOV ! displacement
"end" resolve-label
] with-scope ;

5
basis/help/handbook/handbook.factor
View File

@ -106,10 +106,7 @@ ARTICLE: "numbers" "Numbers"
{ $subsection "complex-numbers" }
"Advanced features:"
{ $subsection "math-vectors" }
{ $subsection "math-intervals" }
{ $subsection "math-bitfields" }
"Implementation:"
{ $subsection "math.libm" } ;
{ $subsection "math-intervals" } ;
USE: io.buffers

19
basis/images/jpeg/jpeg.factor
View File

@ -6,7 +6,7 @@ images.processing io io.binary io.encodings.binary io.files
io.streams.byte-array kernel locals math math.bitwise
math.constants math.functions math.matrices math.order
math.ranges math.vectors memoize multiline namespaces
sequences sequences.deep images.loader ;
sequences sequences.deep images.loader io.streams.limited ;
IN: images.jpeg
QUALIFIED-WITH: bitstreams bs
@ -118,18 +118,18 @@ TUPLE: jpeg-color-info
] with-byte-reader ;
: decode-huff-table ( chunk -- )
data>>
binary
[
1 ! %fixme: Should handle multiple tables at once
data>> [ binary <byte-reader> ] [ length ] bi
stream-throws limit
[
[ input-stream get [ count>> ] [ limit>> ] bi < ]
[
read4/4 swap 2 * +
16 read
dup [ ] [ + ] map-reduce read
binary [ [ read [ B{ } ] unless* ] { } map-as ] with-byte-reader
swap jpeg> huff-tables>> set-nth
] times
] with-byte-reader ;
] while
] with-input-stream* ;
: decode-scan ( chunk -- )
data>>
@ -148,7 +148,10 @@ TUPLE: jpeg-color-info
: singleton-first ( seq -- elt )
[ length 1 assert= ] [ first ] bi ;
ERROR: not-a-baseline-jpeg-image ;
: baseline-parse ( -- )
jpeg> headers>> [ type>> { SOF 0 } = ] any? [ not-a-baseline-jpeg-image ] unless
jpeg> headers>>
{
[ [ type>> { SOF 0 } = ] filter singleton-first decode-frame ]
@ -221,7 +224,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
: V.M ( x A -- x.A ) Mtranspose swap M.V ;
: idct-blas ( b -- b' ) >float-blas-vector dct-matrix-blas V.M ;
: idct ( b -- b' ) idct-blas ;
: idct ( b -- b' ) idct-factor ;
:: draw-block ( block x,y color-id jpeg-image -- )
block dup length>> sqrt >fixnum group flip

9
basis/io/files/info/unix/bsd/bsd.factor
View File

@ -12,10 +12,7 @@ M: bsd new-file-info ( -- class ) bsd-file-info new ;
M: bsd stat>file-info ( stat -- file-info )
[ call-next-method ] keep
{
[ stat-st_flags >>flags ]
[ stat-st_gen >>gen ]
[
stat-st_birthtimespec timespec>unix-time
>>birth-time
]
[ st_flags>> >>flags ]
[ st_gen>> >>gen ]
[ st_birthtimespec>> timespec>unix-time >>birth-time ]
} cleave ;

56
basis/io/files/info/unix/freebsd/freebsd.factor
View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.syntax combinators
io.backend io.files io.files.info io.files.unix kernel math system unix
unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
sequences grouping alien.strings io.encodings.utf8 unix.types
specialized-arrays.direct.uint arrays io.files.info.unix ;
arrays io.files.info.unix classes.struct ;
IN: io.files.info.unix.freebsd
TUPLE: freebsd-file-system-info < unix-file-system-info
@ -13,43 +13,43 @@ version io-size owner syncreads syncwrites asyncreads asyncwrites ;
M: freebsd new-file-system-info freebsd-file-system-info new ;
M: freebsd file-system-statfs ( path -- byte-array )
"statfs" <c-object> [ statfs io-error ] keep ;
\ statfs <struct> [ statfs io-error ] keep ;
M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-info )
{
[ statfs-f_version >>version ]
[ statfs-f_type >>type ]
[ statfs-f_flags >>flags ]
[ statfs-f_bsize >>block-size ]
[ statfs-f_iosize >>io-size ]
[ statfs-f_blocks >>blocks ]
[ statfs-f_bfree >>blocks-free ]
[ statfs-f_bavail >>blocks-available ]
[ statfs-f_files >>files ]
[ statfs-f_ffree >>files-free ]
[ statfs-f_syncwrites >>syncwrites ]
[ statfs-f_asyncwrites >>asyncwrites ]
[ statfs-f_syncreads >>syncreads ]
[ statfs-f_asyncreads >>asyncreads ]
[ statfs-f_namemax >>name-max ]
[ statfs-f_owner >>owner ]
[ statfs-f_fsid 2 <direct-uint-array> >array >>id ]
[ statfs-f_fstypename utf8 alien>string >>type ]
[ statfs-f_mntfromname utf8 alien>string >>device-name ]
[ statfs-f_mntonname utf8 alien>string >>mount-point ]
[ f_version>> >>version ]
[ f_type>> >>type ]
[ f_flags>> >>flags ]
[ f_bsize>> >>block-size ]
[ f_iosize>> >>io-size ]
[ f_blocks>> >>blocks ]
[ f_bfree>> >>blocks-free ]
[ f_bavail>> >>blocks-available ]
[ f_files>> >>files ]
[ f_ffree>> >>files-free ]
[ f_syncwrites>> >>syncwrites ]
[ f_asyncwrites>> >>asyncwrites ]
[ f_syncreads>> >>syncreads ]
[ f_asyncreads>> >>asyncreads ]
[ f_namemax>> >>name-max ]
[ f_owner>> >>owner ]
[ f_fsid>> >>id ]
[ f_fstypename>> utf8 alien>string >>type ]
[ f_mntfromname>> utf8 alien>string >>device-name ]
[ f_mntonname>> utf8 alien>string >>mount-point ]
} cleave ;
M: freebsd file-system-statvfs ( path -- byte-array )
"statvfs" <c-object> [ statvfs io-error ] keep ;
\ statvfs <struct> [ \ statvfs io-error ] keep ;
M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info )
{
[ statvfs-f_favail >>files-available ]
[ statvfs-f_frsize >>preferred-block-size ]
[ f_favail>> >>files-available ]
[ f_frsize>> >>preferred-block-size ]
} cleave ;
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
"statfs" <c-array> dup dup length 0 getfsstat io-error
"statfs" heap-size group
[ statfs-f_mntonname alien>native-string file-system-info ] map ;
\ statfs <struct> dup dup length 0 getfsstat io-error
statfs heap-size group
[ f_mntonname>> alien>native-string file-system-info ] map ;

32
basis/io/files/info/unix/linux/linux.factor
View File

@ -4,8 +4,8 @@ USING: accessors alien.c-types alien.syntax combinators csv
io.backend io.encodings.utf8 io.files io.files.info io.streams.string
io.files.unix kernel math.order namespaces sequences sorting
system unix unix.statfs.linux unix.statvfs.linux io.files.links
specialized-arrays.direct.uint arrays io.files.info.unix assocs
io.pathnames unix.types ;
arrays io.files.info.unix assocs io.pathnames unix.types
classes.struct ;
FROM: csv => delimiter ;
IN: io.files.info.unix.linux
@ -15,30 +15,30 @@ namelen ;
M: linux new-file-system-info linux-file-system-info new ;
M: linux file-system-statfs ( path -- byte-array )
"statfs64" <c-object> [ statfs64 io-error ] keep ;
\ statfs64 <struct> [ statfs64 io-error ] keep ;
M: linux statfs>file-system-info ( struct -- statfs )
{
[ statfs64-f_type >>type ]
[ statfs64-f_bsize >>block-size ]
[ statfs64-f_blocks >>blocks ]
[ statfs64-f_bfree >>blocks-free ]
[ statfs64-f_bavail >>blocks-available ]
[ statfs64-f_files >>files ]
[ statfs64-f_ffree >>files-free ]
[ statfs64-f_fsid 2 <direct-uint-array> >array >>id ]
[ statfs64-f_namelen >>namelen ]
[ statfs64-f_frsize >>preferred-block-size ]
[ f_type>> >>type ]
[ f_bsize>> >>block-size ]
[ f_blocks>> >>blocks ]
[ f_bfree>> >>blocks-free ]
[ f_bavail>> >>blocks-available ]
[ f_files>> >>files ]
[ f_ffree>> >>files-free ]
[ f_fsid>> >>id ]
[ f_namelen>> >>namelen ]
[ f_frsize>> >>preferred-block-size ]
! [ statfs64-f_spare >>spare ]
} cleave ;
M: linux file-system-statvfs ( path -- byte-array )
"statvfs64" <c-object> [ statvfs64 io-error ] keep ;
\ statvfs64 <struct> [ statvfs64 io-error ] keep ;
M: linux statvfs>file-system-info ( struct -- statfs )
{
[ statvfs64-f_flag >>flags ]
[ statvfs64-f_namemax >>name-max ]
[ f_flag>> >>flags ]
[ f_namemax>> >>name-max ]
} cleave ;
TUPLE: mtab-entry file-system-name mount-point type options

48
basis/io/files/info/unix/macosx/macosx.factor
View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators
grouping io.encodings.utf8 io.files kernel math sequences
system unix io.files.unix specialized-arrays.direct.uint arrays
unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx
io.files.info.unix io.files.info ;
io.files.info.unix io.files.info classes.struct struct-arrays ;
IN: io.files.info.unix.macosx
TUPLE: macosx-file-system-info < unix-file-system-info
@ -12,41 +12,39 @@ io-size owner type-id filesystem-subtype ;
M: macosx file-systems ( -- array )
f <void*> dup 0 getmntinfo64 dup io-error
[ *void* ] dip
"statfs64" heap-size [ * memory>byte-array ] keep group
[ statfs64-f_mntonname utf8 alien>string file-system-info ] map ;
! [ [ new-file-system-info ] dip statfs>file-system-info ] map ;
[ *void* ] dip \ statfs64 <direct-struct-array>
[ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ;
M: macosx new-file-system-info macosx-file-system-info new ;
M: macosx file-system-statfs ( normalized-path -- statfs )
"statfs64" <c-object> [ statfs64 io-error ] keep ;
\ statfs64 <struct> [ statfs64 io-error ] keep ;
M: macosx file-system-statvfs ( normalized-path -- statvfs )
"statvfs" <c-object> [ statvfs io-error ] keep ;
\ statvfs <struct> [ statvfs io-error ] keep ;
M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' )
{
[ statfs64-f_bsize >>block-size ]
[ statfs64-f_iosize >>io-size ]
[ statfs64-f_blocks >>blocks ]
[ statfs64-f_bfree >>blocks-free ]
[ statfs64-f_bavail >>blocks-available ]
[ statfs64-f_files >>files ]
[ statfs64-f_ffree >>files-free ]
[ statfs64-f_fsid 2 <direct-uint-array> >array >>id ]
[ statfs64-f_owner >>owner ]
[ statfs64-f_type >>type-id ]
[ statfs64-f_flags >>flags ]
[ statfs64-f_fssubtype >>filesystem-subtype ]
[ statfs64-f_fstypename utf8 alien>string >>type ]
[ statfs64-f_mntonname utf8 alien>string >>mount-point ]
[ statfs64-f_mntfromname utf8 alien>string >>device-name ]
[ f_bsize>> >>block-size ]
[ f_iosize>> >>io-size ]
[ f_blocks>> >>blocks ]
[ f_bfree>> >>blocks-free ]
[ f_bavail>> >>blocks-available ]
[ f_files>> >>files ]
[ f_ffree>> >>files-free ]
[ f_fsid>> >>id ]
[ f_owner>> >>owner ]
[ f_type>> >>type-id ]
[ f_flags>> >>flags ]
[ f_fssubtype>> >>filesystem-subtype ]
[ f_fstypename>> utf8 alien>string >>type ]
[ f_mntonname>> utf8 alien>string >>mount-point ]
[ f_mntfromname>> utf8 alien>string >>device-name ]
} cleave ;
M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' )
{
[ statvfs-f_frsize >>preferred-block-size ]
[ statvfs-f_favail >>files-available ]
[ statvfs-f_namemax >>name-max ]
[ f_frsize>> >>preferred-block-size ]
[ f_favail>> >>files-available ]
[ f_namemax>> >>name-max ]
} cleave ;

59
basis/io/files/info/unix/netbsd/netbsd.factor
View File

@ -4,8 +4,8 @@ USING: alien.syntax kernel unix.stat math unix
combinators system io.backend accessors alien.c-types
io.encodings.utf8 alien.strings unix.types io.files.unix
io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
grouping sequences io.encodings.utf8
specialized-arrays.direct.uint io.files.info.unix ;
grouping sequences io.encodings.utf8 classes.struct
io.files.info.unix ;
IN: io.files.info.unix.netbsd
TUPLE: netbsd-file-system-info < unix-file-system-info
@ -16,38 +16,37 @@ idx mount-from ;
M: netbsd new-file-system-info netbsd-file-system-info new ;
M: netbsd file-system-statvfs
"statvfs" <c-object> [ statvfs io-error ] keep ;
\ statvfs <struct> [ statvfs io-error ] keep ;
M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' )
{
[ statvfs-f_flag >>flags ]
[ statvfs-f_bsize >>block-size ]
[ statvfs-f_frsize >>preferred-block-size ]
[ statvfs-f_iosize >>io-size ]
[ statvfs-f_blocks >>blocks ]
[ statvfs-f_bfree >>blocks-free ]
[ statvfs-f_bavail >>blocks-available ]
[ statvfs-f_bresvd >>blocks-reserved ]
[ statvfs-f_files >>files ]
[ statvfs-f_ffree >>files-free ]
[ statvfs-f_favail >>files-available ]
[ statvfs-f_fresvd >>files-reserved ]
[ statvfs-f_syncreads >>sync-reads ]
[ statvfs-f_syncwrites >>sync-writes ]
[ statvfs-f_asyncreads >>async-reads ]
[ statvfs-f_asyncwrites >>async-writes ]
[ statvfs-f_fsidx 2 <direct-uint-array> >array >>idx ]
[ statvfs-f_fsid >>id ]
[ statvfs-f_namemax >>name-max ]
[ statvfs-f_owner >>owner ]
! [ statvfs-f_spare >>spare ]
[ statvfs-f_fstypename utf8 alien>string >>type ]
[ statvfs-f_mntonname utf8 alien>string >>mount-point ]
[ statvfs-f_mntfromname utf8 alien>string >>device-name ]
[ f_flag>> >>flags ]
[ f_bsize>> >>block-size ]
[ f_frsize>> >>preferred-block-size ]
[ f_iosize>> >>io-size ]
[ f_blocks>> >>blocks ]
[ f_bfree>> >>blocks-free ]
[ f_bavail>> >>blocks-available ]
[ f_bresvd>> >>blocks-reserved ]
[ f_files>> >>files ]
[ f_ffree>> >>files-free ]
[ f_favail>> >>files-available ]
[ f_fresvd>> >>files-reserved ]
[ f_syncreads>> >>sync-reads ]
[ f_syncwrites>> >>sync-writes ]
[ f_asyncreads>> >>async-reads ]
[ f_asyncwrites>> >>async-writes ]
[ f_fsidx>> >>idx ]
[ f_fsid>> >>id ]
[ f_namemax>> >>name-max ]
[ f_owner>> >>owner ]
[ f_fstypename>> utf8 alien>string >>type ]
[ f_mntonname>> utf8 alien>string >>mount-point ]
[ f_mntfromname>> utf8 alien>string >>device-name ]
} cleave ;
M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
"statvfs" <c-array> dup dup length 0 getvfsstat io-error
"statvfs" heap-size group
[ statvfs-f_mntonname utf8 alien>string file-system-info ] map ;
\ statvfs <c-type-array> dup dup length 0 getvfsstat io-error
\ statvfs heap-size group
[ f_mntonname>> utf8 alien>string file-system-info ] map ;

55
basis/io/files/info/unix/openbsd/openbsd.factor
View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings alien.syntax
combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types
specialized-arrays.direct.uint arrays io.files.info.unix ;
arrays io.files.info.unix classes.struct ;
IN: io.files.unix.openbsd
TUPLE: freebsd-file-system-info < unix-file-system-info
@ -14,42 +14,39 @@ owner ;
M: openbsd new-file-system-info freebsd-file-system-info new ;
M: openbsd file-system-statfs
"statfs" <c-object> [ statfs io-error ] keep ;
\ statfs <struct> [ statfs io-error ] keep ;
M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' )
{
[ statfs-f_flags >>flags ]
[ statfs-f_bsize >>block-size ]
[ statfs-f_iosize >>io-size ]
[ statfs-f_blocks >>blocks ]
[ statfs-f_bfree >>blocks-free ]
[ statfs-f_bavail >>blocks-available ]
[ statfs-f_files >>files ]
[ statfs-f_ffree >>files-free ]
[ statfs-f_favail >>files-available ]
[ statfs-f_syncwrites >>sync-writes ]
[ statfs-f_syncreads >>sync-reads ]
[ statfs-f_asyncwrites >>async-writes ]
[ statfs-f_asyncreads >>async-reads ]
[ statfs-f_fsid 2 <direct-uint-array> >array >>id ]
[ statfs-f_namemax >>name-max ]
[ statfs-f_owner >>owner ]
! [ statfs-f_spare >>spare ]
[ statfs-f_fstypename alien>native-string >>type ]
[ statfs-f_mntonname alien>native-string >>mount-point ]
[ statfs-f_mntfromname alien>native-string >>device-name ]
[ f_flags>> >>flags ]
[ f_bsize>> >>block-size ]
[ f_iosize>> >>io-size ]
[ f_blocks>> >>blocks ]
[ f_bfree>> >>blocks-free ]
[ f_bavail>> >>blocks-available ]
[ f_files>> >>files ]
[ f_ffree>> >>files-free ]
[ f_favail>> >>files-available ]
[ f_syncwrites>> >>sync-writes ]
[ f_syncreads>> >>sync-reads ]
[ f_asyncwrites>> >>async-writes ]
[ f_asyncreads>> >>async-reads ]
[ f_fsid>> >>id ]
[ f_namemax>> >>name-max ]
[ f_owner>> >>owner ]
[ f_fstypename>> alien>native-string >>type ]
[ f_mntonname>> alien>native-string >>mount-point ]
[ f_mntfromname>> alien>native-string >>device-name ]
} cleave ;
M: openbsd file-system-statvfs ( normalized-path -- statvfs )
"statvfs" <c-object> [ statvfs io-error ] keep ;
\ statvfs <struct> [ statvfs io-error ] keep ;
M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' )
{
[ statvfs-f_frsize >>preferred-block-size ]
} cleave ;
f_frsize>> >>preferred-block-size ;
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
"statfs" <c-array> dup dup length 0 getfsstat io-error
"statfs" heap-size group
[ statfs-f_mntonname alien>native-string file-system-info ] map ;
statfs <c-type-array> dup dup length 0 getfsstat io-error
statfs heap-size group
[ f_mntonname>> alien>native-string file-system-info ] map ;

41
basis/io/files/info/unix/unix.factor
View File

@ -4,7 +4,7 @@ USING: accessors kernel system math math.bitwise strings arrays
sequences combinators combinators.short-circuit alien.c-types
vocabs.loader calendar calendar.unix io.files.info
io.files.types io.backend io.directories unix unix.stat unix.time unix.users
unix.groups ;
unix.groups classes.struct struct-arrays ;
IN: io.files.info.unix
TUPLE: unix-file-system-info < file-system-info
@ -69,19 +69,19 @@ M: unix stat>file-info ( stat -- file-info )
[ new-file-info ] dip
{
[ stat>type >>type ]
[ stat-st_size >>size ]
[ stat-st_mode >>permissions ]
[ stat-st_ctimespec timespec>unix-time >>created ]
[ stat-st_mtimespec timespec>unix-time >>modified ]
[ stat-st_atimespec timespec>unix-time >>accessed ]
[ stat-st_uid >>uid ]
[ stat-st_gid >>gid ]
[ stat-st_dev >>dev ]
[ stat-st_ino >>ino ]
[ stat-st_nlink >>nlink ]
[ stat-st_rdev >>rdev ]
[ stat-st_blocks >>blocks ]
[ stat-st_blksize >>blocksize ]
[ st_size>> >>size ]
[ st_mode>> >>permissions ]
[ st_ctimespec>> timespec>unix-time >>created ]
[ st_mtimespec>> timespec>unix-time >>modified ]
[ st_atimespec>> timespec>unix-time >>accessed ]
[ st_uid>> >>uid ]
[ st_gid>> >>gid ]
[ st_dev>> >>dev ]
[ st_ino>> >>ino ]
[ st_nlink>> >>nlink ]
[ st_rdev>> >>rdev ]
[ st_blocks>> >>blocks ]
[ st_blksize>> >>blocksize ]
[ drop dup blocks>> standard-unix-block-size * >>size-on-disk ]
} cleave ;
@ -98,12 +98,12 @@ M: unix stat>file-info ( stat -- file-info )
} case ;
M: unix stat>type ( stat -- type )
stat-st_mode n>file-type ;
st_mode>> n>file-type ;
<PRIVATE
: stat-mode ( path -- mode )
normalize-path file-status stat-st_mode ;
normalize-path file-status st_mode>> ;
: chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip
@ -179,14 +179,12 @@ M: unix copy-file-and-info ( from to -- )
<PRIVATE
: make-timeval-array ( array -- byte-array )
[ [ "timeval" <c-object> ] unless* ] map concat ;
: timestamp>timeval ( timestamp -- timeval )
unix-1970 time- duration>microseconds make-timeval ;
: timestamps>byte-array ( timestamps -- byte-array )
[ dup [ timestamp>timeval ] when ] map make-timeval-array ;
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
\ timeval >struct-array ;
PRIVATE>
@ -202,8 +200,7 @@ PRIVATE>
f swap 2array set-file-times ;
: set-file-ids ( path uid gid -- )
[ normalize-path ] 2dip
[ [ -1 ] unless* ] bi@ chown io-error ;
[ normalize-path ] 2dip [ -1 or ] bi@ chown io-error ;
GENERIC: set-file-user ( path string/id -- )

1
basis/math/bits/bits-docs.factor
View File

@ -6,6 +6,7 @@ IN: math.bits
ABOUT: "math.bits"
ARTICLE: "math.bits" "Number bits virtual sequence"
"The " { $vocab-link "math.bits" } " vocabulary implements a virtual sequence which presents an integer as a sequence of bits, with the first element of the sequence being the least significant bit of the integer."
{ $subsection bits }
{ $subsection <bits> }
{ $subsection make-bits } ;

7
basis/math/complex/complex.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private
math.libm math.functions arrays math.functions.private sequences
parser ;
math.functions arrays math.functions.private sequences parser ;
IN: math.complex.private
M: real real-part ; inline
@ -26,8 +25,8 @@ M: complex * [ *re - ] [ *im + ] 2bi rect> ; inline
M: complex / [ / ] complex/ ; inline
M: complex /f [ /f ] complex/ ; inline
M: complex /i [ /i ] complex/ ; inline
M: complex abs absq >float fsqrt ; inline
M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ; inline
M: complex abs absq sqrt ; inline
M: complex sqrt >polar [ sqrt ] [ 2.0 / ] bi* polar> ; inline
IN: syntax

19
basis/math/functions/functions-tests.factor
View File

@ -30,21 +30,40 @@ IN: math.functions.tests
[ 0 ] [ 0 3 ^ ] unit-test
[ 0.0 ] [ 1 log ] unit-test
[ 0.0 ] [ 1.0 log ] unit-test
[ 1.0 ] [ e log ] unit-test
[ t ] [ 1 exp e = ] unit-test
[ t ] [ 1.0 exp e = ] unit-test
[ 1.0 ] [ -1 exp e * ] unit-test
[ 1.0 ] [ 0 cosh ] unit-test
[ 1.0 ] [ 0.0 cosh ] unit-test
[ 0.0 ] [ 1 acosh ] unit-test
[ 0.0 ] [ 1.0 acosh ] unit-test
[ 1.0 ] [ 0 cos ] unit-test
[ 1.0 ] [ 0.0 cos ] unit-test
[ 0.0 ] [ 1 acos ] unit-test
[ 0.0 ] [ 1.0 acos ] unit-test
[ 0.0 ] [ 0 sinh ] unit-test
[ 0.0 ] [ 0.0 sinh ] unit-test
[ 0.0 ] [ 0 asinh ] unit-test
[ 0.0 ] [ 0.0 asinh ] unit-test
[ 0.0 ] [ 0 sin ] unit-test
[ 0.0 ] [ 0.0 sin ] unit-test
[ 0.0 ] [ 0 asin ] unit-test
[ 0.0 ] [ 0.0 asin ] unit-test
[ 0.0 ] [ 0 tan ] unit-test
[ t ] [ pi 2 / tan 1.e10 > ] unit-test
[ t ] [ 10 atan real? ] unit-test
[ t ] [ 10.0 atan real? ] unit-test
[ f ] [ 10 atanh real? ] unit-test
[ f ] [ 10.0 atanh real? ] unit-test
[ t ] [ 10 asin sin 10 1.e-10 ~ ] unit-test
[ t ] [ -1 sqrt neg dup acos cos 1.e-10 ~ ] unit-test

63
basis/math/functions/functions.factor
View File

@ -52,14 +52,25 @@ PRIVATE>
: >polar ( z -- abs arg )
>float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; inline
: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
: cis ( arg -- z ) >float [ fcos ] [ fsin ] bi rect> ; inline
: polar> ( abs arg -- z ) cis * ; inline
GENERIC: exp ( x -- y )
M: float exp fexp ; inline
M: real exp >float exp ; inline
M: complex exp >rect swap fexp swap polar> ; inline
<PRIVATE
: ^mag ( w abs arg -- magnitude )
[ >float-rect swap ] [ swap fpow ] [ rot * fexp /f ] tri* ; inline
[ >float-rect swap ]
[ >float swap >float fpow ]
[ rot * exp /f ]
tri* ; inline
: ^theta ( w abs arg -- theta )
[ >float-rect ] [ flog * swap ] [ * + ] tri* ; inline
@ -91,7 +102,7 @@ PRIVATE>
{
{ [ over 0 = ] [ nip 0^ ] }
{ [ dup integer? ] [ integer^ ] }
{ [ 2dup real^? ] [ fpow ] }
{ [ 2dup real^? ] [ [ >float ] bi@ fpow ] }
[ ^complex ]
} cond ; inline
@ -146,17 +157,13 @@ M: real absq sq ; inline
: >=1? ( x -- ? )
dup complex? [ drop f ] [ 1 >= ] if ; inline
GENERIC: exp ( x -- y )
M: real exp fexp ; inline
M: complex exp >rect swap fexp swap polar> ;
GENERIC: log ( x -- y )
M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ; inline
M: float log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ; inline
M: complex log >polar swap flog swap rect> ;
M: real log >float log ; inline
M: complex log >polar swap flog swap rect> ; inline
: 10^ ( x -- y ) 10 swap ^ ; inline
@ -169,7 +176,9 @@ M: complex cos
[ [ fcos ] [ fcosh ] bi* * ]
[ [ fsin neg ] [ fsinh ] bi* * ] 2bi rect> ;
M: real cos fcos ; inline
M: float cos fcos ; inline
M: real cos >float cos ; inline
: sec ( x -- y ) cos recip ; inline
@ -180,7 +189,9 @@ M: complex cosh
[ [ fcosh ] [ fcos ] bi* * ]
[ [ fsinh ] [ fsin ] bi* * ] 2bi rect> ;
M: real cosh fcosh ; inline
M: float cosh fcosh ; inline
M: real cosh >float cosh ; inline
: sech ( x -- y ) cosh recip ; inline
@ -191,7 +202,9 @@ M: complex sin
[ [ fsin ] [ fcosh ] bi* * ]
[ [ fcos ] [ fsinh ] bi* * ] 2bi rect> ;
M: real sin fsin ; inline
M: float sin fsin ; inline
M: real sin >float sin ; inline
: cosec ( x -- y ) sin recip ; inline
@ -202,7 +215,9 @@ M: complex sinh
[ [ fsinh ] [ fcos ] bi* * ]
[ [ fcosh ] [ fsin ] bi* * ] 2bi rect> ;
M: real sinh fsinh ; inline
M: float sinh fsinh ; inline
M: real sinh >float sinh ; inline
: cosech ( x -- y ) sinh recip ; inline
@ -210,13 +225,17 @@ GENERIC: tan ( x -- y ) foldable
M: complex tan [ sin ] [ cos ] bi / ;
M: real tan ftan ; inline
M: float tan ftan ; inline
M: real tan >float tan ; inline
GENERIC: tanh ( x -- y ) foldable
M: complex tanh [ sinh ] [ cosh ] bi / ;
M: real tanh ftanh ; inline
M: float tanh ftanh ; inline
M: real tanh >float tanh ; inline
: cot ( x -- y ) tan recip ; inline
@ -242,17 +261,19 @@ M: real tanh ftanh ; inline
: -i* ( x -- y ) >rect swap neg rect> ;
: asin ( x -- y )
dup [-1,1]? [ fasin ] [ i* asinh -i* ] if ; inline
dup [-1,1]? [ >float fasin ] [ i* asinh -i* ] if ; inline
: acos ( x -- y )
dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ;
dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ;
inline
GENERIC: atan ( x -- y ) foldable
M: complex atan i* atanh i* ;
M: complex atan i* atanh i* ; inline
M: real atan fatan ; inline
M: float atan fatan ; inline
M: real atan >float atan ; inline
: asec ( x -- y ) recip acos ; inline

8
basis/math/libm/libm-docs.factor
View File

@ -3,10 +3,10 @@ IN: math.libm
ARTICLE: "math.libm" "C standard library math functions"
"The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary."
$nl
"They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
{ $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" }
{ $unchecked-example "USE: math.libm" "2 facos ." "0/0." }
{ $warning
"These functions are unsafe. The compiler special-cases them to operate on floats only. They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
{ $example "USE: math.functions" "2.0 acos ." "C{ 0.0 1.316957896924817 }" }
{ $unchecked-example "USE: math.libm" "2 facos ." "0/0." } }
"Trigonometric functions:"
{ $subsection fcos }
{ $subsection fsin }

33
basis/math/libm/libm.factor
View File

@ -4,54 +4,53 @@ USING: alien ;
IN: math.libm
: facos ( x -- y )
"double" "libm" "acos" { "double" } alien-invoke ; inline
"double" "libm" "acos" { "double" } alien-invoke ;
: fasin ( x -- y )
"double" "libm" "asin" { "double" } alien-invoke ; inline
"double" "libm" "asin" { "double" } alien-invoke ;
: fatan ( x -- y )
"double" "libm" "atan" { "double" } alien-invoke ; inline
"double" "libm" "atan" { "double" } alien-invoke ;
: fatan2 ( x y -- z )
"double" "libm" "atan2" { "double" "double" } alien-invoke ; inline
"double" "libm" "atan2" { "double" "double" } alien-invoke ;
: fcos ( x -- y )
"double" "libm" "cos" { "double" } alien-invoke ; inline
"double" "libm" "cos" { "double" } alien-invoke ;
: fsin ( x -- y )
"double" "libm" "sin" { "double" } alien-invoke ; inline
"double" "libm" "sin" { "double" } alien-invoke ;
: ftan ( x -- y )
"double" "libm" "tan" { "double" } alien-invoke ; inline
"double" "libm" "tan" { "double" } alien-invoke ;
: fcosh ( x -- y )
"double" "libm" "cosh" { "double" } alien-invoke ; inline
"double" "libm" "cosh" { "double" } alien-invoke ;
: fsinh ( x -- y )
"double" "libm" "sinh" { "double" } alien-invoke ; inline
"double" "libm" "sinh" { "double" } alien-invoke ;
: ftanh ( x -- y )
"double" "libm" "tanh" { "double" } alien-invoke ; inline
"double" "libm" "tanh" { "double" } alien-invoke ;
: fexp ( x -- y )
"double" "libm" "exp" { "double" } alien-invoke ; inline
"double" "libm" "exp" { "double" } alien-invoke ;
: flog ( x -- y )
"double" "libm" "log" { "double" } alien-invoke ; inline
"double" "libm" "log" { "double" } alien-invoke ;
: fpow ( x y -- z )
"double" "libm" "pow" { "double" "double" } alien-invoke ; inline
"double" "libm" "pow" { "double" "double" } alien-invoke ;
! Don't inline fsqrt -- its an intrinsic!
: fsqrt ( x -- y )
"double" "libm" "sqrt" { "double" } alien-invoke ;
! Windows doesn't have these...
: facosh ( x -- y )
"double" "libm" "acosh" { "double" } alien-invoke ; inline
"double" "libm" "acosh" { "double" } alien-invoke ;
: fasinh ( x -- y )
"double" "libm" "asinh" { "double" } alien-invoke ; inline
"double" "libm" "asinh" { "double" } alien-invoke ;
: fatanh ( x -- y )
"double" "libm" "atanh" { "double" } alien-invoke ; inline
"double" "libm" "atanh" { "double" } alien-invoke ;

5
basis/math/matrices/matrices-tests.factor
View File

@ -106,4 +106,7 @@ USING: math.matrices math.vectors tools.test math ;
[ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test
[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
[ { 1 2 } { "a" "b" } cross-zip ] unit-test
[ { 1 2 } { "a" "b" } cross-zip ] unit-test
[ { { 4181 6765 } { 6765 10946 } } ]
[ { { 0 1 } { 1 1 } } 20 m^n ] unit-test

2
basis/math/matrices/matrices.factor
View File

@ -139,4 +139,4 @@ PRIVATE>
: m^n ( m n -- n )
make-bits over first length identity-matrix
[ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
[ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;

7
basis/struct-arrays/struct-arrays-tests.factor
View File

@ -44,3 +44,10 @@ STRUCT: test-struct-array
S{ test-struct-array f 20 20 }
} second
] unit-test
! Regression
STRUCT: fixed-string { text char[100] } ;
[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
ALIEN: 123 4 fixed-string <direct-struct-array> [ (underlying)>> ] { } map-as
] unit-test

2
basis/tools/deploy/shaker/shaker.factor
View File

@ -289,6 +289,8 @@ IN: tools.deploy.shaker
"disposables" "destructors" lookup ,
"functor-words" "functors.backend" lookup ,
deploy-threads? [
"initial-thread" "threads" lookup ,
] unless

30
basis/unix/stat/freebsd/32/32.factor
View File

@ -1,30 +0,0 @@
USING: kernel alien.syntax math ;
IN: unix.stat
! FreeBSD 8.0-CURRENT
C-STRUCT: stat
{ "__dev_t" "st_dev" }
{ "ino_t" "st_ino" }
{ "mode_t" "st_mode" }
{ "nlink_t" "st_nlink" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "__dev_t" "st_rdev" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "off_t" "st_size" }
{ "blkcnt_t" "st_blocks" }
{ "blksize_t" "st_blksize" }
{ "fflags_t" "st_flags" }
{ "__uint32_t" "st_gen" }
{ "__int32_t" "st_lspare" }
{ "timespec" "st_birthtimespec" }
! not sure about the padding here.
{ "__uint32_t" "pad0" }
{ "__uint32_t" "pad1" } ;
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;

1
basis/unix/stat/freebsd/32/tags.txt
View File

@ -1 +0,0 @@
unportable

30
basis/unix/stat/freebsd/64/64.factor
View File

@ -1,30 +0,0 @@
USING: kernel alien.syntax math ;
IN: unix.stat
! FreeBSD 8.0-CURRENT
! untested
C-STRUCT: stat
{ "__dev_t" "st_dev" }
{ "ino_t" "st_ino" }
{ "mode_t" "st_mode" }
{ "nlink_t" "st_nlink" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "__dev_t" "st_rdev" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "off_t" "st_size" }
{ "blkcnt_t" "st_blocks" }
{ "blksize_t" "st_blksize" }
{ "fflags_t" "st_flags" }
{ "__uint32_t" "st_gen" }
{ "__int32_t" "st_lspare" }
{ "timespec" "st_birthtimespec" }
! not sure about the padding here.
{ "__uint32_t" "pad0" }
{ "__uint32_t" "pad1" } ;
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;

1
basis/unix/stat/freebsd/64/tags.txt
View File

@ -1 +0,0 @@
unportable

30
basis/unix/stat/freebsd/freebsd.factor
View File

@ -1,7 +1,27 @@
USING: layouts combinators vocabs.loader ;
USING: kernel alien.syntax math classes.struct ;
IN: unix.stat
cell-bits {
{ 32 [ "unix.stat.freebsd.32" require ] }
{ 64 [ "unix.stat.freebsd.64" require ] }
} case
! FreeBSD 8.0-CURRENT
STRUCT: stat
{ st_dev __dev_t }
{ st_ino ino_t }
{ st_mode mode_t }
{ st_nlink nlink_t }
{ st_uid uid_t }
{ st_gid git_t }
{ st_rdev __dev_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ st_size off_t }
{ st_blocks blkcnt_t }
{ st_blksize blksize_t }
{ st_flags fflags_t }
{ st_gen _uint32_t }
{ st_lspare __int32_t }
{ st_birthtimespec timespec }
{ pad0 __int32_t[2] }
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;

37
basis/unix/stat/linux/32/32.factor
View File

@ -1,25 +1,24 @@
USING: kernel alien.syntax math sequences unix
alien.c-types arrays accessors combinators ;
USING: kernel alien.syntax math classes.struct ;
IN: unix.stat
! stat64
C-STRUCT: stat
{ "dev_t" "st_dev" }
{ "ushort" "__pad1" }
{ "__ino_t" "__st_ino" }
{ "mode_t" "st_mode" }
{ "nlink_t" "st_nlink" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "dev_t" "st_rdev" }
{ { "ushort" 2 } "__pad2" }
{ "off64_t" "st_size" }
{ "blksize_t" "st_blksize" }
{ "blkcnt64_t" "st_blocks" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "ulonglong" "st_ino" } ;
STRUCT: stat
{ st_dev dev_t }
{ __pad1 ushort }
{ __st_ino __ino_t }
{ st_mode mode_t }
{ st_nlink nlink_t }
{ st_uid uid_t }
{ st_gid gid_t }
{ st_rdev dev_t }
{ __pad2 ushort[2] }
{ st_size off64_t }
{ st_blksize blksize_t }
{ st_blocks blkcnt64_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ st_ino ulonglong } ;
FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;

37
basis/unix/stat/linux/64/64.factor
View File

@ -1,27 +1,24 @@
USING: kernel alien.syntax math sequences unix
alien.c-types arrays accessors combinators ;
USING: kernel alien.syntax math classes.struct ;
IN: unix.stat
! Ubuntu 7.10 64-bit
C-STRUCT: stat
{ "dev_t" "st_dev" }
{ "ino_t" "st_ino" }
{ "nlink_t" "st_nlink" }
{ "mode_t" "st_mode" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "int" "pad0" }
{ "dev_t" "st_rdev" }
{ "off64_t" "st_size" }
{ "blksize_t" "st_blksize" }
{ "blkcnt64_t" "st_blocks" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "long" "__unused0" }
{ "long" "__unused1" }
{ "long" "__unused2" } ;
STRUCT: stat
{ st_dev dev_t }
{ st_ino ino_t }
{ st_nlink nlink_t }
{ st_mode mode_t }
{ st_uid uid_t }
{ st_gid gid_t }
{ pad0 int }
{ st_rdev dev_t }
{ st_size off64_t }
{ st_blksize blksize_t }
{ st_blocks blkcnt64_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ __unused0 long[3] } ;
FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;

44
basis/unix/stat/macosx/macosx.factor
View File

@ -1,30 +1,30 @@
USING: kernel alien.syntax math unix math.bitwise
alien.c-types alien sequences grouping accessors combinators ;
USING: alien.c-types arrays accessors combinators classes.struct
alien.syntax ;
IN: unix.stat
! Mac OS X ppc
! stat64 structure
C-STRUCT: stat
{ "dev_t" "st_dev" }
{ "mode_t" "st_mode" }
{ "nlink_t" "st_nlink" }
{ "ino64_t" "st_ino" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "dev_t" "st_rdev" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "timespec" "st_birthtimespec" }
{ "off_t" "st_size" }
{ "blkcnt_t" "st_blocks" }
{ "blksize_t" "st_blksize" }
{ "__uint32_t" "st_flags" }
{ "__uint32_t" "st_gen" }
{ "__int32_t" "st_lspare" }
{ "__int64_t" "st_qspare0" }
{ "__int64_t" "st_qspare1" } ;
STRUCT: stat
{ st_dev dev_t }
{ st_mode mode_t }
{ st_nlink nlink_t }
{ st_ino ino64_t }
{ st_uid uid_t }
{ st_gid gid_t }
{ st_rdev dev_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ st_birthtimespec timespec }
{ st_size off_t }
{ st_blocks blkcnt_t }
{ st_blksize blksize_t }
{ st_flags __uint32_t }
{ st_gen __uint32_t }
{ st_lspare __int32_t }
{ st_qspare0 __int64_t }
{ st_qspare1 __int64_t } ;
FUNCTION: int stat64 ( char* pathname, stat* buf ) ;
FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;

38
basis/unix/stat/netbsd/32/32.factor
View File

@ -1,26 +1,26 @@
USING: kernel alien.syntax math ;
USING: kernel alien.syntax math classes.struct ;
IN: unix.stat
! NetBSD 4.0
C-STRUCT: stat
{ "dev_t" "st_dev" }
{ "mode_t" "st_mode" }
{ "ino_t" "st_ino" }
{ "nlink_t" "st_nlink" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "dev_t" "st_rdev" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "timespec" "st_birthtimespec" }
{ "off_t" "st_size" }
{ "blkcnt_t" "st_blocks" }
{ "blksize_t" "st_blksize" }
{ "uint32_t" "st_flags" }
{ "uint32_t" "st_gen" }
{ { "uint32_t" 2 } "st_qspare" } ;
STRUCT: stat
{ st_dev dev_t }
{ st_mode mode_t }
{ st_ino ino_t }
{ st_nlink nlink_t }
{ st_uid uid_t }
{ st_gid gid_t }
{ st_rdev dev_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ st_birthtimespec timespec }
{ st_size off_t }
{ st_blocks blkcnt_t }
{ st_blksize blksize_t }
{ st_flags uint32_t }
{ st_gen uint32_t }
{ st_qspare uint32_t[2] } ;
FUNCTION: int __stat30 ( char* pathname, stat* buf ) ;
FUNCTION: int __lstat30 ( char* pathname, stat* buf ) ;

38
basis/unix/stat/netbsd/64/64.factor
View File

@ -1,26 +1,26 @@
USING: kernel alien.syntax math ;
USING: kernel alien.syntax math classes.struct ;
IN: unix.stat
! NetBSD 4.0
C-STRUCT: stat
{ "dev_t" "st_dev" }
{ "ino_t" "st_ino" }
{ "mode_t" "st_mode" }
{ "nlink_t" "st_nlink" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "dev_t" "st_rdev" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "off_t" "st_size" }
{ "blkcnt_t" "st_blocks" }
{ "blksize_t" "st_blksize" }
{ "uint32_t" "st_flags" }
{ "uint32_t" "st_gen" }
{ "uint32_t" "st_spare0" }
{ "timespec" "st_birthtimespec" } ;
STRUCT: stat
{ st_dev dev_t }
{ st_ino ino_t }
{ st_mode mode_t }
{ st_nlink nlink_t }
{ st_uid uid_t }
{ st_gid gid_t }
{ st_rdev dev_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ st_size off_t }
{ st_blocks blkcnt_t }
{ st_blksize blksize_t }
{ st_flags uint32_t }
{ st_gen uint32_t }
{ st_spare0 uint32_t }
{ st_birthtimespec timespec } ;
FUNCTION: int __stat13 ( char* pathname, stat* buf ) ;
FUNCTION: int __lstat13 ( char* pathname, stat* buf ) ;

42
basis/unix/stat/openbsd/openbsd.factor
View File

@ -1,28 +1,28 @@
USING: kernel alien.syntax math ;
USING: kernel alien.syntax math classes.struct ;
IN: unix.stat
! OpenBSD 4.2
C-STRUCT: stat
{ "dev_t" "st_dev" }
{ "ino_t" "st_ino" }
{ "mode_t" "st_mode" }
{ "nlink_t" "st_nlink" }
{ "uid_t" "st_uid" }
{ "gid_t" "st_gid" }
{ "dev_t" "st_rdev" }
{ "int32_t" "st_lspare0" }
{ "timespec" "st_atimespec" }
{ "timespec" "st_mtimespec" }
{ "timespec" "st_ctimespec" }
{ "off_t" "st_size" }
{ "int64_t" "st_blocks" }
{ "u_int32_t" "st_blksize" }
{ "u_int32_t" "st_flags" }
{ "u_int32_t" "st_gen" }
{ "int32_t" "st_lspare1" }
{ "timespec" "st_birthtimespec" }
{ { "int64_t" 2 } "st_qspare" } ;
STRUCT: stat
{ st_dev dev_t }
{ st_ino ino_t }
{ st_mode mode_t }
{ st_nlink nlink_t }
{ st_uid uid_t }
{ st_gid gid_t }
{ st_rdev dev_t }
{ st_lspare0 int32_t }
{ st_atimespec timespec }
{ st_mtimespec timespec }
{ st_ctimespec timespec }
{ st_size off_t }
{ st_blocks int64_t }
{ st_blksize u_int32_t }
{ st_flags u_int32_t }
{ st_gen u_int32_t }
{ st_lspare1 int32_t }
{ st_birthtimespec timespec }
{ st_qspare int64_t[2] } ;
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;

10
basis/unix/stat/stat.factor
View File

@ -1,5 +1,5 @@
USING: kernel system combinators alien.syntax alien.c-types
math io.backend.unix vocabs.loader unix ;
math io.backend.unix vocabs.loader unix classes.struct ;
IN: unix.stat
! File Types
@ -15,8 +15,8 @@ CONSTANT: S_IFLNK OCT: 120000 ! Symbolic link.
CONSTANT: S_IFSOCK OCT: 140000 ! Socket.
CONSTANT: S_IFWHT OCT: 160000 ! Whiteout.
C-STRUCT: fsid
{ { "int" 2 } "__val" } ;
STRUCT: fsid
{ __val int[2] } ;
TYPEDEF: fsid __fsid_t
TYPEDEF: fsid fsid_t
@ -30,7 +30,7 @@ TYPEDEF: fsid fsid_t
} case >>
: file-status ( pathname -- stat )
"stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;
\ stat <struct> [ [ stat ] unix-system-call drop ] keep ;
: link-status ( pathname -- stat )
"stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;
\ stat <struct> [ [ lstat ] unix-system-call drop ] keep ;

48
basis/unix/statfs/freebsd/freebsd.factor
View File

@ -1,34 +1,34 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax unix.types unix.stat ;
USING: alien.syntax unix.types unix.stat classes.struct ;
IN: unix.statfs.freebsd
CONSTANT: MFSNAMELEN 16 ! length of type name including null */
CONSTANT: MNAMELEN 88 ! size of on/from name bufs
CONSTANT: STATFS_VERSION HEX: 20030518 ! current version number
C-STRUCT: statfs
{ "uint32_t" "f_version" }
{ "uint32_t" "f_type" }
{ "uint64_t" "f_flags" }
{ "uint64_t" "f_bsize" }
{ "uint64_t" "f_iosize" }
{ "uint64_t" "f_blocks" }
{ "uint64_t" "f_bfree" }
{ "int64_t" "f_bavail" }
{ "uint64_t" "f_files" }
{ "int64_t" "f_ffree" }
{ "uint64_t" "f_syncwrites" }
{ "uint64_t" "f_asyncwrites" }
{ "uint64_t" "f_syncreads" }
{ "uint64_t" "f_asyncreads" }
{ { "uint64_t" 10 } "f_spare" }
{ "uint32_t" "f_namemax" }
{ "uid_t" "f_owner" }
{ "fsid_t" "f_fsid" }
{ { "char" 80 } "f_charspare" }
{ { "char" MFSNAMELEN } "f_fstypename" }
{ { "char" MNAMELEN } "f_mntfromname" }
{ { "char" MNAMELEN } "f_mntonname" } ;
STRUCT: statfs
{ f_version uint32_t }
{ f_type uint32_t }
{ f_flags uint64_t }
{ f_bsize uint64_t }
{ f_iosize uint64_t }
{ f_blocks uint64_t }
{ f_bfree uint64_t }
{ f_bavail int64_t }
{ f_files uint64_t }
{ f_ffree int64_t }
{ f_syncwrites uint64_t }
{ f_asyncwrites uint64_t }
{ f_syncreads uint64_t }
{ f_asyncreads uint64_t }
{ f_spare uint64_t[10] }
{ f_namemax uint32_t }
{ f_owner uid_t }
{ f_fsid fsid_t }
{ f_charspare char[80] }
{ f_fstypename { "char" MFSNAMELEN } }
{ f_mntfromname { "char" MNAMELEN } }
{ f_mntonname { "char" MNAMELEN } } ;
FUNCTION: int statfs ( char* path, statvfs* buf ) ;

26
basis/unix/statfs/linux/linux.factor
View File

@ -1,19 +1,19 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax unix.types unix.stat ;
USING: alien.syntax unix.types unix.stat classes.struct ;
IN: unix.statfs.linux
C-STRUCT: statfs64
{ "__SWORD_TYPE" "f_type" }
{ "__SWORD_TYPE" "f_bsize" }
{ "__fsblkcnt64_t" "f_blocks" }
{ "__fsblkcnt64_t" "f_bfree" }
{ "__fsblkcnt64_t" "f_bavail" }
{ "__fsfilcnt64_t" "f_files" }
{ "__fsfilcnt64_t" "f_ffree" }
{ "__fsid_t" "f_fsid" }
{ "__SWORD_TYPE" "f_namelen" }
{ "__SWORD_TYPE" "f_frsize" }
{ { "__SWORD_TYPE" 5 } "f_spare" } ;
STRUCT: statfs64
{ f_type __SWORD_TYPE }
{ f_bsize __SWORD_TYPE }
{ f_blocks __fsblkcnt64_t }
{ f_bfree __fsblkcnt64_t }
{ f_bavail __fsblkcnt64_t }
{ f_files __fsblkcnt64_t }
{ f_ffree __fsblkcnt64_t }
{ f_fsid __fsid_t }
{ f_namelen __SWORD_TYPE }
{ f_frsize __SWORD_TYPE }
{ f_spare __SWORD_TYPE[5] } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;

46
basis/unix/statfs/macosx/macosx.factor
View File

@ -3,7 +3,7 @@
USING: alien.c-types io.encodings.utf8 io.encodings.string
kernel sequences unix.stat accessors unix combinators math
grouping system alien.strings math.bitwise alien.syntax
unix.types ;
unix.types classes.struct ;
IN: unix.statfs.macosx
CONSTANT: MNT_RDONLY HEX: 00000001
@ -65,9 +65,9 @@ CONSTANT: VFS_CTL_NEWADDR HEX: 00010004
CONSTANT: VFS_CTL_TIMEO HEX: 00010005
CONSTANT: VFS_CTL_NOLOCKS HEX: 00010006
C-STRUCT: vfsquery
{ "uint32_t" "vq_flags" }
{ { "uint32_t" 31 } "vq_spare" } ;
STRUCT: vfsquery
{ vq_flags uint32_t }
{ vq_spare uint32_t[31] } ;
CONSTANT: VQ_NOTRESP HEX: 0001
CONSTANT: VQ_NEEDAUTH HEX: 0002
@ -95,26 +95,26 @@ CONSTANT: MFSNAMELEN 15
CONSTANT: MNAMELEN 90
CONSTANT: MFSTYPENAMELEN 16
C-STRUCT: fsid_t
{ { "int32_t" 2 } "val" } ;
STRUCT: fsid_t
{ val int32_t[2] } ;
C-STRUCT: statfs64
{ "uint32_t" "f_bsize" }
{ "int32_t" "f_iosize" }
{ "uint64_t" "f_blocks" }
{ "uint64_t" "f_bfree" }
{ "uint64_t" "f_bavail" }
{ "uint64_t" "f_files" }
{ "uint64_t" "f_ffree" }
{ "fsid_t" "f_fsid" }
{ "uid_t" "f_owner" }
{ "uint32_t" "f_type" }
{ "uint32_t" "f_flags" }
{ "uint32_t" "f_fssubtype" }
{ { "char" MFSTYPENAMELEN } "f_fstypename" }
{ { "char" MAXPATHLEN } "f_mntonname" }
{ { "char" MAXPATHLEN } "f_mntfromname" }
{ { "uint32_t" 8 } "f_reserved" } ;
STRUCT: statfs64
{ f_bsize uint32_t }
{ f_iosize int32_t }
{ f_blocks uint64_t }
{ f_bfree uint64_t }
{ f_bavail uint64_t }
{ f_files uint64_t }
{ f_ffree uint64_t }
{ f_fsid fsid_t }
{ f_owner uid_t }
{ f_type uint32_t }
{ f_flags uint32_t }
{ f_fssubtype uint32_t }
{ f_fstypename { "char" MFSTYPENAMELEN } }
{ f_mntonname { "char" MAXPATHLEN } }
{ f_mntfromname { "char" MAXPATHLEN } }
{ f_reserved uint32_t[8] } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;

48
basis/unix/statfs/openbsd/openbsd.factor
View File

@ -1,33 +1,33 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax unix.types unix.stat ;
USING: alien.syntax unix.types unix.stat classes.struct ;
IN: unix.statfs.openbsd
CONSTANT: MFSNAMELEN 16
CONSTANT: MNAMELEN 90
C-STRUCT: statfs
{ "u_int32_t" "f_flags" }
{ "u_int32_t" "f_bsize" }
{ "u_int32_t" "f_iosize" }
{ "u_int64_t" "f_blocks" }
{ "u_int64_t" "f_bfree" }
{ "int64_t" "f_bavail" }
{ "u_int64_t" "f_files" }
{ "u_int64_t" "f_ffree" }
{ "int64_t" "f_favail" }
{ "u_int64_t" "f_syncwrites" }
{ "u_int64_t" "f_syncreads" }
{ "u_int64_t" "f_asyncwrites" }
{ "u_int64_t" "f_asyncreads" }
{ "fsid_t" "f_fsid" }
{ "u_int32_t" "f_namemax" }
{ "uid_t" "f_owner" }
{ "u_int32_t" "f_ctime" }
{ { "u_int32_t" 3 } "f_spare" }
{ { "char" MFSNAMELEN } "f_fstypename" }
{ { "char" MNAMELEN } "f_mntonname" }
{ { "char" MNAMELEN } "f_mntfromname" }
{ { "char" 160 } "mount_info" } ;
STRUCT: statfs
{ f_flags u_int32_t }
{ f_bsize u_int32_t }
{ f_iosize u_int32_t }
{ f_blocks u_int64_t }
{ f_bfree u_int64_t }
{ f_bavail int64_t }
{ f_files u_int64_t }
{ f_ffree u_int64_t }
{ f_favail int64_t }
{ f_syncwrites u_int64_t }
{ f_syncreads u_int64_t }
{ f_asyncwrites u_int64_t }
{ f_asyncreads u_int64_t }
{ f_fsid fsid_t }
{ f_namemax u_int32_t }
{ f_owner uid_t }
{ f_ctime u_int32_t }
{ f_spare u_int32_t[3] }
{ f_fstypename { "char" MFSNAMELEN } }
{ f_mntonname { "char" MNAMELEN } }
{ f_mntfromname { "char" MNAMELEN } }
{ mount_info char[160] } ;
FUNCTION: int statfs ( char* path, statvfs* buf ) ;

26
basis/unix/statvfs/freebsd/freebsd.factor
View File

@ -1,20 +1,20 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax classes.struct ;
IN: unix.statvfs.freebsd
C-STRUCT: statvfs
{ "fsblkcnt_t" "f_bavail" }
{ "fsblkcnt_t" "f_bfree" }
{ "fsblkcnt_t" "f_blocks" }
{ "fsfilcnt_t" "f_favail" }
{ "fsfilcnt_t" "f_ffree" }
{ "fsfilcnt_t" "f_files" }
{ "ulong" "f_bsize" }
{ "ulong" "f_flag" }
{ "ulong" "f_frsize" }
{ "ulong" "f_fsid" }
{ "ulong" "f_namemax" } ;
STRUCT: statvfs
{ f_bavail fsblkcnt_t }
{ f_bfree fsblkcnt_t }
{ f_blocks fsblkcnt_t }
{ f_favail fsfilcnt_t }
{ f_ffree fsfilcnt_t }
{ f_files fsfilcnt_t }
{ f_bsize ulong }
{ f_flag ulong }
{ f_frsize ulong }
{ f_fsid ulong }
{ f_namemax ulong } ;
! Flags
CONSTANT: ST_RDONLY HEX: 1 ! Read-only file system

28
basis/unix/statvfs/linux/linux.factor
View File

@ -1,21 +1,21 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax classes.struct ;
IN: unix.statvfs.linux
C-STRUCT: statvfs64
{ "ulong" "f_bsize" }
{ "ulong" "f_frsize" }
{ "__fsblkcnt64_t" "f_blocks" }
{ "__fsblkcnt64_t" "f_bfree" }
{ "__fsblkcnt64_t" "f_bavail" }
{ "__fsfilcnt64_t" "f_files" }
{ "__fsfilcnt64_t" "f_ffree" }
{ "__fsfilcnt64_t" "f_favail" }
{ "ulong" "f_fsid" }
{ "ulong" "f_flag" }
{ "ulong" "f_namemax" }
{ { "int" 6 } "__f_spare" } ;
STRUCT: statvfs64
{ f_bsize ulong }
{ f_frsize ulong }
{ f_blocks __fsblkcnt64_t }
{ f_bfree __fsblkcnt64_t }
{ f_bavail __fsblkcnt64_t }
{ f_files __fsfilcnt64_t }
{ f_ffree __fsfilcnt64_t }
{ f_favail __fsfilcnt64_t }
{ f_fsid ulong }
{ f_flag ulong }
{ f_namemax ulong }
{ __f_spare int[6] } ;
FUNCTION: int statvfs64 ( char* path, statvfs64* buf ) ;

26
basis/unix/statvfs/macosx/macosx.factor
View File

@ -1,20 +1,20 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax classes.struct ;
IN: unix.statvfs.macosx
C-STRUCT: statvfs
{ "ulong" "f_bsize" }
{ "ulong" "f_frsize" }
{ "fsblkcnt_t" "f_blocks" }
{ "fsblkcnt_t" "f_bfree" }
{ "fsblkcnt_t" "f_bavail" }
{ "fsfilcnt_t" "f_files" }
{ "fsfilcnt_t" "f_ffree" }
{ "fsfilcnt_t" "f_favail" }
{ "ulong" "f_fsid" }
{ "ulong" "f_flag" }
{ "ulong" "f_namemax" } ;
STRUCT: statvfs
{ f_bsize ulong }
{ f_frsize ulong }
{ f_blocks fsblkcnt_t }
{ f_bfree fsblkcnt_t }
{ f_bavail fsblkcnt_t }
{ f_files fsfilcnt_t }
{ f_ffree fsfilcnt_t }
{ f_favail fsfilcnt_t }
{ f_fsid ulong }
{ f_flag ulong }
{ f_namemax ulong } ;
! Flags
CONSTANT: ST_RDONLY HEX: 1 ! Read-only file system

52
basis/unix/statvfs/netbsd/netbsd.factor
View File

@ -1,35 +1,35 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax classes.struct ;
IN: unix.statvfs.netbsd
CONSTANT: _VFS_NAMELEN 32
CONSTANT: _VFS_MNAMELEN 1024
C-STRUCT: statvfs
{ "ulong" "f_flag" }
{ "ulong" "f_bsize" }
{ "ulong" "f_frsize" }
{ "ulong" "f_iosize" }
{ "fsblkcnt_t" "f_blocks" }
{ "fsblkcnt_t" "f_bfree" }
{ "fsblkcnt_t" "f_bavail" }
{ "fsblkcnt_t" "f_bresvd" }
{ "fsfilcnt_t" "f_files" }
{ "fsfilcnt_t" "f_ffree" }
{ "fsfilcnt_t" "f_favail" }
{ "fsfilcnt_t" "f_fresvd" }
{ "uint64_t" "f_syncreads" }
{ "uint64_t" "f_syncwrites" }
{ "uint64_t" "f_asyncreads" }
{ "uint64_t" "f_asyncwrites" }
{ "fsid_t" "f_fsidx" }
{ "ulong" "f_fsid" }
{ "ulong" "f_namemax" }
{ "uid_t" "f_owner" }
{ { "uint32_t" 4 } "f_spare" }
{ { "char" _VFS_NAMELEN } "f_fstypename" }
{ { "char" _VFS_MNAMELEN } "f_mntonname" }
{ { "char" _VFS_MNAMELEN } "f_mntfromname" } ;
STRUCT: statvfs
{ f_flag ulong }
{ f_bsize ulong }
{ f_frsize ulong }
{ f_iosize ulong }
{ f_blocks fsblkcnt_t }
{ f_bfree fsblkcnt_t }
{ f_bavail fsblkcnt_t }
{ f_bresvd fsblkcnt_t }
{ f_files fsfilcnt_t }
{ f_ffree fsfilcnt_t }
{ f_favail fsfilcnt_t }
{ f_fresvd fsfilcnt_t }
{ f_syncreads uint64_t }
{ f_syncwrites uint64_t }
{ f_asyncreads uint64_t }
{ f_asyncwrites uint64_t }
{ f_fsidx fsid_t }
{ f_fsid ulong }
{ f_namemax ulong }
{ f_owner uid_t }
{ f_spare uint32_t[4] }
{ f_fstypename { "char" _VFS_NAMELEN } }
{ f_mntonname { "char" _VFS_MNAMELEN } }
{ f_mntfromname { "char" _VFS_MNAMELEN } } ;
FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

26
basis/unix/statvfs/openbsd/openbsd.factor
View File

@ -1,20 +1,20 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax classes.struct ;
IN: unix.statvfs.openbsd
C-STRUCT: statvfs
{ "ulong" "f_bsize" }
{ "ulong" "f_frsize" }
{ "fsblkcnt_t" "f_blocks" }
{ "fsblkcnt_t" "f_bfree" }
{ "fsblkcnt_t" "f_bavail" }
{ "fsfilcnt_t" "f_files" }
{ "fsfilcnt_t" "f_ffree" }
{ "fsfilcnt_t" "f_favail" }
{ "ulong" "f_fsid" }
{ "ulong" "f_flag" }
{ "ulong" "f_namemax" } ;
STRUCT: statvfs
{ f_bsize ulong }
{ f_frsize ulong }
{ f_blocks fsblkcnt_t }
{ f_bfree fsblkcnt_t }
{ f_bavail fsblkcnt_t }
{ f_files fsfilcnt_t }
{ f_ffree fsfilcnt_t }
{ f_favail fsfilcnt_t }
{ f_fsid ulong }
{ f_flag ulong }
{ f_namemax ulong } ;
CONSTANT: ST_RDONLY 1
CONSTANT: ST_NOSUID 2

51
basis/unix/time/time.factor
View File

@ -1,40 +1,41 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel alien.syntax alien.c-types math unix.types ;
USING: kernel alien.syntax alien.c-types math unix.types
classes.struct accessors ;
IN: unix.time
C-STRUCT: timeval
{ "long" "sec" }
{ "long" "usec" } ;
STRUCT: timeval
{ sec long }
{ usec long } ;
C-STRUCT: timespec
{ "time_t" "sec" }
{ "long" "nsec" } ;
STRUCT: timespec
{ sec time_t }
{ nsec long } ;
: make-timeval ( us -- timeval )
1000000 /mod
"timeval" <c-object>
[ set-timeval-usec ] keep
[ set-timeval-sec ] keep ;
timeval <struct>
swap >>usec
swap >>sec ;
: make-timespec ( us -- timespec )
1000000 /mod 1000 *
"timespec" <c-object>
[ set-timespec-nsec ] keep
[ set-timespec-sec ] keep ;
timespec <struct>
swap >>nsec
swap >>sec ;
C-STRUCT: tm
{ "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?)
{ "int" "min" } ! Minutes: 0-59
{ "int" "hour" } ! Hours since midnight: 0-23
{ "int" "mday" } ! Day of the month: 1-31
{ "int" "mon" } ! Months *since* january: 0-11
{ "int" "year" } ! Years since 1900
{ "int" "wday" } ! Days since Sunday (0-6)
{ "int" "yday" } ! Days since Jan. 1: 0-365
{ "int" "isdst" } ! +1 Daylight Savings Time, 0 No DST,
{ "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?)
{ "char*" "zone" } ;
STRUCT: tm
{ sec int }
{ min int }
{ hour int }
{ mday int }
{ mon int }
{ year int }
{ wday int }
{ yday int }
{ isdst int }
{ gmtoff long }
{ zone char* } ;
FUNCTION: time_t time ( time_t* t ) ;
FUNCTION: tm* localtime ( time_t* clock ) ;

1
core/math/math-docs.factor
View File

@ -420,6 +420,7 @@ ARTICLE: "bitwise-arithmetic" "Bitwise arithmetic"
{ $subsection 2/ }
{ $subsection 2^ }
{ $subsection bit? }
"Advanced topics:"
{ $subsection "math.bitwise" }
{ $subsection "math.bits" }
{ $see-also "booleans" } ;

6
extra/mongodb/driver/driver.factor
View File

@ -1,7 +1,8 @@
USING: accessors arrays assocs bson.constants combinators
combinators.smart constructors destructors formatting fry hashtables
io io.pools io.sockets kernel linked-assocs math mongodb.connection
mongodb.msg parser prettyprint sequences sets splitting strings
mongodb.msg parser prettyprint prettyprint.custom prettyprint.sections
sequences sets splitting strings
tools.continuations uuid memoize locals ;
IN: mongodb.driver
@ -32,6 +33,9 @@ CONSTANT: PARTIAL? "partial?"
ERROR: mdb-error msg ;
M: mdb-error pprint* ( obj -- )
msg>> text ;
: >pwd-digest ( user password -- digest )
"mongo" swap 3array ":" join md5-checksum ;