Added global jit, and convenience words for dealing with it

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 ) ;

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 ) ;
 

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

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

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

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> ;