diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index 32c1d18d51..9c8d24d1e1 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -38,16 +38,6 @@ HELP: set-alien-value { $description "Stores a value at a byte offset from a base C pointer." } { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; -HELP: define-deref -{ $values { "c-type" "a C type" } } -{ $description "Defines a word " { $snippet "*name" } " with stack effect " { $snippet "( c-ptr -- value )" } " for reading a value with C type " { $snippet "name" } " stored at an alien pointer." } -{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ; - -HELP: define-out -{ $values { "c-type" "a C type" } } -{ $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." } -{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ; - HELP: char { $description "This C type represents a one-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to eight bits; output values will be returned as " { $link math:fixnum } "s." } ; HELP: uchar @@ -121,39 +111,10 @@ $nl ARTICLE: "c-out-params" "Output parameters in C" "A frequently-occurring idiom in C code is the \"out parameter\". If a C function returns more than one value, the caller passes pointers of the correct type, and the C function writes its return values to those locations." $nl -"Each numerical C type, together with " { $snippet "void*" } ", has an associated " { $emphasis "out parameter constructor" } " word which takes a Factor object as input, constructs a byte array of the correct size, and converts the Factor object to a C value stored into the byte array:" -{ $subsections - - - - - - - - - - - - - -} -"You call the out parameter constructor with the required initial value, then pass the byte array to the C function, which receives a pointer to the start of the byte array's data area. The C function then returns, leaving the result in the byte array; you read it back using the next set of words:" -{ $subsections - *char - *uchar - *short - *ushort - *int - *uint - *long - *ulong - *longlong - *ulonglong - *float - *double - *void* -} -"Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link } " and " { $link *void* } " may be used." ; +"To wrap Factor data for consumption by the FFI, we use a utility word that constructs a byte array of the correct size and converts the Factor object to a C value stored into that byte array:" +{ $subsections } +"You call the out parameter constructor with the required initial value, then pass the byte array to the C function, which receives a pointer to the start of the byte array's data area. The C function then returns, leaving the result in the byte array; you read it back using this word:" +{ $subsections deref } ; ARTICLE: "c-types.primitives" "Primitive C types" "The following numerical types are defined in the " { $vocab-link "alien.c-types" } " vocabulary; a " { $snippet "u" } " prefix denotes an unsigned type:" diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 96976b7b6c..93d76a8236 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -2,24 +2,25 @@ USING: alien alien.syntax alien.c-types alien.parser eval kernel tools.test sequences system libc alien.strings io.encodings.ascii io.encodings.utf8 math.constants classes.struct classes accessors compiler.units ; +FROM: alien.c-types => short ; IN: alien.c-types.tests CONSTANT: xyz 123 [ 492 ] [ { int xyz } heap-size ] unit-test -[ -1 ] [ -1 *char ] unit-test -[ -1 ] [ -1 *short ] unit-test -[ -1 ] [ -1 *int ] unit-test +[ -1 ] [ -1 char char deref ] unit-test +[ -1 ] [ -1 short short deref ] unit-test +[ -1 ] [ -1 int int deref ] unit-test ! I don't care if this throws an error or works, but at least ! it should be consistent between platforms -[ -1 ] [ -1.0 *int ] unit-test -[ -1 ] [ -1.0 *long ] unit-test -[ -1 ] [ -1.0 *longlong ] unit-test -[ 1 ] [ 1.0 *uint ] unit-test -[ 1 ] [ 1.0 *ulong ] unit-test -[ 1 ] [ 1.0 *ulonglong ] unit-test +[ -1 ] [ -1.0 int int deref ] unit-test +[ -1 ] [ -1.0 long long deref ] unit-test +[ -1 ] [ -1.0 longlong longlong deref ] unit-test +[ 1 ] [ 1.0 uint uint deref ] unit-test +[ 1 ] [ 1.0 ulong ulong deref ] unit-test +[ 1 ] [ 1.0 ulonglong ulonglong deref ] unit-test UNION-STRUCT: foo { a int } @@ -62,11 +63,11 @@ TYPEDEF: int* MyIntArray [ t ] [ void* c-type MyIntArray c-type = ] unit-test [ - 0 B{ 1 2 3 4 } + 0 B{ 1 2 3 4 } void* ] must-fail os windows? cpu x86.64? and [ - [ -2147467259 ] [ 2147500037 *long ] unit-test + [ -2147467259 ] [ 2147500037 long long deref ] unit-test ] when [ 0 ] [ -10 uchar c-type-clamp ] unit-test diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index f703f0d0f7..6821dae15f 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -1,12 +1,9 @@ ! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays arrays assocs delegate kernel kernel.private math -math.order math.parser namespaces make parser sequences strings -words splitting cpu.architecture alien alien.accessors -alien.strings quotations layouts system compiler.units io -io.files io.encodings.binary io.streams.memory accessors -combinators effects continuations fry classes vocabs -vocabs.loader words.symbol macros ; +USING: accessors alien alien.accessors arrays byte-arrays +classes combinators compiler.units cpu.architecture delegate +fry kernel layouts locals macros math math.order quotations +sequences system words words.symbol ; QUALIFIED: math IN: alien.c-types @@ -21,9 +18,6 @@ SYMBOLS: SINGLETON: void -DEFER: -DEFER: *char - TUPLE: abstract-c-type { class class initial: object } { boxed-class class initial: object } @@ -111,8 +105,6 @@ M: c-type-name base-type c-type ; M: c-type base-type ; -: little-endian? ( -- ? ) 1 *char 1 = ; foldable - GENERIC: heap-size ( name -- size ) M: abstract-c-type heap-size size>> ; @@ -170,19 +162,6 @@ TUPLE: long-long-type < c-type ; : ( -- c-type ) long-long-type new ; -: define-deref ( c-type -- ) - [ name>> CHAR: * prefix "alien.c-types" create ] - [ '[ 0 _ alien-value ] ] - bi (( c-ptr -- value )) define-inline ; - -: define-out ( c-type -- ) - [ name>> "alien.c-types" constructor-word ] - [ dup '[ _ heap-size (byte-array) [ 0 _ set-alien-value ] keep ] ] bi - (( value -- c-ptr )) define-inline ; - -: define-primitive-type ( c-type name -- ) - [ typedef ] [ define-deref ] [ define-out ] tri ; - : if-void ( c-type true false -- ) pick void? [ drop nip call ] [ nip call ] if ; inline @@ -247,7 +226,7 @@ M: pointer c-type [ >c-ptr ] >>unboxer-quot "allot_alien" >>boxer "alien_offset" >>unboxer - \ void* define-primitive-type + \ void* typedef fixnum >>class @@ -260,7 +239,7 @@ M: pointer c-type "from_signed_2" >>boxer "to_signed_2" >>unboxer [ >fixnum ] >>unboxer-quot - \ short define-primitive-type + \ short typedef fixnum >>class @@ -273,7 +252,7 @@ M: pointer c-type "from_unsigned_2" >>boxer "to_unsigned_2" >>unboxer [ >fixnum ] >>unboxer-quot - \ ushort define-primitive-type + \ ushort typedef fixnum >>class @@ -286,7 +265,7 @@ M: pointer c-type "from_signed_1" >>boxer "to_signed_1" >>unboxer [ >fixnum ] >>unboxer-quot - \ char define-primitive-type + \ char typedef fixnum >>class @@ -299,7 +278,7 @@ M: pointer c-type "from_unsigned_1" >>boxer "to_unsigned_1" >>unboxer [ >fixnum ] >>unboxer-quot - \ uchar define-primitive-type + \ uchar typedef math:float >>class @@ -313,7 +292,7 @@ M: pointer c-type "to_float" >>unboxer float-rep >>rep [ >float ] >>unboxer-quot - \ float define-primitive-type + \ float typedef math:float >>class @@ -326,7 +305,7 @@ M: pointer c-type "to_double" >>unboxer double-rep >>rep [ >float ] >>unboxer-quot - \ double define-primitive-type + \ double typedef cell 8 = [ @@ -340,7 +319,7 @@ M: pointer c-type "from_signed_4" >>boxer "to_signed_4" >>unboxer [ >fixnum ] >>unboxer-quot - \ int define-primitive-type + \ int typedef fixnum >>class @@ -353,7 +332,7 @@ M: pointer c-type "from_unsigned_4" >>boxer "to_unsigned_4" >>unboxer [ >fixnum ] >>unboxer-quot - \ uint define-primitive-type + \ uint typedef integer >>class @@ -366,7 +345,7 @@ M: pointer c-type "from_signed_cell" >>boxer "to_fixnum" >>unboxer [ >integer ] >>unboxer-quot - \ longlong define-primitive-type + \ longlong typedef integer >>class @@ -379,14 +358,14 @@ M: pointer c-type "from_unsigned_cell" >>boxer "to_cell" >>unboxer [ >integer ] >>unboxer-quot - \ ulonglong define-primitive-type + \ ulonglong typedef os windows? [ - \ int c-type \ long define-primitive-type - \ uint c-type \ ulong define-primitive-type + \ int c-type \ long typedef + \ uint c-type \ ulong typedef ] [ - \ longlong c-type \ long define-primitive-type - \ ulonglong c-type \ ulong define-primitive-type + \ longlong c-type \ long typedef + \ ulonglong c-type \ ulong typedef ] if \ longlong c-type \ ptrdiff_t typedef @@ -406,7 +385,7 @@ M: pointer c-type "from_signed_cell" >>boxer "to_fixnum" >>unboxer [ >integer ] >>unboxer-quot - \ int define-primitive-type + \ int typedef integer >>class @@ -419,7 +398,7 @@ M: pointer c-type "from_unsigned_cell" >>boxer "to_cell" >>unboxer [ >integer ] >>unboxer-quot - \ uint define-primitive-type + \ uint typedef integer >>class @@ -431,7 +410,7 @@ M: pointer c-type "from_signed_8" >>boxer "to_signed_8" >>unboxer [ >integer ] >>unboxer-quot - \ longlong define-primitive-type + \ longlong typedef integer >>class @@ -443,10 +422,10 @@ M: pointer c-type "from_unsigned_8" >>boxer "to_unsigned_8" >>unboxer [ >integer ] >>unboxer-quot - \ ulonglong define-primitive-type + \ ulonglong typedef - \ int c-type \ long define-primitive-type - \ uint c-type \ ulong define-primitive-type + \ int c-type \ long typedef + \ uint c-type \ ulong typedef \ int c-type \ ptrdiff_t typedef \ int c-type \ intptr_t typedef @@ -459,7 +438,7 @@ M: pointer c-type [ >c-bool ] >>unboxer-quot [ c-bool> ] >>boxer-quot object >>boxed-class - \ bool define-primitive-type + \ bool typedef ] with-compilation-unit @@ -489,3 +468,12 @@ M: double-2-rep rep-component-type drop double ; : c-type-clamp ( value c-type -- value' ) dup { float double } member-eq? [ drop ] [ c-type-interval clamp ] if ; inline + +: ( value c-type -- c-ptr ) + [ heap-size ] keep + '[ 0 _ set-alien-value ] keep ; inline + +: deref ( c-ptr c-type -- value ) + [ 0 ] dip alien-value ; inline + +: little-endian? ( -- ? ) 1 int char deref 1 = ; foldable diff --git a/basis/alien/fortran/fortran-tests.factor b/basis/alien/fortran/fortran-tests.factor index dc0585cab8..38e0d5f27a 100644 --- a/basis/alien/fortran/fortran-tests.factor +++ b/basis/alien/fortran/fortran-tests.factor @@ -192,10 +192,10 @@ intel-unix-abi fortran-abi [ { [ { [ ascii string>alien ] - [ ] - [ ] + [ longlong ] + [ float ] [ ] - [ 1 0 ? ] + [ 1 0 ? c:short ] } spread ] [ { [ length ] [ drop ] [ drop ] [ drop ] [ drop ] } spread ] } 5 ncleave @@ -211,7 +211,7 @@ intel-unix-abi fortran-abi [ [ drop ] [ drop ] [ drop ] - [ *float ] + [ float deref ] [ drop ] [ drop ] } spread @@ -280,7 +280,7 @@ intel-unix-abi fortran-abi [ { [ { [ ascii string>alien ] - [ ] + [ float ] [ ascii string>alien ] } spread ] [ { [ length ] [ drop ] [ length ] } spread ] @@ -298,7 +298,7 @@ intel-unix-abi fortran-abi [ [ ascii alien>nstring ] [ ] [ ascii alien>nstring ] - [ *float ] + [ float deref ] [ ] [ ascii alien>nstring ] } spread diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 3d87431084..4b7142c435 100755 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -1,5 +1,5 @@ ! (c) 2009 Joe Groff, see BSD license -USING: accessors alien alien.c-types alien.complex alien.data +USING: accessors alien alien.complex alien.c-types alien.data alien.parser grouping alien.strings alien.syntax arrays ascii assocs byte-arrays combinators combinators.short-circuit fry generalizations kernel lexer macros math math.parser namespaces @@ -211,11 +211,11 @@ GENERIC: (fortran-arg>c-args) ( type -- main-quot added-quot ) M: integer-type (fortran-arg>c-args) [ size>> { - { f [ [ ] [ drop ] ] } - { 1 [ [ ] [ drop ] ] } - { 2 [ [ ] [ drop ] ] } - { 4 [ [ ] [ drop ] ] } - { 8 [ [ ] [ drop ] ] } + { f [ [ c:int ] [ drop ] ] } + { 1 [ [ c:char ] [ drop ] ] } + { 2 [ [ c:short ] [ drop ] ] } + { 4 [ [ c:int ] [ drop ] ] } + { 8 [ [ c:longlong ] [ drop ] ] } [ invalid-fortran-type ] } case ] args?dims ; @@ -226,9 +226,9 @@ M: logical-type (fortran-arg>c-args) M: real-type (fortran-arg>c-args) [ size>> { - { f [ [ ] [ drop ] ] } - { 4 [ [ ] [ drop ] ] } - { 8 [ [ ] [ drop ] ] } + { f [ [ c:float ] [ drop ] ] } + { 4 [ [ c:float ] [ drop ] ] } + { 8 [ [ c:double ] [ drop ] ] } [ invalid-fortran-type ] } case ] args?dims ; @@ -244,14 +244,14 @@ M: real-complex-type (fortran-arg>c-args) ] args?dims ; M: double-precision-type (fortran-arg>c-args) - [ drop [ ] [ drop ] ] args?dims ; + [ drop [ c:double ] [ drop ] ] args?dims ; M: double-complex-type (fortran-arg>c-args) [ drop [ ] [ drop ] ] args?dims ; M: character-type (fortran-arg>c-args) fix-character-type single-char? - [ [ first ] [ drop ] ] + [ [ first c:char ] [ drop ] ] [ [ ascii string>alien ] [ length ] ] if ; M: misc-type (fortran-arg>c-args) @@ -263,23 +263,25 @@ GENERIC: (fortran-result>) ( type -- quots ) [ dup dims>> [ drop { [ ] } ] ] dip if ; inline M: integer-type (fortran-result>) - [ size>> { - { f [ { [ *int ] } ] } - { 1 [ { [ *char ] } ] } - { 2 [ { [ *short ] } ] } - { 4 [ { [ *int ] } ] } - { 8 [ { [ *longlong ] } ] } - [ invalid-fortran-type ] - } case ] result?dims ; + [ + size>> { + { f [ { [ c:int deref ] } ] } + { 1 [ { [ c:char deref ] } ] } + { 2 [ { [ c:short deref ] } ] } + { 4 [ { [ c:int deref ] } ] } + { 8 [ { [ c:longlong deref ] } ] } + [ invalid-fortran-type ] + } case + ] result?dims ; M: logical-type (fortran-result>) [ call-next-method first [ zero? not ] append 1array ] result?dims ; M: real-type (fortran-result>) [ size>> { - { f [ { [ *float ] } ] } - { 4 [ { [ *float ] } ] } - { 8 [ { [ *double ] } ] } + { f [ { [ c:float deref ] } ] } + { 4 [ { [ c:float deref ] } ] } + { 8 [ { [ c:double deref ] } ] } [ invalid-fortran-type ] } case ] result?dims ; @@ -292,14 +294,14 @@ M: real-complex-type (fortran-result>) } case ] result?dims ; M: double-precision-type (fortran-result>) - [ drop { [ *double ] } ] result?dims ; + [ drop { [ c:double deref ] } ] result?dims ; M: double-complex-type (fortran-result>) [ drop { [ *complex-double ] } ] result?dims ; M: character-type (fortran-result>) fix-character-type single-char? - [ { [ *char 1string ] } ] + [ { [ c:char deref 1string ] } ] [ { [ ] [ ascii alien>nstring ] } ] if ; M: misc-type (fortran-result>) diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 9f7d165925..58d280248f 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -21,7 +21,7 @@ IN: calendar.unix timespec>duration since-1970 ; : get-time ( -- alien ) - f time localtime ; + f time time_t localtime ; : timezone-name ( -- string ) get-time zone>> ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 4c4e8de94d..4e822ba32c 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -275,7 +275,8 @@ M: cucumber equal? "The cucumber has no equal" throw ; [ 4294967295 B{ 255 255 255 255 } -1 ] [ - -1 -1 + -1 int + -1 int [ [ 0 alien-unsigned-4 swap ] [ 0 alien-signed-2 ] bi ] compile-call ] unit-test diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 53017ff452..00345081ca 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -6,6 +6,8 @@ sbufs strings.private slots.private alien math.order alien.accessors alien.c-types alien.data alien.syntax alien.strings namespaces libc io.encodings.ascii classes compiler.test ; FROM: math => float ; +FROM: alien.c-types => short ; +QUALIFIED-WITH: alien.c-types c IN: compiler.tests.intrinsics ! Make sure that intrinsic ops compile to correct code. @@ -429,46 +431,46 @@ ERROR: bug-in-fixnum* x y a b ; [ ] [ "hello world" ascii malloc-string "s" set ] unit-test "s" get [ - [ "hello world" ] [ "s" get [ { byte-array } declare *void* ] compile-call ascii alien>string ] unit-test - [ "hello world" ] [ "s" get [ { c-ptr } declare *void* ] compile-call ascii alien>string ] unit-test + [ "hello world" ] [ "s" get void* [ { byte-array } declare void* deref ] compile-call ascii alien>string ] unit-test + [ "hello world" ] [ "s" get void* [ { c-ptr } declare void* deref ] compile-call ascii alien>string ] unit-test [ ] [ "s" get free ] unit-test ] when -[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare ] compile-call *void* ] unit-test -[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare ] compile-call *void* ] unit-test -[ f ] [ f [ { POSTPONE: f } declare ] compile-call *void* ] unit-test +[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare void* ] compile-call void* deref ] unit-test +[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare void* ] compile-call void* deref ] unit-test +[ f ] [ f [ { POSTPONE: f } declare void* ] compile-call void* deref ] unit-test [ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test [ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test -[ -100 ] [ -100 [ { byte-array } declare *char ] compile-call ] unit-test -[ 156 ] [ -100 [ { byte-array } declare *uchar ] compile-call ] unit-test +[ -100 ] [ -100 char [ { byte-array } declare char deref ] compile-call ] unit-test +[ 156 ] [ -100 uchar [ { byte-array } declare uchar deref ] compile-call ] unit-test -[ -100 ] [ -100 \ def>> [ { fixnum } declare ] prepend compile-call *char ] unit-test -[ 156 ] [ -100 \ def>> [ { fixnum } declare ] prepend compile-call *uchar ] unit-test +[ -100 ] [ -100 [ char ] [ { fixnum } declare ] prepend compile-call char deref ] unit-test +[ 156 ] [ -100 [ uchar ] [ { fixnum } declare ] prepend compile-call uchar deref ] unit-test -[ -1000 ] [ -1000 [ { byte-array } declare *short ] compile-call ] unit-test -[ 64536 ] [ -1000 [ { byte-array } declare *ushort ] compile-call ] unit-test +[ -1000 ] [ -1000 short [ { byte-array } declare short deref ] compile-call ] unit-test +[ 64536 ] [ -1000 ushort [ { byte-array } declare ushort deref ] compile-call ] unit-test -[ -1000 ] [ -1000 \ def>> [ { fixnum } declare ] prepend compile-call *short ] unit-test -[ 64536 ] [ -1000 \ def>> [ { fixnum } declare ] prepend compile-call *ushort ] unit-test +[ -1000 ] [ -1000 [ short ] [ { fixnum } declare ] prepend compile-call short deref ] unit-test +[ 64536 ] [ -1000 [ ushort ] [ { fixnum } declare ] prepend compile-call ushort deref ] unit-test -[ -100000 ] [ -100000 [ { byte-array } declare *int ] compile-call ] unit-test -[ 4294867296 ] [ -100000 [ { byte-array } declare *uint ] compile-call ] unit-test +[ -100000 ] [ -100000 int [ { byte-array } declare int deref ] compile-call ] unit-test +[ 4294867296 ] [ -100000 uint [ { byte-array } declare uint deref ] compile-call ] unit-test -[ -100000 ] [ -100000 \ def>> [ { fixnum } declare ] prepend compile-call *int ] unit-test -[ 4294867296 ] [ -100000 \ def>> [ { fixnum } declare ] prepend compile-call *uint ] unit-test +[ -100000 ] [ -100000 [ int ] [ { fixnum } declare ] prepend compile-call int deref ] unit-test +[ 4294867296 ] [ -100000 [ uint ] [ { fixnum } declare ] prepend compile-call uint deref ] unit-test -[ t ] [ pi pi *double = ] unit-test +[ t ] [ pi pi double double deref = ] unit-test -[ t ] [ pi [ { byte-array } declare *double ] compile-call pi = ] unit-test +[ t ] [ pi double [ { byte-array } declare double deref ] compile-call pi = ] unit-test ! Silly -[ t ] [ pi 4 [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep *float pi - -0.001 0.001 between? ] unit-test -[ t ] [ pi [ { byte-array } declare *float ] compile-call pi - -0.001 0.001 between? ] unit-test +[ t ] [ pi 4 [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep c:float deref pi - -0.001 0.001 between? ] unit-test +[ t ] [ pi c:float [ { byte-array } declare c:float deref ] compile-call pi - -0.001 0.001 between? ] unit-test -[ t ] [ pi 8 [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep *double pi = ] unit-test +[ t ] [ pi 8 [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep double deref pi = ] unit-test [ 4 ] [ 2 B{ 1 2 3 4 5 6 } [ @@ -532,12 +534,14 @@ ERROR: bug-in-fixnum* x y a b ; ] compile-call ] unit-test +! These tests must fail because we're not allowed to store +! a pointer to a byte array inside of an alien object [ - B{ 0 0 0 0 } [ { byte-array } declare ] compile-call + B{ 0 0 0 0 } [ { byte-array } declare void* ] compile-call ] must-fail [ - B{ 0 0 0 0 } [ { c-ptr } declare ] compile-call + B{ 0 0 0 0 } [ { c-ptr } declare void* ] compile-call ] must-fail [ diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 88e7895c89..aedab2b40c 100644 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -17,6 +17,7 @@ compiler.tree.propagation.info compiler.tree.checker compiler.tree.debugger ; FROM: math => float ; +QUALIFIED-WITH: alien.c-types c IN: compiler.tree.cleanup.tests [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test @@ -244,22 +245,22 @@ cell-bits 32 = [ ] when [ t ] [ - [ B{ 1 0 } *short 0 number= ] + [ B{ 1 0 } c:short deref 0 number= ] \ number= inlined? ] unit-test [ t ] [ - [ B{ 1 0 } *short 0 { number number } declare number= ] + [ B{ 1 0 } c:short deref 0 { number number } declare number= ] \ number= inlined? ] unit-test [ t ] [ - [ B{ 1 0 } *short 0 = ] + [ B{ 1 0 } c:short deref 0 = ] \ number= inlined? ] unit-test [ t ] [ - [ B{ 1 0 } *short dup number? [ 0 number= ] [ drop f ] if ] + [ B{ 1 0 } c:short deref dup number? [ 0 number= ] [ drop f ] if ] \ number= inlined? ] unit-test diff --git a/basis/compression/zlib/zlib.factor b/basis/compression/zlib/zlib.factor index c662eec049..fc9f1f9693 100644 --- a/basis/compression/zlib/zlib.factor +++ b/basis/compression/zlib/zlib.factor @@ -36,15 +36,15 @@ ERROR: zlib-failed n string ; : compress ( byte-array -- compressed ) [ - [ compressed-size dup length ] keep [ + [ compressed-size dup length ulong ] keep [ dup length compression.zlib.ffi:compress zlib-error - ] 3keep drop *ulong head + ] 3keep drop ulong deref head ] keep length ; : uncompress ( compressed -- byte-array ) [ - length>> [ ] keep 2dup + length>> [ ] keep ulong 2dup ] [ data>> dup length compression.zlib.ffi:uncompress zlib-error - ] bi *ulong head ; + ] bi ulong deref head ; diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor index ae061cb4eb..4d9f4e8d9f 100644 --- a/basis/core-foundation/numbers/numbers.factor +++ b/basis/core-foundation/numbers/numbers.factor @@ -30,14 +30,14 @@ FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType th GENERIC: ( number -- alien ) M: integer - [ f kCFNumberLongLongType ] dip CFNumberCreate ; + [ f kCFNumberLongLongType ] dip longlong CFNumberCreate ; M: float - [ f kCFNumberDoubleType ] dip CFNumberCreate ; + [ f kCFNumberDoubleType ] dip double CFNumberCreate ; M: t - drop f kCFNumberIntType 1 CFNumberCreate ; + drop f kCFNumberIntType 1 int CFNumberCreate ; M: f - drop f kCFNumberIntType 0 CFNumberCreate ; + drop f kCFNumberIntType 0 int CFNumberCreate ; diff --git a/basis/cpu/x86/sse/sse.factor b/basis/cpu/x86/sse/sse.factor index afcc877953..b9541d6fa9 100644 --- a/basis/cpu/x86/sse/sse.factor +++ b/basis/cpu/x86/sse/sse.factor @@ -5,11 +5,12 @@ macros math math.vectors namespaces quotations sequences system compiler.cfg.comparisons compiler.cfg.intrinsics compiler.codegen.fixup cpu.architecture cpu.x86 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features ; +QUALIFIED-WITH: alien.c-types c IN: cpu.x86.sse ! Scalar floating point with SSE2 -M: x86 %load-float float-rep %load-vector ; -M: x86 %load-double double-rep %load-vector ; +M: x86 %load-float c:float float-rep %load-vector ; +M: x86 %load-double c:double double-rep %load-vector ; M: float-rep copy-register* drop MOVAPS ; M: double-rep copy-register* drop MOVAPS ; diff --git a/basis/cpu/x86/x87/x87.factor b/basis/cpu/x86/x87/x87.factor index 445b913bc9..0751877ca7 100644 --- a/basis/cpu/x86/x87/x87.factor +++ b/basis/cpu/x86/x87/x87.factor @@ -38,12 +38,12 @@ M: double-rep copy-memory* copy-memory-x87 ; M: x86 %load-float 0 [] FLDS - rc-absolute rel-binary-literal + float rc-absolute rel-binary-literal shuffle-down FSTP ; M: x86 %load-double 0 [] FLDL - rc-absolute rel-binary-literal + double rc-absolute rel-binary-literal shuffle-down FSTP ; :: binary-op ( dst src1 src2 quot -- ) diff --git a/basis/endian/endian.factor b/basis/endian/endian.factor index 4928458543..502b130265 100644 --- a/basis/endian/endian.factor +++ b/basis/endian/endian.factor @@ -7,7 +7,7 @@ IN: endian SINGLETONS: big-endian little-endian ; : compute-native-endianness ( -- class ) - 1 *char 0 = big-endian little-endian ? ; + 1 int char deref 0 = big-endian little-endian ? ; SYMBOL: native-endianness native-endianness [ compute-native-endianness ] initialize diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor index ec41e919d8..abfa15b5ed 100644 --- a/basis/environment/unix/unix.factor +++ b/basis/environment/unix/unix.factor @@ -17,7 +17,7 @@ M: unix set-os-env ( value key -- ) swap 1 setenv io-error ; M: unix unset-os-env ( key -- ) unsetenv io-error ; M: unix (os-envs) ( -- seq ) - environ *void* utf8 alien>strings ; + environ void* deref utf8 alien>strings ; : set-void* ( value alien -- ) 0 set-alien-cell ; diff --git a/basis/furnace/auth/auth.factor b/basis/furnace/auth/auth.factor index 2acb09919d..7cd2a890ee 100644 --- a/basis/furnace/auth/auth.factor +++ b/basis/furnace/auth/auth.factor @@ -1,9 +1,9 @@ -! Copyright (c) 2008 Slava Pestov +! Copyright (c) 2008, 2010 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs namespaces kernel sequences sets -destructors combinators fry logging -io.encodings.utf8 io.encodings.string io.binary random -checksums checksums.sha urls +destructors combinators fry logging io.encodings.utf8 +io.encodings.string io.binary io.sockets.secure random checksums +checksums.sha urls html.forms http.server http.server.filters @@ -79,7 +79,7 @@ GENERIC: logged-in-username ( realm -- username ) swap >>default users-in-db >>users sha-256 >>checksum - t >>secure ; inline + ssl-supported? >>secure ; inline : users ( -- provider ) realm get users>> ; diff --git a/basis/furnace/redirection/redirection.factor b/basis/furnace/redirection/redirection.factor index ff81d73f7f..29bb505142 100644 --- a/basis/furnace/redirection/redirection.factor +++ b/basis/furnace/redirection/redirection.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors combinators namespaces fry urls urls.secure -http http.server http.server.redirection http.server.responses +USING: kernel accessors combinators namespaces fry urls http +http.server http.server.redirection http.server.responses http.server.remapping http.server.filters furnace.utilities ; IN: furnace.redirection diff --git a/basis/game/input/dinput/dinput.factor b/basis/game/input/dinput/dinput.factor index f5b3520b12..2cd16bac1f 100755 --- a/basis/game/input/dinput/dinput.factor +++ b/basis/game/input/dinput/dinput.factor @@ -23,15 +23,15 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+ : create-dinput ( -- ) f GetModuleHandle DIRECTINPUT_VERSION IDirectInput8W-iid - f [ f DirectInput8Create ole32-error ] keep *void* + f void* [ f DirectInput8Create ole32-error ] keep void* deref +dinput+ set-global ; : delete-dinput ( -- ) +dinput+ [ com-release f ] change-global ; : device-for-guid ( guid -- device ) - +dinput+ get-global swap f - [ f IDirectInput8W::CreateDevice ole32-error ] keep *void* ; + +dinput+ get-global swap f void* + [ f IDirectInput8W::CreateDevice ole32-error ] keep void* deref ; : set-coop-level ( device -- ) +device-change-window+ get-global DISCL_BACKGROUND DISCL_NONEXCLUSIVE bitor @@ -303,8 +303,8 @@ CONSTANT: pov-values } 2cleave ; : read-device-buffer ( device buffer count -- buffer count' ) - [ DIDEVICEOBJECTDATA heap-size ] 2dip - [ 0 IDirectInputDevice8W::GetDeviceData ole32-error ] 2keep *uint ; + [ DIDEVICEOBJECTDATA heap-size ] 2dip uint + [ 0 IDirectInputDevice8W::GetDeviceData ole32-error ] 2keep uint deref ; : (fill-mouse-state) ( state DIDEVICEOBJECTDATA -- state ) [ dwData>> 32 >signed ] [ dwOfs>> ] bi { diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index 04077fc2f7..757f07483c 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -129,7 +129,7 @@ ARTICLE: "http.client.errors" "HTTP client errors" ARTICLE: "http.client" "HTTP client" "The " { $vocab-link "http.client" } " vocabulary implements an HTTP and HTTPS client on top of " { $link "http" } "." $nl -"For HTTPS support, you must load the " { $vocab-link "urls.secure" } " vocab first. If you don't need HTTPS support, don't load " { $vocab-link "urls.secure" } "; this will reduce the size of images generated by " { $vocab-link "tools.deploy" } "." +"For HTTPS support, you must load the " { $vocab-link "io.sockets.secure" } " vocab first. If you don't need HTTPS support, don't load " { $vocab-link "io.sockets.secure" } "; this will reduce the size of images generated by " { $vocab-link "tools.deploy" } "." $nl "There are two primary usage patterns, data retrieval with GET requests and form submission with POST requests:" { $subsections diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index fd9fed0472..e84f1a8825 100755 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -146,7 +146,7 @@ M: stdin dispose* : wait-for-stdin ( stdin -- size ) [ control>> CHAR: X over io:stream-write1 io:stream-flush ] - [ size>> ssize_t heap-size swap io:stream-read *int ] + [ size>> ssize_t heap-size swap io:stream-read int deref ] bi ; :: refill-stdin ( buffer stdin size -- ) @@ -167,11 +167,11 @@ M: stdin refill M: stdin cancel-operation [ size>> ] [ control>> ] bi [ cancel-operation ] bi@ ; -: control-write-fd ( -- fd ) &: control_write *uint ; +: control-write-fd ( -- fd ) &: control_write uint deref ; -: size-read-fd ( -- fd ) &: size_read *uint ; +: size-read-fd ( -- fd ) &: size_read uint deref ; -: data-read-fd ( -- fd ) &: stdin_read *uint ; +: data-read-fd ( -- fd ) &: stdin_read uint deref ; : ( -- stdin ) stdin new-disposable diff --git a/basis/io/directories/unix/linux/linux.factor b/basis/io/directories/unix/linux/linux.factor index 3d69c5f890..a4d96c5b70 100644 --- a/basis/io/directories/unix/linux/linux.factor +++ b/basis/io/directories/unix/linux/linux.factor @@ -6,6 +6,6 @@ IN: io.directories.unix.linux M: linux find-next-file ( DIR* -- dirent ) dirent - f + f void* [ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep - *void* [ drop f ] unless ; + void* deref [ drop f ] unless ; diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor index 0cc8aaa0e4..a175599e01 100644 --- a/basis/io/directories/unix/unix.factor +++ b/basis/io/directories/unix/unix.factor @@ -37,9 +37,9 @@ HOOK: find-next-file os ( DIR* -- byte-array ) M: unix find-next-file ( DIR* -- byte-array ) dirent - f + f void* [ readdir_r 0 = [ (io-error) ] unless ] 2keep - *void* [ drop f ] unless ; + void* deref [ drop f ] unless ; : dirent-type>file-type ( ch -- type ) { diff --git a/basis/io/files/info/unix/macosx/macosx.factor b/basis/io/files/info/unix/macosx/macosx.factor index ac5f8c23b1..445f164564 100644 --- a/basis/io/files/info/unix/macosx/macosx.factor +++ b/basis/io/files/info/unix/macosx/macosx.factor @@ -13,8 +13,8 @@ TUPLE: macosx-file-system-info < unix-file-system-info io-size owner type-id filesystem-subtype ; M: macosx file-systems ( -- array ) - f dup 0 getmntinfo64 dup io-error - [ *void* ] dip + f void* dup 0 getmntinfo64 dup io-error + [ void* deref ] dip [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ; M: macosx new-file-system-info macosx-file-system-info new ; diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 024b278b4b..70fe03b290 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -131,7 +131,7 @@ M: winnt init-io ( -- ) ERROR: invalid-file-size n ; : handle>file-size ( handle -- n ) - 0 [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ; + 0 ulonglong [ GetFileSizeEx win32-error=0/f ] keep ulonglong deref ; ERROR: seek-before-start n ; @@ -249,7 +249,7 @@ M: winnt init-stdio GetLastError ERROR_ALREADY_EXISTS = not ; : set-file-pointer ( handle length method -- ) - [ [ handle>> ] dip d>w/w ] dip SetFilePointer + [ [ handle>> ] dip d>w/w uint ] dip SetFilePointer INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ; M: windows (file-reader) ( path -- stream ) @@ -350,4 +350,4 @@ M: winnt home [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ] [ "USERPROFILE" os-env ] [ my-documents ] - } 0|| ; \ No newline at end of file + } 0|| ; diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index 0b58df2e43..4a84064c33 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -180,12 +180,12 @@ M: windows wait-for-processes ( -- ? ) GetCurrentProcess ! source process swap handle>> ! handle GetCurrentProcess ! target process - f [ ! target handle + f void* [ ! target handle DUPLICATE_SAME_ACCESS ! desired access TRUE ! inherit handle 0 ! options DuplicateHandle win32-error=0/f - ] keep *void* &dispose ; + ] keep void* deref &dispose ; ! /dev/null simulation : null-input ( -- pipe ) diff --git a/basis/io/monitors/windows/windows.factor b/basis/io/monitors/windows/windows.factor index 8887d718d1..43b3ac7ef4 100644 --- a/basis/io/monitors/windows/windows.factor +++ b/basis/io/monitors/windows/windows.factor @@ -32,7 +32,7 @@ TUPLE: win32-monitor < monitor port ; [ recursive>> 1 0 ? ] } cleave FILE_NOTIFY_CHANGE_ALL - 0 + 0 uint (make-overlapped) [ f ReadDirectoryChangesW win32-error=0/f ] keep ; diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor index fbbea7c4c3..92403a58cb 100644 --- a/basis/io/sockets/secure/secure.factor +++ b/basis/io/sockets/secure/secure.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces continuations destructors io debugger io.sockets io.sockets.private sequences summary @@ -11,6 +11,10 @@ SYMBOL: secure-socket-timeout SYMBOL: secure-socket-backend +HOOK: ssl-supported? secure-socket-backend ( -- ? ) + +M: object ssl-supported? f ; + SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ; TUPLE: secure-config diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor index 8fe9facc0c..c856ef2bc8 100644 --- a/basis/io/sockets/secure/unix/unix.factor +++ b/basis/io/sockets/secure/unix/unix.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. +! Copyright (C) 2007, 2010, Slava Pestov, Elie CHAFTARI. ! See http://factorcode.org/license.txt for BSD license. USING: accessors unix byte-arrays kernel sequences namespaces math math.order combinators init alien alien.c-types @@ -11,6 +11,8 @@ unix.ffi ; FROM: io.ports => shutdown ; IN: io.sockets.secure.unix +M: openssl ssl-supported? t ; + M: ssl-handle handle-fd file>> handle-fd ; : syscall-error ( r -- * ) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 2a7391c36b..fcdc00d127 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -106,10 +106,10 @@ M: ipv4 make-sockaddr ( inet -- sockaddr ) swap [ port>> htons >>port ] [ host>> "0.0.0.0" or ] - [ inet-pton *uint >>addr ] tri ; + [ inet-pton uint deref >>addr ] tri ; M: ipv4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec ) - [ addr>> ] dip inet-ntop ; + [ addr>> uint ] dip inet-ntop ; TUPLE: inet4 < ipv4 { port integer read-only } ; @@ -368,8 +368,8 @@ M: inet present C: inet M: string resolve-host - f prepare-addrinfo f - [ getaddrinfo addrinfo-error ] keep *void* addrinfo memory>struct + f prepare-addrinfo f void* + [ getaddrinfo addrinfo-error ] keep void* deref addrinfo memory>struct [ parse-addrinfo-list ] keep freeaddrinfo ; M: string with-port ; diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index 4d6c699211..3f91c0e8b6 100644 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -16,7 +16,7 @@ IN: io.sockets.unix socket dup io-error init-fd |dispose ; : set-socket-option ( fd level opt -- ) - [ handle-fd ] 2dip 1 dup byte-length setsockopt io-error ; + [ handle-fd ] 2dip 1 int dup byte-length setsockopt io-error ; M: unix addrinfo-error ( n -- ) [ gai_strerror throw ] unless-zero ; @@ -39,11 +39,11 @@ M: unix addrspec-of-family ( af -- addrspec ) ! Client sockets - TCP and Unix domain M: object (get-local-address) ( handle remote -- sockaddr ) - [ handle-fd ] dip empty-sockaddr/size + [ handle-fd ] dip empty-sockaddr/size int [ getsockname io-error ] 2keep drop ; M: object (get-remote-address) ( handle local -- sockaddr ) - [ handle-fd ] dip empty-sockaddr/size + [ handle-fd ] dip empty-sockaddr/size int [ getpeername io-error ] 2keep drop ; : init-client-socket ( fd -- ) @@ -101,7 +101,7 @@ M: object (server) ( addrspec -- handle ) ] with-destructors ; : do-accept ( server addrspec -- fd sockaddr ) - [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* + [ handle>> handle-fd ] [ empty-sockaddr/size int ] bi* [ accept ] 2keep drop ; inline M: object (accept) ( server addrspec -- fd sockaddr ) @@ -138,7 +138,7 @@ CONSTANT: packet-size 65536 packet-size ! nbytes 0 ! flags sockaddr ! from - len ! fromlen + len int ! fromlen recvfrom dup 0 >= [ receive-buffer get-global swap memory>byte-array sockaddr ] [ drop f f ] diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index 157aa5c848..ec00626b51 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -48,11 +48,11 @@ M: win32-socket dispose* ( stream -- ) opened-socket ; M: object (get-local-address) ( socket addrspec -- sockaddr ) - [ handle>> ] dip empty-sockaddr/size + [ handle>> ] dip empty-sockaddr/size int [ getsockname socket-error ] 2keep drop ; M: object (get-remote-address) ( socket addrspec -- sockaddr ) - [ handle>> ] dip empty-sockaddr/size + [ handle>> ] dip empty-sockaddr/size int [ getpeername socket-error ] 2keep drop ; : bind-socket ( win32-socket sockaddr len -- ) @@ -87,7 +87,7 @@ M: windows (raw) ( addrspec -- handle ) [ SOCK_RAW server-socket ] with-destructors ; : malloc-int ( n -- alien ) - malloc-byte-array ; inline + int malloc-byte-array ; inline M: winnt WSASocket-flags ( -- DWORD ) WSA_FLAG_OVERLAPPED ; @@ -181,7 +181,8 @@ TUPLE: AcceptEx-args port } cleave AcceptEx drop winsock-error ; inline : (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr ) - f 0 f [ 0 GetAcceptExSockaddrs ] keep *void* ; + f void* 0 int f void* + [ 0 int GetAcceptExSockaddrs ] keep void* deref ; : extract-remote-address ( AcceptEx -- sockaddr ) [ @@ -246,7 +247,7 @@ TUPLE: WSARecvFrom-args port [ [ port>> addr>> empty-sockaddr dup ] [ lpFrom>> ] - [ lpFromLen>> *int ] + [ lpFromLen>> int deref ] tri memcpy ] bi ; inline @@ -278,7 +279,7 @@ TUPLE: WSASendTo-args port swap make-send-buffer >>lpBuffers 1 >>dwBufferCount 0 >>dwFlags - 0 >>lpNumberOfBytesSent + 0 uint >>lpNumberOfBytesSent (make-overlapped) >>lpOverlapped ; inline : call-WSASendTo ( WSASendTo -- ) diff --git a/basis/iokit/iokit.factor b/basis/iokit/iokit.factor index 4dc4932222..c9de6f8035 100644 --- a/basis/iokit/iokit.factor +++ b/basis/iokit/iokit.factor @@ -156,9 +156,9 @@ TUPLE: mach-error error-code error-string ; io-objects-from-iterator* [ release-io-object ] dip ; : properties-from-io-object ( o -- o nsdictionary ) - dup f [ + dup f void* [ kCFAllocatorDefault kNilOptions IORegistryEntryCreateCFProperties mach-error ] - keep *void* ; + keep void* deref ; diff --git a/basis/math/floats/half/half.factor b/basis/math/floats/half/half.factor index ffa3550452..d82e3b1fdd 100644 --- a/basis/math/floats/half/half.factor +++ b/basis/math/floats/half/half.factor @@ -41,6 +41,6 @@ SYMBOL: half 2 >>align 2 >>align-first [ >float ] >>unboxer-quot -\ half define-primitive-type +\ half typedef >> diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index fda840b281..0589e0eede 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -142,7 +142,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) [ 1 { uint } ] dip with-out-parameters ; inline : (delete-gl-object) ( id quot -- ) - [ 1 swap ] dip call ; inline + [ 1 swap uint ] dip call ; inline : gen-gl-buffer ( -- id ) [ glGenBuffers ] (gen-gl-object) ; diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 720665a1b8..30df656d4a 100644 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -8,7 +8,7 @@ SPECIALIZED-ARRAY: uint IN: opengl.shaders : with-gl-shader-source-ptr ( string quot -- ) - swap ascii malloc-string [ swap call ] keep free ; inline + swap ascii malloc-string [ void* swap call ] keep free ; inline : ( source kind -- shader ) glCreateShader dup rot @@ -47,7 +47,7 @@ IN: opengl.shaders : gl-shader-info-log ( shader -- log ) dup gl-shader-info-log-length dup [ 1 calloc &free - [ 0 swap glGetShaderInfoLog ] keep + [ 0 int swap glGetShaderInfoLog ] keep ascii alien>string ] with-destructors ; @@ -90,7 +90,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; : gl-program-info-log ( program -- log ) dup gl-program-info-log-length dup [ 1 calloc &free - [ 0 swap glGetProgramInfoLog ] keep + [ 0 int swap glGetProgramInfoLog ] keep ascii alien>string ] with-destructors ; @@ -107,7 +107,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; : gl-program-shaders ( program -- shaders ) dup gl-program-shaders-length 2 * - 0 + 0 int over [ glGetAttachedShaders ] keep [ zero? not ] filter ; diff --git a/basis/random/random.factor b/basis/random/random.factor index ba5d9c7ca3..ae7c0ad1e3 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -90,8 +90,8 @@ ERROR: too-many-samples seq n ; secure-random-generator get swap with-random ; inline : uniform-random-float ( min max -- n ) - 4 random-bytes underlying>> *uint >float - 4 random-bytes underlying>> *uint >float + 4 random-bytes underlying>> uint deref >float + 4 random-bytes underlying>> uint deref >float 2.0 32 ^ * + [ over - 2.0 -64 ^ * ] dip * + ; inline diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index b476a47072..722dff6d91 100644 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -94,7 +94,7 @@ $nl "" "FUNCTION: void get_device_info ( int* length ) ;" "" - "0 [ get_device_info ] keep ." + "0 int [ get_device_info ] keep ." } "For a full discussion of Factor heap allocation versus unmanaged memory allocation, see " { $link "byte-arrays-gc" } "." $nl diff --git a/basis/system-info/macosx/macosx.factor b/basis/system-info/macosx/macosx.factor index b51fd52995..11a89fc4bd 100644 --- a/basis/system-info/macosx/macosx.factor +++ b/basis/system-info/macosx/macosx.factor @@ -11,23 +11,23 @@ LIBRARY: libc FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, void* newp, size_t newlen ) ; : make-int-array ( seq -- byte-array ) - [ ] map concat ; + [ int ] map concat ; : (sysctl-query) ( name namelen oldp oldlenp -- oldp ) over [ f 0 sysctl io-error ] dip ; : sysctl-query ( seq n -- byte-array ) [ [ make-int-array ] [ length ] bi ] dip - [ ] [ ] bi (sysctl-query) ; + [ ] [ uint ] bi (sysctl-query) ; : sysctl-query-string ( seq -- n ) 4096 sysctl-query utf8 alien>string ; : sysctl-query-uint ( seq -- n ) - 4 sysctl-query *uint ; + 4 sysctl-query uint deref ; : sysctl-query-ulonglong ( seq -- n ) - 8 sysctl-query *ulonglong ; + 8 sysctl-query ulonglong deref ; : machine ( -- str ) { 6 1 } sysctl-query-string ; : model ( -- str ) { 6 2 } sysctl-query-string ; diff --git a/basis/system-info/windows/windows.factor b/basis/system-info/windows/windows.factor index 0aba5eeff1..5ea68dbbad 100644 --- a/basis/system-info/windows/windows.factor +++ b/basis/system-info/windows/windows.factor @@ -95,10 +95,10 @@ M: winnt available-virtual-mem ( -- n ) : computer-name ( -- string ) MAX_COMPUTERNAME_LENGTH 1 + - [ dup ] keep + [ dup ] keep uint GetComputerName win32-error=0/f alien>native-string ; : username ( -- string ) UNLEN 1 + - [ dup ] keep + [ dup ] keep uint GetUserName win32-error=0/f alien>native-string ; diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 48647df92d..1e7777d9d7 100644 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -128,7 +128,7 @@ CONSTANT: window-control>styleMask : make-context-transparent ( view -- ) -> openGLContext - 0 NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ; + 0 int NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ; M:: cocoa-ui-backend (open-window) ( world -- ) world [ [ dim>> ] dip ] diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index e98c31b295..7837402701 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -332,7 +332,7 @@ CLASS: FactorView < NSOpenGLView NSTextInput ] : sync-refresh-to-screen ( GLView -- ) - -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 + -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int CGLSetParameter drop ; : ( dim pixel-format -- view ) diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 5178dbb499..68a0a756a9 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -16,6 +16,7 @@ ui.pixel-formats.private memoize classes colors specialized-arrays classes.struct alien.data ; FROM: namespaces => set ; SPECIALIZED-ARRAY: POINT +QUALIFIED-WITH: alien.c-types c IN: ui.backend.windows SINGLETON: windows-ui-backend @@ -66,7 +67,7 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: WGL_ARB { $ WGL_SUPPORT_OPENGL_ARB 1 } H{ >WGL_ARB [ drop f ] [ [ [ world>> handle>> hDC>> ] [ handle>> ] bi 0 1 ] dip - first { int } + first int { int } [ wglGetPixelFormatAttribivARB win32-error=0/f ] with-out-parameters ] if-empty ; @@ -168,7 +169,7 @@ M: windows-ui-backend (pixel-format-attribute) PRIVATE> -: lo-word ( wparam -- lo ) *short ; inline +: lo-word ( wparam -- lo ) c:short c:short deref ; inline : hi-word ( wparam -- hi ) -16 shift lo-word ; inline : >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; : GET_APPCOMMAND_LPARAM ( lParam -- appCommand ) diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 5da7c189ae..10564a85a6 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -22,10 +22,10 @@ GENERIC: group-struct ( obj -- group/f ) : (group-struct) ( id -- group-struct id group-struct byte-array length void* ) [ \ unix.ffi:group ] dip over 4096 - [ ] keep f ; + [ ] keep f void* ; : check-group-struct ( group-struct ptr -- group-struct/f ) - *void* [ drop f ] unless ; + void* deref [ drop f ] unless ; M: integer group-struct ( id -- group/f ) (group-struct) @@ -67,13 +67,13 @@ ERROR: no-group string ; groups ( byte-array n -- groups ) - [ 4 grouping:group ] dip head-slice [ *uint group-name ] map ; + [ 4 grouping:group ] dip head-slice [ uint deref group-name ] map ; : (user-groups) ( string -- seq ) #! first group is -1337, legacy unix code -1337 unix.ffi:NGROUPS_MAX [ 4 * ] keep - [ [ unix.ffi:getgrouplist ] unix-system-call drop ] 2keep - [ 4 tail-slice ] [ *int 1 - ] bi* >groups ; + int [ [ unix.ffi:getgrouplist ] unix-system-call drop ] 2keep + [ 4 tail-slice ] [ int deref 1 - ] bi* >groups ; PRIVATE> diff --git a/basis/unix/types/freebsd/freebsd.factor b/basis/unix/types/freebsd/freebsd.factor index 4973df989d..41cf7ac188 100644 --- a/basis/unix/types/freebsd/freebsd.factor +++ b/basis/unix/types/freebsd/freebsd.factor @@ -22,5 +22,3 @@ TYPEDEF: __uint32_t fflags_t TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: long time_t - -ALIAS: diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor index a3dddfc93e..54307365be 100644 --- a/basis/unix/types/linux/linux.factor +++ b/basis/unix/types/linux/linux.factor @@ -32,4 +32,4 @@ TYPEDEF: ulonglong __fsfilcnt64_t TYPEDEF: ulonglong ino64_t TYPEDEF: ulonglong off64_t -ALIAS: \ No newline at end of file +: ( n -- long ) long ; diff --git a/basis/unix/types/macosx/macosx.factor b/basis/unix/types/macosx/macosx.factor index 2bebc981f9..fc435cd9fb 100644 --- a/basis/unix/types/macosx/macosx.factor +++ b/basis/unix/types/macosx/macosx.factor @@ -33,7 +33,3 @@ TYPEDEF: char[512] io_string_t TYPEDEF: kern_return_t IOReturn TYPEDEF: uint IOOptionBits - - - -ALIAS: diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor index 7dacc97061..58fd5d400b 100644 --- a/basis/unix/types/netbsd/netbsd.factor +++ b/basis/unix/types/netbsd/netbsd.factor @@ -17,8 +17,6 @@ TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t -ALIAS: - cell-bits { { 32 [ "unix.types.netbsd.32" require ] } { 64 [ "unix.types.netbsd.64" require ] } diff --git a/basis/unix/types/openbsd/openbsd.factor b/basis/unix/types/openbsd/openbsd.factor index 7c8fbd2b9d..30bc539207 100644 --- a/basis/unix/types/openbsd/openbsd.factor +++ b/basis/unix/types/openbsd/openbsd.factor @@ -17,5 +17,3 @@ TYPEDEF: __uint32_t fflags_t TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t - -ALIAS: \ No newline at end of file diff --git a/basis/unix/utilities/utilities.factor b/basis/unix/utilities/utilities.factor index 919b2ae8a2..cd32c91d3c 100644 --- a/basis/unix/utilities/utilities.factor +++ b/basis/unix/utilities/utilities.factor @@ -8,14 +8,14 @@ IN: unix.utilities SPECIALIZED-ARRAY: void* : more? ( alien -- ? ) - { [ ] [ *void* ] } 1&& ; + { [ ] [ void* deref ] } 1&& ; : advance ( void* -- void* ) cell swap ; : alien>strings ( alien encoding -- strings ) [ [ dup more? ] ] dip - '[ [ advance ] [ *void* _ alien>string ] bi ] + '[ [ advance ] [ void* deref _ alien>string ] bi ] produce nip ; : strings>alien ( strings encoding -- array ) diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 7b2d2a4975..19aea0fdac 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -187,3 +187,4 @@ SYNTAX: URL" lexer get skip-blank parse-string >url suffix! ; USE: vocabs.loader { "urls" "prettyprint" } "urls.prettyprint" require-when +{ "urls" "io.sockets.secure" } "urls.secure" require-when diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor index fdc48adfbe..3f0dddab29 100644 --- a/basis/windows/com/com-tests.factor +++ b/basis/windows/com/com-tests.factor @@ -58,7 +58,7 @@ C: test-implementation dup +guinea-pig-implementation+ set [ drop S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test - E_FAIL *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test + E_FAIL long long deref 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test 20 1array [ +guinea-pig-implementation+ get [ 20 IInherited::setX ] diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index dc6a0604fb..f6380cbf51 100644 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -11,7 +11,7 @@ IN: windows.com.syntax MACRO: com-invoke ( n return parameters -- ) [ 2nip length ] 3keep '[ - _ npick *void* _ cell * alien-cell _ _ + _ npick void* deref _ cell * alien-cell _ _ stdcall alien-indirect ] ; diff --git a/basis/windows/iphlpapi/iphlpapi.factor b/basis/windows/iphlpapi/iphlpapi.factor index cb00dde66b..b6b69d10b4 100644 --- a/basis/windows/iphlpapi/iphlpapi.factor +++ b/basis/windows/iphlpapi/iphlpapi.factor @@ -63,7 +63,7 @@ TYPEDEF: FIXED_INFO* PFIXED_INFO FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ; : get-fixed-info ( -- FIXED_INFO ) - FIXED_INFO dup byte-length + FIXED_INFO dup byte-length ulong [ GetNetworkParams n>win32-error-check ] 2keep drop ; : dns-server-ips ( -- sequence ) @@ -72,4 +72,4 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ; [ IpAddress>> String>> [ 0 = ] trim-tail utf8 decode , ] [ Next>> ] bi dup ] loop drop - ] { } make ; \ No newline at end of file + ] { } make ; diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index 25c80061b2..50b61dcf89 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -21,7 +21,7 @@ CONSTANT: registry-value-max-length 16384 [ key subkey mode ] dip n>win32-error-string open-key-failed ] if - ] keep *uint ; + ] keep uint deref ; :: create-key* ( hKey lpSubKey lpClass dwOptions samDesired lpSecurityAttributes -- hkey new? ) hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes @@ -29,8 +29,8 @@ CONSTANT: registry-value-max-length 16384 DWORD f :> ret! [ RegCreateKeyEx ret! ] 2keep - [ *uint ] - [ *uint REG_CREATED_NEW_KEY = ] bi* + [ uint deref ] + [ uint deref REG_CREATED_NEW_KEY = ] bi* ret ERROR_SUCCESS = [ [ hKey lpSubKey 0 lpClass dwOptions samDesired @@ -67,11 +67,11 @@ CONSTANT: registry-value-max-length 16384 length 2 * ; :: reg-query-value-ex ( key subkey ptr1 ptr2 buffer -- buffer ) - buffer length :> pdword + buffer length uint :> pdword key subkey ptr1 ptr2 buffer pdword [ RegQueryValueEx ] 2keep rot :> ret ret ERROR_SUCCESS = [ - *uint head + uint deref head ] [ ret ERROR_MORE_DATA = [ 2drop @@ -116,7 +116,7 @@ TUPLE: registry-enum-key ; key MAX_PATH dup TCHAR dup :> class-buffer - swap dup :> class-buffer-length + swap int dup :> class-buffer-length f DWORD dup :> sub-keys DWORD dup :> longest-subkey @@ -130,13 +130,13 @@ TUPLE: registry-enum-key ; ret ERROR_SUCCESS = [ key class-buffer - sub-keys *uint - longest-subkey *uint - longest-class-string *uint - #values *uint - max-value *uint - max-value-data *uint - security-descriptor *uint + sub-keys uint deref + longest-subkey uint deref + longest-class-string uint deref + #values uint deref + max-value uint deref + max-value-data uint deref + security-descriptor uint deref last-write-time FILETIME>timestamp registry-info boa ] [ @@ -191,4 +191,4 @@ PRIVATE> 21 2^ reg-query-value-ex ; : read-registry ( key subkey -- registry-info ) - KEY_READ [ reg-query-info-key ] with-open-registry-key ; \ No newline at end of file + KEY_READ [ reg-query-info-key ] with-open-registry-key ; diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor index cde6c11efb..4c6593f921 100755 --- a/basis/windows/uniscribe/uniscribe.factor +++ b/basis/windows/uniscribe/uniscribe.factor @@ -42,9 +42,9 @@ TUPLE: script-string < disposable font string metrics ssa size image ; f ! piDx f ! pTabdef f ! pbInClass - f ! pssa + f void* ! pssa [ ScriptStringAnalyse ] keep - [ ole32-error ] [ |ScriptStringFree *void* ] bi* ; + [ ole32-error ] [ |ScriptStringFree void* deref ] bi* ; : set-dc-colors ( dc font -- ) [ background>> color>RGB SetBkColor drop ] @@ -103,7 +103,7 @@ TUPLE: script-string < disposable font string metrics ssa size image ; PRIVATE> M: script-string dispose* - ssa>> ScriptStringFree ole32-error ; + ssa>> void* ScriptStringFree ole32-error ; SYMBOL: cached-script-strings diff --git a/basis/x11/clipboard/clipboard.factor b/basis/x11/clipboard/clipboard.factor index 496b9d688c..49a9f89039 100644 --- a/basis/x11/clipboard/clipboard.factor +++ b/basis/x11/clipboard/clipboard.factor @@ -28,11 +28,11 @@ TUPLE: x-clipboard atom contents ; CurrentTime XConvertSelection drop ; : snarf-property ( prop-return -- string ) - dup *void* [ *void* utf8 alien>string ] [ drop f ] if ; + dup void* deref [ void* deref utf8 alien>string ] [ drop f ] if ; : window-property ( win prop delete? -- string ) [ [ dpy get ] 2dip 0 -1 ] dip AnyPropertyType - 0 0 0 0 f + 0 Atom 0 int 0 ulong 0 ulong f void* [ XGetWindowProperty drop ] keep snarf-property ; : selection-from-event ( event window -- string ) @@ -53,7 +53,7 @@ TUPLE: x-clipboard atom contents ; [ dpy get ] dip [ requestor>> ] [ property>> XA_TIMESTAMP 32 PropModeReplace ] - [ time>> ] tri + [ time>> int ] tri 1 XChangeProperty drop ; : send-notify ( evt prop -- ) diff --git a/basis/x11/windows/windows.factor b/basis/x11/windows/windows.factor index 1becb30f45..cd1ef0217f 100644 --- a/basis/x11/windows/windows.factor +++ b/basis/x11/windows/windows.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math math.bitwise math.vectors -namespaces sequences arrays fry classes.struct literals -x11 x11.xlib x11.constants x11.events -x11.glx ; +USING: accessors alien.c-types kernel math math.bitwise +math.vectors namespaces sequences arrays fry classes.struct +literals x11 x11.xlib x11.constants x11.events x11.glx ; IN: x11.windows CONSTANT: create-window-mask @@ -79,7 +78,7 @@ CONSTANT: event-mask dpy get swap XDestroyWindow drop ; : set-closable ( win -- ) - dpy get swap XA_WM_DELETE_WINDOW 1 + dpy get swap XA_WM_DELETE_WINDOW Atom 1 XSetWMProtocols drop ; : map-window ( win -- ) dpy get swap XMapWindow drop ; diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor index 06add388b1..acae3cf891 100644 --- a/basis/x11/xim/xim.factor +++ b/basis/x11/xim/xim.factor @@ -42,7 +42,7 @@ SYMBOL: keysym : prepare-lookup ( -- ) buf-size keybuf set - 0 keysym set ; + 0 KeySym keysym set ; : finish-lookup ( len -- string keysym ) keybuf get swap 2 * head utf16n decode @@ -51,7 +51,7 @@ SYMBOL: keysym : lookup-string ( event xic -- string keysym ) [ prepare-lookup - swap keybuf get buf-size keysym get 0 + swap keybuf get buf-size keysym get 0 int XwcLookupString finish-lookup ] with-scope ; diff --git a/basis/x11/xinput2/xinput2.factor b/basis/x11/xinput2/xinput2.factor index 80aaf95d63..1a6b0e3cf2 100644 --- a/basis/x11/xinput2/xinput2.factor +++ b/basis/x11/xinput2/xinput2.factor @@ -5,7 +5,7 @@ x11.constants x11.xinput2.ffi ; IN: x11.xinput2 : (xi2-available?) ( display -- ? ) - 2 0 [ ] bi@ + 2 0 [ int ] bi@ XIQueryVersion { { BadRequest [ f ] } diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index e20314bf11..33293746c5 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -48,17 +48,11 @@ TYPEDEF: int Bool TYPEDEF: ulong VisualID TYPEDEF: ulong Time -ALIAS: -ALIAS: -ALIAS: -ALIAS: -ALIAS: - -ALIAS: *XID *ulong +: *XID ( bytes -- n ) ulong deref ; ALIAS: *Window *XID ALIAS: *Drawable *XID ALIAS: *KeySym *XID -ALIAS: *Atom *ulong +: *Atom ( bytes -- n ) ulong deref ; ! ! 2 - Display Functions ! diff --git a/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor b/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor index 403015bad5..522c33bbf1 100644 --- a/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor +++ b/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor @@ -22,9 +22,9 @@ ERROR: invalid-demangle-args name ; "_Z" head? ; :: demangle ( mangled-name -- c++-name ) - 0 :> length - 0 :> status [ + 0 ulong :> length + 0 int :> status [ mangled-name ascii string>alien f length status __cxa_demangle &(free) :> demangled-buf - mangled-name status *int demangle-error + mangled-name status int deref demangle-error demangled-buf ascii alien>string ] with-destructors ; diff --git a/extra/audio/engine/engine.factor b/extra/audio/engine/engine.factor index d7079c4aaa..3fcfbdfa9f 100644 --- a/extra/audio/engine/engine.factor +++ b/extra/audio/engine/engine.factor @@ -122,7 +122,7 @@ ERROR: audio-context-not-available device-name ; :: flush-source ( al-source -- ) al-source alSourceStop - 0 c: :> dummy-buffer + 0 c:uint c: :> dummy-buffer al-source AL_BUFFERS_PROCESSED get-source-param [ al-source 1 dummy-buffer alSourceUnqueueBuffers ] times @@ -161,7 +161,7 @@ ERROR: audio-context-not-available device-name ; audio-clip t >>done? drop ] [ al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData - al-source 1 al-buffer c: alSourceQueueBuffers + al-source 1 al-buffer c:uint c: alSourceQueueBuffers ] if ] unless ; @@ -190,10 +190,10 @@ M: static-audio-clip (update-audio-clip) M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- ) audio-clip al-source>> :> al-source - 0 c: :> buffer + 0 c:uint c: :> buffer al-source AL_BUFFERS_PROCESSED get-source-param [ al-source 1 buffer alSourceUnqueueBuffers - audio-clip buffer c:*uint queue-clip-buffer + audio-clip buffer c:uint c:deref queue-clip-buffer ] times ; : update-audio-clip ( audio-clip -- ) @@ -256,7 +256,7 @@ M: audio-engine dispose* audio-engine get-available-source :> al-source al-source [ - 1 0 c: [ alGenBuffers ] keep c:*uint :> al-buffer + 1 0 c:uint c: [ alGenBuffers ] keep c:uint c:deref :> al-buffer al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave alBufferData @@ -301,7 +301,7 @@ M: audio-clip dispose* M: static-audio-clip dispose* [ call-next-method ] - [ [ 1 ] dip al-buffer>> c: alDeleteBuffers ] bi ; + [ [ 1 ] dip al-buffer>> c:uint c: alDeleteBuffers ] bi ; M: streaming-audio-clip dispose* [ call-next-method ] diff --git a/extra/audio/vorbis/vorbis.factor b/extra/audio/vorbis/vorbis.factor index e67c7b7934..7e69aea7b4 100644 --- a/extra/audio/vorbis/vorbis.factor +++ b/extra/audio/vorbis/vorbis.factor @@ -157,7 +157,7 @@ ERROR: no-vorbis-in-ogg ; [ init-vorbis-codec ] if ; : get-pending-decoded-audio ( vorbis-stream -- pcm len ) - dsp-state>> f [ vorbis_synthesis_pcmout ] keep *void* swap ; + dsp-state>> f void* [ vorbis_synthesis_pcmout ] keep void* deref swap ; : float>short-sample ( float -- short ) -32767.5 * 0.5 - >integer -32768 32767 clamp ; inline diff --git a/extra/benchmark/ui-panes/ui-panes.factor b/extra/benchmark/ui-panes/ui-panes.factor index 9d16f75e15..f50a966218 100644 --- a/extra/benchmark/ui-panes/ui-panes.factor +++ b/extra/benchmark/ui-panes/ui-panes.factor @@ -1,7 +1,7 @@ -USING: ui.gadgets.panes prettyprint io sequences ; +USING: io kernel math.parser sequences ui.gadgets.panes ; IN: benchmark.ui-panes : ui-pane-benchmark ( -- ) - [ 10000 iota [ . ] each ] with-output-stream* ; + [ 10000 iota [ number>string print ] each ] make-pane drop ; MAIN: ui-pane-benchmark diff --git a/extra/cuda/contexts/contexts.factor b/extra/cuda/contexts/contexts.factor index 7a9ab59a6a..714eaab94c 100644 --- a/extra/cuda/contexts/contexts.factor +++ b/extra/cuda/contexts/contexts.factor @@ -10,13 +10,13 @@ IN: cuda.contexts : create-context ( device flags -- context ) swap [ CUcontext ] 2dip - [ cuCtxCreate cuda-error ] 3keep 2drop *void* ; inline + [ cuCtxCreate cuda-error ] 3keep 2drop void* deref ; inline : sync-context ( -- ) cuCtxSynchronize cuda-error ; inline : context-device ( -- n ) - CUdevice [ cuCtxGetDevice cuda-error ] keep *int ; inline + CUdevice [ cuCtxGetDevice cuda-error ] keep int deref ; inline : destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor index 2e2cdd660f..566622eb02 100644 --- a/extra/cuda/cuda.factor +++ b/extra/cuda/cuda.factor @@ -16,7 +16,7 @@ TUPLE: cuda-error code ; dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ; : cuda-version ( -- n ) - c:int [ cuDriverGetVersion cuda-error ] keep c:*int ; + c:int [ cuDriverGetVersion cuda-error ] keep c:int c:deref ; : init-cuda ( -- ) 0 cuInit cuda-error ; inline diff --git a/extra/cuda/devices/devices.factor b/extra/cuda/devices/devices.factor index 4e7a50e6f2..07e066a439 100644 --- a/extra/cuda/devices/devices.factor +++ b/extra/cuda/devices/devices.factor @@ -8,10 +8,11 @@ prettyprint sequences ; IN: cuda.devices : #cuda-devices ( -- n ) - int [ cuDeviceGetCount cuda-error ] keep *int ; + int [ cuDeviceGetCount cuda-error ] keep int deref ; : n>cuda-device ( n -- device ) - [ CUdevice ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ; + [ CUdevice ] dip [ cuDeviceGet cuda-error ] 2keep + drop int deref ; : enumerate-cuda-devices ( -- devices ) #cuda-devices iota [ n>cuda-device ] map ; @@ -34,17 +35,17 @@ IN: cuda.devices : cuda-device-capability ( n -- pair ) [ int int ] dip [ cuDeviceComputeCapability cuda-error ] - [ drop [ *int ] bi@ ] 3bi 2array ; + [ drop [ int deref ] bi@ ] 3bi 2array ; : cuda-device-memory ( n -- bytes ) [ uint ] dip [ cuDeviceTotalMem cuda-error ] - [ drop *uint ] 2bi ; + [ drop uint deref ] 2bi ; : cuda-device-attribute ( attribute n -- n ) [ int ] 2dip [ cuDeviceGetAttribute cuda-error ] - [ 2drop *int ] 3bi ; + [ 2drop int deref ] 3bi ; : cuda-device. ( n -- ) { diff --git a/extra/cuda/gl/gl.factor b/extra/cuda/gl/gl.factor index d4943e1350..78e108ae7a 100644 --- a/extra/cuda/gl/gl.factor +++ b/extra/cuda/gl/gl.factor @@ -7,7 +7,7 @@ IN: cuda.gl : create-gl-cuda-context ( device flags -- context ) swap [ CUcontext ] 2dip - [ cuGLCtxCreate cuda-error ] 3keep 2drop *void* ; inline + [ cuGLCtxCreate cuda-error ] 3keep 2drop void* deref ; inline : with-gl-cuda-context ( device flags quot -- ) [ set-up-cuda-context create-gl-cuda-context ] dip (with-cuda-context) ; inline @@ -15,20 +15,20 @@ IN: cuda.gl : gl-buffer>resource ( gl-buffer flags -- resource ) enum>number [ CUgraphicsResource ] 2dip - [ cuGraphicsGLRegisterBuffer cuda-error ] 3keep 2drop *void* ; inline + [ cuGraphicsGLRegisterBuffer cuda-error ] 3keep 2drop void* deref ; inline : buffer>resource ( buffer flags -- resource ) [ handle>> ] dip gl-buffer>resource ; inline : map-resource ( resource -- device-ptr size ) - [ 1 swap f cuGraphicsMapResources cuda-error ] [ + [ 1 swap void* f cuGraphicsMapResources cuda-error ] [ [ CUdeviceptr uint ] dip [ cuGraphicsResourceGetMappedPointer cuda-error ] 3keep drop - [ *uint ] [ *uint ] bi* + [ uint deref ] [ uint deref ] bi* ] bi ; inline : unmap-resource ( resource -- ) - 1 swap f cuGraphicsUnmapResources cuda-error ; inline + 1 swap void* f cuGraphicsUnmapResources cuda-error ; inline DESTRUCTOR: unmap-resource diff --git a/extra/cuda/libraries/libraries.factor b/extra/cuda/libraries/libraries.factor index e930745a17..bd5d867fbb 100644 --- a/extra/cuda/libraries/libraries.factor +++ b/extra/cuda/libraries/libraries.factor @@ -75,7 +75,7 @@ PRIVATE> : load-module ( path -- module ) [ CUmodule ] dip - [ cuModuleLoad cuda-error ] 2keep drop c:*void* ; + [ cuModuleLoad cuda-error ] 2keep drop c:void* c:deref ; : unload-module ( module -- ) cuModuleUnload cuda-error ; @@ -152,7 +152,7 @@ MACRO: cuda-arguments ( c-types abi -- quot: ( args... function -- ) ) : get-function-ptr ( module string -- function ) [ CUfunction ] 2dip - [ cuModuleGetFunction cuda-error ] 3keep 2drop c:*void* ; + [ cuModuleGetFunction cuda-error ] 3keep 2drop c:void* c:deref ; : cached-module ( module-name -- alien ) lookup-cuda-library @@ -172,7 +172,7 @@ MACRO: cuda-invoke ( module-name function-name arguments -- ) : cuda-global* ( module-name symbol-name -- device-ptr size ) [ CUdeviceptr c:uint ] 2dip [ cached-module ] dip - '[ _ _ cuModuleGetGlobal cuda-error ] 2keep [ c:*uint ] bi@ ; inline + '[ _ _ cuModuleGetGlobal cuda-error ] 2keep [ c:uint c:deref ] bi@ ; inline : cuda-global ( module-name symbol-name -- device-ptr ) cuda-global* drop ; inline diff --git a/extra/cuda/memory/memory.factor b/extra/cuda/memory/memory.factor index f3c452093a..41a1cac7ff 100644 --- a/extra/cuda/memory/memory.factor +++ b/extra/cuda/memory/memory.factor @@ -10,7 +10,7 @@ IN: cuda.memory : cuda-malloc ( n -- ptr ) [ CUdeviceptr ] dip '[ _ cuMemAlloc cuda-error ] keep - c:*int ; inline + c:int c:deref ; inline : cuda-malloc-type ( n type -- ptr ) c:heap-size * cuda-malloc ; inline diff --git a/extra/ecdsa/ecdsa.factor b/extra/ecdsa/ecdsa.factor index 547b7b9ae9..74fdad63ea 100644 --- a/extra/ecdsa/ecdsa.factor +++ b/extra/ecdsa/ecdsa.factor @@ -67,9 +67,9 @@ PRIVATE> :: ecdsa-sign ( DGST -- sig ) ec-key-handle :> KEY KEY ECDSA_size dup ssl-error :> SIG - 0 :> LEN + 0 uint :> LEN 0 DGST dup length SIG LEN KEY ECDSA_sign ssl-error - LEN *uint SIG resize ; + LEN uint deref SIG resize ; : ecdsa-verify ( dgst sig -- ? ) ec-key-handle [ 0 -rot [ dup length ] bi@ ] dip ECDSA_verify 0 > ; diff --git a/extra/gpu/buffers/buffers.factor b/extra/gpu/buffers/buffers.factor index 6172c8ad8c..9ea08a7c83 100644 --- a/extra/gpu/buffers/buffers.factor +++ b/extra/gpu/buffers/buffers.factor @@ -57,7 +57,7 @@ TUPLE: buffer < gpu-object } case ; inline : get-buffer-int ( target enum -- value ) - 0 [ glGetBufferParameteriv ] keep *int ; inline + 0 int [ glGetBufferParameteriv ] keep int deref ; inline : bind-buffer ( buffer -- target ) [ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ; inline diff --git a/extra/gpu/framebuffers/framebuffers.factor b/extra/gpu/framebuffers/framebuffers.factor index 1aa9ae33df..6f469a3c8b 100644 --- a/extra/gpu/framebuffers/framebuffers.factor +++ b/extra/gpu/framebuffers/framebuffers.factor @@ -18,7 +18,8 @@ TUPLE: renderbuffer < gpu-object [ glGetRenderbufferParameteriv ] keep *int ; + GL_RENDERBUFFER swap 0 int + [ glGetRenderbufferParameteriv ] keep int deref ; PRIVATE> diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index d1c137128a..b032004d40 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -199,7 +199,7 @@ TR: hyphens>underscores "-" "_" ; name length 1 + :> name-buffer-length { index name-buffer-length dup - [ f 0 0 ] dip + [ f 0 int 0 int ] dip [ glGetTransformFeedbackVarying ] 3keep ascii alien>string vertex-attribute assert-feedback-attribute diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor index db76774038..31a8678060 100755 --- a/extra/gpu/state/state.factor +++ b/extra/gpu/state/state.factor @@ -416,11 +416,11 @@ M: mask-state set-gpu-state* [ set-gpu-state* ] if ; inline : get-gl-bool ( enum -- value ) - 0 [ glGetBooleanv ] keep *uchar c-bool> ; + 0 uchar [ glGetBooleanv ] keep uchar deref c-bool> ; : get-gl-int ( enum -- value ) - 0 [ glGetIntegerv ] keep *int ; + 0 int [ glGetIntegerv ] keep int deref ; : get-gl-float ( enum -- value ) - 0 [ glGetFloatv ] keep *float ; + 0 c:float [ glGetFloatv ] keep c:float deref ; : get-gl-bools ( enum count -- value ) [ glGetBooleanv ] keep [ c-bool> ] { } map-as ; diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index c67a03cbfc..d9ae88675a 100644 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -171,8 +171,8 @@ ERROR: undefined-find-nth m n seq quot ; [ [ name>> { "form" "input" } member? ] filter ] map ; : find-html-objects ( vector string -- vector' ) - dupd find-opening-tags-by-name - [ first2 find-between* ] curry map ; + over find-opening-tags-by-name + [ first2 find-between* ] with map ; : form-action ( vector -- string ) [ name>> "form" = ] find nip "action" attribute ; diff --git a/extra/javascriptcore/javascriptcore.factor b/extra/javascriptcore/javascriptcore.factor index 738f1749bc..6dff17a433 100644 --- a/extra/javascriptcore/javascriptcore.factor +++ b/extra/javascriptcore/javascriptcore.factor @@ -38,7 +38,7 @@ SYMBOL: js-context : eval-js ( string -- result-string ) [ js-context get dup ] dip JSStringCreateWithUTF8CString f f 0 JSValueRef - [ JSEvaluateScript ] keep *void* + [ JSEvaluateScript ] keep void* deref dup [ nip JSValueRef>string javascriptcore-error ] [ drop JSValueRef>string ] if ; : eval-js-standalone ( string -- result-string ) diff --git a/extra/llvm/jit/jit.factor b/extra/llvm/jit/jit.factor index fc755fd00f..2c4c0a509f 100644 --- a/extra/llvm/jit/jit.factor +++ b/extra/llvm/jit/jit.factor @@ -25,9 +25,9 @@ TUPLE: jit ee mps ; LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ; : remove-provider ( provider -- ) - current-jit ee>> value>> swap value>> f f - [ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when* - *void* module new swap >>value + current-jit ee>> value>> swap value>> f void* f void* + [ LLVMRemoveModuleProvider drop ] 2keep void* deref [ llvm-throw ] when* + void* deref module new swap >>value [ value>> remove-functions ] with-disposal ; : remove-module ( name -- ) @@ -44,5 +44,5 @@ TUPLE: jit ee mps ; : function-pointer ( name -- alien ) current-jit ee>> value>> dup - rot f [ LLVMFindFunction drop ] keep - *void* LLVMGetPointerToGlobal ; \ No newline at end of file + rot f void* [ LLVMFindFunction drop ] keep + void* deref LLVMGetPointerToGlobal ; diff --git a/extra/llvm/reader/reader.factor b/extra/llvm/reader/reader.factor index 8c324b41e4..176e89b994 100644 --- a/extra/llvm/reader/reader.factor +++ b/extra/llvm/reader/reader.factor @@ -7,9 +7,9 @@ IN: llvm.reader : buffer>module ( buffer -- module ) [ - value>> f f + value>> f void* f void* [ LLVMParseBitcode drop ] 2keep - *void* [ llvm-throw ] when* *void* + void* deref [ llvm-throw ] when* void* deref module new swap >>value ] with-disposal ; @@ -17,4 +17,4 @@ IN: llvm.reader buffer>module ; : load-into-jit ( path name -- ) - [ load-module ] dip add-module ; \ No newline at end of file + [ load-module ] dip add-module ; diff --git a/extra/llvm/wrappers/wrappers.factor b/extra/llvm/wrappers/wrappers.factor index 05aafce973..24df1d5a12 100644 --- a/extra/llvm/wrappers/wrappers.factor +++ b/extra/llvm/wrappers/wrappers.factor @@ -33,9 +33,9 @@ M: engine dispose* value>> LLVMDisposeExecutionEngine ; : (engine) ( provider -- engine ) [ - value>> f f + value>> f void* f void* [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep - *void* [ llvm-throw ] when* *void* + void* deref [ llvm-throw ] when* void* deref ] [ t >>disposed drop ] bi engine ; @@ -57,6 +57,6 @@ TUPLE: buffer value disposed ; M: buffer dispose* value>> LLVMDisposeMemoryBuffer ; : ( path -- module ) - f f + f void* f void* [ LLVMCreateMemoryBufferWithContentsOfFile drop ] 2keep - *void* [ llvm-throw ] when* *void* buffer ; \ No newline at end of file + void* deref [ llvm-throw ] when* void* deref buffer ; diff --git a/extra/openal/alut/macosx/macosx.factor b/extra/openal/alut/macosx/macosx.factor index 54439b762c..5380930dd1 100755 --- a/extra/openal/alut/macosx/macosx.factor +++ b/extra/openal/alut/macosx/macosx.factor @@ -9,6 +9,6 @@ LIBRARY: alut FUNCTION: void alutLoadWAVFile ( c-string fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency ) ; M: macosx load-wav-file ( path -- format data size frequency ) - 0 f 0 0 + 0 int f void* 0 int 0 int [ alutLoadWAVFile ] 4 nkeep - [ [ [ *int ] dip *void* ] dip *int ] dip *int ; + [ [ [ int deref ] dip void* deref ] dip int deref ] dip int deref ; diff --git a/extra/openal/alut/other/other.factor b/extra/openal/alut/other/other.factor index 8b1cbd0cb3..42e6172c9f 100755 --- a/extra/openal/alut/other/other.factor +++ b/extra/openal/alut/other/other.factor @@ -9,6 +9,9 @@ LIBRARY: alut FUNCTION: void alutLoadWAVFile ( c-string fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency, ALboolean* looping ) ; M: object load-wav-file ( filename -- format data size frequency ) - 0 f 0 0 - [ 0 alutLoadWAVFile ] 4 nkeep - { [ *int ] [ *void* ] [ *int ] [ *int ] } spread ; + 0 int + f void* + 0 int + 0 int + [ 0 char alutLoadWAVFile ] 4 nkeep + { [ int deref ] [ void* deref ] [ int deref ] [ int deref ] } spread ; diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor index 853b33b386..b1baa46d30 100755 --- a/extra/openal/openal.factor +++ b/extra/openal/openal.factor @@ -264,13 +264,13 @@ DESTRUCTOR: alcDestroyContext alSourcei ; : get-source-param ( source param -- value ) - 0 dup [ alGetSourcei ] dip *uint ; + 0 uint dup [ alGetSourcei ] dip uint deref ; : set-buffer-param ( source param value -- ) alBufferi ; : get-buffer-param ( source param -- value ) - 0 dup [ alGetBufferi ] dip *uint ; + 0 uint dup [ alGetBufferi ] dip uint deref ; : source-play ( source -- ) alSourcePlay ; diff --git a/extra/opencl/ffi/ffi-tests.factor b/extra/opencl/ffi/ffi-tests.factor index 1ec96e4c76..60083a0b0a 100644 --- a/extra/opencl/ffi/ffi-tests.factor +++ b/extra/opencl/ffi/ffi-tests.factor @@ -29,33 +29,33 @@ ERROR: cl-error err ; str-alien str-buffer dup length memcpy str-alien ; :: opencl-square ( in -- out ) - 0 f 0 [ clGetPlatformIDs cl-success ] keep *uint + 0 f 0 uint [ clGetPlatformIDs cl-success ] keep uint deref dup [ f clGetPlatformIDs cl-success ] keep first - CL_DEVICE_TYPE_DEFAULT 1 f [ f clGetDeviceIDs cl-success ] keep *void* :> device-id - f 1 device-id f f 0 [ clCreateContext ] keep *int cl-success :> context - context device-id 0 0 [ clCreateCommandQueue ] keep *int cl-success :> queue + CL_DEVICE_TYPE_DEFAULT 1 f void* [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id + f 1 device-id void* f f 0 int [ clCreateContext ] keep int deref cl-success :> context + context device-id 0 0 int [ clCreateCommandQueue ] keep int deref cl-success :> queue [ - context 1 kernel-source cl-string-array - f 0 [ clCreateProgramWithSource ] keep *int cl-success + context 1 kernel-source cl-string-array void* + f 0 int [ clCreateProgramWithSource ] keep int deref cl-success [ 0 f f f f clBuildProgram cl-success ] - [ "square" cl-string-array 0 [ clCreateKernel ] keep *int cl-success ] + [ "square" cl-string-array 0 int [ clCreateKernel ] keep int deref cl-success ] [ ] tri ] with-destructors :> ( kernel program ) context CL_MEM_READ_ONLY in byte-length f - 0 [ clCreateBuffer ] keep *int cl-success :> input + 0 int [ clCreateBuffer ] keep int deref cl-success :> input context CL_MEM_WRITE_ONLY in byte-length f - 0 [ clCreateBuffer ] keep *int cl-success :> output + 0 int [ clCreateBuffer ] keep int deref cl-success :> output queue input CL_TRUE 0 in byte-length in 0 f f clEnqueueWriteBuffer cl-success - kernel 0 cl_mem heap-size input clSetKernelArg cl-success - kernel 1 cl_mem heap-size output clSetKernelArg cl-success - kernel 2 uint heap-size in length clSetKernelArg cl-success + kernel 0 cl_mem heap-size input void* clSetKernelArg cl-success + kernel 1 cl_mem heap-size output void* clSetKernelArg cl-success + kernel 2 uint heap-size in length uint clSetKernelArg cl-success - queue kernel 1 f in length f + queue kernel 1 f in length ulonglong f 0 f f clEnqueueNDRangeKernel cl-success queue clFinish cl-success diff --git a/extra/opencl/opencl-tests.factor b/extra/opencl/opencl-tests.factor index 6fd7bb581d..628a9b0d63 100644 --- a/extra/opencl/opencl-tests.factor +++ b/extra/opencl/opencl-tests.factor @@ -32,7 +32,7 @@ __kernel void square( cl-read-access num-bytes in &dispose :> in-buffer cl-write-access num-bytes f &dispose :> out-buffer - kernel in-buffer out-buffer num-floats 3array + kernel in-buffer out-buffer num-floats uint 3array { num-floats } [ ] cl-queue-kernel &dispose drop cl-finish diff --git a/extra/opencl/opencl.factor b/extra/opencl/opencl.factor index 17f0143ae1..0fa5db9784 100644 --- a/extra/opencl/opencl.factor +++ b/extra/opencl/opencl.factor @@ -17,7 +17,7 @@ ERROR: cl-error err ; dup f = [ cl-error ] [ drop ] if ; inline : info-data-size ( handle name info-quot -- size_t ) - [ 0 f 0 ] dip [ call cl-success ] 2keep drop *size_t ; inline + [ 0 f 0 ] dip [ call cl-success ] 2keep drop size_t deref ; inline : info-data-bytes ( handle name info-quot size -- bytes ) swap [ dup f ] dip [ call cl-success ] 3keep 2drop ; inline @@ -26,7 +26,7 @@ ERROR: cl-error err ; [ 3dup info-data-size info-data-bytes ] dip call ; inline : 2info-data-size ( handle1 handle2 name info-quot -- size_t ) - [ 0 f 0 ] dip [ call cl-success ] 2keep drop *size_t ; inline + [ 0 f 0 ] dip [ call cl-success ] 2keep drop size_t deref ; inline : 2info-data-bytes ( handle1 handle2 name info-quot size -- bytes ) swap [ dup f ] dip [ call cl-success ] 3keep 2drop ; inline @@ -35,22 +35,22 @@ ERROR: cl-error err ; [ 4dup 2info-data-size 2info-data-bytes ] dip call ; inline : info-bool ( handle name quot -- ? ) - [ *uint CL_TRUE = ] info ; inline + [ uint deref CL_TRUE = ] info ; inline : info-ulong ( handle name quot -- ulong ) - [ *ulonglong ] info ; inline + [ ulonglong deref ] info ; inline : info-int ( handle name quot -- int ) - [ *int ] info ; inline + [ int deref ] info ; inline : info-uint ( handle name quot -- uint ) - [ *uint ] info ; inline + [ uint deref ] info ; inline : info-size_t ( handle name quot -- size_t ) - [ *size_t ] info ; inline + [ size_t deref ] info ; inline : 2info-size_t ( handle1 handle2 name quot -- size_t ) - [ *size_t ] 2info ; inline + [ size_t deref ] 2info ; inline : info-string ( handle name quot -- string ) [ ascii decode 1 head* ] info ; inline @@ -311,7 +311,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; : platform-devices ( platform-id -- devices ) CL_DEVICE_TYPE_ALL [ - 0 f 0 [ clGetDeviceIDs cl-success ] keep *uint + 0 f 0 uint [ clGetDeviceIDs cl-success ] keep uint deref ] [ rot dup [ f clGetDeviceIDs cl-success ] keep ] 2bi ; inline @@ -340,7 +340,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; [ length ] [ strings>char*-array ] [ [ length ] size_t-array{ } map-as ] tri - 0 [ clCreateProgramWithSource ] keep *int cl-success + 0 int [ clCreateProgramWithSource ] keep int deref cl-success ] with-destructors ; :: (build-program) ( program-handle device options -- program ) @@ -403,7 +403,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; [ clGetEventProfilingInfo ] info-ulong ; : bind-kernel-arg-buffer ( kernel index buffer -- ) - [ handle>> ] [ cl_mem heap-size ] [ handle>> ] tri* + [ handle>> ] [ cl_mem heap-size ] [ handle>> void* deref ] tri* clSetKernelArg cl-success ; inline : bind-kernel-arg-data ( kernel index byte-array -- ) @@ -425,7 +425,7 @@ PRIVATE> ] dip bind ; inline : cl-platforms ( -- platforms ) - 0 f 0 [ clGetPlatformIDs cl-success ] keep *uint + 0 f 0 uint [ clGetPlatformIDs cl-success ] keep uint deref dup [ f clGetPlatformIDs cl-success ] keep [ dup @@ -437,14 +437,14 @@ PRIVATE> : ( devices -- cl-context ) [ f ] dip [ length ] [ [ id>> ] void*-array{ } map-as ] bi - f f 0 [ clCreateContext ] keep *int cl-success + f f 0 int [ clCreateContext ] keep int deref cl-success cl-context new-disposable swap >>handle ; : ( context device out-of-order? profiling? -- command-queue ) [ [ handle>> ] [ id>> ] bi* ] 2dip [ [ CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE ] [ 0 ] if ] [ [ CL_QUEUE_PROFILING_ENABLE ] [ 0 ] if ] bi* bitor - 0 [ clCreateCommandQueue ] keep *int cl-success + 0 int [ clCreateCommandQueue ] keep int deref cl-success cl-queue new-disposable swap >>handle ; : cl-out-of-order-execution? ( command-queue -- ? ) @@ -462,7 +462,7 @@ PRIVATE> [ buffer-access-constant ] [ [ CL_MEM_COPY_HOST_PTR ] [ CL_MEM_ALLOC_HOST_PTR ] if ] tri* bitor ] 2dip - 0 [ clCreateBuffer ] keep *int cl-success + 0 int [ clCreateBuffer ] keep int deref cl-success cl-buffer new-disposable swap >>handle ; : cl-read-buffer ( buffer-range -- byte-array ) @@ -488,7 +488,7 @@ PRIVATE> [ [ buffer>> handle>> ] [ offset>> ] bi ] tri* swapd ] 2dip [ length ] keep [ f ] [ [ handle>> ] void*-array{ } map-as ] if-empty - f [ clEnqueueCopyBuffer cl-success ] keep *void* cl-event + f void* [ clEnqueueCopyBuffer cl-success ] keep void* deref cl-event new-disposable swap >>handle ; : cl-queue-read-buffer ( buffer-range alien dependent-events -- event ) @@ -496,7 +496,7 @@ PRIVATE> [ (current-cl-queue) handle>> ] dip [ buffer>> handle>> CL_FALSE ] [ offset>> ] [ size>> ] tri ] 2dip [ length ] keep [ f ] [ [ handle>> ] void*-array{ } map-as ] if-empty - f [ clEnqueueReadBuffer cl-success ] keep *void* cl-event + f void* [ clEnqueueReadBuffer cl-success ] keep void* cl-event new-disposable swap >>handle ; : cl-queue-write-buffer ( buffer-range alien dependent-events -- event ) @@ -504,7 +504,7 @@ PRIVATE> [ (current-cl-queue) handle>> ] dip [ buffer>> handle>> CL_FALSE ] [ offset>> ] [ size>> ] tri ] 2dip [ length ] keep [ f ] [ [ handle>> ] void*-array{ } map-as ] if-empty - f [ clEnqueueWriteBuffer cl-success ] keep *void* cl-event + f void* [ clEnqueueWriteBuffer cl-success ] keep void* deref cl-event new-disposable swap >>handle ; : ( normalized-coords? addressing-mode filter-mode -- sampler ) @@ -512,7 +512,7 @@ PRIVATE> [ [ CL_TRUE ] [ CL_FALSE ] if ] [ addressing-mode-constant ] [ filter-mode-constant ] - tri* 0 [ clCreateSampler ] keep *int cl-success + tri* 0 int [ clCreateSampler ] keep int deref cl-success cl-sampler new-disposable swap >>handle ; : cl-normalized-coords? ( sampler -- ? ) @@ -531,7 +531,7 @@ PRIVATE> : ( program kernel-name -- kernel ) [ handle>> ] [ ascii encode 0 suffix ] bi* - 0 [ clCreateKernel ] keep *int cl-success + 0 int [ clCreateKernel ] keep int deref cl-success cl-kernel new-disposable swap >>handle ; inline : cl-kernel-name ( kernel -- string ) @@ -549,7 +549,7 @@ PRIVATE> kernel handle>> sizes [ length f ] [ [ ] size_t-array{ } map-as f ] bi dependent-events [ length ] [ [ f ] [ [ handle>> ] void*-array{ } map-as ] if-empty ] bi - f [ clEnqueueNDRangeKernel cl-success ] keep *void* + f void* [ clEnqueueNDRangeKernel cl-success ] keep void* deref cl-event new-disposable swap >>handle ; : cl-event-type ( event -- command-type ) @@ -573,7 +573,7 @@ PRIVATE> : cl-marker ( -- event ) (current-cl-queue) - f [ clEnqueueMarker cl-success ] keep *void* cl-event new-disposable + f void* [ clEnqueueMarker cl-success ] keep void* deref cl-event new-disposable swap >>handle ; inline : cl-barrier ( -- ) diff --git a/extra/tokyo/assoc-functor/assoc-functor.factor b/extra/tokyo/assoc-functor/assoc-functor.factor index de160f5598..a7e53394bb 100644 --- a/extra/tokyo/assoc-functor/assoc-functor.factor +++ b/extra/tokyo/assoc-functor/assoc-functor.factor @@ -28,14 +28,14 @@ INSTANCE: TYPE assoc M: TYPE dispose* [ DBDEL f ] change-handle drop ; M: TYPE at* ( key db -- value/f ? ) - handle>> swap object>bytes dup length 0 + handle>> swap object>bytes dup length 0 int DBGET [ [ memory>object ] [ tcfree ] bi t ] [ f f ] if* ; M: TYPE assoc-size ( db -- size ) handle>> DBRNUM ; : DBKEYS ( db -- keys ) [ assoc-size ] [ handle>> ] bi - dup DBITERINIT drop 0 + dup DBITERINIT drop 0 int [ 2dup DBITERNEXT dup ] [ [ memory>object ] [ tcfree ] bi [ pick ] dip swap push diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor index 9236cc9504..81a676ec24 100644 --- a/extra/twitter/twitter.factor +++ b/extra/twitter/twitter.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators hashtables http http.client json.reader kernel macros namespaces sequences -urls.secure fry oauth urls system ; +io.sockets.secure fry oauth urls ; IN: twitter ! Configuration @@ -20,9 +20,8 @@ twitter-source [ "factor" ] initialize ] with-scope ; inline : twitter-url ( string -- string' ) - os windows? - "http://twitter.com/" - "https://twitter.com/" ? prepend ; + ssl-supported? + "https://twitter.com/" "http://twitter.com/" ? prepend ; PRIVATE>