llvm: more of the old api added, and some tests

diff --git a/extra/llvm/ffi/ffi-tests.factor b/extra/llvm/ffi/ffi-tests.factor
index 4836c219f1b1de25d85cc706ebfecce16238d2c9..51865760d9a5eb292d47fa1682c88cd62251573b 100644 (file)
--- a/extra/llvm/ffi/ffi-tests.factor
+++ b/extra/llvm/ffi/ffi-tests.factor
@@ -4,6 +4,14 @@ IN: llvm.ffi.tests
 
 { } [
     "my_module" LLVMModuleCreateWithName
-    dup LLVMDumpModule
+    ! dup LLVMDumpModule
     LLVMDisposeModule
 ] unit-test
+
+{ 10 } [
+    LLVMInt32Type 10 LLVMVectorType LLVMGetVectorSize
+] unit-test
+
+{ 32 } [
+    LLVMInt32Type LLVMGetIntTypeWidth
+] unit-test

diff --git a/extra/llvm/ffi/ffi.factor b/extra/llvm/ffi/ffi.factor
index b5cc25f9ec50662e973a74e8255ccdaf52eb7e0b..05495bb1e29271ce58b49c96717ce4dd864f35c7 100644 (file)
--- a/extra/llvm/ffi/ffi.factor
+++ b/extra/llvm/ffi/ffi.factor
@@ -24,7 +24,6 @@ TYPEDEF: void* LLVMModuleRef
 TYPEDEF: void* LLVMPassManagerRef
 TYPEDEF: void* LLVMModuleProviderRef
 TYPEDEF: void* LLVMTypeRef
-TYPEDEF: void* LLVMTypeHandleRef
 TYPEDEF: void* LLVMValueRef
 TYPEDEF: void* LLVMBasicBlockRef
 TYPEDEF: void* LLVMBuilderRef
@@ -60,19 +59,58 @@ FUNCTION: LLVMBool LLVMVerifyModule ( LLVMModuleRef M, int Action, char **OutMes
 FUNCTION: c-string LLVMGetTarget ( LLVMModuleRef M )
 
 ! Types
+
+! ! Basic  types
+FUNCTION: LLVMTypeRef LLVMFloatType ( )
+FUNCTION: LLVMTypeRef LLVMDoubleType ( )
+
+FUNCTION: LLVMTypeRef LLVMX86FP80Type ( )
+FUNCTION: LLVMTypeRef LLVMFP128Type ( )
+FUNCTION: LLVMTypeRef LLVMPPCFP128Type ( )
+
+FUNCTION: LLVMTypeRef LLVMVoidType ( )
+FUNCTION: LLVMTypeRef LLVMLabelType ( )
+FUNCTION: LLVMTypeRef LLVMOpaqueType ( )
+
+! ! Integer type
 FUNCTION: LLVMTypeRef LLVMInt1Type ( )
 FUNCTION: LLVMTypeRef LLVMInt8Type ( )
 FUNCTION: LLVMTypeRef LLVMInt16Type ( )
 FUNCTION: LLVMTypeRef LLVMInt32Type ( )
 FUNCTION: LLVMTypeRef LLVMInt64Type ( )
 FUNCTION: LLVMTypeRef LLVMIntType ( unsigned NumBits )
+FUNCTION: unsigned LLVMGetIntTypeWidth ( LLVMTypeRef IntegerTy )
+
+! ! Array type
+FUNCTION: LLVMTypeRef LLVMArrayType ( LLVMTypeRef ElementType, unsigned ElementCount )
+FUNCTION: unsigned LLVMGetArrayLength ( LLVMTypeRef ArrayTy )
+
+! ! Pointer type
+FUNCTION: LLVMTypeRef LLVMPointerType ( LLVMTypeRef ElementType, unsigned AddressSpace )
+
+! ! Vector type
+FUNCTION: LLVMTypeRef LLVMVectorType ( LLVMTypeRef ElementType, unsigned ElementCount )
+FUNCTION: unsigned LLVMGetVectorSize ( LLVMTypeRef VectorTy )
+
+! ! Function type
 FUNCTION: LLVMTypeRef LLVMFunctionType ( LLVMTypeRef ReturnType,
                                          LLVMTypeRef* ParamTypes,
                                          unsigned ParamCount, int IsVarArg )
-FUNCTION: LLVMTypeKind LLVMGetTypeKind ( LLVMTypeRef Ty )
 FUNCTION: LLVMTypeRef LLVMGetReturnType ( LLVMTypeRef FunctionTy )
+FUNCTION: int LLVMIsFunctionVarArg ( LLVMTypeRef FunctionTy )
+FUNCTION: unsigned LLVMCountParamTypes ( LLVMTypeRef FunctionTy )
+FUNCTION: void LLVMGetParamTypes ( LLVMTypeRef FunctionTy, LLVMTypeRef* Dest )
+
+! ! Struct type
+FUNCTION: LLVMTypeRef LLVMStructType ( LLVMTypeRef* ElementTypes,
+                                       unsigned ElementCount, int Packed )
+FUNCTION: int LLVMIsPackedStruct ( LLVMTypeRef StructTy )
+FUNCTION: unsigned LLVMCountStructElementTypes ( LLVMTypeRef StructTy )
+FUNCTION: void LLVMGetStructElementTypes ( LLVMTypeRef StructTy, LLVMTypeRef* Dest )
+
+! ! Type util
+FUNCTION: LLVMTypeKind LLVMGetTypeKind ( LLVMTypeRef Ty )
 FUNCTION: LLVMTypeRef LLVMGetElementType ( LLVMTypeRef Ty )
-FUNCTION: unsigned LLVMGetIntTypeWidth ( LLVMTypeRef IntegerTy )
 
 ! Values
 FUNCTION: LLVMValueRef LLVMAddFunction ( LLVMModuleRef M,
@@ -155,4 +193,4 @@ FUNCTION: void LLVMInitializeX86TargetInfo ( )
 FUNCTION: void LLVMInitializeX86Target ( )
 FUNCTION: void LLVMInitializeX86TargetMC ( )
 
-! Removed symbols: LLVMCreateJITCompiler
+! Removed symbols: LLVMCreateJITCompiler, LLVMCreateTypeHandle

diff --git a/extra/llvm/wrappers/wrappers-docs.factor b/extra/llvm/wrappers/wrappers-docs.factor
index eee657a5f795e4e6823bcc6434f8bdbe749e0b13..59171181fa9ec295d47d03909a898a25c9e6849a 100644 (file)
--- a/extra/llvm/wrappers/wrappers-docs.factor
+++ b/extra/llvm/wrappers/wrappers-docs.factor
@@ -6,3 +6,7 @@ IN: llvm.wrappers
 HELP: <provider>
 { $values { "module" module } { "provider" provider } }
 { $description "Creates a module provider from a given module. The provider takes ownership of the module." } ;
+
+HELP: <engine>
+{ $values { "module" module } { "engine" engine } }
+{ $description "Creates a engine from a given module. The engine takes ownership of the module and disposes it." } ;

diff --git a/extra/llvm/wrappers/wrappers-tests.factor b/extra/llvm/wrappers/wrappers-tests.factor
index 3a6956117a18ae7512d365de223a2134f418b9e2..acaaaadca4595fce2d0aebcc74c42760eb2b2b16 100644 (file)
--- a/extra/llvm/wrappers/wrappers-tests.factor
+++ b/extra/llvm/wrappers/wrappers-tests.factor
@@ -2,14 +2,22 @@ USING: accessors alien destructors io.pathnames kernel llvm.ffi
 llvm.reader llvm.wrappers tools.test ;
 IN: llvm.wrappers.tests
 
-CONSTANT: ADD.BC "resource:extra/llvm/wrappers/add.bc"
+: add.bc ( -- path )
+    "resource:extra/llvm/wrappers/add.bc" absolute-path ;
 
 { 728 t } [
-    ADD.BC absolute-path <buffer>
+    add.bc <buffer>
     [ value>> [ LLVMGetBufferSize ] keep ] with-disposal alien?
 ] unit-test
 
-{ "sum" 2 } [
-    ADD.BC absolute-path load-module <engine>
-    "sum" find-function [ LLVMGetValueName ] [ LLVMCountParams ] bi
+{ "sum" 2 32 LLVMIntegerTypeKind } [
+    add.bc load-module <engine>
+    "sum" find-function
+    [ LLVMGetValueName ]
+    [ LLVMCountParams ]
+    [
+        LLVMTypeOf LLVMGetElementType LLVMGetReturnType
+        [ LLVMGetIntTypeWidth ]
+        [ LLVMGetTypeKind ] bi
+    ] tri
 ] unit-test

diff --git a/extra/llvm/wrappers/wrappers.factor b/extra/llvm/wrappers/wrappers.factor
index 67aef496787b0433be5a6a92b42e052130d79ef4..ce0a576e02f26a993d6e99819b65825e7ec59e14 100644 (file)
--- a/extra/llvm/wrappers/wrappers.factor
+++ b/extra/llvm/wrappers/wrappers.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Matthew Willis, 2017 Björn Lindqvist.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data alien.strings destructors io
-io.encodings.utf8 kernel llvm.ffi prettyprint ;
+USING: accessors alien.c-types alien.data alien.strings destructors
+io.encodings.utf8 kernel llvm.ffi ;
 IN: llvm.wrappers
 
 ERROR: llvm-error message ;
@@ -9,6 +9,9 @@ ERROR: llvm-error message ;
 : llvm-throw ( void* -- )
     [ utf8 alien>string ] [ LLVMDisposeMessage ] bi llvm-error ;
 
+: llvm-throw-on-error ( quot -- )
+    keep swap 0 = [ drop ] [ void* deref llvm-throw ] if ; inline
+
 : <dispose> ( alien class -- disposable ) new swap >>value ;
 
 TUPLE: module value disposed ;
@@ -17,6 +20,10 @@ M: module dispose* value>> LLVMDisposeModule ;
 : <module> ( name -- module )
     LLVMModuleCreateWithName module <dispose> ;
 
+: verify-module ( module -- )
+    value>> LLVMReturnStatusAction f void* <ref>
+    [ LLVMVerifyModule ] llvm-throw-on-error ;
+
 TUPLE: provider value module disposed ;
 M: provider dispose* value>> LLVMDisposeModuleProvider ;
 
@@ -32,9 +39,8 @@ TUPLE: engine value disposed ;
 M: engine dispose* value>> LLVMDisposeExecutionEngine ;
 
 : (engine) ( LLVMModuleRef -- LLVMExecutionEngineRef )
-    f void* <ref> f void* <ref>
-    [ swapd LLVMCreateExecutionEngineForModule drop ] 2keep
-    void* deref [ llvm-throw ] when*
+    f void* <ref> swap dupd f void* <ref>
+    [ LLVMCreateExecutionEngineForModule ] llvm-throw-on-error
     void* deref ;
 
 : <engine> ( module -- engine )
@@ -57,3 +63,13 @@ M: buffer dispose* value>> LLVMDisposeMemoryBuffer ;
     f void* <ref> f void* <ref>
     [ LLVMCreateMemoryBufferWithContentsOfFile drop ] 2keep
     void* deref [ llvm-throw ] when* void* deref buffer <dispose> ;
+
+: (add-block) ( value -- basic-block )
+    "entry" LLVMAppendBasicBlock ;
+
+TUPLE: builder value disposed ;
+M: builder dispose* value>> LLVMDisposeBuilder ;
+
+: <builder> ( value -- builder )
+    (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
+    builder <dispose> ;