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

llvm.examples.sumfunc: making the example work with the wrapper-based api

modern-harvey2
Björn Lindqvist 2017-07-15 01:22:47 +02:00
parent ed3e3ebb78
commit 1c1afb15a1
1 changed files with 19 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
extra/llvm/examples/sumfunc/sumfunc.factor
View File

@ -1,61 +1,32 @@
USING: alien.c-types alien.data arrays destructors kernel llvm.ffi USING: accessors alien.c-types alien.data arrays destructors kernel
locals math sequences ; llvm.ffi llvm.wrappers sequences ;
IN: llvm.examples.sumfunc IN: llvm.examples.sumfunc
! From: ! From:
! https://pauladamsmith.com/blog/2015/01/how-to-get-started-with-llvm-c-api.html ! https://pauladamsmith.com/blog/2015/01/how-to-get-started-with-llvm-c-api.html
ERROR: llvm-verify message ; : add-function ( module name type -- value )
[ value>> ] 2dip LLVMAddFunction ;
: declare-function ( module name ret params -- value ) : dump-module ( module -- )
[ void* >c-array ] [ length ] bi 0 LLVMFunctionType LLVMAddFunction ; value>> LLVMDumpModule ;
: verify-module ( module -- ) : create-sum-type ( -- type )
! Does it leak? LLVMInt32Type LLVMInt32Type LLVMInt32Type 2array
LLVMReturnStatusAction [ void* >c-array ] [ length ] bi 0 LLVMFunctionType ;
{ c-string } [ LLVMVerifyModule ] with-out-parameters
swap 0 = [ drop ] [ llvm-verify ] if ;
: with-module ( name quot -- )
[
swap LLVMModuleCreateWithName
&LLVMDisposeModule
[ swap call ]
[ dup verify-module LLVMDumpModule ] bi
] with-destructors ; inline
: with-builder ( quot -- )
[
LLVMCreateBuilder &LLVMDisposeBuilder swap call
] with-destructors ; inline
: create-execution-engine-for-module ( module -- engine )
[ f LLVMExecutionEngineRef <ref> dup ] dip f
LLVMCreateExecutionEngineForModule drop
LLVMExecutionEngineRef deref ;
: with-execution-engine ( module quot -- )
[
swap create-execution-engine-for-module
&LLVMDisposeExecutionEngine
swap call
] with-destructors ; inline
: create-sum-body ( sum -- ) : create-sum-body ( sum -- )
[ dup <builder> [
value>>
! sum builder ! sum builder
over "entry" LLVMAppendBasicBlock swap dupd
! sum builder bb [ 0 LLVMGetParam ] [ 1 LLVMGetParam ] bi
dupd LLVMPositionBuilderAtEnd
! sum builder
swap dupd [ 0 LLVMGetParam ] [ 1 LLVMGetParam ] bi
! builder builder p0 p1 ! builder builder p0 p1
"tmp" LLVMBuildAdd "tmp" LLVMBuildAdd
LLVMBuildRet drop LLVMBuildRet drop
] with-builder ; ] with-disposal ;
:: create-sum-function ( -- ) : create-sum-function ( -- )
"my_module" [ "my_module" <module> [
"sum" LLVMInt32Type LLVMInt32Type LLVMInt32Type 2array [ "sum" create-sum-type add-function create-sum-body ]
declare-function create-sum-body [ verify-module ] [ dump-module ] tri
] with-module ; ] with-disposal ;