update some naked alien-invokes to use c-type words
parent
f9320e229f
commit
7fac3682a6
|
@ -6,6 +6,7 @@ compiler.cfg arrays locals byte-arrays kernel.private math
|
|||
slots.private vectors sbufs strings math.partial-dispatch
|
||||
hashtables assocs combinators.short-circuit
|
||||
strings.private accessors compiler.cfg.instructions ;
|
||||
FROM: alien.c-types => int ;
|
||||
IN: compiler.cfg.builder.tests
|
||||
|
||||
! Just ensure that various CFGs build correctly.
|
||||
|
@ -66,7 +67,7 @@ IN: compiler.cfg.builder.tests
|
|||
[ [ t ] loop ]
|
||||
[ [ dup ] loop ]
|
||||
[ [ 2 ] [ 3 throw ] if 4 ]
|
||||
[ "int" f "malloc" { "int" } alien-invoke ]
|
||||
[ int f "malloc" { int } alien-invoke ]
|
||||
[ "int" { "int" } "cdecl" alien-indirect ]
|
||||
[ "int" { "int" } "cdecl" [ ] alien-callback ]
|
||||
[ swap - + * ]
|
||||
|
@ -213,4 +214,4 @@ IN: compiler.cfg.builder.tests
|
|||
] when
|
||||
|
||||
! Regression. Make sure everything is inlined correctly
|
||||
[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
|
||||
[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
|
||||
|
|
|
@ -122,13 +122,13 @@ unit-test
|
|||
[ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test
|
||||
|
||||
: ffi_test_18 ( w x y z -- int )
|
||||
"int" "f-stdcall" "ffi_test_18" { "int" "int" "int" "int" }
|
||||
int "f-stdcall" "ffi_test_18" { int int int int }
|
||||
alien-invoke gc ;
|
||||
|
||||
[ 25 ] [ 2 3 4 5 ffi_test_18 ] unit-test
|
||||
|
||||
: ffi_test_19 ( x y z -- BAR )
|
||||
"BAR" "f-stdcall" "ffi_test_19" { "long" "long" "long" }
|
||||
BAR "f-stdcall" "ffi_test_19" { long long long }
|
||||
alien-invoke gc ;
|
||||
|
||||
[ 11 6 -7 ] [
|
||||
|
@ -157,17 +157,17 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
|
|||
! Make sure XT doesn't get clobbered in stack frame
|
||||
|
||||
: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y )
|
||||
"int"
|
||||
int
|
||||
"f-cdecl" "ffi_test_31"
|
||||
{ "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
|
||||
{ int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int }
|
||||
alien-invoke gc 3 ;
|
||||
|
||||
[ 861 3 ] [ 42 [ ] each ffi_test_31 ] unit-test
|
||||
|
||||
: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
|
||||
"float"
|
||||
float
|
||||
"f-cdecl" "ffi_test_31_point_5"
|
||||
{ "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" }
|
||||
{ float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float }
|
||||
alien-invoke ;
|
||||
|
||||
[ 861.0 ] [ 42 [ >float ] each ffi_test_31_point_5 ] unit-test
|
||||
|
|
|
@ -270,8 +270,8 @@ TUPLE: id obj ;
|
|||
{ float } declare dup 0 =
|
||||
[ drop 1 ] [
|
||||
dup 0 >=
|
||||
[ 2 "double" "libm" "pow" { "double" "double" } alien-invoke ]
|
||||
[ -0.5 "double" "libm" "pow" { "double" "double" } alien-invoke ]
|
||||
[ 2 double "libm" "pow" { double double } alien-invoke ]
|
||||
[ -0.5 double "libm" "pow" { double double } alien-invoke ]
|
||||
if
|
||||
] if ;
|
||||
|
||||
|
@ -475,4 +475,4 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
|
|||
[ 2 0 ] [
|
||||
1 1
|
||||
[ [ HEX: f bitand ] bi@ [ shift ] [ drop -3 shift ] 2bi ] compile-call
|
||||
] unit-test
|
||||
] unit-test
|
||||
|
|
|
@ -120,8 +120,8 @@ FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ;
|
|||
FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 n ) ;
|
||||
! Bind the same function as above, but for unsigned 64bit integers
|
||||
: sqlite3-bind-uint64 ( pStmt index in64 -- int )
|
||||
"int" "sqlite" "sqlite3_bind_int64"
|
||||
{ "sqlite3_stmt*" "int" "sqlite3_uint64" } alien-invoke ;
|
||||
int "sqlite" "sqlite3_bind_int64"
|
||||
{ sqlite3_stmt* int sqlite3_uint64 } alien-invoke ;
|
||||
FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ;
|
||||
FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ;
|
||||
FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ;
|
||||
|
@ -134,8 +134,8 @@ FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ;
|
|||
FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ;
|
||||
! Bind the same function as above, but for unsigned 64bit integers
|
||||
: sqlite3-column-uint64 ( pStmt col -- uint64 )
|
||||
"sqlite3_uint64" "sqlite" "sqlite3_column_int64"
|
||||
{ "sqlite3_stmt*" "int" } alien-invoke ;
|
||||
sqlite3_uint64 "sqlite" "sqlite3_column_int64"
|
||||
{ sqlite3_stmt* int } alien-invoke ;
|
||||
FUNCTION: double sqlite3_column_double ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ;
|
||||
FUNCTION: char* sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ;
|
||||
|
|
|
@ -7,7 +7,7 @@ SPECIALIZED-ARRAY: char
|
|||
IN: system-info.linux
|
||||
|
||||
: (uname) ( buf -- int )
|
||||
"int" f "uname" { "char*" } alien-invoke ;
|
||||
int f "uname" { char* } alien-invoke ;
|
||||
|
||||
: uname ( -- seq )
|
||||
65536 <char-array> [ (uname) io-error ] keep
|
||||
|
|
Loading…
Reference in New Issue