1 ;; Define some wrappers around the low-level C API functions to make them easier to use.
3 (defun LLVMFunctionType* (ret params is-var-arg
)
4 (let ((len (length params
)))
5 (cffi:with-foreign-object
(array :pointer len
)
6 (loop for param in params
9 (setf (cffi:mem-aref array
:pointer i
) param
))
10 (LLVMFunctionType ret array len is-var-arg
))))
12 (defun LLVMBuildCall* (builder fn args name
)
13 (let ((len (length args
)))
14 (cffi:with-foreign-object
(array :pointer len
)
18 (setf (cffi:mem-aref array
:pointer i
) arg
))
19 (LLVMBuildCall builder fn array len name
))))
21 (defun LLVMAddIncoming* (phi-node incoming-val incoming-block
)
22 (cffi:with-foreign-objects
((incoming-vals :pointer
)
23 (incoming-blocks :pointer
))
24 (setf (cffi:mem-aref incoming-vals
:pointer
0) incoming-val
)
25 (setf (cffi:mem-aref incoming-blocks
:pointer
0) incoming-block
)
26 (LLVMAddIncoming phi-node incoming-vals incoming-blocks
1)))
28 (defun LLVMCreateJITCompiler* (provider opt
)
29 (cffi:with-foreign-objects
((out-engine :pointer
)
30 (out-error-str :pointer
))
31 (if (= 0 (LLVMCreateJITCompiler out-engine provider opt out-error-str
))
32 (cffi:mem-ref out-engine
:pointer
)
33 (let* ((error-str (cffi:mem-ref out-error-str
:pointer
))
34 (error-str-lisp (cffi:foreign-string-to-lisp error-str
)))
35 (LLVMDisposeMessage error-str
)
36 (error "LLVMCreateJITCompiler: ~s" error-str-lisp
)))))
39 (defun LLVMBuildGEP* (builder ptr indices
)
40 (let ((len (length indices
)))
41 (cffi:with-foreign-object
(array :pointer len
)
42 (loop for arg in indices
45 (setf (cffi:mem-aref array
:pointer i
) arg
))
46 (LLVMBuildGEP builder ptr array len
""))))
51 ;; Load up the native codegen.
52 (cffi:defcfun
("CLLLVM_LLVMInitializeNativeTarget" CLLLVM_LLVMInitializeNativeTarget
) :int
)
53 (cffi:defcfun
("CLLLVM_LLVMModuleProviderGetModule" CLLLVM_LLVMModuleProviderGetModule
) :pointer
54 (modprovider :pointer
))
55 (cffi:defcfun
("CLLLVM_LLVMParseAssemblyString" CLLLVM_LLVMParseAssemblyString
) :pointer
60 (CLLLVM_LLVMInitializeNativeTarget)
62 ;; A global context. Most of LLVM is only thread-safe within a single "context". There is an
63 ;; internal-to-LLVM C default global context, implicitly used by a number of functions like
64 ;; LLVM*Type (without InContext on the end), but I make a lisp-side global context here for clarity.
66 ;; Delete with LLVMContextDispose when done.
68 ;; ...FIXME...or not. For some reason making a custom context makes things fail to verify, stating
69 ;; that I've mixed contexts. Need to figure out if this is my fault or a bug in LLVM.
71 ;; So just use the standard global context
72 ;; (defvar *llvm-context* (LLVMContextCreate))
73 (defvar *llvm-context
* (LLVMGetGlobalContext))
75 ;; Top-level LLVM module for running the JIT in. Other modules can be made for codegen-to-disk, but
76 ;; only a single module for JIT execution can exist in the process.
77 (defvar *jit-module
* (LLVMModuleCreateWithNameInContext "jit-module" *llvm-context
*))
79 ;; Module provider...dunno what the purpose of this is, it wraps the module
80 ;; Delete with LLVMDisposeModuleProvider; don't delete the wrapped module
81 (defvar *jit-module-provider
* (LLVMCreateModuleProviderForExistingModule *jit-module
*))
83 ;; Create the JIT compiler, optimization level 2 (whatever that means). This call fails if you run
84 ;; it twice in a process. (which is why we can have only one module for JIT code)
85 (defvar *jit-execution-engine
* (LLVMCreateJITCompiler* *jit-module-provider
* 2))
87 ;; Optimization passes. Cleanup with LLVMDisposePassManager.
88 (defvar *jit-pass-manager
* (LLVMCreateFunctionPassManager *jit-module-provider
*))
89 (let ((pass *jit-pass-manager
*))
90 (LLVMAddTargetData (LLVMGetExecutionEngineTargetData *jit-execution-engine
*) pass
)
91 (LLVMAddConstantPropagationPass pass
)
92 (LLVMAddInstructionCombiningPass pass
)
93 (LLVMAddPromoteMemoryToRegisterPass pass
)
95 (LLVMAddCFGSimplificationPass pass
))