install functions from llvm bytecode, with test

diff --git a/extra/llvm/core/core.factor b/extra/llvm/core/core.factor
index 292a25b80b6c678b202e3444b5c5ec50a1a5a7ec..f63927455ac0b735da60573d4e6411c75916ec6e 100644 (file)
--- a/extra/llvm/core/core.factor
+++ b/extra/llvm/core/core.factor
@@ -10,6 +10,8 @@ IN: llvm.core
 
 "LLVMCore" "/usr/local/lib/libLLVMCore.dylib" "cdecl" add-library
 
+"LLVMBitReader" "/usr/local/lib/libLLVMBitReader.dylib" "cdecl" add-library
+
 >>
 
 ! llvm-c/Core.h
@@ -124,9 +126,11 @@ TYPEDEF: void* LLVMBasicBlockRef
 
 TYPEDEF: void* LLVMBuilderRef
 
+TYPEDEF: void* LLVMMemoryBufferRef
+
 ! Functions
 
-FUNCTION: void LLVMDisposeMessage ( char *Message ) ;
+FUNCTION: void LLVMDisposeMessage ( char* Message ) ;
 
 FUNCTION: LLVMModuleRef LLVMModuleCreateWithName ( char* ModuleID ) ;
 
@@ -395,3 +399,18 @@ FUNCTION: LLVMValueRef LLVMBuildExtractValue
 ( LLVMBuilderRef Builder, LLVMValueRef AggVal, unsigned Index, char* Name ) ;
 FUNCTION: LLVMValueRef LLVMBuildInsertValue
 ( LLVMBuilderRef Builder, LLVMValueRef AggVal, LLVMValueRef EltVal, unsigned Index, char* Name ) ;
+
+! Memory Buffers/Bit Reader
+
+FUNCTION: int LLVMCreateMemoryBufferWithContentsOfFile
+( char* Path, LLVMMemoryBufferRef* OutMemBuf, char** OutMessage ) ;
+
+FUNCTION: void LLVMDisposeMemoryBuffer ( LLVMMemoryBufferRef MemBuf ) ;
+
+LIBRARY: LLVMBitReader
+
+FUNCTION: int LLVMParseBitcode
+( LLVMMemoryBufferRef MemBuf, LLVMModuleRef* OutModule, char** OutMessage ) ;
+ 
+FUNCTION: int LLVMGetBitcodeModuleProvider
+( LLVMMemoryBufferRef MemBuf, LLVMModuleProviderRef* OutMP, char** OutMessage ) ;

diff --git a/extra/llvm/invoker/invoker.factor b/extra/llvm/invoker/invoker.factor
new file mode 100644 (file)
index 0000000..55ebe6d
--- /dev/null
+++ b/extra/llvm/invoker/invoker.factor
@@ -0,0 +1,54 @@
+USING: accessors alien arrays assocs compiler.units effects
+io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
+llvm.types make namespaces sequences specialized-arrays.alien
+vocabs words ;
+
+IN: llvm.invoker
+
+! get function name, ret type, param types and names
+
+! load module
+! iterate through functions in a module
+
+TUPLE: function name alien return params ;
+
+: params ( llvm-function -- param-list )
+    dup LLVMCountParams <void*-array>
+    [ LLVMGetParams ] keep >array
+    [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
+
+: <function> ( LLVMValueRef -- function )
+    function new
+    over LLVMGetValueName >>name
+    over LLVMTypeOf tref> type>> return>> >>return
+    swap params >>params ;
+
+: (functions) ( llvm-function -- )
+    [ dup , LLVMGetNextFunction (functions) ] when* ;
+
+: functions ( llvm-module -- functions )
+    LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
+
+: function-effect ( function -- effect )
+    [ params>> [ first ] map ] [ 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 ,
+        "cdecl" , \ alien-indirect ,
+    ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
+
+: install-module ( name -- )
+    thejit get mps>> at [
+        module>> functions [ install-function ] each
+    ] [ "no such module" throw ] if* ;
+
+: install-bc ( path -- )
+    [ normalize-path ] [ file-name ] bi
+    [ load-into-jit ] keep install-module ;
+    
+<< "alien.llvm" create-vocab drop >>
\ No newline at end of file

diff --git a/extra/llvm/jit/jit-tests.factor b/extra/llvm/jit/jit-tests.factor
index 5a894e5a50171b585460a563296a9610051250c2..9808ecb953b537532e5c72a3beadbe6ff879d8a0 100644 (file)
--- a/extra/llvm/jit/jit-tests.factor
+++ b/extra/llvm/jit/jit-tests.factor
@@ -1,3 +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
+[ ] [ "test" <module> "test" add-module "test" remove-module ] unit-test
\ No newline at end of file

diff --git a/extra/llvm/jit/jit.factor b/extra/llvm/jit/jit.factor
index 5a8574261964e6e8eac3a1276f43c1713b80f067..9281b609e369f78eb6ae3a78b8f7ee5cb4e5b087 100644 (file)
--- a/extra/llvm/jit/jit.factor
+++ b/extra/llvm/jit/jit.factor
@@ -8,11 +8,7 @@ SYMBOL: thejit
 TUPLE: jit ee mps ;
 
 : empty-engine ( -- engine )
-    "initial-module" <module> [
-        <provider>
-    ] with-disposal [
-        <engine>
-    ] with-disposal ;
+    "initial-module" <module> <provider> <engine> ;
 
 : <jit> ( -- jit )
     jit new empty-engine >>ee H{ } clone >>mps ;
@@ -25,21 +21,27 @@ TUPLE: jit ee mps ;
     ! free machine code for each function in module
     LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
 
-: (remove-provider) ( provider -- )
+: 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 -- )
+: remove-module ( name -- )
     dup thejit get mps>> at [
-        (remove-provider)
+        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 ;
+: add-module ( module name -- )
+    [ <provider> ] dip [ remove-module ] keep
+    thejit get ee>> value>> pick
+    [ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
+    thejit get mps>> set-at ;
+
+: function-pointer ( name -- alien )
+    thejit get ee>> value>> dup
+    rot f <void*> [ LLVMFindFunction drop ] keep
+    *void* LLVMGetPointerToGlobal ;
 
 thejit [ <jit> ] initialize
\ No newline at end of file

diff --git a/extra/llvm/reader/add.bc b/extra/llvm/reader/add.bc
new file mode 100644 (file)
index 0000000..c0ba738
Binary files /dev/null and b/extra/llvm/reader/add.bc differ

diff --git a/extra/llvm/reader/add.ll b/extra/llvm/reader/add.ll
new file mode 100644 (file)
index 0000000..4ac57a2
--- /dev/null
+++ b/extra/llvm/reader/add.ll
@@ -0,0 +1,5 @@
+define i32 @add(i32 %x, i32 %y) {
+entry:
+  %sum = add i32 %x, %y
+  ret i32 %sum
+}

diff --git a/extra/llvm/reader/reader.factor b/extra/llvm/reader/reader.factor
new file mode 100644 (file)
index 0000000..8ff6d50
--- /dev/null
+++ b/extra/llvm/reader/reader.factor
@@ -0,0 +1,18 @@
+USING: accessors alien.c-types alien.syntax destructors kernel
+llvm.core llvm.engine llvm.jit llvm.wrappers ;
+
+IN: llvm.reader
+
+: buffer>module ( buffer -- module )
+    [
+        value>> f <void*> f <void*>
+        [ LLVMParseBitcode drop ] 2keep
+        *void* [ llvm-throw ] when* *void*
+        module new swap >>value
+    ] with-disposal ;
+
+: load-module ( path -- module )
+    <buffer> buffer>module ;
+
+: load-into-jit ( path name -- )
+    [ load-module ] dip add-module ;
\ No newline at end of file

diff --git a/extra/llvm/wrappers/wrappers-tests.factor b/extra/llvm/wrappers/wrappers-tests.factor
index fe90184a5d3883ccd53cad8f559d2ec9254113d7..321762e2cf9ee83cfa3a9e1eaa4b33a057413b6b 100644 (file)
--- a/extra/llvm/wrappers/wrappers-tests.factor
+++ b/extra/llvm/wrappers/wrappers-tests.factor
@@ -1,5 +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
+[ ] [ "test" <module> <provider> dispose ] unit-test
+[ ] [ "llvm.jit" vocabs member? [ "test" <module> <provider> <engine> dispose ] unless ] unit-test
\ No newline at end of file

diff --git a/extra/llvm/wrappers/wrappers.factor b/extra/llvm/wrappers/wrappers.factor
index 2a3e696edc2c5594af91d406c9ba4ce84a60f16e..22da1b36f467cc1f19269b79242824df8f047f89 100644 (file)
--- a/extra/llvm/wrappers/wrappers.factor
+++ b/extra/llvm/wrappers/wrappers.factor
@@ -1,10 +1,11 @@
-USING: accessors alien.c-types alien.strings destructors kernel
+USING: accessors alien.c-types alien.strings
+io.encodings.utf8 destructors kernel
 llvm.core llvm.engine ;
 
 IN: llvm.wrappers
 
 : llvm-throw ( char* -- )
-    [ alien>string ] [ LLVMDisposeMessage ] bi throw ;
+    [ utf8 alien>string ] [ LLVMDisposeMessage ] bi throw ;
 
 : <dispose> ( alien class -- disposable ) new swap >>value ;
 
@@ -14,21 +15,21 @@ M: module dispose* value>> LLVMDisposeModule ;
 : <module> ( name -- module )
     LLVMModuleCreateWithName module <dispose> ;
 
-TUPLE: provider value disposed ;
+TUPLE: provider value module 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> ;
+: (provider) ( module -- provider )
+    [ value>> LLVMCreateModuleProviderForExistingModule provider <dispose> ]
+    [ t >>disposed value>> ] bi
+    >>module ;
+
+: <provider> ( module -- provider )
+    [ (provider) ] with-disposal ;
 
 TUPLE: engine value disposed ;
 M: engine dispose* value>> LLVMDisposeExecutionEngine ;
 
-: <engine> ( provider -- engine )
+: (engine) ( provider -- engine )
     [
         value>> f <void*> f <void*>
         [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep
@@ -37,6 +38,9 @@ M: engine dispose* value>> LLVMDisposeExecutionEngine ;
     [ t >>disposed drop ] bi
     engine <dispose> ;
 
+: <engine> ( provider -- engine )
+    [ (engine) ] with-disposal ;
+
 : (add-block) ( name -- basic-block )
     "function" swap LLVMAppendBasicBlock ;
 
@@ -45,4 +49,12 @@ M: builder dispose* value>> LLVMDisposeBuilder ;
 
 : <builder> ( name -- builder )
     (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
-    builder <dispose> ;
\ No newline at end of file
+    builder <dispose> ;
+
+TUPLE: buffer value disposed ;
+M: buffer dispose* value>> LLVMDisposeMemoryBuffer ;
+
+: <buffer> ( path -- module )
+    f <void*> f <void*>
+    [ LLVMCreateMemoryBufferWithContentsOfFile drop ] 2keep
+    *void* [ llvm-throw ] when* *void* buffer <dispose> ;
\ No newline at end of file