Added global jit, and convenience words for dealing with it

diff --git a/extra/llvm/core/core.factor b/extra/llvm/core/core.factor
index d4002d719ac06f4fc2d611251454ac83219670f8..292a25b80b6c678b202e3444b5c5ec50a1a5a7ec 100644 (file)
--- a/extra/llvm/core/core.factor
+++ b/extra/llvm/core/core.factor
@@ -221,6 +221,10 @@ FUNCTION: void LLVMGetParams ( LLVMValueRef Fn, LLVMValueRef* Params ) ;
 FUNCTION: LLVMValueRef
 LLVMAddFunction ( LLVMModuleRef M, char* Name, LLVMTypeRef FunctionTy ) ;
 
+FUNCTION: LLVMValueRef LLVMGetFirstFunction ( LLVMModuleRef M ) ;
+
+FUNCTION: LLVMValueRef LLVMGetNextFunction ( LLVMValueRef Fn ) ;
+
 FUNCTION: unsigned LLVMGetFunctionCallConv ( LLVMValueRef Fn ) ;
 
 FUNCTION: void LLVMSetFunctionCallConv ( LLVMValueRef Fn, unsigned CC ) ;

diff --git a/extra/llvm/engine/engine.factor b/extra/llvm/engine/engine.factor
index db5c7014efd82b4f2ad8d134c2c973de8558def1..ad51d02785f6ccf45280f9997644c26be716d43b 100644 (file)
--- a/extra/llvm/engine/engine.factor
+++ b/extra/llvm/engine/engine.factor
@@ -50,6 +50,13 @@ FUNCTION: int LLVMCreateJITCompiler
 
 FUNCTION: void LLVMDisposeExecutionEngine ( LLVMExecutionEngineRef EE ) ;
 
+FUNCTION: void LLVMFreeMachineCodeForFunction ( LLVMExecutionEngineRef EE, LLVMValueRef F ) ;
+
+FUNCTION: void LLVMAddModuleProvider ( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP ) ;
+
+FUNCTION: int LLVMRemoveModuleProvider
+( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP, LLVMModuleRef* OutMod, char** OutError ) ;
+
 FUNCTION: int LLVMFindFunction
 ( LLVMExecutionEngineRef EE, char* Name, LLVMValueRef* OutFn ) ;
 

diff --git a/extra/llvm/jit/jit-tests.factor b/extra/llvm/jit/jit-tests.factor
new file mode 100644 (file)
index 0000000..5a894e5
--- /dev/null
+++ b/extra/llvm/jit/jit-tests.factor
@@ -0,0 +1,3 @@
+USING: destructors llvm.jit llvm.wrappers tools.test ;
+
+[ ] [ "test" <module> [ <provider> ] with-disposal [ "test" add-provider ] with-disposal "test" remove-provider ] unit-test
\ No newline at end of file

diff --git a/extra/llvm/jit/jit.factor b/extra/llvm/jit/jit.factor
new file mode 100644 (file)
index 0000000..5a85742
--- /dev/null
+++ b/extra/llvm/jit/jit.factor
@@ -0,0 +1,45 @@
+USING: accessors alien.c-types alien.syntax assocs destructors
+kernel llvm.core llvm.engine llvm.wrappers namespaces ;
+
+IN: llvm.jit
+
+SYMBOL: thejit
+
+TUPLE: jit ee mps ;
+
+: empty-engine ( -- engine )
+    "initial-module" <module> [
+        <provider>
+    ] with-disposal [
+        <engine>
+    ] with-disposal ;
+
+: <jit> ( -- jit )
+    jit new empty-engine >>ee H{ } clone >>mps ;
+
+: (remove-functions) ( function -- )
+    thejit get ee>> value>> over LLVMFreeMachineCodeForFunction
+    LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
+
+: remove-functions ( module -- )
+    ! free machine code for each function in module
+    LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
+
+: (remove-provider) ( provider -- )
+    thejit get ee>> value>> swap value>> f <void*> f <void*>
+    [ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
+    *void* module new swap >>value
+    [ value>> remove-functions ] with-disposal ;
+
+: remove-provider ( name -- )
+    dup thejit get mps>> at [
+        (remove-provider)
+        thejit get mps>> delete-at
+    ] [ drop ] if* ;
+
+: add-provider ( provider name -- )
+    dup remove-provider
+    thejit get ee>> value>>  pick value>> LLVMAddModuleProvider
+    [ t >>disposed ] dip thejit get mps>> set-at ;
+
+thejit [ <jit> ] initialize
\ No newline at end of file

diff --git a/extra/llvm/wrappers/wrappers-tests.factor b/extra/llvm/wrappers/wrappers-tests.factor
new file mode 100644 (file)
index 0000000..fe90184
--- /dev/null
+++ b/extra/llvm/wrappers/wrappers-tests.factor
@@ -0,0 +1,5 @@
+USING: destructors kernel llvm.wrappers sequences tools.test vocabs ;
+
+[ ] [ "test" <module> dispose ] unit-test
+[ ] [ "test" <module> [ <provider> ] with-disposal dispose ] unit-test
+[ ] [ "llvm.jit" vocabs member? [ "test" <module> [ <provider> ] with-disposal [ <engine> ] with-disposal dispose ] unless ] unit-test
\ No newline at end of file

diff --git a/extra/llvm/wrappers/wrappers.factor b/extra/llvm/wrappers/wrappers.factor
new file mode 100644 (file)
index 0000000..2a3e696
--- /dev/null
+++ b/extra/llvm/wrappers/wrappers.factor
@@ -0,0 +1,48 @@
+USING: accessors alien.c-types alien.strings destructors kernel
+llvm.core llvm.engine ;
+
+IN: llvm.wrappers
+
+: llvm-throw ( char* -- )
+    [ alien>string ] [ LLVMDisposeMessage ] bi throw ;
+
+: <dispose> ( alien class -- disposable ) new swap >>value ;
+
+TUPLE: module value disposed ;
+M: module dispose* value>> LLVMDisposeModule ;
+
+: <module> ( name -- module )
+    LLVMModuleCreateWithName module <dispose> ;
+
+TUPLE: provider value disposed ;
+M: provider dispose* value>> LLVMDisposeModuleProvider ;
+
+: <provider> ( module -- module-provider )
+    ! we don't want to dispose when an error occurs
+    ! for example, retries with the same module wouldn't work
+    ! but we do want to mark the module as disposed on success
+    [ value>> LLVMCreateModuleProviderForExistingModule ]
+    [ t >>disposed drop ] bi
+    provider <dispose> ;
+
+TUPLE: engine value disposed ;
+M: engine dispose* value>> LLVMDisposeExecutionEngine ;
+
+: <engine> ( provider -- engine )
+    [
+        value>> f <void*> f <void*>
+        [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep
+        *void* [ llvm-throw ] when* *void*
+    ]
+    [ t >>disposed drop ] bi
+    engine <dispose> ;
+
+: (add-block) ( name -- basic-block )
+    "function" swap LLVMAppendBasicBlock ;
+
+TUPLE: builder value disposed ;
+M: builder dispose* value>> LLVMDisposeBuilder ;
+
+: <builder> ( name -- builder )
+    (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
+    builder <dispose> ;
\ No newline at end of file