Start to clean things up to get into a state usable by others.
[cl-llvm.git] / examples / test.lisp
blobf320aba01bd4d492cd8f105e94a4e311430adc35
1 (require 'cl-llvm)
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)
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*)))
23 ;; Use the c-call calling convention (the default)
24 (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv :LLVMCCallConv))
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)
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))
43 ;; Create true BB
44 (LLVMPositionBuilderAtEnd builder iftrue)
45 (setf res-iftrue (LLVMConstInt (LLVMInt32TypeInContext *llvm-context*) 1 0))
46 (LLVMBuildBr builder end)
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)
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)))
62 ;; Verify that module is valid
63 (when (/= 0 (LLVMVerifyModule mod :LLVMPrintMessageAction (cffi:null-pointer)))
64 (error "Module didn't verify!"))
66 ;; Dump textual description for debugging purposes
67 (LLVMDumpValue fac)
68 ;; Run some optimizations
69 (LLVMRunFunctionPassManager *jit-pass-manager* fac)
70 (LLVMDumpValue fac)
72 ;; Clean up
73 (LLVMDisposeBuilder builder)
74 fac)))
76 (defun build-string-fun ()
77 (let* ((mod *jit-module*))
78 ;; Build it
79 (let* ((fac_args (list (LLVMInt32TypeInContext *llvm-context*)))
80 (fac (LLVMAddFunction mod "fac" (LLVMFunctionType* (LLVMInt32TypeInContext *llvm-context*)
81 fac_args 0)))
82 ;; Create code-builder object; this is reused throughout the rest of the function.
83 (builder (LLVMCreateBuilderInContext *llvm-context*)))
85 ;; Use the c-call calling convention (the default)
86 (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv :LLVMCCallConv))
88 ;; Create 4 new basic blocks: entry, iftrue, iffalse, end
89 (let* ((entry (LLVMAppendBasicBlockInContext *llvm-context* fac "entry")))
90 (LLVMPositionBuilderAtEnd builder entry)
91 (let ((global (LLVMAddGlobal mod (LLVMArrayType (LLVMInt8Type) 5) ".str")))
92 (LLVMSetInitializer global (LLVMConstStringInContext *llvm-context* "asdf" 4 0))
93 (LLVMSetGlobalConstant global 1)
94 (LLVMBuildRet builder (LLVMBuildGEP* builder global (list (LLVMConstInt (LLVMInt32Type) 0 0)
95 (LLVMConstInt (LLVMInt32Type) 0 0))))))
97 ;; Dump textual description for debugging purposes
98 (LLVMDumpValue fac)
100 ;; Verify that module is valid
101 (when (/= 0 (LLVMVerifyModule mod :LLVMPrintMessageAction (cffi:null-pointer)))
102 (error "Module didn't verify!"))
104 ;; Run some optimizations
105 ; (LLVMRunFunctionPassManager *jit-pass-manager* fac)
106 ; (LLVMDumpValue fac)
108 ;; Clean up
109 (LLVMDisposeBuilder builder)
110 fac)))
112 ;; Run the code!
113 (defun run-fun (fun n)
114 (let ((fun-ptr (LLVMGetPointerToGlobal *jit-execution-engine* fun)))
115 (cffi:foreign-funcall-pointer fun-ptr () :int64 n :int64)))