Remove <uint> *uint and friends. Hopefully remove the last usages of these words
parent
4ca9bd0bba
commit
67c37591ca
|
@ -38,16 +38,6 @@ HELP: set-alien-value
|
||||||
{ $description "Stores a value at a byte offset from a base C pointer." }
|
{ $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." } ;
|
{ $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
|
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." } ;
|
{ $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
|
HELP: uchar
|
||||||
|
|
|
@ -63,11 +63,11 @@ TYPEDEF: int* MyIntArray
|
||||||
[ t ] [ void* c-type MyIntArray c-type = ] unit-test
|
[ 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
|
] must-fail
|
||||||
|
|
||||||
os windows? cpu x86.64? and [
|
os windows? cpu x86.64? and [
|
||||||
[ -2147467259 ] [ 2147500037 <long> *long ] unit-test
|
[ -2147467259 ] [ 2147500037 long <ref> long deref ] unit-test
|
||||||
] when
|
] when
|
||||||
|
|
||||||
[ 0 ] [ -10 uchar c-type-clamp ] unit-test
|
[ 0 ] [ -10 uchar c-type-clamp ] unit-test
|
||||||
|
|
|
@ -167,19 +167,6 @@ TUPLE: long-long-type < c-type ;
|
||||||
: <long-long-type> ( -- c-type )
|
: <long-long-type> ( -- c-type )
|
||||||
long-long-type new ;
|
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 -- )
|
: if-void ( c-type true false -- )
|
||||||
pick void? [ drop nip call ] [ nip call ] if ; inline
|
pick void? [ drop nip call ] [ nip call ] if ; inline
|
||||||
|
|
||||||
|
@ -244,7 +231,7 @@ M: pointer c-type
|
||||||
[ >c-ptr ] >>unboxer-quot
|
[ >c-ptr ] >>unboxer-quot
|
||||||
"allot_alien" >>boxer
|
"allot_alien" >>boxer
|
||||||
"alien_offset" >>unboxer
|
"alien_offset" >>unboxer
|
||||||
\ void* define-primitive-type
|
\ void* typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
@ -257,7 +244,7 @@ M: pointer c-type
|
||||||
"from_signed_2" >>boxer
|
"from_signed_2" >>boxer
|
||||||
"to_signed_2" >>unboxer
|
"to_signed_2" >>unboxer
|
||||||
[ >fixnum ] >>unboxer-quot
|
[ >fixnum ] >>unboxer-quot
|
||||||
\ short define-primitive-type
|
\ short typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
@ -270,7 +257,7 @@ M: pointer c-type
|
||||||
"from_unsigned_2" >>boxer
|
"from_unsigned_2" >>boxer
|
||||||
"to_unsigned_2" >>unboxer
|
"to_unsigned_2" >>unboxer
|
||||||
[ >fixnum ] >>unboxer-quot
|
[ >fixnum ] >>unboxer-quot
|
||||||
\ ushort define-primitive-type
|
\ ushort typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
@ -283,7 +270,7 @@ M: pointer c-type
|
||||||
"from_signed_1" >>boxer
|
"from_signed_1" >>boxer
|
||||||
"to_signed_1" >>unboxer
|
"to_signed_1" >>unboxer
|
||||||
[ >fixnum ] >>unboxer-quot
|
[ >fixnum ] >>unboxer-quot
|
||||||
\ char define-primitive-type
|
\ char typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
@ -296,7 +283,7 @@ M: pointer c-type
|
||||||
"from_unsigned_1" >>boxer
|
"from_unsigned_1" >>boxer
|
||||||
"to_unsigned_1" >>unboxer
|
"to_unsigned_1" >>unboxer
|
||||||
[ >fixnum ] >>unboxer-quot
|
[ >fixnum ] >>unboxer-quot
|
||||||
\ uchar define-primitive-type
|
\ uchar typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
math:float >>class
|
math:float >>class
|
||||||
|
@ -310,7 +297,7 @@ M: pointer c-type
|
||||||
"to_float" >>unboxer
|
"to_float" >>unboxer
|
||||||
float-rep >>rep
|
float-rep >>rep
|
||||||
[ >float ] >>unboxer-quot
|
[ >float ] >>unboxer-quot
|
||||||
\ float define-primitive-type
|
\ float typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
math:float >>class
|
math:float >>class
|
||||||
|
@ -323,7 +310,7 @@ M: pointer c-type
|
||||||
"to_double" >>unboxer
|
"to_double" >>unboxer
|
||||||
double-rep >>rep
|
double-rep >>rep
|
||||||
[ >float ] >>unboxer-quot
|
[ >float ] >>unboxer-quot
|
||||||
\ double define-primitive-type
|
\ double typedef
|
||||||
|
|
||||||
cell 8 = [
|
cell 8 = [
|
||||||
<c-type>
|
<c-type>
|
||||||
|
@ -337,7 +324,7 @@ M: pointer c-type
|
||||||
"from_signed_4" >>boxer
|
"from_signed_4" >>boxer
|
||||||
"to_signed_4" >>unboxer
|
"to_signed_4" >>unboxer
|
||||||
[ >fixnum ] >>unboxer-quot
|
[ >fixnum ] >>unboxer-quot
|
||||||
\ int define-primitive-type
|
\ int typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
@ -350,7 +337,7 @@ M: pointer c-type
|
||||||
"from_unsigned_4" >>boxer
|
"from_unsigned_4" >>boxer
|
||||||
"to_unsigned_4" >>unboxer
|
"to_unsigned_4" >>unboxer
|
||||||
[ >fixnum ] >>unboxer-quot
|
[ >fixnum ] >>unboxer-quot
|
||||||
\ uint define-primitive-type
|
\ uint typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
@ -363,7 +350,7 @@ M: pointer c-type
|
||||||
"from_signed_cell" >>boxer
|
"from_signed_cell" >>boxer
|
||||||
"to_fixnum" >>unboxer
|
"to_fixnum" >>unboxer
|
||||||
[ >integer ] >>unboxer-quot
|
[ >integer ] >>unboxer-quot
|
||||||
\ longlong define-primitive-type
|
\ longlong typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
@ -376,14 +363,14 @@ M: pointer c-type
|
||||||
"from_unsigned_cell" >>boxer
|
"from_unsigned_cell" >>boxer
|
||||||
"to_cell" >>unboxer
|
"to_cell" >>unboxer
|
||||||
[ >integer ] >>unboxer-quot
|
[ >integer ] >>unboxer-quot
|
||||||
\ ulonglong define-primitive-type
|
\ ulonglong typedef
|
||||||
|
|
||||||
os windows? [
|
os windows? [
|
||||||
\ int c-type \ long define-primitive-type
|
\ int c-type \ long typedef
|
||||||
\ uint c-type \ ulong define-primitive-type
|
\ uint c-type \ ulong typedef
|
||||||
] [
|
] [
|
||||||
\ longlong c-type \ long define-primitive-type
|
\ longlong c-type \ long typedef
|
||||||
\ ulonglong c-type \ ulong define-primitive-type
|
\ ulonglong c-type \ ulong typedef
|
||||||
] if
|
] if
|
||||||
|
|
||||||
\ longlong c-type \ ptrdiff_t typedef
|
\ longlong c-type \ ptrdiff_t typedef
|
||||||
|
@ -403,7 +390,7 @@ M: pointer c-type
|
||||||
"from_signed_cell" >>boxer
|
"from_signed_cell" >>boxer
|
||||||
"to_fixnum" >>unboxer
|
"to_fixnum" >>unboxer
|
||||||
[ >integer ] >>unboxer-quot
|
[ >integer ] >>unboxer-quot
|
||||||
\ int define-primitive-type
|
\ int typedef
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
@ -416,7 +403,7 @@ M: pointer c-type
|
||||||
"from_unsigned_cell" >>boxer
|
"from_unsigned_cell" >>boxer
|
||||||
"to_cell" >>unboxer
|
"to_cell" >>unboxer
|
||||||
[ >integer ] >>unboxer-quot
|
[ >integer ] >>unboxer-quot
|
||||||
\ uint define-primitive-type
|
\ uint typedef
|
||||||
|
|
||||||
<long-long-type>
|
<long-long-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
@ -428,7 +415,7 @@ M: pointer c-type
|
||||||
"from_signed_8" >>boxer
|
"from_signed_8" >>boxer
|
||||||
"to_signed_8" >>unboxer
|
"to_signed_8" >>unboxer
|
||||||
[ >integer ] >>unboxer-quot
|
[ >integer ] >>unboxer-quot
|
||||||
\ longlong define-primitive-type
|
\ longlong typedef
|
||||||
|
|
||||||
<long-long-type>
|
<long-long-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
@ -440,10 +427,10 @@ M: pointer c-type
|
||||||
"from_unsigned_8" >>boxer
|
"from_unsigned_8" >>boxer
|
||||||
"to_unsigned_8" >>unboxer
|
"to_unsigned_8" >>unboxer
|
||||||
[ >integer ] >>unboxer-quot
|
[ >integer ] >>unboxer-quot
|
||||||
\ ulonglong define-primitive-type
|
\ ulonglong typedef
|
||||||
|
|
||||||
\ int c-type \ long define-primitive-type
|
\ int c-type \ long typedef
|
||||||
\ uint c-type \ ulong define-primitive-type
|
\ uint c-type \ ulong typedef
|
||||||
|
|
||||||
\ int c-type \ ptrdiff_t typedef
|
\ int c-type \ ptrdiff_t typedef
|
||||||
\ int c-type \ intptr_t typedef
|
\ int c-type \ intptr_t typedef
|
||||||
|
@ -456,7 +443,7 @@ M: pointer c-type
|
||||||
[ >c-bool ] >>unboxer-quot
|
[ >c-bool ] >>unboxer-quot
|
||||||
[ c-bool> ] >>boxer-quot
|
[ c-bool> ] >>boxer-quot
|
||||||
object >>boxed-class
|
object >>boxed-class
|
||||||
\ bool define-primitive-type
|
\ bool typedef
|
||||||
|
|
||||||
] with-compilation-unit
|
] with-compilation-unit
|
||||||
|
|
||||||
|
|
|
@ -430,14 +430,14 @@ ERROR: bug-in-fixnum* x y a b ;
|
||||||
[ ] [ "hello world" ascii malloc-string "s" set ] unit-test
|
[ ] [ "hello world" ascii malloc-string "s" set ] unit-test
|
||||||
|
|
||||||
"s" get [
|
"s" get [
|
||||||
[ "hello world" ] [ "s" get <void*> [ { byte-array } 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*> [ { c-ptr } 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
|
[ ] [ "s" get free ] unit-test
|
||||||
] when
|
] when
|
||||||
|
|
||||||
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } 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*> ] 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
|
[ 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
|
[ 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
|
[ t ] [ pi double <ref> [ { byte-array } declare double deref ] compile-call pi = ] unit-test
|
||||||
|
|
||||||
! Silly
|
! 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 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 ] [
|
[ 4 ] [
|
||||||
2 B{ 1 2 3 4 5 6 } <displaced-alien> [
|
2 B{ 1 2 3 4 5 6 } <displaced-alien> [
|
||||||
|
@ -534,11 +534,11 @@ ERROR: bug-in-fixnum* x y a b ;
|
||||||
] unit-test
|
] 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
|
] 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
|
] must-fail
|
||||||
|
|
||||||
[
|
[
|
||||||
|
|
|
@ -36,15 +36,15 @@ ERROR: zlib-failed n string ;
|
||||||
|
|
||||||
: compress ( byte-array -- compressed )
|
: 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
|
dup length compression.zlib.ffi:compress zlib-error
|
||||||
] 3keep drop *ulong head
|
] 3keep drop ulong deref head
|
||||||
] keep length <compressed> ;
|
] keep length <compressed> ;
|
||||||
|
|
||||||
: uncompress ( compressed -- byte-array )
|
: uncompress ( compressed -- byte-array )
|
||||||
[
|
[
|
||||||
length>> [ <byte-array> ] keep <ulong> 2dup
|
length>> [ <byte-array> ] keep ulong <ref> 2dup
|
||||||
] [
|
] [
|
||||||
data>> dup length
|
data>> dup length
|
||||||
compression.zlib.ffi:uncompress zlib-error
|
compression.zlib.ffi:uncompress zlib-error
|
||||||
] bi *ulong head ;
|
] bi ulong deref head ;
|
||||||
|
|
|
@ -5,11 +5,12 @@ macros math math.vectors namespaces quotations sequences system
|
||||||
compiler.cfg.comparisons compiler.cfg.intrinsics
|
compiler.cfg.comparisons compiler.cfg.intrinsics
|
||||||
compiler.codegen.fixup cpu.architecture cpu.x86
|
compiler.codegen.fixup cpu.architecture cpu.x86
|
||||||
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features ;
|
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features ;
|
||||||
|
QUALIFIED-WITH: alien.c-types c
|
||||||
IN: cpu.x86.sse
|
IN: cpu.x86.sse
|
||||||
|
|
||||||
! Scalar floating point with SSE2
|
! Scalar floating point with SSE2
|
||||||
M: x86 %load-float <float> float-rep %load-vector ;
|
M: x86 %load-float c:float <ref> float-rep %load-vector ;
|
||||||
M: x86 %load-double <double> double-rep %load-vector ;
|
M: x86 %load-double c:double <ref> double-rep %load-vector ;
|
||||||
|
|
||||||
M: float-rep copy-register* drop MOVAPS ;
|
M: float-rep copy-register* drop MOVAPS ;
|
||||||
M: double-rep copy-register* drop MOVAPS ;
|
M: double-rep copy-register* drop MOVAPS ;
|
||||||
|
|
|
@ -38,12 +38,12 @@ M: double-rep copy-memory* copy-memory-x87 ;
|
||||||
|
|
||||||
M: x86 %load-float
|
M: x86 %load-float
|
||||||
0 [] FLDS
|
0 [] FLDS
|
||||||
<float> rc-absolute rel-binary-literal
|
float <ref> rc-absolute rel-binary-literal
|
||||||
shuffle-down FSTP ;
|
shuffle-down FSTP ;
|
||||||
|
|
||||||
M: x86 %load-double
|
M: x86 %load-double
|
||||||
0 [] FLDL
|
0 [] FLDL
|
||||||
<double> rc-absolute rel-binary-literal
|
double <ref> rc-absolute rel-binary-literal
|
||||||
shuffle-down FSTP ;
|
shuffle-down FSTP ;
|
||||||
|
|
||||||
:: binary-op ( dst src1 src2 quot -- )
|
:: binary-op ( dst src1 src2 quot -- )
|
||||||
|
|
|
@ -41,6 +41,6 @@ SYMBOL: half
|
||||||
2 >>align
|
2 >>align
|
||||||
2 >>align-first
|
2 >>align-first
|
||||||
[ >float ] >>unboxer-quot
|
[ >float ] >>unboxer-quot
|
||||||
\ half define-primitive-type
|
\ half typedef
|
||||||
|
|
||||||
>>
|
>>
|
||||||
|
|
|
@ -8,7 +8,7 @@ SPECIALIZED-ARRAY: uint
|
||||||
IN: opengl.shaders
|
IN: opengl.shaders
|
||||||
|
|
||||||
: with-gl-shader-source-ptr ( string quot -- )
|
: 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 )
|
: <gl-shader> ( source kind -- shader )
|
||||||
glCreateShader dup rot
|
glCreateShader dup rot
|
||||||
|
|
|
@ -23,4 +23,4 @@ TYPEDEF: long ssize_t
|
||||||
TYPEDEF: int pid_t
|
TYPEDEF: int pid_t
|
||||||
TYPEDEF: long time_t
|
TYPEDEF: long time_t
|
||||||
|
|
||||||
ALIAS: <time_t> <long>
|
: <time_t> ( n -- long ) long <ref> ;
|
||||||
|
|
|
@ -32,4 +32,4 @@ TYPEDEF: ulonglong __fsfilcnt64_t
|
||||||
TYPEDEF: ulonglong ino64_t
|
TYPEDEF: ulonglong ino64_t
|
||||||
TYPEDEF: ulonglong off64_t
|
TYPEDEF: ulonglong off64_t
|
||||||
|
|
||||||
ALIAS: <time_t> <long>
|
: <time_t> ( n -- long ) long <ref> ;
|
||||||
|
|
|
@ -36,4 +36,4 @@ TYPEDEF: uint IOOptionBits
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
ALIAS: <time_t> <long>
|
: <time_t> ( n -- long ) long <ref> ;
|
||||||
|
|
|
@ -58,7 +58,7 @@ C: <test-implementation> test-implementation
|
||||||
dup +guinea-pig-implementation+ set [ drop
|
dup +guinea-pig-implementation+ set [ drop
|
||||||
|
|
||||||
S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
|
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 [
|
20 1array [
|
||||||
+guinea-pig-implementation+ get
|
+guinea-pig-implementation+ get
|
||||||
[ 20 IInherited::setX ]
|
[ 20 IInherited::setX ]
|
||||||
|
|
|
@ -63,7 +63,7 @@ TYPEDEF: FIXED_INFO* PFIXED_INFO
|
||||||
FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ;
|
FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ;
|
||||||
|
|
||||||
: get-fixed-info ( -- FIXED_INFO )
|
: 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 ;
|
[ GetNetworkParams n>win32-error-check ] 2keep drop ;
|
||||||
|
|
||||||
: dns-server-ips ( -- sequence )
|
: dns-server-ips ( -- sequence )
|
||||||
|
@ -72,4 +72,4 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ;
|
||||||
[ IpAddress>> String>> [ 0 = ] trim-tail utf8 decode , ]
|
[ IpAddress>> String>> [ 0 = ] trim-tail utf8 decode , ]
|
||||||
[ Next>> ] bi dup
|
[ Next>> ] bi dup
|
||||||
] loop drop
|
] loop drop
|
||||||
] { } make ;
|
] { } make ;
|
||||||
|
|
|
@ -48,17 +48,17 @@ TYPEDEF: int Bool
|
||||||
TYPEDEF: ulong VisualID
|
TYPEDEF: ulong VisualID
|
||||||
TYPEDEF: ulong Time
|
TYPEDEF: ulong Time
|
||||||
|
|
||||||
ALIAS: <XID> <ulong>
|
: <XID> ( n -- ulong ) ulong <ref> ;
|
||||||
ALIAS: <Window> <XID>
|
ALIAS: <Window> <XID>
|
||||||
ALIAS: <Drawable> <XID>
|
ALIAS: <Drawable> <XID>
|
||||||
ALIAS: <KeySym> <XID>
|
ALIAS: <KeySym> <XID>
|
||||||
ALIAS: <Atom> <ulong>
|
: <Atom> ( n -- ulong ) ulong <ref> ;
|
||||||
|
|
||||||
ALIAS: *XID *ulong
|
: *XID ( bytes -- n ) ulong deref ;
|
||||||
ALIAS: *Window *XID
|
ALIAS: *Window *XID
|
||||||
ALIAS: *Drawable *XID
|
ALIAS: *Drawable *XID
|
||||||
ALIAS: *KeySym *XID
|
ALIAS: *KeySym *XID
|
||||||
ALIAS: *Atom *ulong
|
: *Atom ( bytes -- n ) ulong deref ;
|
||||||
!
|
!
|
||||||
! 2 - Display Functions
|
! 2 - Display Functions
|
||||||
!
|
!
|
||||||
|
|
|
@ -122,7 +122,7 @@ ERROR: audio-context-not-available device-name ;
|
||||||
|
|
||||||
:: flush-source ( al-source -- )
|
:: flush-source ( al-source -- )
|
||||||
al-source alSourceStop
|
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 AL_BUFFERS_PROCESSED get-source-param [
|
||||||
al-source 1 dummy-buffer alSourceUnqueueBuffers
|
al-source 1 dummy-buffer alSourceUnqueueBuffers
|
||||||
] times
|
] times
|
||||||
|
@ -161,7 +161,7 @@ ERROR: audio-context-not-available device-name ;
|
||||||
audio-clip t >>done? drop
|
audio-clip t >>done? drop
|
||||||
] [
|
] [
|
||||||
al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
|
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
|
] if
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
|
@ -190,10 +190,10 @@ M: static-audio-clip (update-audio-clip)
|
||||||
|
|
||||||
M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
|
M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
|
||||||
audio-clip al-source>> :> al-source
|
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 AL_BUFFERS_PROCESSED get-source-param [
|
||||||
al-source 1 buffer alSourceUnqueueBuffers
|
al-source 1 buffer alSourceUnqueueBuffers
|
||||||
audio-clip buffer c:*uint queue-clip-buffer
|
audio-clip buffer c:uint c:deref queue-clip-buffer
|
||||||
] times ;
|
] times ;
|
||||||
|
|
||||||
: update-audio-clip ( audio-clip -- )
|
: update-audio-clip ( audio-clip -- )
|
||||||
|
@ -256,7 +256,7 @@ M: audio-engine dispose*
|
||||||
audio-engine get-available-source :> al-source
|
audio-engine get-available-source :> al-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
|
al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
|
||||||
alBufferData
|
alBufferData
|
||||||
|
|
||||||
|
@ -301,7 +301,7 @@ M: audio-clip dispose*
|
||||||
|
|
||||||
M: static-audio-clip dispose*
|
M: static-audio-clip dispose*
|
||||||
[ call-next-method ]
|
[ 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*
|
M: streaming-audio-clip dispose*
|
||||||
[ call-next-method ]
|
[ call-next-method ]
|
||||||
|
|
|
@ -16,7 +16,7 @@ TUPLE: cuda-error code ;
|
||||||
dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
|
dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
|
||||||
|
|
||||||
: cuda-version ( -- n )
|
: 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 ( -- )
|
: init-cuda ( -- )
|
||||||
0 cuInit cuda-error ; inline
|
0 cuInit cuda-error ; inline
|
||||||
|
|
|
@ -172,7 +172,7 @@ MACRO: cuda-invoke ( module-name function-name arguments -- )
|
||||||
: cuda-global* ( module-name symbol-name -- device-ptr size )
|
: cuda-global* ( module-name symbol-name -- device-ptr size )
|
||||||
[ CUdeviceptr <c-object> c:uint <c-object> ] 2dip
|
[ CUdeviceptr <c-object> c:uint <c-object> ] 2dip
|
||||||
[ cached-module ] dip
|
[ 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 ( module-name symbol-name -- device-ptr )
|
||||||
cuda-global* drop ; inline
|
cuda-global* drop ; inline
|
||||||
|
|
|
@ -10,7 +10,7 @@ IN: cuda.memory
|
||||||
: cuda-malloc ( n -- ptr )
|
: cuda-malloc ( n -- ptr )
|
||||||
[ CUdeviceptr <c-object> ] dip
|
[ CUdeviceptr <c-object> ] dip
|
||||||
'[ _ cuMemAlloc cuda-error ] keep
|
'[ _ cuMemAlloc cuda-error ] keep
|
||||||
c:*int ; inline
|
c:int c:deref ; inline
|
||||||
|
|
||||||
: cuda-malloc-type ( n type -- ptr )
|
: cuda-malloc-type ( n type -- ptr )
|
||||||
c:heap-size * cuda-malloc ; inline
|
c:heap-size * cuda-malloc ; inline
|
||||||
|
|
|
@ -420,7 +420,7 @@ M: mask-state set-gpu-state*
|
||||||
: get-gl-int ( enum -- value )
|
: get-gl-int ( enum -- value )
|
||||||
0 int <ref> [ glGetIntegerv ] keep int deref ;
|
0 int <ref> [ glGetIntegerv ] keep int deref ;
|
||||||
: get-gl-float ( enum -- value )
|
: 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 )
|
: get-gl-bools ( enum count -- value )
|
||||||
<byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;
|
<byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;
|
||||||
|
|
Loading…
Reference in New Issue