examples/test.lisp

   1 (require 'cl-llvm)
   2
   3 ;;; HACK! make sigabrt not abort.
   4 (defun sigabrt-handler (signal info context)
   5   (declare (ignore signal info))
   6   (declare (type system-area-pointer context))
   7   (sb-sys:with-interrupts
   8          (error "sigabrt at #X~X"
   9                 (with-alien ((context (* sb-sys:os-context-t) context))
  10                   (sb-sys:sap-int (sb-vm:context-pc context))))))
  11 (sb-sys:enable-interrupt sb-posix:sigabrt #'sigabrt-handler)
  12
  13 ;; Make a factorial function!
  14 (defun build-fac-fun ()
  15   (let* ((mod *jit-module*))
  16     ;; Build it
  17     (let* ((fac_args (list (LLVMInt32TypeInContext *llvm-context*)))
  18            (fac (LLVMAddFunction mod "fac" (LLVMFunctionType* (LLVMInt32TypeInContext *llvm-context*)
  19                                                               fac_args 0)))
  20          ;; Create code-builder object; this is reused throughout the rest of the function.
  21          (builder (LLVMCreateBuilderInContext *llvm-context*)))
  22
  23       ;; Use the c-call calling convention (the default)
  24       (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv :LLVMCCallConv))
  25
  26       ;; Create 4 new basic blocks: entry, iftrue, iffalse, end
  27       (let* ((entry (LLVMAppendBasicBlockInContext *llvm-context* fac "entry"))
  28              (iftrue (LLVMAppendBasicBlockInContext *llvm-context* fac "iftrue"))
  29              (iffalse (LLVMAppendBasicBlockInContext *llvm-context* 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 (LLVMInt32TypeInContext *llvm-context*) 0 0)
  40                                       "n == 0")))
  41           (LLVMBuildCondBr builder IfNode iftrue iffalse))
  42
  43         ;; Create true BB
  44         (LLVMPositionBuilderAtEnd builder iftrue)
  45         (setf res-iftrue (LLVMConstInt (LLVMInt32TypeInContext *llvm-context*) 1 0))
  46         (LLVMBuildBr builder end)
  47
  48         ;; Create false BB
  49         (LLVMPositionBuilderAtEnd builder iffalse)
  50         (let* ((n-minus (LLVMBuildSub builder n (LLVMConstInt (LLVMInt32TypeInContext *llvm-context*) 1 0) "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 (LLVMInt32TypeInContext *llvm-context*) "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 (/= 0 (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 code!
  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