2 ;; (load (compile-file "test.lisp"))
3 ;; (let ((fac (build-fac-fun)))
6 ;; TADA! it outputs 120.
11 ;; Make a factorial function!
12 (defun build-fac-fun ()
13 (let* ((mod *jit-module
*))
15 (let* ((fac_args (list (LLVMInt32Type)))
16 (fac (LLVMAddFunction mod
"fac" (LLVMFunctionType (LLVMInt32Type)
18 ;; Create code-builder object; this is reused throughout the
19 ;; rest of the function.
20 (builder (LLVMCreateBuilder)))
22 ;; Use the c-call calling convention (the default)
23 (LLVMSetFunctionCallConv fac
(cffi:foreign-enum-value
'LLVMCallConv
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
)
37 (LLVMPositionBuilderAtEnd builder entry
)
38 (let* ((IfNode (LLVMBuildICmp builder
:LLVMIntEQ n
39 (LLVMConstInt (LLVMInt32Type) 0 nil
)
41 (LLVMBuildCondBr builder IfNode iftrue iffalse
))
44 (LLVMPositionBuilderAtEnd builder iftrue
)
45 (setf res-iftrue
(LLVMConstInt (LLVMInt32Type) 1 nil
))
46 (LLVMBuildBr builder end
)
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
)
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
)))
62 ;; Verify that module is valid
63 (when (LLVMVerifyModule mod
:LLVMPrintMessageAction
(cffi:null-pointer
))
64 (error "Module didn't verify!"))
66 ;; Dump textual description for debugging purposes
68 ;; Run some optimizations
69 (LLVMRunFunctionPassManager *jit-pass-manager
* fac
)
73 (LLVMDisposeBuilder builder
)
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
)))