Remove <uint> *uint and friends. Hopefully remove the last usages of these words

db4
Doug Coleman 2010-10-25 15:54:42 -05:00
parent 4ca9bd0bba
commit 67c37591ca
20 changed files with 63 additions and 85 deletions

View File

@ -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

View File

@ -63,11 +63,11 @@ TYPEDEF: int* MyIntArray
[ t ] [ void* c-type MyIntArray c-type = ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> <void*>
0 B{ 1 2 3 4 } <displaced-alien> void* <ref>
] must-fail
os windows? cpu x86.64? and [
[ -2147467259 ] [ 2147500037 <long> *long ] unit-test
[ -2147467259 ] [ 2147500037 long <ref> long deref ] unit-test
] when
[ 0 ] [ -10 uchar c-type-clamp ] unit-test

View File

@ -167,19 +167,6 @@ TUPLE: long-long-type < c-type ;
: <long-long-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
<c-type>
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
<c-type>
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
<c-type>
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
<c-type>
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
<c-type>
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
<c-type>
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 = [
<c-type>
@ -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
<c-type>
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
<c-type>
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
<c-type>
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
<c-type>
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
<long-long-type>
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
<long-long-type>
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

View File

@ -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 <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
[ "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 <void*> ] compile-call void* deref ] unit-test
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare <void*> ] 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* <ref> ] 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 <ref> [ { byte-array } declare double deref ] compile-call pi = ] unit-test
! Silly
[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep *float pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep float deref pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi float <ref> [ { byte-array } declare float deref ] compile-call pi - -0.001 0.001 between? ] unit-test
[ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep *double pi = ] unit-test
[ t ] [ pi 8 <byte-array> [ [ { 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 } <displaced-alien> [
@ -534,11 +534,11 @@ ERROR: bug-in-fixnum* x y a b ;
] unit-test
[
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
B{ 0 0 0 0 } [ { byte-array } declare void* deref ] compile-call
] must-fail
[
B{ 0 0 0 0 } [ { c-ptr } declare <void*> ] compile-call
B{ 0 0 0 0 } [ { c-ptr } declare void* deref ] compile-call
] must-fail
[

View File

@ -36,15 +36,15 @@ ERROR: zlib-failed n string ;
: compress ( byte-array -- compressed )
[
[ compressed-size <byte-array> dup length <ulong> ] keep [
[ compressed-size <byte-array> dup length ulong <ref> ] keep [
dup length compression.zlib.ffi:compress zlib-error
] 3keep drop *ulong head
] 3keep drop ulong deref head
] keep length <compressed> ;
: uncompress ( compressed -- byte-array )
[
length>> [ <byte-array> ] keep <ulong> 2dup
length>> [ <byte-array> ] keep ulong <ref> 2dup
] [
data>> dup length
compression.zlib.ffi:uncompress zlib-error
] bi *ulong head ;
] bi ulong deref head ;

View File

@ -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> float-rep %load-vector ;
M: x86 %load-double <double> double-rep %load-vector ;
M: x86 %load-float c:float <ref> float-rep %load-vector ;
M: x86 %load-double c:double <ref> double-rep %load-vector ;
M: float-rep copy-register* drop MOVAPS ;
M: double-rep copy-register* drop MOVAPS ;

View File

@ -38,12 +38,12 @@ M: double-rep copy-memory* copy-memory-x87 ;
M: x86 %load-float
0 [] FLDS
<float> rc-absolute rel-binary-literal
float <ref> rc-absolute rel-binary-literal
shuffle-down FSTP ;
M: x86 %load-double
0 [] FLDL
<double> rc-absolute rel-binary-literal
double <ref> rc-absolute rel-binary-literal
shuffle-down FSTP ;
:: binary-op ( dst src1 src2 quot -- )

View File

@ -41,6 +41,6 @@ SYMBOL: half
2 >>align
2 >>align-first
[ >float ] >>unboxer-quot
\ half define-primitive-type
\ half typedef
>>

View File

@ -8,7 +8,7 @@ SPECIALIZED-ARRAY: uint
IN: opengl.shaders
: with-gl-shader-source-ptr ( string quot -- )
swap ascii malloc-string [ <void*> swap call ] keep free ; inline
swap ascii malloc-string [ void* <ref> swap call ] keep free ; inline
: <gl-shader> ( source kind -- shader )
glCreateShader dup rot

View File

@ -23,4 +23,4 @@ TYPEDEF: long ssize_t
TYPEDEF: int pid_t
TYPEDEF: long time_t
ALIAS: <time_t> <long>
: <time_t> ( n -- long ) long <ref> ;

View File

@ -32,4 +32,4 @@ TYPEDEF: ulonglong __fsfilcnt64_t
TYPEDEF: ulonglong ino64_t
TYPEDEF: ulonglong off64_t
ALIAS: <time_t> <long>
: <time_t> ( n -- long ) long <ref> ;

View File

@ -36,4 +36,4 @@ TYPEDEF: uint IOOptionBits
ALIAS: <time_t> <long>
: <time_t> ( n -- long ) long <ref> ;

View File

@ -58,7 +58,7 @@ C: <test-implementation> test-implementation
dup +guinea-pig-implementation+ set [ drop
S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
E_FAIL long <ref> long deref 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
20 1array [
+guinea-pig-implementation+ get
[ 20 IInherited::setX ]

View File

@ -63,7 +63,7 @@ TYPEDEF: FIXED_INFO* PFIXED_INFO
FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ;
: get-fixed-info ( -- FIXED_INFO )
FIXED_INFO <struct> dup byte-length <ulong>
FIXED_INFO <struct> dup byte-length ulong <ref>
[ 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 ;
] { } make ;

View File

@ -48,17 +48,17 @@ TYPEDEF: int Bool
TYPEDEF: ulong VisualID
TYPEDEF: ulong Time
ALIAS: <XID> <ulong>
: <XID> ( n -- ulong ) ulong <ref> ;
ALIAS: <Window> <XID>
ALIAS: <Drawable> <XID>
ALIAS: <KeySym> <XID>
ALIAS: <Atom> <ulong>
: <Atom> ( n -- ulong ) ulong <ref> ;
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
!

View File

@ -122,7 +122,7 @@ ERROR: audio-context-not-available device-name ;
:: flush-source ( al-source -- )
al-source alSourceStop
0 c:<uint> :> dummy-buffer
0 c:uint c:<ref> :> 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:<uint> alSourceQueueBuffers
al-source 1 al-buffer c:uint c:<ref> 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:<uint> :> buffer
0 c:uint c:<ref> :> 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:<uint> [ alGenBuffers ] keep c:*uint :> al-buffer
1 0 c:uint c:<ref> [ 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:<uint> alDeleteBuffers ] bi ;
[ [ 1 ] dip al-buffer>> c:uint c:<ref> alDeleteBuffers ] bi ;
M: streaming-audio-clip dispose*
[ call-next-method ]

View File

@ -16,7 +16,7 @@ TUPLE: cuda-error code ;
dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
: cuda-version ( -- n )
c:int <c-object> [ cuDriverGetVersion cuda-error ] keep c:*int ;
c:int <c-object> [ cuDriverGetVersion cuda-error ] keep c:int c:deref ;
: init-cuda ( -- )
0 cuInit cuda-error ; inline

View File

@ -172,7 +172,7 @@ MACRO: cuda-invoke ( module-name function-name arguments -- )
: cuda-global* ( module-name symbol-name -- device-ptr size )
[ CUdeviceptr <c-object> c:uint <c-object> ] 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

View File

@ -10,7 +10,7 @@ IN: cuda.memory
: cuda-malloc ( n -- ptr )
[ CUdeviceptr <c-object> ] 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

View File

@ -420,7 +420,7 @@ M: mask-state set-gpu-state*
: get-gl-int ( enum -- value )
0 int <ref> [ glGetIntegerv ] keep int deref ;
: get-gl-float ( enum -- value )
0 float <ref> [ glGetFloatv ] keep float deref ;
0 c:float <ref> [ glGetFloatv ] keep c:float deref ;
: get-gl-bools ( enum count -- value )
<byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;