From 5203ba6a765fa1e34e0d5e717cb66d8ef9b1f12d Mon Sep 17 00:00:00 2001 From: James Y Knight Date: Mon, 21 Dec 2009 18:53:04 -0500 Subject: [PATCH] Update example so it works again. --- README | 7 ++ examples/test.lisp | 198 ++++++++++++++++++++++------------------------------- 2 files changed, 88 insertions(+), 117 deletions(-) rewrite examples/test.lisp (63%) diff --git a/README b/README index 13281fe..25f52dc 100644 --- a/README +++ b/README @@ -26,6 +26,13 @@ USING 3) (require 'cl-llvm) + +There's an example of usage in examples/test.lisp. + +A more substantial example of usage is my work to port SBCL itself to +support an LLVM backend, available at: +http://repo.or.cz/w/sbcl/llvm.git/ + NOTES ===== diff --git a/examples/test.lisp b/examples/test.lisp dissimilarity index 63% index f320aba..0bb2fb3 100644 --- a/examples/test.lisp +++ b/examples/test.lisp @@ -1,117 +1,81 @@ -(require 'cl-llvm) - -;;; HACK! make sigabrt not abort. -;; (defun sigabrt-handler (signal info context) -;; (declare (ignore signal info)) -;; (declare (type system-area-pointer context)) -;; (sb-sys:with-interrupts -;; (error "sigabrt at #X~X" -;; (with-alien ((context (* sb-sys:os-context-t) context)) -;; (sb-sys:sap-int (sb-vm:context-pc context)))))) -;; (sb-sys:enable-interrupt sb-posix:sigabrt #'sigabrt-handler) - -;; Make a factorial function! -(defun build-fac-fun () - (let* ((mod *jit-module*)) - ;; Build it - (let* ((fac_args (list (LLVMInt32TypeInContext *llvm-context*))) - (fac (LLVMAddFunction mod "fac" (LLVMFunctionType* (LLVMInt32TypeInContext *llvm-context*) - fac_args 0))) - ;; Create code-builder object; this is reused throughout the rest of the function. - (builder (LLVMCreateBuilderInContext *llvm-context*))) - - ;; Use the c-call calling convention (the default) - (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv :LLVMCCallConv)) - - ;; Create 4 new basic blocks: entry, iftrue, iffalse, end - (let* ((entry (LLVMAppendBasicBlockInContext *llvm-context* fac "entry")) - (iftrue (LLVMAppendBasicBlockInContext *llvm-context* fac "iftrue")) - (iffalse (LLVMAppendBasicBlockInContext *llvm-context* fac "iffalse")) - (end (LLVMAppendBasicBlock fac "end")) - ;; get 0th function argument - (n (LLVMGetParam fac 0)) - ;; make some extra vars to stick stuff in - res-iftrue res-iffalse) - - ;; Create entry BB - (LLVMPositionBuilderAtEnd builder entry) - (let* ((IfNode (LLVMBuildICmp builder :LLVMIntEQ n - (LLVMConstInt (LLVMInt32TypeInContext *llvm-context*) 0 0) - "n == 0"))) - (LLVMBuildCondBr builder IfNode iftrue iffalse)) - - ;; Create true BB - (LLVMPositionBuilderAtEnd builder iftrue) - (setf res-iftrue (LLVMConstInt (LLVMInt32TypeInContext *llvm-context*) 1 0)) - (LLVMBuildBr builder end) - - ;; Create false BB - (LLVMPositionBuilderAtEnd builder iffalse) - (let* ((n-minus (LLVMBuildSub builder n (LLVMConstInt (LLVMInt32TypeInContext *llvm-context*) 1 0) "n - 1")) - (call-fac (LLVMBuildCall* builder fac (list n-minus) "fac(n - 1)"))) - (setf res-iffalse (LLVMBuildMul builder n call-fac "n * fac(n - 1)"))) - (LLVMBuildBr builder end) - - ;; Create end BB - (LLVMPositionBuilderAtEnd builder end) - (let ((res (LLVMBuildPhi builder (LLVMInt32TypeInContext *llvm-context*) "result"))) - (LLVMAddIncoming* res res-iftrue iftrue) - (LLVMAddIncoming* res res-iffalse iffalse) - (LLVMBuildRet builder res))) - - ;; Verify that module is valid - (when (/= 0 (LLVMVerifyModule mod :LLVMPrintMessageAction (cffi:null-pointer))) - (error "Module didn't verify!")) - - ;; Dump textual description for debugging purposes - (LLVMDumpValue fac) - ;; Run some optimizations - (LLVMRunFunctionPassManager *jit-pass-manager* fac) - (LLVMDumpValue fac) - - ;; Clean up - (LLVMDisposeBuilder builder) - fac))) - -(defun build-string-fun () - (let* ((mod *jit-module*)) - ;; Build it - (let* ((fac_args (list (LLVMInt32TypeInContext *llvm-context*))) - (fac (LLVMAddFunction mod "fac" (LLVMFunctionType* (LLVMInt32TypeInContext *llvm-context*) - fac_args 0))) - ;; Create code-builder object; this is reused throughout the rest of the function. - (builder (LLVMCreateBuilderInContext *llvm-context*))) - - ;; Use the c-call calling convention (the default) - (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv :LLVMCCallConv)) - - ;; Create 4 new basic blocks: entry, iftrue, iffalse, end - (let* ((entry (LLVMAppendBasicBlockInContext *llvm-context* fac "entry"))) - (LLVMPositionBuilderAtEnd builder entry) - (let ((global (LLVMAddGlobal mod (LLVMArrayType (LLVMInt8Type) 5) ".str"))) - (LLVMSetInitializer global (LLVMConstStringInContext *llvm-context* "asdf" 4 0)) - (LLVMSetGlobalConstant global 1) - (LLVMBuildRet builder (LLVMBuildGEP* builder global (list (LLVMConstInt (LLVMInt32Type) 0 0) - (LLVMConstInt (LLVMInt32Type) 0 0)))))) - - ;; Dump textual description for debugging purposes - (LLVMDumpValue fac) - - ;; Verify that module is valid - (when (/= 0 (LLVMVerifyModule mod :LLVMPrintMessageAction (cffi:null-pointer))) - (error "Module didn't verify!")) - - ;; Run some optimizations -; (LLVMRunFunctionPassManager *jit-pass-manager* fac) -; (LLVMDumpValue fac) - - ;; Clean up - (LLVMDisposeBuilder builder) - fac))) - -;; Run the code! -(defun run-fun (fun n) - (let ((fun-ptr (LLVMGetPointerToGlobal *jit-execution-engine* fun))) - (cffi:foreign-funcall-pointer fun-ptr () :int64 n :int64))) - - +;; To run the example: +;; (load (compile-file "test.lisp")) +;; (let ((fac (build-fac-fun))) +;; (run-fun fac 5)) +;; +;; TADA! it outputs 120. + +(require 'cl-llvm) +(use-package :llvm) + +;; Make a factorial function! +(defun build-fac-fun () + (let* ((mod *jit-module*)) + ;; Build it + (let* ((fac_args (list (LLVMInt32Type))) + (fac (LLVMAddFunction mod "fac" (LLVMFunctionType (LLVMInt32Type) + fac_args nil))) + ;; Create code-builder object; this is reused throughout the + ;; rest of the function. + (builder (LLVMCreateBuilder))) + + ;; Use the c-call calling convention (the default) + (LLVMSetFunctionCallConv fac (cffi:foreign-enum-value 'LLVMCallConv + :LLVMCCallConv)) + + ;; Create 4 new basic blocks: entry, iftrue, iffalse, end + (let* ((entry (LLVMAppendBasicBlock fac "entry")) + (iftrue (LLVMAppendBasicBlock fac "iftrue")) + (iffalse (LLVMAppendBasicBlock fac "iffalse")) + (end (LLVMAppendBasicBlock fac "end")) + ;; get 0th function argument + (n (LLVMGetParam fac 0)) + ;; make some extra vars to stick stuff in + res-iftrue res-iffalse) + + ;; Create entry BB + (LLVMPositionBuilderAtEnd builder entry) + (let* ((IfNode (LLVMBuildICmp builder :LLVMIntEQ n + (LLVMConstInt (LLVMInt32Type) 0 nil) + "n == 0"))) + (LLVMBuildCondBr builder IfNode iftrue iffalse)) + + ;; Create true BB + (LLVMPositionBuilderAtEnd builder iftrue) + (setf res-iftrue (LLVMConstInt (LLVMInt32Type) 1 nil)) + (LLVMBuildBr builder end) + + ;; Create false BB + (LLVMPositionBuilderAtEnd builder iffalse) + (let* ((n-minus (LLVMBuildSub builder n (LLVMConstInt (LLVMInt32Type) 1 nil) "n - 1")) + (call-fac (LLVMBuildCall builder fac (list n-minus) "fac(n - 1)"))) + (setf res-iffalse (LLVMBuildMul builder n call-fac "n * fac(n - 1)"))) + (LLVMBuildBr builder end) + + ;; Create end BB + (LLVMPositionBuilderAtEnd builder end) + (let ((res (LLVMBuildPhi builder (LLVMInt32Type) "result"))) + (LLVMAddIncoming res res-iftrue iftrue) + (LLVMAddIncoming res res-iffalse iffalse) + (LLVMBuildRet builder res))) + + ;; Verify that module is valid + (when (LLVMVerifyModule mod :LLVMPrintMessageAction (cffi:null-pointer)) + (error "Module didn't verify!")) + + ;; Dump textual description for debugging purposes + (LLVMDumpValue fac) + ;; Run some optimizations + (LLVMRunFunctionPassManager *jit-pass-manager* fac) + (LLVMDumpValue fac) + + ;; Clean up + (LLVMDisposeBuilder builder) + fac))) + +;; Run the function! +(defun run-fun (fun n) + (let ((fun-ptr (LLVMGetPointerToGlobal *jit-execution-engine* fun))) + (cffi:foreign-funcall-pointer fun-ptr () :int64 n :int64))) + + -- 2.11.4.GIT