src/stuff.lisp

   1 ;; Define some wrappers around the low-level C API functions to make them easier to use.
   2
   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
   7             for i from 0
   8             do
   9             (setf (cffi:mem-aref array :pointer i) param))
  10       (LLVMFunctionType ret array len is-var-arg))))
  11
  12 (defun LLVMBuildCall* (builder fn args name)
  13   (let ((len (length args)))
  14     (cffi:with-foreign-object (array :pointer len)
  15       (loop for arg in args
  16             for i from 0
  17             do
  18             (setf (cffi:mem-aref array :pointer i) arg))
  19       (LLVMBuildCall builder fn array len name))))
  20
  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)))
  27
  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)))))
  37
  38
  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
  43             for i from 0
  44             do
  45             (setf (cffi:mem-aref array :pointer i) arg))
  46       (LLVMBuildGEP builder ptr array len ""))))
  47
  48
  49
  50
  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
  56   (asm-string :string)
  57   (module :pointer)
  58   (context :pointer))
  59
  60 (CLLLVM_LLVMInitializeNativeTarget)
  61
  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.
  65 ;;
  66 ;; Delete with LLVMContextDispose when done.
  67 ;;
  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.
  70 ;;
  71 ;; So just use the standard global context
  72 ;;  (defvar *llvm-context* (LLVMContextCreate))
  73 (defvar *llvm-context* (LLVMGetGlobalContext))
  74
  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*))
  78
  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*))
  82
  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))
  86
  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)
  94   (LLVMAddGVNPass pass)
  95   (LLVMAddCFGSimplificationPass pass))