]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into more_aggressive_coalescing
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 28 Sep 2009 00:29:50 +0000 (19:29 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 28 Sep 2009 00:29:50 +0000 (19:29 -0500)
115 files changed:
basis/alien/c-types/c-types-tests.factor [changed mode: 0644->0755]
basis/alien/c-types/c-types.factor
basis/alien/parser/parser-tests.factor [new file with mode: 0644]
basis/cocoa/runtime/runtime.factor
basis/cocoa/types/types.factor
basis/compiler/cfg/instructions/instructions.factor
basis/compiler/cfg/linear-scan/allocation/allocation.factor
basis/compiler/cfg/linear-scan/allocation/state/state.factor
basis/compiler/cfg/linear-scan/assignment/assignment.factor
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
basis/compiler/cfg/linear-scan/resolve/resolve.factor
basis/compiler/codegen/codegen.factor
basis/compiler/tests/codegen.factor
basis/compression/inflate/inflate.factor
basis/compression/zlib/ffi/ffi.factor
basis/core-foundation/arrays/arrays.factor
basis/core-foundation/attributed-strings/attributed-strings.factor
basis/core-foundation/bundles/bundles.factor
basis/core-foundation/data/data.factor
basis/core-foundation/dictionaries/dictionaries.factor
basis/core-foundation/file-descriptors/file-descriptors.factor
basis/core-foundation/fsevents/fsevents.factor
basis/core-foundation/run-loop/run-loop.factor
basis/core-foundation/strings/strings.factor
basis/core-foundation/time/time.factor
basis/core-foundation/timers/timers.factor
basis/core-foundation/urls/urls.factor
basis/core-graphics/core-graphics.factor
basis/core-graphics/types/types.factor
basis/core-text/fonts/fonts.factor
basis/cpu/architecture/architecture.factor
basis/cpu/ppc/ppc.factor
basis/cpu/x86/32/32.factor
basis/cpu/x86/64/64.factor
basis/cpu/x86/x86.factor
basis/db/postgresql/ffi/ffi.factor
basis/environment/unix/macosx/macosx.factor
basis/glib/glib.factor
basis/images/bitmap/loading/loading.factor
basis/images/png/png.factor
basis/images/tiff/tiff.factor
basis/io/pipes/unix/unix.factor
basis/iokit/hid/hid.factor
basis/math/blas/matrices/matrices.factor
basis/math/blas/vectors/vectors.factor
basis/math/floats/env/x86/x86.factor
basis/math/vectors/simd/functor/functor.factor
basis/math/vectors/simd/simd-docs.factor
basis/math/vectors/vectors.factor
basis/opengl/gl/gl.factor
basis/opengl/gl/windows/windows.factor [changed mode: 0644->0755]
basis/opengl/textures/textures.factor
basis/openssl/libcrypto/libcrypto.factor
basis/openssl/libssl/libssl.factor
basis/pango/cairo/cairo.factor
basis/pango/fonts/fonts.factor
basis/pango/layouts/layouts.factor
basis/pango/pango.factor
basis/random/mersenne-twister/mersenne-twister.factor
basis/tools/disassembler/udis/udis.factor
basis/ui/pens/gradient/gradient.factor
basis/ui/pens/polygon/polygon.factor
basis/ui/pixel-formats/pixel-formats.factor
basis/unix/bsd/bsd.factor
basis/unix/getfsstat/macosx/macosx.factor
basis/unix/kqueue/kqueue.factor
basis/unix/kqueue/macosx/macosx.factor
basis/unix/process/process.factor
basis/unix/stat/macosx/macosx.factor
basis/unix/statvfs/macosx/macosx.factor
basis/unix/types/types.factor
basis/unix/unix.factor
basis/vm/vm.factor
basis/windows/advapi32/advapi32.factor
basis/windows/com/com.factor [changed mode: 0644->0755]
basis/windows/com/syntax/syntax.factor
basis/windows/dinput/dinput.factor
basis/windows/gdi32/gdi32.factor
basis/windows/kernel32/kernel32.factor
basis/windows/ole32/ole32.factor
basis/windows/shell32/shell32.factor [changed mode: 0644->0755]
basis/windows/types/types.factor
basis/windows/user32/user32.factor
basis/windows/usp10/usp10.factor
basis/windows/winsock/winsock.factor
basis/x11/constants/constants.factor
basis/x11/xlib/xlib.factor
extra/benchmark/dawes/dawes.factor
extra/benchmark/dispatch2/dispatch2.factor
extra/benchmark/dispatch3/dispatch3.factor
extra/benchmark/fasta/fasta.factor
extra/benchmark/nbody-simd/nbody-simd.factor
extra/benchmark/nbody/nbody.factor
extra/benchmark/raytracer/raytracer.factor
extra/benchmark/spectral-norm/spectral-norm.factor
extra/benchmark/struct-arrays/struct-arrays.factor
extra/freetype/freetype.factor
extra/gpu/render/render-docs.factor
extra/gpu/util/util.factor
extra/gpu/util/wasd/wasd.factor
extra/grid-meshes/grid-meshes.factor
extra/images/normalization/normalization.factor
extra/jamshred/player/player.factor
extra/jamshred/tunnel/tunnel.factor
extra/native-thread-test/native-thread-test.factor
extra/nurbs/nurbs.factor
extra/ogg/ogg.factor
extra/openal/macosx/macosx.factor
extra/openal/other/other.factor
extra/opengl/glu/glu.factor
extra/terrain/terrain.factor
extra/tokyo/alien/tchdb/tchdb.factor
extra/tokyo/alien/tctdb/tctdb.factor
misc/vim/syntax/factor.vim

old mode 100644 (file)
new mode 100755 (executable)
index a893ffe..f48ed50
@@ -1,50 +1,50 @@
-USING: alien alien.syntax alien.c-types kernel tools.test
-sequences system libc alien.strings io.encodings.utf8
-math.constants ;
+USING: alien alien.syntax alien.c-types alien.parser
+kernel tools.test sequences system libc alien.strings
+io.encodings.utf8 math.constants classes.struct ;
 IN: alien.c-types.tests
 
 CONSTANT: xyz 123
 
-[ 492 ] [ { "int" xyz } heap-size ] unit-test
+[ 492 ] [ { int xyz } heap-size ] unit-test
 
 [ -1 ] [ -1 <char> *char ] unit-test
 [ -1 ] [ -1 <short> *short ] unit-test
 [ -1 ] [ -1 <int> *int ] unit-test
 
-C-UNION: foo
-    "int"
-    "int" ;
+UNION-STRUCT: foo
+    { a int }
+    { b int } ;
 
-[ f ] [ "char*" c-type "void*" c-type eq? ] unit-test
-[ t ] [ "char**" c-type "void*" c-type eq? ] unit-test
+[ f ] [ "char*"  parse-c-type c-type void* c-type eq? ] unit-test
+[ t ] [ "char**" parse-c-type c-type void* c-type eq? ] unit-test
 
-[ t ] [ "foo" heap-size "int" heap-size = ] unit-test
+[ t ] [ foo heap-size int heap-size = ] unit-test
 
 TYPEDEF: int MyInt
 
-[ t ] [ "int" c-type "MyInt" c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyInt*" c-type eq? ] unit-test
+[ t ] [ int c-type MyInt c-type eq? ] unit-test
+[ t ] [ void* c-type "MyInt*" parse-c-type c-type eq? ] unit-test
 
 TYPEDEF: char MyChar
 
-[ t ] [ "char" c-type "MyChar" c-type eq? ] unit-test
-[ f ] [ "void*" c-type "MyChar*" c-type eq? ] unit-test
-[ t ] [ "char*" c-type "MyChar*" c-type eq? ] unit-test
+[ t ] [ char c-type MyChar c-type eq? ] unit-test
+[ f ] [  void*               c-type "MyChar*" parse-c-type c-type eq? ] unit-test
+[ t ] [ "char*" parse-c-type c-type "MyChar*" parse-c-type c-type eq? ] unit-test
 
-[ 32 ] [ { "int" 8 } heap-size ] unit-test
+[ 32 ] [ { int 8 } heap-size ] unit-test
 
 TYPEDEF: char* MyString
 
-[ t ] [ "char*" c-type "MyString" c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyString*" c-type eq? ] unit-test
+[ t ] [ char* c-type  MyString                c-type eq? ] unit-test
+[ t ] [ void* c-type "MyString*" parse-c-type c-type eq? ] unit-test
 
 TYPEDEF: int* MyIntArray
 
-[ t ] [ "void*" c-type "MyIntArray" c-type eq? ] unit-test
+[ t ] [ void* c-type MyIntArray c-type eq? ] unit-test
 
 TYPEDEF: uchar* MyLPBYTE
 
-[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test
+[ t ] [ { char* utf8 } c-type MyLPBYTE c-type = ] unit-test
 
 [
     0 B{ 1 2 3 4 } <displaced-alien> <void*>
index 984fa4e36ef970db90149561240dd02e25032259..ab1c9df77e14b6c0859c7aba9ce243b85728e79a 100755 (executable)
@@ -60,6 +60,8 @@ GENERIC: c-type ( name -- c-type ) foldable
 
 GENERIC: resolve-pointer-type ( name -- c-type )
 
+<< \ void \ void* "pointer-c-type" set-word-prop >>
+
 M: word resolve-pointer-type
     dup "pointer-c-type" word-prop
     [ ] [ drop void* ] ?if ;
diff --git a/basis/alien/parser/parser-tests.factor b/basis/alien/parser/parser-tests.factor
new file mode 100644 (file)
index 0000000..b9ef08e
--- /dev/null
@@ -0,0 +1,27 @@
+! (c)2009 Joe Groff bsd license
+USING: accessors alien.c-types alien.parser alien.syntax
+tools.test vocabs.parser ;
+IN: alien.parser.tests
+
+TYPEDEF: char char2
+
+[ int ] [ "int" parse-c-type ] unit-test
+[ { int 5 } ] [ "int[5]" parse-c-type ] unit-test
+[ { int 5 10 11 } ] [ "int[5][10][11]" parse-c-type ] unit-test
+[ void* ] [ "int*" parse-c-type ] unit-test
+[ void* ] [ "int**" parse-c-type ] unit-test
+[ void* ] [ "int***" parse-c-type ] unit-test
+[ void* ] [ "int****" parse-c-type ] unit-test
+[ char* ] [ "char*" parse-c-type ] unit-test
+[ void* ] [ "char**" parse-c-type ] unit-test
+[ void* ] [ "char***" parse-c-type ] unit-test
+[ void* ] [ "char****" parse-c-type ] unit-test
+[ char2 ] [ "char2" parse-c-type ] unit-test
+[ char* ] [ "char2*" parse-c-type ] unit-test
+
+SYMBOL: not-c-type
+
+[ "not-c-type" parse-c-type ] [ no-c-type? ] must-fail-with
+! uncomment this when string C type parsing goes away
+! [ "not-word" parse-c-type ] [ error>> no-word-error? ] must-fail-with
+
index 28d812a4893749d7f6bcd92a3ee533ca59889dca..f02f1f6182d6de07a6e1a33d31c513953c20a30e 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax classes.struct ;
+USING: alien.c-types alien.syntax classes.struct ;
 IN: cocoa.runtime
 
 TYPEDEF: void* SEL
index 0e0ef72ad290a8ea6d60d896e4b8fdb0b5ca182d..1e1ec98245988c39292f4f2cf5600b050c69898b 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax combinators kernel layouts
-classes.struct core-graphics.types ;
+classes.struct cocoa.runtime core-graphics.types ;
 IN: cocoa.types
 
 TYPEDEF: long NSInteger
index 6f9e7d03a9bd7d7f1229cba8449a47136d9c1d09..1eee379dd5069ceecfda9514485bc09f2271f6dc 100644 (file)
@@ -657,7 +657,8 @@ literal: label
 def: dst/int-rep
 use: src1/int-rep src2/int-rep ;
 
-TUPLE: spill-slot n ; C: <spill-slot> spill-slot
+TUPLE: spill-slot { n integer } ;
+C: <spill-slot> spill-slot
 
 INSN: _gc
 temp: temp1 temp2
@@ -667,11 +668,11 @@ literal: data-values tagged-values uninitialized-locs ;
 ! virtual registers
 INSN: _spill
 use: src
-literal: rep n ;
+literal: rep dst ;
 
 INSN: _reload
 def: dst
-literal: rep n ;
+literal: rep src ;
 
 INSN: _spill-area-size
 literal: n ;
index c23867ffe29172e8c765259b01754a810f695f8b..ac32265e654723e0f339a36324f4320ea754d1fb 100644 (file)
@@ -34,11 +34,15 @@ IN: compiler.cfg.linear-scan.allocation
         [ drop assign-blocked-register ]
     } cond ;
 
+: spill-at-sync-point ( live-interval n -- ? )
+    ! If the live interval has a usage at 'n', don't spill it,
+    ! since this means its being defined by the sync point
+    ! instruction. Output t if this is the case.
+    2dup [ uses>> ] dip swap member? [ 2drop t ] [ spill f ] if ;
+
 : handle-sync-point ( n -- )
     [ active-intervals get values ] dip
-    [ '[ [ _ spill ] each ] each ]
-    [ drop [ delete-all ] each ]
-    2bi ;
+    '[ [ _ spill-at-sync-point ] filter-here ] each ;
 
 :: handle-progress ( n sync? -- )
     n {
index a311f97b660d790da27180ca859b452f48f278ef..3ae000891e6e0827d237f806a293e27eb063ae20 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators cpu.architecture fry heaps
 kernel math math.order namespaces sequences vectors
-compiler.cfg compiler.cfg.registers
+compiler.cfg compiler.cfg.registers compiler.cfg.instructions
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.allocation.state
 
@@ -118,7 +118,8 @@ SYMBOL: unhandled-intervals
 
 : next-spill-slot ( rep -- n )
     rep-size cfg get
-    [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ;
+    [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop
+    <spill-slot> ;
 
 ! Minheap of sync points which still need to be processed
 SYMBOL: unhandled-sync-points
@@ -126,7 +127,7 @@ SYMBOL: unhandled-sync-points
 ! Mapping from vregs to spill slots
 SYMBOL: spill-slots
 
-: vreg-spill-slot ( vreg -- n )
+: vreg-spill-slot ( vreg -- spill-slot )
     spill-slots get [ rep-of next-spill-slot ] cache ;
 
 : init-allocator ( registers -- )
index 572107be6cd05142e58751f809a8390cbcf13193..8959add822a1011c07f2e5ebb7f5d6f01200adf1 100644 (file)
@@ -33,7 +33,7 @@ ERROR: bad-vreg vreg ;
 : (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> ] [ bad-vreg ] if ] unless ;
+    ?at [ spill-slots get ?at [ ] [ bad-vreg ] if ] unless ;
 
 : vreg>reg ( vreg -- reg )
     pending-interval-assoc get (vreg>reg) ;
index f09fe403e66a691a982650a059e00716a8d305bf..77c9e348c925bcf0f4bc561db003827073393594 100644 (file)
@@ -92,7 +92,7 @@ H{
        { end 2 }
        { uses V{ 0 1 } }
        { ranges V{ T{ live-range f 0 2 } } }
-       { spill-to 0 }
+       { spill-to T{ spill-slot f 0 } }
     }
     T{ live-interval
        { vreg 1 }
@@ -100,7 +100,7 @@ H{
        { end 5 }
        { uses V{ 5 } }
        { ranges V{ T{ live-range f 5 5 } } }
-       { reload-from 0 }
+       { reload-from T{ spill-slot f 0 } }
     }
 ] [
     T{ live-interval
@@ -119,7 +119,7 @@ H{
        { end 1 }
        { uses V{ 0 } }
        { ranges V{ T{ live-range f 0 1 } } }
-       { spill-to 4 }
+       { spill-to T{ spill-slot f 4 } }
     }
     T{ live-interval
        { vreg 2 }
@@ -127,7 +127,7 @@ H{
        { end 5 }
        { uses V{ 1 5 } }
        { ranges V{ T{ live-range f 1 5 } } }
-       { reload-from 4 }
+       { reload-from T{ spill-slot f 4 } }
     }
 ] [
     T{ live-interval
@@ -146,7 +146,7 @@ H{
        { end 1 }
        { uses V{ 0 } }
        { ranges V{ T{ live-range f 0 1 } } }
-       { spill-to 8 }
+       { spill-to T{ spill-slot f 8 } }
     }
     T{ live-interval
        { vreg 3 }
@@ -154,7 +154,7 @@ H{
        { end 30 }
        { uses V{ 20 30 } }
        { ranges V{ T{ live-range f 20 30 } } }
-       { reload-from 8 }
+       { reload-from T{ spill-slot f 8 } }
     }
 ] [
     T{ live-interval
@@ -1042,8 +1042,8 @@ V{
 
 [ _spill ] [ 1 get instructions>> second class ] unit-test
 [ _reload ] [ 4 get instructions>> 4 swap nth class ] unit-test
-[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ n>> cell / ] map ] unit-test
-[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> cell / ] map ] unit-test
+[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ dst>> n>> cell / ] map ] unit-test
+[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ src>> n>> cell / ] map ] unit-test
 
 ! Resolve pass should insert this
 [ _reload ] [ 5 get predecessors>> first instructions>> first class ] unit-test
index 47c1f0ae76e673c6bc0b211708494cd933bf33e7..e7f291d61312b5a21de70ecbd43cca4ce2f7b831 100644 (file)
@@ -17,7 +17,7 @@ IN: compiler.cfg.linear-scan.resolve.tests
 
 [
     {
-        T{ _reload { dst 1 } { rep int-rep } { n 0 } }
+        T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 0 } } }
     }
 ] [
     [
@@ -27,7 +27,7 @@ IN: compiler.cfg.linear-scan.resolve.tests
 
 [
     {
-        T{ _spill { src 1 } { rep int-rep } { n 0 } }
+        T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 0 } } }
     }
 ] [
     [
@@ -54,14 +54,14 @@ H{ } clone spill-temps set
     { { { 0 int-rep } { 1 int-rep } } { { 1 int-rep } { 0 int-rep } } }
     mapping-instructions {
         {
-            T{ _spill { src 0 } { rep int-rep } { n 8 } }
+            T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 8 } } }
             T{ ##copy { dst 0 } { src 1 } { rep int-rep } }
-            T{ _reload { dst 1 } { rep int-rep } { n 8 } }
+            T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 8 } } }
         }
         {
-            T{ _spill { src 1 } { rep int-rep } { n 8 } }
+            T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 8 } } }
             T{ ##copy { dst 1 } { src 0 } { rep int-rep } }
-            T{ _reload { dst 0 } { rep int-rep } { n 8 } }
+            T{ _reload { dst 0 } { rep int-rep } { src T{ spill-slot f 8 } } }
         }
     } member?
 ] unit-test
index 15dff234488c684cc069a72fd703557bd4781cf3..20c9ee4e99d257dc09f42bc2df3883d7d2fd2d2c 100644 (file)
@@ -34,10 +34,10 @@ SYMBOL: spill-temps
     ] if ;
 
 : memory->register ( from to -- )
-    swap [ first2 ] [ first n>> ] bi* _reload ;
+    swap [ first2 ] [ first ] bi* _reload ;
 
 : register->memory ( from to -- )
-    [ first2 ] [ first n>> ] bi* _spill ;
+    [ first2 ] [ first ] bi* _spill ;
 
 : temp->register ( from to -- )
     nip [ first ] [ second ] [ second spill-temp ] tri _reload ;
index 0c9d7ab45a316e416228d89db6f51095deabec23..76c47d2ef25e474297ec840e2336a27c3f5c4195 100755 (executable)
@@ -240,7 +240,7 @@ CODEGEN: _reload %reload
 GENERIC# save-gc-root 1 ( gc-root operand temp -- )
 
 M:: spill-slot save-gc-root ( gc-root operand temp -- )
-    temp int-rep operand n>> %reload
+    temp int-rep operand %reload
     gc-root temp %save-gc-root ;
 
 M: object save-gc-root drop %save-gc-root ;
@@ -253,7 +253,7 @@ GENERIC# load-gc-root 1 ( gc-root operand temp -- )
 
 M:: spill-slot load-gc-root ( gc-root operand temp -- )
     gc-root temp %load-gc-root
-    temp int-rep operand n>> %spill ;
+    temp int-rep operand %spill ;
 
 M: object load-gc-root drop %load-gc-root ;
 
index 3dbde076a6dc6bfd13dc9ddd46ad2b6652818070..a4f19966b1985b71658c156598b9a1ad645c15b7 100644 (file)
@@ -1,9 +1,10 @@
-USING: generalizations accessors arrays compiler kernel kernel.private
-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.libm math.parser alien.c-types ;
+USING: generalizations accessors arrays compiler kernel
+kernel.private 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.libm math.parser math.functions ;
 FROM: math => float ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
@@ -432,6 +433,7 @@ cell 4 = [
     ] compile-call
 ] unit-test
 
+! Bug in CSSA construction
 TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-only } ;
 
 [ 2 ] [
@@ -449,3 +451,13 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
         ] 2curry each-integer
     ] compile-call
 ] unit-test
+
+! Bug in linear scan's partial sync point logic
+[ t ] [
+    [ 1.0 100 [ fsin ] times 1.0 float+ ] compile-call
+    1.168852488727981 1.e-9 ~
+] unit-test
+
+[ 65537.0 ] [
+    [ 2.0 4 [ 2.0 fpow ] times 1.0 float+ ] compile-call
+] unit-test
index fa3f4d1284b2d503383409043ba11cf8f9e66c28..26b851cc1eb5b20157dd0c1144c95cb294ee0363 100644 (file)
@@ -1,10 +1,9 @@
 ! Copyright (C) 2009 Marc Fauconneau.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays
-byte-vectors combinators fry grouping hashtables
-compression.huffman images io.binary kernel locals
-math math.bitwise math.order math.ranges multiline sequences
-sorting ;
+USING: accessors arrays assocs byte-vectors combinators
+compression.huffman fry hashtables io.binary kernel locals math
+math.bitwise math.order math.ranges sequences sorting ;
+QUALIFIED-WITH: bitstreams bs
 IN: compression.inflate
 
 QUALIFIED-WITH: bitstreams bs
@@ -177,42 +176,9 @@ CONSTANT: dist-table
         case
     ]
     [ produce ] keep call suffix concat ;
-    
-  !  [ produce ] keep dip swap suffix
-
-:: paeth ( a b c -- p ) 
-    a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
-    sort-keys first second ;
-    
-:: png-unfilter-line ( prev curr filter -- curr' )
-    prev :> c
-    prev 3 tail-slice :> b
-    curr :> a
-    curr 3 tail-slice :> x
-    x length [0,b)
-    filter {
-        { 0 [ drop ] }
-        { 1 [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
-        { 2 [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
-        { 3 [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
-        { 4 [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
-    } case 
-    curr 3 tail ;
 
 PRIVATE>
 
-: reverse-png-filter' ( lines -- byte-array )
-    [ first ] [ 1 tail ] [ map ] bi-curry@ bi nip
-    concat [ 128 + ] B{ } map-as ;
-
-: reverse-png-filter ( lines -- byte-array )
-    dup first length 0 <array> prefix
-    [ { 0 0 } prepend ] map
-    2 clump [
-        first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
-        png-unfilter-line
-    ] map B{ } concat-as ;
-
 : zlib-inflate ( bytes -- bytes )
     bs:<lsb0-bit-reader>
     [ check-zlib-header ] [ inflate-loop ] bi
index a472f9a2fe85479c52d161f48ca05abfedf91a46..553b55cf6e94ed664da1b6afe73787d220d714e3 100755 (executable)
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax combinators system alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators system
+alien.libraries ;
 IN: compression.zlib.ffi
 
 << "zlib" {
index 1205352fcb75b5bc744efab7c37d481cbd5d894d..f0dfff9143d06158c73834f40c15117dde855a90 100644 (file)
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel sequences fry ;
+USING: alien.c-types alien.syntax core-foundation kernel
+sequences fry ;
 IN: core-foundation.arrays
 
 TYPEDEF: void* CFArrayRef
index 48c262f3a37d722ceb5eed9225f86ac292018c9c..cd620bb876cce22654901e56c446960c36a29093 100644 (file)
@@ -1,6 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel destructors core-foundation
+USING: alien.c-types alien.syntax kernel destructors
+core-foundation core-foundation.dictionaries
+core-foundation.strings
 core-foundation.utilities ;
 IN: core-foundation.attributed-strings
 
@@ -16,4 +18,4 @@ FUNCTION: CFAttributedStringRef CFAttributedStringCreate (
     [
         [ >cf &CFRelease ] bi@
         [ kCFAllocatorDefault ] 2dip CFAttributedStringCreate
-    ] with-destructors ;
\ No newline at end of file
+    ] with-destructors ;
index 790f1766c39666bb2151af301aeb0de369c59edd..e45e2c52beb0ae1bbaa8b2f7be6ba9bad81991b4 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel sequences core-foundation
-core-foundation.urls ;
+USING: alien.c-types alien.syntax kernel sequences
+core-foundation core-foundation.urls ;
 IN: core-foundation.bundles
 
 TYPEDEF: void* CFBundleRef
index ef5973888edf872cc898ba16c80ccc15bfa756b4..c4c09d0cc5042d9bb256f6abf382ad4d75eecb0a 100644 (file)
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax kernel math sequences ;
+USING: alien.c-types alien.syntax core-foundation kernel math
+sequences ;
 IN: core-foundation.data
 
 TYPEDEF: void* CFDataRef
@@ -16,4 +17,4 @@ FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFInd
 FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
 
 : <CFData> ( byte-array -- alien )
-    [ f ] dip dup length CFDataCreate ;
\ No newline at end of file
+    [ f ] dip dup length CFDataCreate ;
index cc0175e0eaa5807ada0750ad2ad8acbd6f4ba6b4..04b5aacb39e1e991a1bc4bc94e7f80888c3036f6 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax core-foundation kernel assocs
+USING: alien.c-types alien.syntax core-foundation kernel assocs
 specialized-arrays math sequences accessors ;
 IN: core-foundation.dictionaries
 
@@ -31,4 +31,4 @@ FUNCTION: void* CFDictionaryGetValue (
     [ [ underlying>> ] bi@ ] [ nip length ] 2bi
     &: kCFTypeDictionaryKeyCallBacks
     &: kCFTypeDictionaryValueCallBacks
-    CFDictionaryCreate ;
\ No newline at end of file
+    CFDictionaryCreate ;
index c9fe3131b148271497b9ffe60f69c31272bb1736..2520f1c3dab2dfcceff792e448da640367128b22 100644 (file)
@@ -1,11 +1,12 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel math.bitwise core-foundation ;
+USING: alien.c-types alien.syntax kernel math.bitwise core-foundation ;
 IN: core-foundation.file-descriptors
 
 TYPEDEF: void* CFFileDescriptorRef
 TYPEDEF: int CFFileDescriptorNativeDescriptor
 TYPEDEF: void* CFFileDescriptorCallBack
+TYPEDEF: void* CFFileDescriptorContext*
 
 FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
     CFAllocatorRef allocator,
index 9a22046a3a3ae27adb1a4c40a8435b82bebc1f12..6f5484fb77199198a60899a3882c2c60beb2f7eb 100755 (executable)
@@ -4,8 +4,8 @@ USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
 continuations combinators io.encodings.utf8 destructors locals
 arrays specialized-arrays classes.struct core-foundation
-core-foundation.run-loop core-foundation.strings
-core-foundation.time ;
+core-foundation.arrays core-foundation.run-loop
+core-foundation.strings core-foundation.time unix.types ;
 IN: core-foundation.fsevents
 
 SPECIALIZED-ARRAY: void*
index 10d858a32f5f4fcbb689131124bc855f237f3aa1..7b454266f26bdcbc8276e8cdd6b88c5786254d38 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.syntax kernel math namespaces
-sequences destructors combinators threads heaps deques calendar
-core-foundation core-foundation.strings
+USING: accessors alien alien.c-types alien.syntax kernel math
+namespaces sequences destructors combinators threads heaps
+deques calendar core-foundation core-foundation.strings
 core-foundation.file-descriptors core-foundation.timers
 core-foundation.time ;
 IN: core-foundation.run-loop
index 4bbe0502304f33cc599000d25809828826cb7fdd..cbabb083aa23444f272f8e5592128330cea8802f 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.strings io.encodings.string kernel
-sequences byte-arrays io.encodings.utf8 math core-foundation
+USING: alien.c-types alien.syntax alien.strings io.encodings.string
+kernel sequences byte-arrays io.encodings.utf8 math core-foundation
 core-foundation.arrays destructors parser fry alien words ;
 IN: core-foundation.strings
 
index 15ad7bb1a14a9694b9426d9578e375e4bed4a980..8f0965246250f1e894919373a39ef7d4e97a12e8 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar alien.syntax ;
+USING: calendar alien.c-types alien.syntax ;
 IN: core-foundation.time
 
 TYPEDEF: double CFTimeInterval
index 51ee98259231e48bc4fc35b63fbfb1925f021087..cf17cb41d9e9a9bb9ffdb2dfe714c1448f17ae69 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system math kernel calendar core-foundation
-core-foundation.time ;
+USING: alien.c-types alien.syntax system math kernel calendar
+core-foundation core-foundation.time ;
 IN: core-foundation.timers
 
 TYPEDEF: void* CFRunLoopTimerRef
index 7ffef498b64e7cbee26d7492c18e4ea5b5546e0e..f22095c3444b73ad50f2d9c958c08a8b80151e52 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel core-foundation.strings
-core-foundation ;
+USING: alien.c-types alien.syntax kernel core-foundation.strings
+core-foundation core-foundation.urls ;
 IN: core-foundation.urls
 
 CONSTANT: kCFURLPOSIXPathStyle 0
index a7bec0479846a6bb74cab4e0afe610dcf9547753..f3f759115cc2204ccab25a097ffaf23f35e27f9d 100644 (file)
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.destructors alien.syntax accessors
 destructors fry kernel math math.bitwise sequences libc colors
-images images.memory core-graphics.types core-foundation.utilities ;
+images images.memory core-graphics.types core-foundation.utilities
+opengl.gl ;
 IN: core-graphics
 
 ! CGImageAlphaInfo
index ad4620e174c8398137ee0ac83e412d09703be582..a1e9b1dc9a1655f7d0e98cee3ee8c70e65de566a 100644 (file)
@@ -1,10 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types alien.syntax classes.struct kernel layouts
-math math.rectangles arrays ;
+math math.rectangles arrays literals ;
+FROM: alien.c-types => float ;
 IN: core-graphics.types
 
-<< cell 4 = "float" "double" ? "CGFloat" typedef >>
+SYMBOL: CGFloat
+<< cell 4 = float double ? \ CGFloat typedef >>
 
 : <CGFloat> ( x -- alien )
     cell 4 = [ <float> ] [ <double> ] if ; inline
index 2656811c1fc92eec8faa5aca9b3d5a9f90c19199..6e85c949091e0ed07e3a297b82b6693653a9815e 100644 (file)
@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.syntax assocs core-foundation
-core-foundation.strings core-text.utilities destructors init
-kernel math memoize fonts combinators ;
+USING: accessors alien.c-types alien.syntax assocs core-foundation
+core-foundation.dictionaries core-foundation.strings
+core-graphics.types core-text.utilities destructors init
+kernel math memoize fonts combinators unix.types ;
 IN: core-text.fonts
 
 TYPEDEF: void* CTFontRef
index 0ddd477b8948a5e87a3ce192a2bcff07bb208705..4bd95a38a4754fbe9e9d8b95b5f11126fb4a9214 100644 (file)
@@ -309,8 +309,8 @@ HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-float-ordered-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-float-unordered-branch cpu ( label cc src1 src2 -- )
 
-HOOK: %spill cpu ( src rep n -- )
-HOOK: %reload cpu ( dst rep n -- )
+HOOK: %spill cpu ( src rep dst -- )
+HOOK: %reload cpu ( dst rep src -- )
 
 HOOK: %loop-entry cpu ( -- )
 
index 01e8513b2f4a6408c5bf22f415e257fe376a7015..5c96131466f367a740cc993ee33f27232f100fa7 100644 (file)
@@ -630,11 +630,11 @@ M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
         { stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
     } case ;
 
-M: ppc %spill ( src rep n -- )
-    swap [ spill@ ] dip store-to-frame ;
+M: ppc %spill ( src rep dst -- )
+    swap [ n>> spill@ ] dip store-to-frame ;
 
-M: ppc %reload ( dst rep n -- )
-    swap [ spill@ ] dip load-from-frame ;
+M: ppc %reload ( dst rep src -- )
+    swap [ n>> spill@ ] dip load-from-frame ;
 
 M: ppc %loop-entry ;
 
index 5f6c0d469698f977ea84df95347c744ff0326c62..809e0684305845ddf1b6faf0f0d20b8abc020ca8 100755 (executable)
@@ -282,6 +282,34 @@ M: x86.32 %callback-value ( ctype -- )
     ! Unbox EAX
     unbox-return ;
 
+GENERIC: float-function-param ( stack-slot dst src -- )
+
+M:: spill-slot float-function-param ( stack-slot dst src -- )
+    ! We can clobber dst here since its going to contain the
+    ! final result
+    dst src double-rep %copy
+    stack-slot dst double-rep %copy ;
+
+M: register float-function-param
+    nip double-rep %copy ;
+
+: float-function-return ( reg -- )
+    ESP [] FSTPL
+    ESP [] MOVSD
+    ESP 16 ADD ;
+
+M:: x86.32 %unary-float-function ( dst src func -- )
+    ESP -16 [+] dst src float-function-param
+    ESP 16 SUB
+    func f %alien-invoke
+    dst float-function-return ;
+
+M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
+    ESP -16 [+] dst src1 float-function-param
+    ESP  -8 [+] dst src2 float-function-param
+    ESP 16 SUB
+    func f %alien-invoke
+    dst float-function-return ;
 
 M: x86.32 %cleanup ( params -- )
     #! a) If we just called an stdcall function in Windows, it
index 562563039e6d87a8329450a5500ce3e296fd5078..805dda982b004061eaeb714ffb002874326563da 100644 (file)
@@ -218,8 +218,8 @@ 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-param ( i src -- )
+    [ float-regs param-regs nth ] dip double-rep %copy ;
 
 : float-function-return ( reg -- )
     float-regs return-reg double-rep %copy ;
@@ -230,6 +230,8 @@ M:: x86.64 %unary-float-function ( dst src func -- )
     dst float-function-return ;
 
 M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
+    ! src1 might equal dst; otherwise it will be a spill slot
+    ! src2 is always a spill slot
     0 src1 float-function-param
     1 src2 float-function-param
     func f %alien-invoke
@@ -249,9 +251,6 @@ M:: x86.64 %call-gc ( gc-root-count temp -- )
 ! x86-64.
 enable-alien-4-intrinsics
 
-! Enable fast calling of libc math functions
-enable-float-functions
-
 USE: vocabs.loader
 
 {
index 3a41b331d9e2c3f180301b01285ba1e5c1eaac2f..e78519b9e0f389242bd78640176f700e9768d036 100644 (file)
@@ -142,7 +142,10 @@ M: double-2-rep copy-register* drop MOVUPD ;
 M: vector-rep copy-register* drop MOVDQU ;
 
 M: x86 %copy ( dst src rep -- )
-    2over eq? [ 3drop ] [ copy-register* ] if ;
+    2over eq? [ 3drop ] [
+        [ [ dup spill-slot? [ n>> spill@ ] when ] bi@ ] dip
+        copy-register*
+    ] if ;
 
 M: x86 %fixnum-add ( label dst src1 src2 -- )
     int-rep two-operand ADD JO ;
@@ -954,11 +957,8 @@ M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
 M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
     \ UCOMISD (%compare-float-branch) ;
 
-M:: x86 %spill ( src rep n -- )
-    n spill@ src rep %copy ;
-
-M:: x86 %reload ( dst rep n -- )
-    dst n spill@ rep %copy ;
+M:: x86 %spill ( src rep dst -- ) dst src rep %copy ;
+M:: x86 %reload ( dst rep src -- ) dst src rep %copy ;
 
 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
 
@@ -1006,6 +1006,7 @@ enable-fixnum-log2
         enable-float-intrinsics
         enable-fsqrt
         enable-float-min/max
+        enable-float-functions
         install-sse2-check
     ] when ;
 
index 93f93c9a13ce1952fbc7d1961155be7b13d9bfb7..88618c6212b841b910b6881d2adcc55a1490eff5 100644 (file)
@@ -1,7 +1,8 @@
 ! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 ! tested on debian linux with postgresql 8.1
-USING: alien alien.syntax combinators system alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators system
+alien.libraries ;
 IN: db.postgresql.ffi
 
 << "postgresql" {
@@ -68,8 +69,8 @@ TYPEDEF: void* PQconninfoOption*
 TYPEDEF: void* PGnotify*
 TYPEDEF: void* PQArgBlock*
 TYPEDEF: void* PQprintOpt*
-TYPEDEF: void* FILE*
 TYPEDEF: void* SSL*
+TYPEDEF: void* FILE*
 
 LIBRARY: postgresql
 
index 51cee7ba087d643291680a3049f682d8656a6ed0..e811455927cb8b2cddbbaec05b592a1cfb27bd6a 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system environment.unix ;
+USING: alien.c-types alien.syntax system environment.unix ;
 IN: environment.unix.macosx
 
 FUNCTION: void* _NSGetEnviron ( ) ;
index ca481cb900fc9645f068d25daf631539881c953a..157a426e19e783769ba82c6fd44910ca2ae8def2 100755 (executable)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Matthew Willis.
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license
-USING: alien alien.syntax alien.destructors combinators system
-alien.libraries ;
+USING: alien alien.c-types alien.syntax alien.destructors
+combinators system alien.libraries ;
 IN: glib
 
 <<
@@ -27,12 +27,10 @@ TYPEDEF: void* gpointer
 TYPEDEF: int gint
 TYPEDEF: bool gboolean
 
-FUNCTION: void
-g_free ( gpointer mem ) ;
+FUNCTION: void g_free ( gpointer mem ) ;
 
 LIBRARY: gobject
 
-FUNCTION: void
-g_object_unref ( gpointer object ) ;
+FUNCTION: void g_object_unref ( gpointer object ) ;
 
 DESTRUCTOR: g_object_unref
index 823cfcd03a9f67c519103a62146b49ef164013e1..91e0cb882db1b3e5ac92535616793dd5314dd5f0 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays combinators
+USING: accessors alien.c-types arrays byte-arrays combinators
 compression.run-length fry grouping images images.loader io
 io.binary io.encodings.8-bit io.encodings.binary
 io.encodings.string io.streams.limited kernel math math.bitwise
index 8dde02687d91106bfd2f0c42752fe03da7bdc090..7e8f69d55514a2d10f502e64e46dff046527dfec 100755 (executable)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors images io io.binary io.encodings.ascii
-io.encodings.binary io.encodings.string io.files io.files.info kernel
-sequences io.streams.limited fry combinators arrays math checksums
-checksums.crc32 compression.inflate grouping byte-arrays images.loader ;
+USING: accessors arrays checksums checksums.crc32 combinators
+compression.inflate fry grouping images images.loader io
+io.binary io.encodings.ascii io.encodings.string kernel locals
+math math.bitwise math.ranges sequences sorting ;
 IN: images.png
 
 SINGLETON: png-image
@@ -78,27 +78,52 @@ ERROR: bad-checksum ;
 
 ERROR: unknown-color-type n ;
 ERROR: unimplemented-color-type image ;
-ERROR: unknown-filter-method image ;
 
 : inflate-data ( loading-png -- bytes )
     find-compressed-bytes zlib-inflate ; 
 
-: png-group-width ( loading-png -- n )
+: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline
+
+: png-bytes-per-pixel ( loading-png -- n )
     dup color-type>> {
-        { 2 [ [ bit-depth>> 8 / 3 * ] [ width>> ] bi * 1 + ] }
-        { 6 [ [ bit-depth>> 8 / 4 * ] [ width>> ] bi * 1 + ] }
+        { 2 [ scale-bit-depth 3 * ] }
+        { 6 [ scale-bit-depth 4 * ] }
         [ unknown-color-type ]
-    } case ;
+    } case ; inline
 
-: filter-png ( groups loading-png -- byte-array )
-    filter-method>> {
-        { filter-none [ reverse-png-filter ] }
-        [ unknown-filter-method ]
-    } case ;
+: png-group-width ( loading-png -- n )
+    ! 1 + is for the filter type, 1 byte preceding each line
+    [ png-bytes-per-pixel ] [ width>> ] bi * 1 + ;
+
+:: paeth ( a b c -- p ) 
+    a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
+    sort-keys first second ;
+
+:: png-unfilter-line ( prev curr filter -- curr' )
+    prev :> c
+    prev 3 tail-slice :> b
+    curr :> a
+    curr 3 tail-slice :> x
+    x length [0,b)
+    filter {
+        { filter-none [ drop ] }
+        { filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
+        { filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
+        { filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
+        { filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
+    } case 
+    curr 3 tail ;
+
+: reverse-png-filter ( lines -- byte-array )
+    dup first length 0 <array> prefix
+    [ { 0 0 } prepend ] map
+    2 clump [
+        first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
+        png-unfilter-line
+    ] map B{ } concat-as ;
 
 : png-image-bytes ( loading-png -- byte-array )
-    [ [ inflate-data ] [ png-group-width ] bi group ]
-    [ filter-png ] bi ;
+    [ inflate-data ] [ png-group-width ] bi group reverse-png-filter ;
 
 : decode-greyscale ( loading-png -- loading-png )
     unimplemented-color-type ;
index c589349dff2fbd43d6b17c6dafd8ac17e09ef984..dfc3c8b4411650b0df1219fdd94d9f619d21e424 100755 (executable)
@@ -7,6 +7,7 @@ io.encodings.string io.encodings.utf8 io.files kernel math
 math.bitwise math.order math.parser pack prettyprint sequences
 strings math.vectors specialized-arrays locals
 images.loader ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: images.tiff
 
index 7319ad1db8270f96a1edda8fdbe20cfa3f0af1bb..8493f14d2607821f3b20a70c1dfcbdef6986d82d 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel unix math sequences
+USING: alien.c-types system kernel unix math sequences
 io.backend.unix io.ports specialized-arrays accessors ;
 QUALIFIED: io.pipes
 SPECIALIZED-ARRAY: int
index a1a4b942b7941bfa16e3e610d86564e7d30b6536..b3894d7b496dfe867554160baa3994c7a0f5cb31 100644 (file)
@@ -1,6 +1,7 @@
-USING: iokit alien alien.syntax alien.c-types kernel
-system core-foundation core-foundation.data
-core-foundation.dictionaries ;
+USING: iokit alien alien.syntax alien.c-types kernel system
+core-foundation core-foundation.arrays core-foundation.data
+core-foundation.dictionaries core-foundation.run-loop
+core-foundation.strings core-foundation.time ;
 IN: iokit.hid
 
 CONSTANT: kIOHIDDeviceKey "IOHIDDevice"
index aa9681bb2e952360d1add249b10f14efedba6df5..0a6fc147ade16f62d221bec1d22d90efbbb4a03e 100755 (executable)
@@ -1,10 +1,11 @@
-USING: accessors alien alien.c-types alien.data arrays
-byte-arrays combinators combinators.short-circuit fry
-kernel locals macros math math.blas.ffi math.blas.vectors
-math.blas.vectors.private math.complex math.functions
-math.order functors words sequences sequences.merged
-sequences.private shuffle parser prettyprint.backend
-prettyprint.custom ascii specialized-arrays ;
+USING: accessors alien alien.c-types alien.complex
+alien.data arrays byte-arrays combinators
+combinators.short-circuit fry kernel locals macros math
+math.blas.ffi math.blas.vectors math.blas.vectors.private
+math.complex math.functions math.order functors words
+sequences sequences.merged sequences.private shuffle
+parser prettyprint.backend prettyprint.custom ascii
+specialized-arrays ;
 FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: double
index 20ee7925b080a285d67838cb96859cf18962ab5b..8d057de720d8673852c7104ef50f4fe77a4e066f 100755 (executable)
@@ -1,8 +1,8 @@
-USING: accessors alien alien.c-types arrays ascii byte-arrays combinators
-combinators.short-circuit fry kernel math math.blas.ffi
-math.complex math.functions math.order sequences sequences.private
-functors words locals parser prettyprint.backend prettyprint.custom
-specialized-arrays ;
+USING: accessors alien alien.c-types alien.complex arrays ascii
+byte-arrays combinators combinators.short-circuit fry kernel
+math math.blas.ffi math.complex math.functions math.order
+sequences sequences.private functors words locals parser
+prettyprint.backend prettyprint.custom specialized-arrays ;
 FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: double
index e9120567aaa11a5491a407538fa335e4cdc8e86c..2b73628b4ce064b7c6074647d2ad801cd082fa8d 100644 (file)
@@ -1,7 +1,7 @@
-USING: accessors alien.syntax arrays assocs biassocs
-classes.struct combinators cpu.x86.features kernel literals
-math math.bitwise math.floats.env math.floats.env.private
-system ;
+USING: accessors alien.c-types alien.syntax arrays assocs
+biassocs classes.struct combinators cpu.x86.features kernel
+literals math math.bitwise math.floats.env
+math.floats.env.private system ;
 IN: math.floats.env.x86
 
 STRUCT: sse-env
index c76ed573d5ef218d29f0e21406ed0dd094f9e4b7..6ed74caa1f744c8429e73634cc66e8b9d3f4161c 100644 (file)
@@ -111,6 +111,7 @@ N            [ 16 T heap-size /i ]
 A            DEFINES-CLASS ${T}-${N}
 A-boa        DEFINES ${A}-boa
 A-with       DEFINES ${A}-with
+A-cast       DEFINES ${A}-cast
 >A           DEFINES >${A}
 A{           DEFINES ${A}{
 
@@ -170,6 +171,9 @@ SYNTAX: A{ \ } [ >A ] parse-literal ;
     \ A-boa \ A-rep \ A define-boa-custom-inlining
 ] when
 
+: A-cast ( simd-array -- simd-array' )
+    underlying>> \ A boa ; inline
+
 INSTANCE: A sequence
 
 <PRIVATE
@@ -228,6 +232,7 @@ A/2-with     IS ${A/2}-with
 A            DEFINES-CLASS ${T}-${N}
 A-boa        DEFINES ${A}-boa
 A-with       DEFINES ${A}-with
+A-cast       DEFINES ${A}-cast
 >A           DEFINES >${A}
 A{           DEFINES ${A}{
 
@@ -295,6 +300,9 @@ M: A pprint* pprint-object ;
 
 \ A-rep 2 boa-effect \ A-boa set-stack-effect
 
+: A-cast ( simd-array -- simd-array' )
+    [ underlying1>> ] [ underlying2>> ] bi \ A boa ; inline
+
 INSTANCE: A sequence
 
 : A-vv->v-op ( v1 v2 quot -- v3 )
index 2fdb9ff88c936c0725e82cd297bd5f9dbf669c8a..6dc0f87dd4b096658d0e7fb76dac2e90f1685843 100644 (file)
@@ -68,6 +68,7 @@ ARTICLE: "math.vectors.simd.words" "SIMD vector words"
     { "Word" "Stack effect" "Description" }
     { { $snippet "type-with" } { $snippet "( x -- simd-array )" } "creates a new instance where all components are set to a single scalar" }
     { { $snippet "type-boa" } { $snippet "( ... -- simd-array )" } "creates a new instance where components are read from the stack" }
+    { { $snipept "type-cast" } { $snippet "( simd-array -- simd-array' )" } "creates a new SIMD array where the underlying data is taken from another SIMD array, with no format conversion" }
     { { $snippet ">type" } { $snippet "( seq -- simd-array )" } "creates a new instance initialized with the elements of an existing sequence, which must have the correct length" }
     { { $snippet "type{" } { $snippet "type{ elements... }" } "parsing word defining literal syntax for an SIMD vector; the correct number of elements must be given" }
 }
index a40506f98014f82cc9f99e9b45710a9dc346aec8..fb4c7592d375c5d4e88cf2f1f00b7e2410ca982d 100644 (file)
@@ -55,11 +55,33 @@ PRIVATE>
         [ drop call ]
     } case ; inline
 
+: fp-bitwise-unary ( x seq quot -- z )
+    swap element-type {
+        { c:double [ [ double>bits ] dip call bits>double ] }
+        { c:float  [ [ float>bits  ] dip call bits>float  ] }
+        [ drop call ]
+    } case ; inline
+
 PRIVATE>
 
 : vbitand ( u v -- w ) over '[ _ [ bitand ] fp-bitwise-op ] 2map ;
 : vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ;
 : vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ;
+: vbitnot ( u -- w ) dup '[ _ [ bitnot ] fp-bitwise-unary ] map ;
+
+: vand ( u v -- w ) [ and ] 2map ;
+: vor  ( u v -- w ) [ or  ] 2map ;
+: vxor ( u v -- w ) [ xor ] 2map ;
+: vnot ( u -- w )   [ not ] map ;
+
+: v<  ( u v -- w ) [ <   ] { } 2map-as ;
+: v<= ( u v -- w ) [ <=  ] { } 2map-as ;
+: v>= ( u v -- w ) [ >=  ] { } 2map-as ;
+: v>  ( u v -- w ) [ >   ] { } 2map-as ;
+: vunordered? ( u v -- w ) [ unordered? ] { } 2map-as ;
+: v=  ( u v -- w ) [ =   ] { } 2map-as ;
+
+: v?   ( ? u v -- w ) [ ? ] pick 3map-as ;
 
 : vlshift ( u n -- w ) '[ _ shift ] map ;
 : vrshift ( u n -- w ) neg '[ _ shift ] map ;
index 32c3ca4b82ccfcaac9dcc1524126746f9bc6376a..412405c8522221032db1b19b89c1522de0c6502d 100644 (file)
@@ -3,9 +3,9 @@
 
 ! This file is based on the gl.h that comes with xorg-x11 6.8.2
 
-USING: alien alien.syntax combinators kernel parser sequences
-system words opengl.gl.extensions ;
-
+USING: alien alien.c-types alien.syntax combinators kernel parser
+sequences system words opengl.gl.extensions ;
+FROM: alien.c-types => short ;
 IN: opengl.gl
 
 TYPEDEF: uint    GLenum
old mode 100644 (file)
new mode 100755 (executable)
index c8a179e..5821e3f
@@ -1,4 +1,4 @@
-USING: alien.syntax kernel windows.types ;
+USING: alien.c-types alien.syntax kernel windows.types ;
 IN: opengl.gl.windows
 
 LIBRARY: gl
index 28d920d8d6a16ed3b22540af5767fb71065b67a6..d846afe3a90cb492ed63bc47703b7c102203e94e 100755 (executable)
@@ -5,6 +5,7 @@ kernel opengl opengl.gl opengl.capabilities combinators images
 images.tesselation grouping sequences math math.vectors
 math.matrices generalizations fry arrays namespaces system
 locals literals specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: opengl.textures
 
index df9955a53cdf7af181d7cbe90c6485f90cb3fa57..ed280ecd691b1648eac830975021e860f126e550 100644 (file)
@@ -103,15 +103,15 @@ FUNCTION: void* BIO_f_buffer (  ) ;
 
 CONSTANT: EVP_MAX_MD_SIZE 64
 
+TYPEDEF: void* EVP_MD*
+TYPEDEF: void* ENGINE*
+
 STRUCT: EVP_MD_CTX
     { digest EVP_MD* }
     { engine ENGINE* }
     { flags ulong }
     { md_data void* } ;
 
-TYPEDEF: void* EVP_MD*
-TYPEDEF: void* ENGINE*
-
 ! Initialize ciphers and digest tables
 FUNCTION: void OpenSSL_add_all_ciphers (  ) ;
 
index 520c7175c6a0135c8f5f2f30ac6b80a732b17000..9e2b13159a2bf5b0c0eba85288b5e6cdf6a202ed 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2007 Elie CHAFTARI
 ! Portions copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax combinators kernel system namespaces
-assocs parser lexer sequences words quotations math.bitwise
-alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators kernel
+system namespaces assocs parser lexer sequences words
+quotations math.bitwise alien.libraries ;
 
 IN: openssl.libssl
 
@@ -95,6 +95,17 @@ TYPEDEF: void* SSL*
 
 LIBRARY: libssl
 
+! ===============================================
+! x509.h
+! ===============================================
+
+TYPEDEF: void* X509_NAME*
+
+TYPEDEF: void* X509*
+
+FUNCTION: int X509_NAME_get_text_by_NID ( X509_NAME* name, int nid, void* buf, int len ) ;
+FUNCTION: X509_NAME* X509_get_subject_name ( X509* a ) ;
+
 ! ===============================================
 ! ssl.h
 ! ===============================================
@@ -258,17 +269,6 @@ CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_STORE  HEX: 0200
 : SSL_SESS_CACHE_NO_INTERNAL ( -- n )
     { SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE } flags ; inline
 
-! ===============================================
-! x509.h
-! ===============================================
-
-TYPEDEF: void* X509_NAME*
-
-TYPEDEF: void* X509*
-
-FUNCTION: int X509_NAME_get_text_by_NID ( X509_NAME* name, int nid, void* buf, int len ) ;
-FUNCTION: X509_NAME* X509_get_subject_name ( X509* a ) ;
-
 ! ===============================================
 ! x509_vfy.h
 ! ===============================================
index 45b7a9cb319c72e4507284ed3cb34f45c2c6614e..2ad730ee6e32a1cca77fd48d7475746272e49eec 100644 (file)
@@ -3,8 +3,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 ! pangocairo bindings, from pango/pangocairo.h
-USING: alien alien.syntax combinators system cairo.ffi
-alien.libraries ;
+USING: arrays sequences alien alien.c-types alien.destructors
+alien.libraries alien.syntax math math.functions math.vectors
+destructors combinators colors fonts accessors assocs namespaces
+kernel pango pango.fonts pango.layouts glib unicode.data images
+cache init system math.rectangles fry memoize io.encodings.utf8
+classes.struct cairo cairo.ffi ;
 IN: pango.cairo
 
 << {
@@ -15,6 +19,9 @@ IN: pango.cairo
 
 LIBRARY: pangocairo
 
+TYPEDEF: void* PangoCairoFontMap*
+TYPEDEF: void* PangoCairoFont*
+
 FUNCTION: PangoFontMap*
 pango_cairo_font_map_new ( ) ;
 
@@ -87,3 +94,150 @@ pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ;
 
 FUNCTION: void
 pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ;
+
+TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
+
+SYMBOL: dpi
+
+72 dpi set-global
+
+: set-layout-font ( font layout -- )
+    swap cache-font-description pango_layout_set_font_description ;
+
+: set-layout-text ( str layout -- )
+    #! Replace nulls with something else since Pango uses null-terminated
+    #! strings
+    swap -1 pango_layout_set_text ;
+
+: layout-extents ( layout -- ink-rect logical-rect )
+    PangoRectangle <struct>
+    PangoRectangle <struct>
+    [ pango_layout_get_extents ] 2keep
+    [ PangoRectangle>rect ] bi@ ;
+
+: layout-baseline ( layout -- baseline )
+    pango_layout_get_iter &pango_layout_iter_free
+    pango_layout_iter_get_baseline
+    pango>float ;
+
+: set-foreground ( cr font -- )
+    foreground>> set-source-color ;
+
+: fill-background ( cr font dim -- )
+    [ background>> set-source-color ]
+    [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
+
+: rect-translate-x ( rect x -- rect' )
+    '[ _ 0 2array v- ] change-loc ;
+
+: first-line ( layout -- line )
+    layout>> 0 pango_layout_get_line_readonly ;
+
+: line-offset>x ( layout n -- x )
+    #! n is an index into the UTF8 encoding of the text
+    [ drop first-line ] [ swap string>> >utf8-index ] 2bi
+    0 0 <int> [ pango_layout_line_index_to_x ] keep
+    *int pango>float ;
+
+: x>line-offset ( layout x -- n )
+    #! n is an index into the UTF8 encoding of the text
+    [
+        [ first-line ] dip
+        float>pango 0 <int> 0 <int>
+        [ pango_layout_line_x_to_index drop ] 2keep
+        [ *int ] bi@ swap
+    ] [ drop string>> ] 2bi utf8-index> + ;
+
+: selection-start/end ( selection -- start end )
+    selection>> [ start>> ] [ end>> ] bi ;
+
+: selection-rect ( layout -- rect )
+    [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
+    [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
+
+: fill-selection-background ( cr layout -- )
+    dup selection>> [
+        [ selection>> color>> set-source-color ]
+        [
+            [ selection-rect ] [ ink-rect>> loc>> first ] bi
+            rect-translate-x
+            fill-rect
+        ] 2bi
+    ] [ 2drop ] if ;
+
+: text-position ( layout -- loc )
+    [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
+
+: set-text-position ( cr loc -- )
+    first2 cairo_move_to ;
+
+: draw-layout ( layout -- image )
+    dup ink-rect>> dim>> [ >fixnum ] map [
+        swap {
+            [ layout>> pango_cairo_update_layout ]
+            [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
+            [ fill-selection-background ]
+            [ text-position set-text-position ]
+            [ font>> set-foreground ]
+            [ layout>> pango_cairo_show_layout ]
+        } 2cleave
+    ] make-bitmap-image ;
+
+: escape-nulls ( str -- str' )
+    { { 0 CHAR: zero-width-no-break-space } } substitute ;
+
+: unpack-selection ( layout string/selection -- layout )
+    dup selection? [
+        [ string>> escape-nulls >>string ] [ >>selection ] bi
+    ] [ escape-nulls >>string ] if ; inline
+
+: set-layout-resolution ( layout -- )
+    pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
+
+: <PangoLayout> ( text font -- layout )
+    dummy-cairo pango_cairo_create_layout |g_object_unref
+    [ set-layout-resolution ] keep
+    [ set-layout-font ] keep
+    [ set-layout-text ] keep ;
+
+: glyph-height ( font string -- y )
+    swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
+
+MEMO: missing-font-metrics ( font -- metrics )
+    #! Pango doesn't provide x-height and cap-height but Core Text does, so we
+    #! simulate them on Pango.
+    [
+        [ metrics new ] dip
+        [ "x" glyph-height >>x-height ]
+        [ "Y" glyph-height >>cap-height ] bi
+    ] with-destructors ;
+
+: layout-metrics ( layout -- metrics )
+    dup font>> missing-font-metrics clone
+        swap
+        [ layout>> layout-baseline >>ascent ]
+        [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
+        dup [ height>> ] [ ascent>> ] bi - >>descent ;
+
+: <layout> ( font string -- line )
+    [
+        layout new-disposable
+            swap unpack-selection
+            swap >>font
+            dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
+            dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
+            dup layout-metrics >>metrics
+            dup draw-layout >>image
+    ] with-destructors ;
+
+M: layout dispose* layout>> g_object_unref ;
+
+SYMBOL: cached-layouts
+
+: cached-layout ( font string -- layout )
+    cached-layouts get [ <layout> ] 2cache ;
+
+: cached-line ( font string -- line )
+    cached-layout layout>> first-line ;
+
+[ <cache-assoc> cached-layouts set-global ] "pango.cairo" add-init-hook
index abfc086820d03e782a60a776134315d7e71dc259..eb3e2208b1ce90c9faf7fe0cb2e6fd9312c7f96c 100644 (file)
@@ -15,6 +15,15 @@ PANGO_STYLE_OBLIQUE
 PANGO_STYLE_ITALIC ;
 
 TYPEDEF: int PangoWeight
+TYPEDEF: void* PangoFont*
+TYPEDEF: void* PangoFontFamily*
+TYPEDEF: void* PangoFontFace*
+TYPEDEF: void* PangoFontMap*
+TYPEDEF: void* PangoFontMetrics*
+TYPEDEF: void* PangoFontDescription*
+TYPEDEF: void* PangoGlyphString*
+TYPEDEF: void* PangoLanguage*
+
 CONSTANT: PANGO_WEIGHT_THIN 100
 CONSTANT: PANGO_WEIGHT_ULTRALIGHT 200
 CONSTANT: PANGO_WEIGHT_LIGHT 300
@@ -102,4 +111,4 @@ MEMO: (cache-font-description) ( font -- description )
 : cache-font-description ( font -- description )
     strip-font-colors (cache-font-description) ;
 
-[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-init-hook
\ No newline at end of file
+[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-init-hook
index 7a7bd86aea2cded2bdaaa2419a115e080a4e5eb5..a03d26fb6782b8d20c4b45afcff164aef610b963 100644 (file)
@@ -4,12 +4,16 @@
 USING: arrays sequences alien alien.c-types alien.destructors
 alien.syntax math math.functions math.vectors destructors combinators
 colors fonts accessors assocs namespaces kernel pango pango.fonts
-pango.cairo cairo cairo.ffi glib unicode.data images cache init
+glib unicode.data images cache init
 math.rectangles fry memoize io.encodings.utf8 classes.struct ;
 IN: pango.layouts
 
 LIBRARY: pango
 
+TYPEDEF: void* PangoLayout*
+TYPEDEF: void* PangoLayoutIter*
+TYPEDEF: void* PangoLayoutLine*
+
 FUNCTION: PangoLayout*
 pango_layout_new ( PangoContext* context ) ;
 
@@ -60,149 +64,3 @@ pango_layout_iter_free ( PangoLayoutIter* iter ) ;
 
 DESTRUCTOR: pango_layout_iter_free
 
-TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
-
-SYMBOL: dpi
-
-72 dpi set-global
-
-: set-layout-font ( font layout -- )
-    swap cache-font-description pango_layout_set_font_description ;
-
-: set-layout-text ( str layout -- )
-    #! Replace nulls with something else since Pango uses null-terminated
-    #! strings
-    swap -1 pango_layout_set_text ;
-
-: set-layout-resolution ( layout -- )
-    pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
-
-: <PangoLayout> ( text font -- layout )
-    dummy-cairo pango_cairo_create_layout |g_object_unref
-    [ set-layout-resolution ] keep
-    [ set-layout-font ] keep
-    [ set-layout-text ] keep ;
-
-: layout-extents ( layout -- ink-rect logical-rect )
-    PangoRectangle <struct>
-    PangoRectangle <struct>
-    [ pango_layout_get_extents ] 2keep
-    [ PangoRectangle>rect ] bi@ ;
-
-: glyph-height ( font string -- y )
-    swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
-
-MEMO: missing-font-metrics ( font -- metrics )
-    #! Pango doesn't provide x-height and cap-height but Core Text does, so we
-    #! simulate them on Pango.
-    [
-        [ metrics new ] dip
-        [ "x" glyph-height >>x-height ]
-        [ "Y" glyph-height >>cap-height ] bi
-    ] with-destructors ;
-
-: layout-baseline ( layout -- baseline )
-    pango_layout_get_iter &pango_layout_iter_free
-    pango_layout_iter_get_baseline
-    pango>float ;
-
-: set-foreground ( cr font -- )
-    foreground>> set-source-color ;
-
-: fill-background ( cr font dim -- )
-    [ background>> set-source-color ]
-    [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
-
-: rect-translate-x ( rect x -- rect' )
-    '[ _ 0 2array v- ] change-loc ;
-
-: first-line ( layout -- line )
-    layout>> 0 pango_layout_get_line_readonly ;
-
-: line-offset>x ( layout n -- x )
-    #! n is an index into the UTF8 encoding of the text
-    [ drop first-line ] [ swap string>> >utf8-index ] 2bi
-    0 0 <int> [ pango_layout_line_index_to_x ] keep
-    *int pango>float ;
-
-: x>line-offset ( layout x -- n )
-    #! n is an index into the UTF8 encoding of the text
-    [
-        [ first-line ] dip
-        float>pango 0 <int> 0 <int>
-        [ pango_layout_line_x_to_index drop ] 2keep
-        [ *int ] bi@ swap
-    ] [ drop string>> ] 2bi utf8-index> + ;
-
-: selection-start/end ( selection -- start end )
-    selection>> [ start>> ] [ end>> ] bi ;
-
-: selection-rect ( layout -- rect )
-    [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
-    [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
-
-: fill-selection-background ( cr layout -- )
-    dup selection>> [
-        [ selection>> color>> set-source-color ]
-        [
-            [ selection-rect ] [ ink-rect>> loc>> first ] bi
-            rect-translate-x
-            fill-rect
-        ] 2bi
-    ] [ 2drop ] if ;
-
-: text-position ( layout -- loc )
-    [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
-
-: set-text-position ( cr loc -- )
-    first2 cairo_move_to ;
-
-: layout-metrics ( layout -- metrics )
-    dup font>> missing-font-metrics clone
-        swap
-        [ layout>> layout-baseline >>ascent ]
-        [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
-        dup [ height>> ] [ ascent>> ] bi - >>descent ;
-
-: draw-layout ( layout -- image )
-    dup ink-rect>> dim>> [ >fixnum ] map [
-        swap {
-            [ layout>> pango_cairo_update_layout ]
-            [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
-            [ fill-selection-background ]
-            [ text-position set-text-position ]
-            [ font>> set-foreground ]
-            [ layout>> pango_cairo_show_layout ]
-        } 2cleave
-    ] make-bitmap-image ;
-
-: escape-nulls ( str -- str' )
-    { { 0 CHAR: zero-width-no-break-space } } substitute ;
-
-: unpack-selection ( layout string/selection -- layout )
-    dup selection? [
-        [ string>> escape-nulls >>string ] [ >>selection ] bi
-    ] [ escape-nulls >>string ] if ; inline
-
-: <layout> ( font string -- line )
-    [
-        layout new-disposable
-            swap unpack-selection
-            swap >>font
-            dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
-            dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
-            dup layout-metrics >>metrics
-            dup draw-layout >>image
-    ] with-destructors ;
-
-M: layout dispose* layout>> g_object_unref ;
-
-SYMBOL: cached-layouts
-
-: cached-layout ( font string -- layout )
-    cached-layouts get [ <layout> ] 2cache ;
-
-: cached-line ( font string -- line )
-    cached-layout layout>> first-line ;
-
-[ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook
index 11e15ae951a67701b90fafe06e72f0cda2f68c23..03134ed7871ac348c23397218dd010afaf0b5487 100644 (file)
@@ -23,8 +23,9 @@ CONSTANT: PANGO_SCALE 1024
 : pango>float ( n -- x ) PANGO_SCALE /f ; inline
 : float>pango ( x -- n ) PANGO_SCALE * >integer ; inline
 
-FUNCTION: PangoContext*
-pango_context_new ( ) ;
+TYPEDEF: void* PangoContext*
+
+FUNCTION: PangoContext* pango_context_new ( ) ;
 
 STRUCT: PangoRectangle
     { x int }
index 3a44066cafa64d8b5efaaccfe1096004a742842e..e29f97ef2e0d87262972328726ed513ca06e5646 100644 (file)
@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 ! mersenne twister based on 
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-USING: kernel math namespaces sequences sequences.private system
-init accessors math.ranges random math.bitwise combinators
-specialized-arrays fry ;
+USING: alien.c-types kernel math namespaces sequences
+sequences.private system init accessors math.ranges random
+math.bitwise combinators specialized-arrays fry ;
 SPECIALIZED-ARRAY: uint
 IN: random.mersenne-twister
 
index 89bd5f726c970484538e4beb1d0fb7d96cc59317..effb2d6f0e0ca71d5aebc0ff28582cbe82fc678a 100755 (executable)
@@ -31,7 +31,7 @@ STRUCT: ud
     { inp_hook void* }
     { inp_curr uchar }
     { inp_fill uchar }
-    { inp_file FILE* }
+    { inp_file void* }
     { inp_ctr uchar }
     { inp_buff uchar* }
     { inp_buff_end uchar* }
@@ -68,7 +68,7 @@ STRUCT: ud
     { c3 uchar }
     { inp_cache uchar[256] }
     { inp_sess uchar[64] }
-    { itab_entry ud_itab_entry* } ;
+    { itab_entry void* } ;
 
 FUNCTION: void ud_translate_intel ( ud* u ) ;
 FUNCTION: void ud_translate_att ( ud* u ) ;
index 53b4357d44f52871f148eb1743d8b16cd849a3f6..7f7bd02204884598504d9fc1644108186b3adec8 100644 (file)
@@ -3,6 +3,7 @@
 USING: kernel accessors math math.vectors locals sequences
 specialized-arrays colors arrays combinators
 opengl opengl.gl ui.pens ui.pens.caching ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: ui.pens.gradient
 
index a39a5cb7cdba4cbec476d80ed922e931da884bec..c1e1ada61b8b7d5f365371efd6a3d4dfc5ec1a8e 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors help.markup help.syntax kernel opengl
-opengl.gl sequences math.vectors ui.gadgets ui.pens
-specialized-arrays ;
+USING: accessors alien.c-types colors help.markup help.syntax
+kernel opengl opengl.gl sequences math.vectors ui.gadgets
+ui.pens specialized-arrays ;
 SPECIALIZED-ARRAY: float
 IN: ui.pens.polygon
 
@@ -36,4 +36,4 @@ M: polygon draw-interior
 
 : <polygon-gadget> ( color points -- gadget )
     [ <polygon> ] [ { 0 0 } [ vmax ] reduce ] bi
-    [ <gadget> ] 2dip [ >>interior ] [ >>dim ] bi* ;
\ No newline at end of file
+    [ <gadget> ] 2dip [ >>interior ] [ >>dim ] bi* ;
index 5dcd9bde9ad4f09ad610e75c41d342c8a3c0a545..abc857c5667d358b091a2a22715f83a06b3df0c0 100644 (file)
@@ -1,6 +1,6 @@
-USING: accessors assocs classes destructors functors kernel
-lexer math parser sequences specialized-arrays ui.backend
-words ;
+USING: alien.c-types accessors assocs classes destructors
+functors kernel lexer math parser sequences specialized-arrays
+ui.backend words ;
 SPECIALIZED-ARRAY: int
 IN: ui.pixel-formats
 
index ebc0b80097808a3de6decad79532a31a222bc175..0825e42930297005b7a8049d70f858d3b53bd87f 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax classes.struct combinators system
-vocabs.loader ;
+USING: alien.c-types alien.syntax classes.struct combinators
+system unix.types vocabs.loader ;
 IN: unix
 
 CONSTANT: MAXPATHLEN 1024
index 0db1bb86ad4b0070a80e8d9db5f51c7c75eadc82..0b76d048fe8c7dc1d50cc8d2876d2c529d907f78 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax unix.statfs.macosx ;
 IN: unix.getfsstat.macosx
 
 CONSTANT: MNT_WAIT    1   ! synchronously wait for I/O to complete
 CONSTANT: MNT_NOWAIT  2   ! start all I/O, but do not wait for it
 
-FUNCTION: int getfsstat64 ( statfs* buf, int bufsize, int flags ) ;
+FUNCTION: int getfsstat64 ( statfs64* buf, int bufsize, int flags ) ;
index 6c3b9ef2cb07bfb05a66fe22dfbb488829eea193..17b653418a2fafbe287f689d0e750154bcb9fa5b 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system sequences vocabs.loader words
+USING: alien.c-types alien.syntax system sequences vocabs.loader words
 accessors ;
 IN: unix.kqueue
 
index c30584efab94905f5fad8a25edcc0be5a37774dd..f0dc8c8f5e879fb9b5ab07d1b0e1c3860ed2466f 100644 (file)
@@ -1,4 +1,4 @@
-USING: alien.syntax classes.struct ;
+USING: alien.c-types alien.syntax classes.struct unix.time ;
 IN: unix.kqueue
 
 STRUCT: kevent
index 2912f8b744326aeac16f909ecb738acd036b4bab..ab10aef3eac299fc60b899c4e5fcbc14512d492b 100644 (file)
@@ -1,6 +1,6 @@
 USING: kernel alien.c-types alien.data alien.strings sequences
 math alien.syntax unix namespaces continuations threads assocs
-io.backend.unix io.encodings.utf8 unix.utilities fry ;
+io.backend.unix io.encodings.utf8 unix.types unix.utilities fry ;
 IN: unix.process
 
 ! Low-level Unix process launching utilities. These are used
index afab727ddb5a011045d1bab82bc17b811a56838a..a2104dcb336154ab7bfc361270c7ad4847d9da69 100644 (file)
@@ -1,8 +1,8 @@
 USING: alien.c-types arrays accessors combinators classes.struct
-alien.syntax ;
+alien.syntax unix.time unix.types ;
 IN: unix.stat
 
-! Mac OS X ppc
+! Mac OS X
 
 ! stat64 structure
 STRUCT: stat
index 3b1fe71a6a8cf41f442e4578860bcbd78d2570f7..3fe44a28d06f1667137a04df6fe1d339ed5cdb00 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax classes.struct ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
 IN: unix.statvfs.macosx
 
 STRUCT: statvfs
index 4ca2c4368a584712f1647e8f5a7ad04c9a3bf570..6fdaeef8cf477cc8fc8ce68d66e6496718ea1378 100644 (file)
@@ -1,4 +1,4 @@
-USING: kernel system alien.syntax combinators vocabs.loader ;
+USING: kernel system alien.c-types alien.syntax combinators vocabs.loader ;
 IN: unix.types
 
 TYPEDEF: char int8_t
@@ -37,6 +37,12 @@ TYPEDEF: fsfilcnt_t __fsfilcnt_t
 TYPEDEF: __uint64_t rlim_t
 TYPEDEF: uint32_t id_t
 
+TYPEDEF: void* DIR*
+TYPEDEF: void* FILE*
+TYPEDEF: void* rlimit*
+TYPEDEF: void* rusage*
+TYPEDEF: void* sockaddr*
+
 os {
     { linux   [ "unix.types.linux"   require ] }
     { macosx  [ "unix.types.macosx"  require ] }
@@ -45,3 +51,4 @@ os {
     { netbsd  [ "unix.types.netbsd"  require ] }
     { winnt [ ] }
 } case
+
index 59a3331354a59378ce916846ef7c8734c51e38f2..fa61e9041a5260d28d9db673282478b1d71b009f 100644 (file)
@@ -5,7 +5,7 @@ USING: alien alien.c-types alien.syntax kernel libc
 sequences continuations byte-arrays strings math namespaces
 system combinators vocabs.loader accessors
 stack-checker macros locals generalizations unix.types
-io vocabs classes.struct ;
+io vocabs classes.struct unix.time ;
 IN: unix
 
 CONSTANT: PROT_NONE   0
@@ -35,12 +35,6 @@ CONSTANT: DT_LNK      10
 CONSTANT: DT_SOCK     12
 CONSTANT: DT_WHT      14
 
-STRUCT: group
-    { gr_name char* }
-    { gr_passwd char* }
-    { gr_gid int }
-    { gr_mem char** } ;
-
 LIBRARY: libc
 
 FUNCTION: char* strerror ( int errno ) ;
@@ -68,6 +62,26 @@ MACRO:: unix-system-call ( quot -- )
         ]
     ] ;
 
+<<
+
+{
+    { [ os linux? ] [ "unix.linux" require ] }
+    { [ os bsd? ] [ "unix.bsd" require ] }
+    { [ os solaris? ] [ "unix.solaris" require ] }
+} cond
+
+"debugger" vocab [
+    "unix.debugger" require
+] when
+
+>>
+
+STRUCT: group
+    { gr_name char* }
+    { gr_passwd char* }
+    { gr_gid int }
+    { gr_mem char** } ;
+
 FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
 FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
 FUNCTION: int chdir ( char* path ) ;
@@ -86,7 +100,7 @@ FUNCTION: int dup2 ( int oldd, int newd ) ;
 ! FUNCTION: int dup ( int oldd ) ;
 : _exit ( status -- * )
     #! We throw to give this a terminating stack effect.
-    "int" f "_exit" { "int" } alien-invoke "Exit failed" throw ;
+    int f "_exit" { int } alien-invoke "Exit failed" throw ;
 FUNCTION: void endpwent ( ) ;
 FUNCTION: int fchdir ( int fd ) ;
 FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
@@ -207,12 +221,3 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ;
 
 FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
 
-{
-    { [ os linux? ] [ "unix.linux" require ] }
-    { [ os bsd? ] [ "unix.bsd" require ] }
-    { [ os solaris? ] [ "unix.solaris" require ] }
-} cond
-
-"debugger" vocab [
-    "unix.debugger" require
-] when
index 3ea501b561a5205ff745a7b661cdbd313b6aa0e6..728cbb83d8743c9ba202a517c9c0eff4a26a6141 100644 (file)
@@ -1,9 +1,10 @@
 ! Copyright (C) 2009 Phil Dawes.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: classes.struct alien.syntax ;
+USING: classes.struct alien.c-types alien.syntax ;
 IN: vm
 
 TYPEDEF: void* cell
+TYPEDEF: void* context*
 
 STRUCT: zone
     { start cell }
index 21f048a00f43bcba99f7dc66c5cdff6f204a3fe9..fa478b03edb4b34bfbe1475fccb0dc47c5b9dcf6 100755 (executable)
@@ -1,5 +1,5 @@
-USING: alien.syntax kernel math windows.types windows.kernel32
-math.bitwise classes.struct ;
+USING: alien.c-types alien.syntax kernel math windows.types
+windows.kernel32 math.bitwise classes.struct ;
 IN: windows.advapi32
 
 LIBRARY: advapi32
@@ -222,15 +222,15 @@ C-ENUM:
     SE_WMIGUID_OBJECT
     SE_REGISTRY_WOW64_32KEY ;
 
-TYPEDEF: TRUSTEE* PTRUSTEE
-
 STRUCT: TRUSTEE
-    { pMultipleTrustee PTRUSTEE }
+    { pMultipleTrustee TRUSTEE* }
     { MultipleTrusteeOperation MULTIPLE_TRUSTEE_OPERATION }
     { TrusteeForm TRUSTEE_FORM }
     { TrusteeType TRUSTEE_TYPE }
     { ptstrName LPTSTR } ;
 
+TYPEDEF: TRUSTEE* PTRUSTEE
+
 STRUCT: EXPLICIT_ACCESS
     { grfAccessPermissions DWORD }
     { grfAccessMode ACCESS_MODE }
old mode 100644 (file)
new mode 100755 (executable)
index e06f5b6..45a74e2
@@ -1,45 +1,51 @@
-USING: alien alien.c-types alien.destructors windows.com.syntax\r
-windows.ole32 windows.types continuations kernel alien.syntax\r
-libc destructors accessors alien.data ;\r
-IN: windows.com\r
-\r
-LIBRARY: ole32\r
-\r
-COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}\r
-    HRESULT QueryInterface ( REFGUID iid, void** ppvObject )\r
-    ULONG AddRef ( )\r
-    ULONG Release ( ) ;\r
-\r
-COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}\r
-    HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
-    HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
-    HRESULT QueryGetData ( FORMATETC* pFormatetc )\r
-    HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )\r
-    HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )\r
-    HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )\r
-    HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )\r
-    HRESULT DUnadvise ( DWORD pdwConnection )\r
-    HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;\r
-\r
-COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}\r
-    HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
-    HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
-    HRESULT DragLeave ( )\r
-    HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;\r
-\r
-: com-query-interface ( interface iid -- interface' )\r
-    [\r
-        "void*" malloc-object &free\r
-        [ IUnknown::QueryInterface ole32-error ] keep *void*\r
-    ] with-destructors ;\r
-\r
-: com-add-ref ( interface -- interface )\r
-     [ IUnknown::AddRef drop ] keep ; inline\r
-\r
-: com-release ( interface -- )\r
-    IUnknown::Release drop ; inline\r
-\r
-: with-com-interface ( interface quot -- )\r
-    over [ com-release ] curry [ ] cleanup ; inline\r
-\r
-DESTRUCTOR: com-release\r
+USING: alien alien.c-types alien.destructors windows.com.syntax
+windows.ole32 windows.types continuations kernel alien.syntax
+libc destructors accessors alien.data ;
+IN: windows.com
+
+LIBRARY: ole32
+
+COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
+    HRESULT QueryInterface ( REFGUID iid, void** ppvObject )
+    ULONG AddRef ( )
+    ULONG Release ( ) ;
+
+TYPEDEF: void* IAdviseSink*
+
+COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}
+    HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
+    HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
+    HRESULT QueryGetData ( FORMATETC* pFormatetc )
+    HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )
+    HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )
+    HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )
+    HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )
+    HRESULT DUnadvise ( DWORD pdwConnection )
+    HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;
+
+COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
+    HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )
+    HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )
+    HRESULT DragLeave ( )
+    HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;
+
+FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
+FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
+FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
+
+: com-query-interface ( interface iid -- interface' )
+    [
+        "void*" malloc-object &free
+        [ IUnknown::QueryInterface ole32-error ] keep *void*
+    ] with-destructors ;
+
+: com-add-ref ( interface -- interface )
+     [ IUnknown::AddRef drop ] keep ; inline
+
+: com-release ( interface -- )
+    IUnknown::Release drop ; inline
+
+: with-com-interface ( interface quot -- )
+    over [ com-release ] curry [ ] cleanup ; inline
+
+DESTRUCTOR: com-release
index 3cf8b55e39e270e0825b3ecd49ea1014a4d2a639..bbade332cc0d77fc22348ba6fa3445187779e880 100755 (executable)
@@ -1,8 +1,8 @@
-USING: alien alien.c-types alien.accessors effects kernel
-windows.ole32 parser lexer splitting grouping sequences
-namespaces assocs quotations generalizations accessors words
-macros alien.syntax fry arrays layouts math classes.struct
-windows.kernel32 ;
+USING: alien alien.c-types alien.accessors alien.parser
+effects kernel windows.ole32 parser lexer splitting grouping
+sequences namespaces assocs quotations generalizations
+accessors words macros alien.syntax fry arrays layouts math
+classes.struct windows.kernel32 ;
 IN: windows.com.syntax
 
 <PRIVATE
@@ -14,7 +14,7 @@ MACRO: com-invoke ( n return parameters -- )
         "stdcall" alien-indirect
     ] ;
 
-TUPLE: com-interface-definition name parent iid functions ;
+TUPLE: com-interface-definition word parent iid functions ;
 C: <com-interface-definition> com-interface-definition
 
 TUPLE: com-function-definition name return parameters ;
@@ -25,22 +25,25 @@ SYMBOL: +com-interface-definitions+
 [ H{ } +com-interface-definitions+ set-global ]
 unless
 
+ERROR: no-com-interface interface ;
+
 : find-com-interface-definition ( name -- definition )
-    dup "f" = [ drop f ] [
+    [
         dup +com-interface-definitions+ get-global at*
-        [ nip ]
-        [ " COM interface hasn't been defined" prepend throw ]
-        if
-    ] if ;
+        [ nip ] [ drop no-com-interface ] if
+    ] [ f ] if* ;
 
 : save-com-interface-definition ( definition -- )
-    dup name>> +com-interface-definitions+ get-global set-at ;
+    dup word>> +com-interface-definitions+ get-global set-at ;
 
 : (parse-com-function) ( tokens -- definition )
     [ second ]
     [ first ]
-    [ 3 tail [ CHAR: , swap remove ] map 2 group { "void*" "this" } prefix ]
-    tri
+    [
+        3 tail [ CHAR: , swap remove ] map
+        2 group [ first2 normalize-c-arg 2array ] map
+        { void* "this" } prefix
+    ] tri
     <com-function-definition> ;
 
 : parse-com-functions ( -- functions )
@@ -48,10 +51,11 @@ unless
     [ (parse-com-function) ] map ;
 
 : (iid-word) ( definition -- word )
-    name>> "-iid" append create-in ;
+    word>> name>> "-iid" append create-in ;
 
 : (function-word) ( function interface -- word )
-    name>> "::" rot name>> 3append create-in ;
+    swap [ word>> name>> "::" ] [ name>> ] bi*
+    3append create-in ;
 
 : family-tree ( definition -- definitions )
     dup parent>> [ family-tree ] [ { } ] if*
@@ -79,7 +83,7 @@ unless
 
 : define-words-for-com-interface ( definition -- )
     [ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ]
-    [ name>> "com-interface" swap typedef ]
+    [ word>> void* swap typedef ]
     [
         dup family-tree-functions
         [ (define-word-for-function) ] with each-index
@@ -89,8 +93,8 @@ unless
 PRIVATE>
 
 SYNTAX: COM-INTERFACE:
-    scan
-    scan find-com-interface-definition
+    CREATE-C-TYPE
+    scan-object find-com-interface-definition
     scan string>guid
     parse-com-functions
     <com-interface-definition>
index 598df9a389cd05fcd01848b06631cd0ecf5f2103..157bde9dbd1a83a326a5ad29923f2a363b8dfd61 100755 (executable)
@@ -1,6 +1,6 @@
 USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
 alien alien.c-types alien.syntax kernel system namespaces math
-classes.struct ;
+classes.struct windows.types ;
 IN: windows.dinput
 
 LIBRARY: dinput
index 5187c3f6609398c332b65aa753b725f767436b05..43307cb6bac99561b4cb939761724fe07fc516d5 100755 (executable)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax alien.destructors kernel windows.types
-math.bitwise ;
+USING: alien alien.c-types alien.syntax alien.destructors
+kernel windows.types math.bitwise ;
 IN: windows.gdi32
 
 CONSTANT: BI_RGB 0
index 075b0218b3e4cde1c2bf2762edff8a1c193316d0..bb0a679c0156aa63063824c994eb5ef4439115d8 100755 (executable)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel windows.types multiline
-classes.struct ;
+USING: alien alien.c-types alien.syntax kernel windows.types
+multiline classes.struct ;
 IN: windows.kernel32
 
 CONSTANT: MAX_PATH 260
@@ -543,7 +543,7 @@ STRUCT: DCB
 TYPEDEF: DCB* PDCB
 TYPEDEF: DCB* LPDCB
 
-STRUCT: COMM_CONFIG
+STRUCT: COMMCONFIG
     { dwSize DWORD }
     { wVersion WORD }
     { wReserved WORD }
index 3bc7f459600425c849cd028018690c1f1ec3952f..6e90cae89a77a70ab544f2967664cf3c031bc413 100755 (executable)
@@ -111,10 +111,6 @@ CONSTANT: COINIT_SPEED_OVER_MEMORY 8
 FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
 FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
 
-FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
-FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
-FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
-
 : succeeded? ( hresult -- ? )
     0 HEX: 7FFFFFFF between? ;
 
old mode 100644 (file)
new mode 100755 (executable)
index 6b4e0d7..bede62c
@@ -3,8 +3,8 @@
 USING: alien alien.c-types alien.strings alien.syntax
 classes.struct combinators io.encodings.utf16n io.files
 io.pathnames kernel windows.errors windows.com
-windows.com.syntax windows.user32 windows.ole32 windows
-specialized-arrays ;
+windows.com.syntax windows.types windows.user32
+windows.ole32 windows specialized-arrays ;
 SPECIALIZED-ARRAY: ushort
 IN: windows.shell32
 
index f3455fbb0f830802c1ada71885a8c9a0a7f84f8a..ea5daba68889d7e7dda02a0ff8dda211781456dd 100755 (executable)
@@ -61,6 +61,7 @@ TYPEDEF: ulong       ULONG_PTR
 TYPEDEF: int         INT32
 TYPEDEF: uint        UINT32
 TYPEDEF: uint        DWORD32
+TYPEDEF: long        LONG32
 TYPEDEF: ulong       ULONG32
 TYPEDEF: ulonglong   ULONG64
 TYPEDEF: long*       POINTER_32
@@ -75,6 +76,8 @@ TYPEDEF: longlong    LARGE_INTEGER
 TYPEDEF: ulonglong   ULARGE_INTEGER
 TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
+TYPEDEF: size_t SIZE_T
+TYPEDEF: ptrdiff_t SSIZE_T
 
 TYPEDEF: wchar_t*  LPCSTR
 TYPEDEF: wchar_t*  LPWSTR
@@ -201,15 +204,6 @@ TYPEDEF: LONG_PTR            SSIZE_T
 TYPEDEF: LONGLONG            USN
 TYPEDEF: UINT_PTR            WPARAM
 
-TYPEDEF: RECT* LPRECT
-TYPEDEF: void* PWNDCLASS
-TYPEDEF: void* PWNDCLASSEX
-TYPEDEF: void* LPWNDCLASS
-TYPEDEF: void* LPWNDCLASSEX
-TYPEDEF: void* MSGBOXPARAMSA
-TYPEDEF: void* MSGBOXPARAMSW
-TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
-
 TYPEDEF: size_t socklen_t
 
 TYPEDEF: void* WNDPROC
@@ -343,6 +337,14 @@ TYPEDEF: PFD* LPPFD
 TYPEDEF: HANDLE HGLRC
 TYPEDEF: HANDLE HRGN
 
+TYPEDEF: void* PWNDCLASS
+TYPEDEF: void* PWNDCLASSEX
+TYPEDEF: void* LPWNDCLASS
+TYPEDEF: void* LPWNDCLASSEX
+TYPEDEF: void* MSGBOXPARAMSA
+TYPEDEF: void* MSGBOXPARAMSW
+TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
+
 STRUCT: LVITEM
     { mask uint }
     { iItem int }
index 43b59d613b03843733f1ffe5fe6404fe0701b897..e10ee6735777fb15d88a99006803d871b1a762b7 100755 (executable)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax parser namespaces kernel math
-windows.types generalizations math.bitwise classes.struct
-literals ;
+USING: alien alien.c-types alien.syntax parser namespaces
+kernel math windows.types generalizations math.bitwise
+classes.struct literals windows.kernel32 ;
 IN: windows.user32
 
 ! HKL for ActivateKeyboardLayout
index eb57a469258ff10558ad03f7b28c9c7c34f96a5b..f021b552899cfc5843894ba61329ee0002879080 100755 (executable)
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.destructors classes.struct ;
+USING: alien.c-types alien.syntax alien.destructors classes.struct
+windows.types ;
 IN: windows.usp10
 
 LIBRARY: usp10
@@ -56,6 +57,9 @@ SCRIPT_JUSTIFFY_RESERVED4 ;
 STRUCT: SCRIPT_VISATTR
     { flags WORD } ;
 
+TYPEDEF: void* SCRIPT_CACHE*
+TYPEDEF: void* ABC*
+
 FUNCTION: HRESULT ScriptShape (
     HDC hdc,
     SCRIPT_CACHE* psc,
index dc751e64a6e40c6b4216744fc3d5fc7fe009d336..b50fadb5bac578bafe598ad3337d0cb36deefbac 100755 (executable)
@@ -105,6 +105,8 @@ CONSTANT: SD_BOTH 2
 
 CONSTANT: SOL_SOCKET HEX: ffff
 
+TYPEDEF: void* sockaddr*
+
 STRUCT: sockaddr-in
     { family short }
     { port ushort }
@@ -139,13 +141,15 @@ STRUCT: timeval
     { sec long }
     { usec long } ;
 
+TYPEDEF: void* fd_set*
+
 LIBRARY: winsock
 
 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
 
 FUNCTION: ushort htons ( ushort n ) ;
 FUNCTION: ushort ntohs ( ushort n ) ;
-FUNCTION: int bind ( void* socket, sockaddr_in* sockaddr, int len ) ;
+FUNCTION: int bind ( void* socket, sockaddr-in* sockaddr, int len ) ;
 FUNCTION: int listen ( void* socket, int backlog ) ;
 FUNCTION: char* inet_ntoa ( int in-addr ) ;
 FUNCTION: int getaddrinfo ( char* nodename,
@@ -158,15 +162,15 @@ FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
 
 FUNCTION: hostent* gethostbyname ( char* name ) ;
 FUNCTION: int gethostname ( char* name, int len ) ;
-FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
+FUNCTION: int connect ( void* socket, sockaddr-in* sockaddr, int addrlen ) ;
 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
 FUNCTION: int closesocket ( SOCKET s ) ;
 FUNCTION: int shutdown ( SOCKET s, int how ) ;
 FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
 FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
 
-FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
-FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
+FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
+FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
 
 TYPEDEF: uint SERVICETYPE
 TYPEDEF: OVERLAPPED WSAOVERLAPPED
index 1fe825d6af042618f85a7a22a226a2e553dbd19d..763cddaaf10877f581eafc14d8bbe7f501bbbc7e 100644 (file)
@@ -3,7 +3,7 @@
 
 ! Based on X.h
 
-USING: alien alien.syntax math x11.xlib ;
+USING: alien alien.c-types alien.syntax math x11.xlib ;
 IN: x11.constants
 
 TYPEDEF: ulong Mask
@@ -406,4 +406,4 @@ CONSTANT: MSBFirst 1
 ! * EXTENDED WINDOW MANAGER HINTS
 ! *****************************************************************
 
-C-ENUM: _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;
\ No newline at end of file
+C-ENUM: _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;
index 0cd7704cf88781f3c2fcd1bb9cd64ffa6be8ffa9..2b90b1bff276fb367b85bcddf45be4b69beaad00 100644 (file)
@@ -410,10 +410,6 @@ STRUCT: XCharStruct
 { descent short }
 { attributes ushort } ;
 
-X-FUNCTION: Font XLoadFont ( Display* display, char* name ) ;
-X-FUNCTION: XFontStruct* XQueryFont ( Display* display, XID font_ID ) ;
-X-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, char* name ) ;
-
 STRUCT: XFontStruct
 { ext_data XExtData* }
 { fid Font }
@@ -432,6 +428,10 @@ STRUCT: XFontStruct
 { ascent int }
 { descent int } ;
 
+X-FUNCTION: Font XLoadFont ( Display* display, char* name ) ;
+X-FUNCTION: XFontStruct* XQueryFont ( Display* display, XID font_ID ) ;
+X-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, char* name ) ;
+
 X-FUNCTION: int XTextWidth ( XFontStruct* font_struct, char* string, int count ) ;
 
 ! 8.6 - Drawing Text
index ebfa37cdbcd817a0b18a121a6b5e9e2d3a36857a..31c202b803716a6d1a02a088b3f93ab9e6573754 100644 (file)
@@ -1,4 +1,5 @@
-USING: sequences kernel math specialized-arrays fry ;
+USING: alien.c-types sequences kernel math specialized-arrays
+fry ;
 SPECIALIZED-ARRAY: int
 IN: benchmark.dawes
 
index 5dcefdda5a0ec7019746b4be188827910c433d43..87848cee9dfae4532333da07036f259e756e4ac7 100644 (file)
@@ -1,4 +1,4 @@
-USING: make math sequences splitting grouping
+USING: alien.c-types make math sequences splitting grouping
 kernel columns specialized-arrays bit-arrays ;
 SPECIALIZED-ARRAY: double
 IN: benchmark.dispatch2
@@ -29,4 +29,4 @@ IN: benchmark.dispatch2
     1000000 sequences
     [ [ 0 swap nth don't-flush-me ] each ] curry times ;
 
-MAIN: dispatch-test
\ No newline at end of file
+MAIN: dispatch-test
index 58301b57af14328d57ca20b5b6efb8c1f2e3e3c5..d5b5432f079abd5389795bf623b10c0db81c371d 100644 (file)
@@ -1,4 +1,4 @@
-USING: sequences math mirrors splitting grouping
+USING: alien.c-types sequences math mirrors splitting grouping
 kernel make assocs alien.syntax columns
 specialized-arrays bit-arrays ;
 SPECIALIZED-ARRAY: double
index 5b1a50c9e6226d373d4cc98f51495a050701a365..1ad769173bb8c4c5291c46cad2212fd79dfb4879 100755 (executable)
@@ -1,7 +1,7 @@
 ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
-USING: math kernel io io.files locals multiline assocs sequences
-sequences.private benchmark.reverse-complement hints
-io.encodings.ascii byte-arrays specialized-arrays ;
+USING: alien.c-types math kernel io io.files locals multiline
+assocs sequences sequences.private benchmark.reverse-complement
+hints io.encodings.ascii byte-arrays specialized-arrays ;
 SPECIALIZED-ARRAY: double
 IN: benchmark.fasta
 
index c47cdf4ee8f15f9b7a7330bf0329f7bf09e2ae13..6648c5263902e4a4a6ac90ee06a94f980524799f 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors fry kernel locals math math.constants
-math.functions math.vectors math.vectors.simd prettyprint
-combinators.smart sequences hints classes.struct
+USING: accessors alien.c-types fry kernel locals math
+math.constants math.functions math.vectors math.vectors.simd
+prettyprint combinators.smart sequences hints classes.struct
 specialized-arrays ;
 SIMD: double
 IN: benchmark.nbody-simd
index fc1cbaa12c211bc24ad38471376a6edb422823ca..c7ffed2bb32728c5763f789a87dcb3255cbebc1a 100644 (file)
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors specialized-arrays fry kernel locals math
-math.constants math.functions math.vectors prettyprint
-combinators.smart sequences hints arrays ;
+USING: accessors specialized-arrays fry kernel
+locals math math.constants math.functions math.vectors
+prettyprint combinators.smart sequences hints arrays ;
+FROM: alien.c-types => double ;
 SPECIALIZED-ARRAY: double
 IN: benchmark.nbody
 
index 96f345510f0a400efa44501de37e59c8f49c22e9..2413e7fd1e38991a47ccee77d20c543b542148f9 100755 (executable)
@@ -1,10 +1,10 @@
 ! Factor port of the raytracer benchmark from
 ! http://www.ffconsultancy.com/free/ray_tracer/languages.html
-
-USING: arrays accessors specialized-arrays io io.files
-io.files.temp io.encodings.binary kernel math math.constants
-math.functions math.vectors math.parser make sequences
-sequences.private words hints ;
+USING: arrays accessors specialized-arrays io
+io.files io.files.temp io.encodings.binary kernel math
+math.constants math.functions math.vectors math.parser make
+sequences sequences.private words hints ;
+FROM: alien.c-types => double ;
 SPECIALIZED-ARRAY: double
 IN: benchmark.raytracer
 
index 41ae5b35781b3d6ced2fb634f49de8657deb4182..68efffe08313b3f056c3033a796804b1ddd21db1 100644 (file)
@@ -1,7 +1,8 @@
 ! Factor port of
 ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
-USING: specialized-arrays kernel math math.functions
-math.vectors sequences prettyprint words hints locals ;
+USING: alien.c-types specialized-arrays kernel math
+math.functions math.vectors sequences prettyprint words hints
+locals ;
 SPECIALIZED-ARRAY: double
 IN: benchmark.spectral-norm
 
index 24c3ec965dc24b43f7e5ce7482cb0c5ea8e76bcc..942f78a483219ef6450b0de4af7e6e9ee4d675dd 100644 (file)
@@ -3,6 +3,7 @@
 USING: accessors classes.struct combinators.smart fry kernel
 math math.functions math.order math.parser sequences
 specialized-arrays io ;
+FROM: alien.c-types => float ;
 IN: benchmark.struct-arrays
 
 STRUCT: point { x float } { y float } { z float } ;
index 6644596828bd3bb4da78523226b763af8aafcb39..6105381f86cec6618098b22c5c7349b3302cf02f 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel system combinators
+USING: alien alien.c-types alien.syntax kernel system combinators
 alien.libraries classes.struct ;
 IN: freetype
 
@@ -38,8 +38,8 @@ TYPEDEF: long FT_F26Dot6
 FUNCTION: FT_Error FT_Init_FreeType ( void* library ) ;
 
 ! circular reference between glyph and face
-TYPEDEF: void face
-TYPEDEF: void glyph
+TYPEDEF: void* face*
+TYPEDEF: void* glyph*
 
 STRUCT: glyph
     { library void* }
@@ -166,6 +166,8 @@ STRUCT: FT_Bitmap
     { palette_mode char }
     { palette void* } ;
 
+TYPEDEF: void* FT_Face*
+
 FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;
 
 FUNCTION: FT_Error FT_New_Memory_Face ( void* library, FT_Byte* file_base, FT_Long file_size, FT_Long face_index, FT_Face* aface ) ;
index 35b529df5f7e0814a3a365dd8e0f38f645699614..e34b9b119dd0cb6e07658d982f0b9602ebe18e6e 100755 (executable)
@@ -1,9 +1,11 @@
 ! (c)2009 Joe Groff bsd license
-USING: alien alien.syntax byte-arrays classes gpu.buffers
-gpu.framebuffers gpu.shaders gpu.textures help.markup
+USING: alien alien.c-types alien.syntax byte-arrays classes
+gpu.buffers gpu.framebuffers gpu.shaders gpu.textures help.markup
 help.syntax images kernel math sequences
 specialized-arrays strings ;
-SPECIALIZED-ARRAY: float
+QUALIFIED-WITH: alien.c-types c
+QUALIFIED-WITH: math m
+SPECIALIZED-ARRAY: c:float
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: uint
 SPECIALIZED-ARRAY: ulong
@@ -49,7 +51,7 @@ $nl
 "Uniform parameters are passed from Factor to the shader program through the uniform tuple as follows:"
 { $list
 { { $link int-uniform } "s and " { $link uint-uniform } "s take their values from Factor " { $link integer } "s." }
-{ { $link float-uniform } "s take their values from Factor " { $link float } "s." }
+{ { $link float-uniform } "s take their values from Factor " { $link m:float } "s." }
 { { $link bool-uniform } "s take their values from Factor " { $link boolean } "s." }
 { { $link texture-uniform } "s take their values from " { $link texture } " objects." }
 { "Vector uniforms take their values from Factor " { $link sequence } "s of the corresponding component type."
index 862c94d4b304e9212ec1ee031d12c79eefd91f9d..1c9c8e629ccf3624f35fdc54dd2a4e0c14b45d3b 100644 (file)
@@ -1,6 +1,7 @@
 ! (c)2009 Joe Groff bsd license
 USING: gpu.buffers gpu.render gpu.shaders gpu.textures images kernel
 specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: gpu.util
 
index 9145434d90e688b70ddb9d8cacde1ef0ddd818ca..496735f0dbf2434b3fe20e8e45f11bb694d2c3d2 100644 (file)
@@ -5,6 +5,7 @@ gpu.render gpu.state kernel literals
 locals math math.constants math.functions math.matrices
 math.order math.vectors opengl.gl sequences
 ui ui.gadgets.worlds specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: gpu.util.wasd
 
index 94638de3460b8dbd6fbdc7f42e485f40fde9c212..4eaa702468c795a9002f353345bafffd11d42e15 100644 (file)
@@ -1,6 +1,7 @@
 ! (c)2009 Joe Groff bsd license
 USING: accessors arrays destructors kernel math opengl
 opengl.gl sequences sequences.product specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: grid-meshes
 
index 8706ac58341ed561b61dd93f57eaa98c054c2474..f557e979dd372eebde4003b1613b90e57e9d3515 100755 (executable)
@@ -1,7 +1,9 @@
 ! Copyright (C) 2009 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors grouping sequences combinators math
-byte-arrays fry images half-floats specialized-arrays ;
+USING: alien.c-types kernel accessors grouping sequences
+combinators math byte-arrays fry images half-floats
+specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: uint
 SPECIALIZED-ARRAY: ushort
 SPECIALIZED-ARRAY: float
index 536974952e255eb1bc17c3f9413d679968f6756d..e4c954d793d04f2b33fbd5a9971c2dbab67eb498 100644 (file)
@@ -4,7 +4,8 @@ USING: accessors colors.constants combinators jamshred.log
 jamshred.oint jamshred.sound jamshred.tunnel kernel locals math
 math.constants math.order math.ranges math.vectors math.matrices
 sequences shuffle specialized-arrays strings system ;
-SPECIALIZED-ARRAY: float
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
 IN: jamshred.player
 
 TUPLE: player < oint
index 2767444c8f930a377db801425669353080e02e7b..742f8346225d379b7dd1323b8d53e354ac8fd096 100644 (file)
@@ -5,6 +5,7 @@ kernel literals locals math math.constants math.matrices
 math.order math.quadratic math.ranges math.vectors random
 sequences specialized-arrays vectors ;
 FROM: jamshred.oint => distance ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: jamshred.tunnel
 
index 16eff168d423e3de22877c18f037ff5eea4e9575..508e590d010275c6ab531a30ac51e07aa1da134b 100644 (file)
@@ -1,5 +1,6 @@
-USING: alien.syntax io io.encodings.utf16n io.encodings.utf8 io.files
-kernel namespaces sequences system threads unix.utilities ;
+USING: alien.c-types alien.syntax io io.encodings.utf16n
+io.encodings.utf8 io.files kernel namespaces sequences system threads
+unix.utilities ;
 IN: native-thread-test
 
 FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
@@ -22,4 +23,4 @@ M: unix native-string-encoding utf8 ;
 : testthread ( -- )
      "/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
 
-MAIN: testthread
\ No newline at end of file
+MAIN: testthread
index b8f2f1cb5f8dba3cc238815270cf1906c380616a..0df063e2c6dbce5558d47d8169450bef9594cfa6 100644 (file)
@@ -1,7 +1,8 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors arrays grouping kernel locals math math.order
-math.ranges math.vectors math.vectors.homogeneous sequences
-specialized-arrays ;
+USING: accessors alien.c-types arrays grouping kernel locals
+math math.order math.ranges math.vectors
+math.vectors.homogeneous sequences specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: nurbs
 
index 6cd6964721af767dd4b083c2545b5ce36f999450..24227167c97e9c05032835e0802681213eb59a92 100644 (file)
@@ -122,7 +122,7 @@ FUNCTION: int      ogg_sync_pageout ( ogg-sync-state* oy, ogg-page* og ) ;
 FUNCTION: int      ogg_stream_pagein ( ogg-stream-state* os, ogg-page* og ) ;
 FUNCTION: int      ogg_stream_packetout ( ogg-stream-state* os, ogg-packet* op ) ;
 FUNCTION: int      ogg_stream_packetpeek ( ogg-stream-state* os, ogg-packet* op ) ;
-FUNCTION: int      ogg_stream_init (ogg-stream-state* os, int serialno ) ;
+FUNCTION: int      ogg_stream_init ( ogg-stream-state* os, int serialno ) ;
 FUNCTION: int      ogg_stream_clear ( ogg-stream-state* os ) ;
 FUNCTION: int      ogg_stream_reset ( ogg-stream-state* os ) ;
 FUNCTION: int      ogg_stream_reset_serialno ( ogg-stream-state* os, int serialno ) ;
index 81d360eca1ea2e83fb96276310d734f08d0616b0..f0a6b928e93305bf46d739bd98dd69303b0a3ec2 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types kernel alien alien.syntax shuffle
-openal.backend namespaces system generalizations ;
+openal openal.backend namespaces system generalizations ;
 IN: openal.macosx
 
 LIBRARY: alut
index 0936c94150862a81f94771005e4dea9a505db1af..ada8d6b1fb18868b9272e536c3fd400349cde5cb 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax combinators generalizations
-kernel openal.backend ;
+kernel openal openal.backend ;
 IN: openal.other
 
 LIBRARY: alut
index a8404bb13aaa8f3214575af74ea143cccc5908f3..a62745cb6aab473cb87b1f219634bbe2b9b7984b 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Alex Chapman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.libraries alien.syntax kernel sequences words system
-combinators ;
+USING: alien alien.c-types alien.libraries alien.syntax kernel
+sequences words system combinators opengl.gl ;
 IN: opengl.glu
 
 <<
@@ -268,4 +268,4 @@ FUNCTION: GLint gluUnProject ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdo
 ! FUNCTION: GLint gluUnProject4 ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble clipW, GLdouble* model, GLdouble* proj, GLint* view, GLdouble nearVal, GLdouble farVal, GLdouble* objX, GLdouble* objY, GLdouble* objZ, GLdouble* objW ) ;
 
 : gl-look-at ( eye focus up -- )
-    [ first3 ] tri@ gluLookAt ;
\ No newline at end of file
+    [ first3 ] tri@ gluLookAt ;
index 95322e423a93bd0c92fb18743910638f89f91670..050a83542212c625af0dfa3f141584a7850e579e 100644 (file)
@@ -9,6 +9,7 @@ terrain.generation terrain.shaders ui ui.gadgets
 ui.gadgets.worlds ui.pixel-formats game-worlds method-chains
 math.affine-transforms noise ui.gestures combinators.short-circuit
 destructors grid-meshes ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: terrain
 
index 3793846050c8ae2bbdd5403b6897a4d11aaa03b8..b9503bdab4a74910dfd2bacc2a529953459885a0 100755 (executable)
@@ -6,6 +6,7 @@ IN: tokyo.alien.tchdb
 
 LIBRARY: tokyocabinet
 
+TYPEDEF: void* TCXSTR*
 TYPEDEF: void* TCHDB*
 
 CONSTANT: HDBFOPEN  1
index e43ed9c765117521bad97f37d2ac0ca1fc15ef9f..8373a6aaaaf5be22e7aeb323cfc53dec5b5df369 100755 (executable)
@@ -8,6 +8,7 @@ LIBRARY: tokyocabinet
 
 TYPEDEF: void* TDBIDX*
 TYPEDEF: void* TCTDB*
+TYPEDEF: void* TCMAP*
 
 CONSTANT: TDBFOPEN  HDBFOPEN
 CONSTANT: TDBFFATAL HDBFFATAL
index 00b4a4e9f7cefdb465cb46b9081fb6cad6539a26..138e142eae58e39a26a153d458df66a8ec5ccdd3 100644 (file)
@@ -23,11 +23,11 @@ else
     set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255
 endif
 
-syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple
+syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple,factorStruct
 
 syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained
-syn match factorComment /\<#! .*/ contains=factorTodo
-syn match factorComment /\<! .*/ contains=factorTodo
+syn match factorComment /\<#!\>.*/ contains=factorTodo
+syn match factorComment /\<!\>.*/ contains=factorTodo
 
 syn cluster factorDefnContents contains=@factorCluster,factorStackEffect,factorLiteralStackEffect,factorArray0,factorQuotation0
 
@@ -84,13 +84,18 @@ syn match   factorChar          /\<CHAR:\s\+\\\=\S\>/
 syn match   factorBackslash     /\<\\\>\s\+\S\+\>/
 
 syn region  factorUsing         start=/\<USING:\>/       end=/;/
+syn match   factorQualified     /\<QUALIFIED:\s\+\S\+\>/
+syn match   factorQualifiedWith /\<QUALIFIED-WITH:\s\+\S\+\s\+\S\+\>/
+syn region  factorFrom          start=/\<FROM:\>/        end=/;/
 syn region  factorSingletons    start=/\<SINGLETONS:\>/  end=/;/
 syn match   factorSymbol        /\<SYMBOL:\s\+\S\+\>/
 syn region  factorSymbols       start=/\<SYMBOLS:\>/     end=/;/
 syn region  factorConstructor2  start=/\<CONSTRUCTOR:\?/ end=/;/
 syn region  factorTuple         start=/\<TUPLE:\>/ end=/\<;\>/
+syn region  factorStruct        start=/\<\(UNION-STRUCT:\|STRUCT:\)\>/ end=/\<;\>/
 
 syn match   factorConstant      /\<CONSTANT:\s\+\S\+\>/
+syn match   factorAlias         /\<ALIAS:\s\+\S\+\>/
 syn match   factorSingleton     /\<SINGLETON:\s\+\S\+\>/
 syn match   factorPostpone      /\<POSTPONE:\s\+\S\+\>/
 syn match   factorDefer         /\<DEFER:\s\+\S\+\>/
@@ -102,8 +107,7 @@ syn match   factorMain          /\<MAIN:\s\+\S\+\>/
 syn match   factorConstructor   /\<C:\s\+\S\+\s\+\S\+\>/
 syn match   factorAlien         /\<ALIEN:\s\+\d\+\>/
 
-syn cluster factorWordOps       contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
-
+syn cluster factorWordOps       contains=factorConstant,factorAlias,factorSingleton,factorSingletons,factorSymbol,factorSymbols,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
 
 "TODO:
 "misc:
@@ -113,20 +117,10 @@ syn cluster factorWordOps       contains=factorSymbol,factorPostpone,factorDefer
 " PRIMITIVE:
 
 "C interface:
-" FIELD:
-" BEGIN-STRUCT:
 " C-ENUM:
 " FUNCTION:
-" END-STRUCT
-" DLL"
 " TYPEDEF:
 " LIBRARY:
-" C-UNION:
-"QUALIFIED:
-"QUALIFIED-WITH:
-"FROM:
-"ALIAS:
-"! POSTPONE: "
 "#\ "
 
 syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
@@ -143,18 +137,18 @@ syn match factorLiteralStackEffect /\<(( .*--.* ))\>/
 
 "adapted from lisp.vim
 if exists("g:factor_norainbow") 
-    syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
+    syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
 else
-    syn region factorQuotation0           matchgroup=hlLevel0 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
-    syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
-    syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
-    syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
-    syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
-    syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
-    syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
-    syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
-    syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
-    syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
+    syn region factorQuotation0           matchgroup=hlLevel0 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
+    syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
+    syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
+    syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
+    syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
+    syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
+    syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
+    syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
+    syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
+    syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/  end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
 endif
 
 if exists("g:factor_norainbow") 
@@ -222,6 +216,9 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorFloat                  Float
     HiLink factorInt                    Number
     HiLink factorUsing                  Include
+    HiLink factorQualified              Include
+    HiLink factorQualifiedWith          Include
+    HiLink factorFrom                   Include
     HiLink factorUse                    Include
     HiLink factorUnuse                  Include
     HiLink factorIn                     Define
@@ -243,6 +240,7 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorForget                 Define
     HiLink factorAlien                  Define
     HiLink factorTuple                  Typedef
+    HiLink factorStruct                 Typedef
 
     if &bg == "dark"
         hi   hlLevel0 ctermfg=red         guifg=red1