From 67c37591ca402760ad85959e4b04b5d20a3d7df3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 25 Oct 2010 15:54:42 -0500 Subject: [PATCH] Remove *uint and friends. Hopefully remove the last usages of these words --- basis/alien/c-types/c-types-docs.factor | 10 ----- basis/alien/c-types/c-types-tests.factor | 4 +- basis/alien/c-types/c-types.factor | 57 +++++++++--------------- basis/compiler/tests/intrinsics.factor | 16 +++---- basis/compression/zlib/zlib.factor | 8 ++-- basis/cpu/x86/sse/sse.factor | 5 ++- basis/cpu/x86/x87/x87.factor | 4 +- basis/math/floats/half/half.factor | 2 +- basis/opengl/shaders/shaders.factor | 2 +- basis/unix/types/freebsd/freebsd.factor | 2 +- basis/unix/types/linux/linux.factor | 2 +- basis/unix/types/macosx/macosx.factor | 2 +- basis/windows/com/com-tests.factor | 2 +- basis/windows/iphlpapi/iphlpapi.factor | 4 +- basis/x11/xlib/xlib.factor | 8 ++-- extra/audio/engine/engine.factor | 12 ++--- extra/cuda/cuda.factor | 2 +- extra/cuda/libraries/libraries.factor | 2 +- extra/cuda/memory/memory.factor | 2 +- extra/gpu/state/state.factor | 2 +- 20 files changed, 63 insertions(+), 85 deletions(-) diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index 5970f701fb..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 diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 7125f24d41..93d76a8236 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -63,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 1bef9ea273..6243e37b22 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -167,19 +167,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 @@ -244,7 +231,7 @@ M: pointer c-type [ >c-ptr ] >>unboxer-quot "allot_alien" >>boxer "alien_offset" >>unboxer - \ void* define-primitive-type + \ void* typedef fixnum >>class @@ -257,7 +244,7 @@ M: pointer c-type "from_signed_2" >>boxer "to_signed_2" >>unboxer [ >fixnum ] >>unboxer-quot - \ short define-primitive-type + \ short typedef fixnum >>class @@ -270,7 +257,7 @@ M: pointer c-type "from_unsigned_2" >>boxer "to_unsigned_2" >>unboxer [ >fixnum ] >>unboxer-quot - \ ushort define-primitive-type + \ ushort typedef fixnum >>class @@ -283,7 +270,7 @@ M: pointer c-type "from_signed_1" >>boxer "to_signed_1" >>unboxer [ >fixnum ] >>unboxer-quot - \ char define-primitive-type + \ char typedef fixnum >>class @@ -296,7 +283,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 @@ -310,7 +297,7 @@ M: pointer c-type "to_float" >>unboxer float-rep >>rep [ >float ] >>unboxer-quot - \ float define-primitive-type + \ float typedef math:float >>class @@ -323,7 +310,7 @@ M: pointer c-type "to_double" >>unboxer double-rep >>rep [ >float ] >>unboxer-quot - \ double define-primitive-type + \ double typedef cell 8 = [ @@ -337,7 +324,7 @@ M: pointer c-type "from_signed_4" >>boxer "to_signed_4" >>unboxer [ >fixnum ] >>unboxer-quot - \ int define-primitive-type + \ int typedef fixnum >>class @@ -350,7 +337,7 @@ M: pointer c-type "from_unsigned_4" >>boxer "to_unsigned_4" >>unboxer [ >fixnum ] >>unboxer-quot - \ uint define-primitive-type + \ uint typedef integer >>class @@ -363,7 +350,7 @@ M: pointer c-type "from_signed_cell" >>boxer "to_fixnum" >>unboxer [ >integer ] >>unboxer-quot - \ longlong define-primitive-type + \ longlong typedef integer >>class @@ -376,14 +363,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 @@ -403,7 +390,7 @@ M: pointer c-type "from_signed_cell" >>boxer "to_fixnum" >>unboxer [ >integer ] >>unboxer-quot - \ int define-primitive-type + \ int typedef integer >>class @@ -416,7 +403,7 @@ M: pointer c-type "from_unsigned_cell" >>boxer "to_cell" >>unboxer [ >integer ] >>unboxer-quot - \ uint define-primitive-type + \ uint typedef integer >>class @@ -428,7 +415,7 @@ M: pointer c-type "from_signed_8" >>boxer "to_signed_8" >>unboxer [ >integer ] >>unboxer-quot - \ longlong define-primitive-type + \ longlong typedef integer >>class @@ -440,10 +427,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 @@ -456,7 +443,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 diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 3cc7447fb2..191a7f535b 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -430,14 +430,14 @@ 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* deref ] compile-call ascii alien>string ] unit-test - [ "hello world" ] [ "s" get [ { c-ptr } declare void* deref ] compile-call ascii alien>string ] unit-test + [ "hello world" ] [ "s" get void* deref [ { byte-array } declare void* deref ] compile-call ascii alien>string ] unit-test + [ "hello world" ] [ "s" get void* deref [ { 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* deref ] unit-test -[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare ] compile-call void* deref ] unit-test +[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare void* deref ] compile-call void* deref ] unit-test +[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare void* deref ] 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 @@ -466,10 +466,10 @@ ERROR: bug-in-fixnum* x y a b ; [ 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 4 [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep float deref pi - -0.001 0.001 between? ] unit-test [ t ] [ pi float [ { byte-array } declare 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 } [ @@ -534,11 +534,11 @@ ERROR: bug-in-fixnum* x y a b ; ] unit-test [ - B{ 0 0 0 0 } [ { byte-array } declare ] compile-call + B{ 0 0 0 0 } [ { byte-array } declare void* deref ] compile-call ] must-fail [ - B{ 0 0 0 0 } [ { c-ptr } declare ] compile-call + B{ 0 0 0 0 } [ { c-ptr } declare void* deref ] compile-call ] must-fail [ 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/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/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/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 76a9f96933..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 diff --git a/basis/unix/types/freebsd/freebsd.factor b/basis/unix/types/freebsd/freebsd.factor index 4973df989d..a0d7226aac 100644 --- a/basis/unix/types/freebsd/freebsd.factor +++ b/basis/unix/types/freebsd/freebsd.factor @@ -23,4 +23,4 @@ TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: long time_t -ALIAS: +: ( n -- long ) long ; 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..20c84c2e83 100644 --- a/basis/unix/types/macosx/macosx.factor +++ b/basis/unix/types/macosx/macosx.factor @@ -36,4 +36,4 @@ TYPEDEF: uint IOOptionBits -ALIAS: +: ( n -- long ) long ; 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/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/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index e20314bf11..6fc5206711 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -48,17 +48,17 @@ TYPEDEF: int Bool TYPEDEF: ulong VisualID TYPEDEF: ulong Time -ALIAS: +: ( n -- ulong ) ulong ; ALIAS: ALIAS: ALIAS: -ALIAS: +: ( n -- ulong ) ulong ; -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/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/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/libraries/libraries.factor b/extra/cuda/libraries/libraries.factor index 0dc404c1cf..bd5d867fbb 100644 --- a/extra/cuda/libraries/libraries.factor +++ b/extra/cuda/libraries/libraries.factor @@ -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/gpu/state/state.factor b/extra/gpu/state/state.factor index 80fc89fea4..31a8678060 100755 --- a/extra/gpu/state/state.factor +++ b/extra/gpu/state/state.factor @@ -420,7 +420,7 @@ M: mask-state set-gpu-state* : get-gl-int ( enum -- value ) 0 int [ glGetIntegerv ] keep int deref ; : get-gl-float ( enum -- value ) - 0 float [ glGetFloatv ] keep float deref ; + 0 c:float [ glGetFloatv ] keep c:float deref ; : get-gl-bools ( enum count -- value ) [ glGetBooleanv ] keep [ c-bool> ] { } map-as ; -- 2.34.1