examples/test.lisp

   1 ;; To run the example:
   2 ;; (load (compile-file "test.lisp"))
   3 ;; (let ((fac (build-fac-fun)))
   4 ;;   (run-fun fac 5))
   5 ;;
   6 ;; TADA! it outputs 120.
   7
   8 (require 'cl-llvm)
   9 (use-package :llvm)
  10
  11 ;; Make a factorial function!
  12 (defun build-fac-fun ()
  13   (let* ((mod *jit-module*))
  14     ;; Build it
  15     (let* ((fac_args (list (LLVMInt32Type)))
  16            (fac (LLVMAddFunction mod "fac" (LLVMFunctionType (LLVMInt32Type)
  17                                                              fac_args nil)))
  18          ;; Create code-builder object; this is reused throughout the
  19          ;; rest of the function.
  20          (builder (LLVMCreateBuilder)))
  21
  22       ;; Use the c-call calling convention (the default)
  23       (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv
  24                                                             :LLVMCCallConv))
  25
  26       ;; Create 4 new basic blocks: entry, iftrue, iffalse, end
  27       (let* ((entry (LLVMAppendBasicBlock fac "entry"))
  28              (iftrue (LLVMAppendBasicBlock fac "iftrue"))
  29              (iffalse (LLVMAppendBasicBlock fac "iffalse"))
  30              (end (LLVMAppendBasicBlock fac "end"))
  31              ;; get 0th function argument
  32              (n (LLVMGetParam fac 0))
  33              ;; make some extra vars to stick stuff in
  34              res-iftrue res-iffalse)
  35
  36         ;; Create entry BB
  37         (LLVMPositionBuilderAtEnd builder entry)
  38         (let* ((IfNode (LLVMBuildICmp builder :LLVMIntEQ n
  39                                       (LLVMConstInt (LLVMInt32Type) 0 nil)
  40                                       "n == 0")))
  41           (LLVMBuildCondBr builder IfNode iftrue iffalse))
  42
  43         ;; Create true BB
  44         (LLVMPositionBuilderAtEnd builder iftrue)
  45         (setf res-iftrue (LLVMConstInt (LLVMInt32Type) 1 nil))
  46         (LLVMBuildBr builder end)
  47
  48         ;; Create false BB
  49         (LLVMPositionBuilderAtEnd builder iffalse)
  50         (let* ((n-minus (LLVMBuildSub builder n (LLVMConstInt (LLVMInt32Type) 1 nil) "n - 1"))
  51                (call-fac (LLVMBuildCall builder fac (list n-minus) "fac(n - 1)")))
  52           (setf res-iffalse (LLVMBuildMul builder n call-fac "n * fac(n - 1)")))
  53         (LLVMBuildBr builder end)
  54
  55         ;; Create end BB
  56         (LLVMPositionBuilderAtEnd builder end)
  57         (let ((res (LLVMBuildPhi builder (LLVMInt32Type) "result")))
  58           (LLVMAddIncoming res res-iftrue iftrue)
  59           (LLVMAddIncoming res res-iffalse iffalse)
  60           (LLVMBuildRet builder res)))
  61
  62       ;; Verify that module is valid
  63       (when (LLVMVerifyModule mod :LLVMPrintMessageAction (cffi:null-pointer))
  64         (error "Module didn't verify!"))
  65
  66       ;; Dump textual description for debugging purposes
  67       (LLVMDumpValue fac)
  68       ;; Run some optimizations
  69       (LLVMRunFunctionPassManager *jit-pass-manager* fac)
  70       (LLVMDumpValue fac)
  71
  72       ;; Clean up
  73       (LLVMDisposeBuilder builder)
  74       fac)))
  75
  76 ;; Run the function!
  77 (defun run-fun (fun n)
  78   (let ((fun-ptr (LLVMGetPointerToGlobal *jit-execution-engine* fun)))
  79     (cffi:foreign-funcall-pointer fun-ptr () :int64 n :int64)))
  80
  81