steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

invoker infers function param c-types more generally

db4
Matthew Willis 2009-06-30 22:55:20 +09:00
parent d4c03d8459
commit b46999584b
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/llvm/invoker/invoker.factor
View File

@ -30,15 +30,15 @@ TUPLE: function name alien return params ;
LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
: function-effect ( function -- effect )
[ params>> [ first ] map ] [ void? 0 1 ? ] bi <effect> ;
[ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi <effect> ;
: install-function ( function -- )
dup name>> "alien.llvm" create-vocab drop
"alien.llvm" create swap
[
dup name>> function-pointer ,
dup return>> drop "int" ,
dup params>> [ drop "int" ] map ,
dup return>> c-type ,
dup params>> [ second c-type ] map ,
"cdecl" , \ alien-indirect ,
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;

14
extra/llvm/types/types.factor
View File

@ -18,20 +18,32 @@ IN: llvm.types
!
GENERIC: (>tref) ( type -- LLVMTypeRef )
GENERIC: ((tref>)) ( LLVMTypeRef type -- type )
GENERIC: c-type ( type -- str )
! default implementation for simple types
M: object ((tref>)) nip ;
: unsupported-type ( -- )
"cannot generate c-type: unsupported llvm type" throw ;
M: object c-type unsupported-type ;
TUPLE: integer size ;
C: <integer> integer
M: integer (>tref) size>> LLVMIntType ;
M: integer ((tref>)) swap LLVMGetIntTypeWidth >>size ;
M: integer c-type size>> {
{ 64 [ "longlong" ] }
{ 32 [ "int" ] }
{ 16 [ "short" ] }
{ 8 [ "char" ] }
[ unsupported-type ]
} case ;
SINGLETONS: float double x86_fp80 fp128 ppc_fp128 ;
M: float (>tref) drop LLVMFloatType ;
M: double (>tref) drop LLVMDoubleType ;
M: double c-type drop "double" ;
M: x86_fp80 (>tref) drop LLVMX86FP80Type ;
M: fp128 (>tref) drop LLVMFP128Type ;
M: ppc_fp128 (>tref) drop LLVMPPCFP128Type ;
@ -41,6 +53,7 @@ SINGLETONS: opaque label void metadata ;
M: opaque (>tref) drop LLVMOpaqueType ;
M: label (>tref) drop LLVMLabelType ;
M: void (>tref) drop LLVMVoidType ;
M: void c-type drop "void" ;
M: metadata (>tref) drop
"metadata types unsupported by llvm c bindings" throw ;
@ -85,6 +98,7 @@ TUPLE: pointer < enclosing type ;
M: pointer (>tref)* type>> (>tref) 0 LLVMPointerType ;
M: pointer clean* type>> clean ;
M: pointer (tref>)* swap LLVMGetElementType (tref>) >>type ;
M: pointer c-type type>> 8 <integer> = "char*" "void*" ? ;
TUPLE: vector < enclosing size type ;
: <vector> ( s t -- o )