Skip to content

Instantly share code, notes, and snippets.

@nasser
Last active September 15, 2015 22:13
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save nasser/817ad1e7eed9e2338181 to your computer and use it in GitHub Desktop.
Save nasser/817ad1e7eed9e2338181 to your computer and use it in GitHub Desktop.
Fibonacci sequence in Clojure/LLVM
;; https://pauladamsmith.com/blog/2015/01/how-to-get-started-with-llvm-c-api.html
(import LLVM
LLVMModuleRef
LLVMTypeRef
Wrap
LLVMBool
LLVMLinkage)
(def genstr (comp str gensym))
(defn add
([bldr a b] (add bldr a b "tmp"))
([bldr a b n]
(LLVM/BuildAdd bldr a b n)))
(defn sub
([bldr a b] (sub bldr a b "tmp"))
([bldr a b n]
(LLVM/BuildSub bldr a b n)))
(defn mul
([bldr a b] (mul bldr a b "tmp"))
([bldr a b n]
(LLVM/BuildMul bldr a b n)))
(defn call
([bldr f args] (call bldr f args "tmp"))
([bldr f args n]
(LLVM/BuildCall bldr f (into-array args) n)))
(defn ret
[bldr v] (LLVM/BuildRet bldr v))
(defn param [f i]
(LLVM/GetParam f i))
(defn icmp-ult
([bldr lhs rhs] (icmp-ult bldr lhs rhs "tmp"))
([bldr lhs rhs n]
(LLVM/BuildICmp bldr LLVMIntPredicate/LLVMIntULT lhs rhs n)))
(defn br
([bldr dest]
(LLVM/BuildBr bldr dest))
([bldr if then else]
(LLVM/BuildCondBr bldr if then else)))
(defn gep-ib
([bldr v i] (gep-ib v i "tmp"))
([bldr v i n]
(LLVM/BuildInBoundsGEP bldr v i n)))
(defn append-block [f n]
(let [block (LLVM/AppendBasicBlock f n)
builder (LLVM/CreateBuilder)]
(LLVM/PositionBuilderAtEnd builder block)
[block builder]))
(defn const-int [i]
(LLVM/ConstInt (LLVM/Int32Type) i (LLVMBool. 0)))
(defn const-str [s]
(LLVM/ConstString s (count s) (LLVMBool. 0)))
(defn pointer [t] (LLVM/PointerType t 0))
(def i32 (LLVM/Int32Type))
(def i8 (LLVM/Int8Type))
(def i32* (pointer i32))
(def i8* (pointer i8))
(defn fntype
([ret params] (fntype ret params false))
([ret params variadic] (LLVM/FunctionType ret (into-array LLVMTypeRef params) variadic)))
(let [module (LLVM/ModuleCreateWithName "my_module")
_ (LLVM/SetTarget module "x86_64-apple-macosx10.9.0")
fib (Wrap/AddFunction module "fib"
(fntype i32 [i32]))
main (Wrap/AddFunction module "main"
(fntype i32 []))
puti (Wrap/AddFunction module "puti"
(fntype i32 [i32] false))
_ (LLVM/SetLinkage puti LLVMLinkage/LLVMExternalLinkage)
]
(let [[entry eb] (append-block fib "entry")
[base bb] (append-block fib "base")
[recurse rb] (append-block fib "recurse")
x (param fib 0)]
(br eb (icmp-ult eb x (const-int 2))
base
recurse)
(ret bb x)
(ret rb (add rb (call rb fib [(sub rb x (const-int 1))])
(call rb fib [(sub rb x (const-int 2))]))))
(let [[entry eb] (append-block main "entry")]
(call eb puti [(call eb fib [(const-int 25)])])
(ret eb (const-int 0)))
(LLVM/WriteBitcodeToFile module "fib.bc"))
; gcc -emit-llvm -S -c fib.bc
; ModuleID = 'fib.bc'
target triple = "x86_64-apple-macosx10.9.0"
define i32 @fib(i32) {
entry:
%tmp = icmp ult i32 %0, 2
br i1 %tmp, label %base, label %recurse
base: ; preds = %entry
ret i32 %0
recurse: ; preds = %entry
%tmp1 = sub i32 %0, 1
%tmp2 = call i32 @fib(i32 %tmp1)
%tmp3 = sub i32 %0, 2
%tmp4 = call i32 @fib(i32 %tmp3)
%tmp5 = add i32 %tmp2, %tmp4
ret i32 %tmp5
}
define i32 @main() {
entry:
%tmp = call i32 @fib(i32 25)
%tmp1 = call i32 @puti(i32 %tmp)
ret i32 0
}
declare i32 @puti(i32)
fib:
(__TEXT,__text) section
_fib:
0000000100000ef0 pushq %rbp
0000000100000ef1 movq %rsp, %rbp
0000000100000ef4 pushq %r14
0000000100000ef6 pushq %rbx
0000000100000ef7 movl %edi, %ebx
0000000100000ef9 cmpl $0x1, %ebx
0000000100000efc ja 0x100000f02
0000000100000efe movl %ebx, %eax
0000000100000f00 jmp 0x100000f1a
0000000100000f02 leal -0x1(%rbx), %edi
0000000100000f05 callq _fib
0000000100000f0a movl %eax, %r14d
0000000100000f0d addl $-0x2, %ebx
0000000100000f10 movl %ebx, %edi
0000000100000f12 callq _fib
0000000100000f17 addl %r14d, %eax
0000000100000f1a popq %rbx
0000000100000f1b popq %r14
0000000100000f1d popq %rbp
0000000100000f1e retq
0000000100000f1f nop
_main:
0000000100000f20 pushq %rbp
0000000100000f21 movq %rsp, %rbp
0000000100000f24 movl $0x19, %edi
0000000100000f29 callq _fib
0000000100000f2e movl %eax, %edi
0000000100000f30 callq _puti
0000000100000f35 xorl %eax, %eax
0000000100000f37 popq %rbp
0000000100000f38 retq
0000000100000f39 nop
0000000100000f3a nop
0000000100000f3b nop
0000000100000f3c nop
0000000100000f3d nop
0000000100000f3e nop
0000000100000f3f nop
_puti:
0000000100000f40 pushq %rbp
0000000100000f41 movq %rsp, %rbp
0000000100000f44 movl %edi, %ecx
0000000100000f46 leaq 0x2d(%rip), %rdi ## literal pool for: "%d\n"
0000000100000f4d xorl %eax, %eax
0000000100000f4f movl %ecx, %esi
0000000100000f51 popq %rbp
0000000100000f52 jmp 0x100000f58 ## symbol stub for: _printf
#include <stdio.h>
int puti(int i) {
return printf("%d\n", i);
}
$ gcc -O3 fib.bc puti.c -o fib
$ ./fib
75025
@tiye
Copy link

tiye commented Sep 4, 2015

I thought it's calling Java, but your reference saying it's C. Why's that?

(import LLVM
        LLVMModuleRef
        LLVMTypeRef
        Wrap
        LLVMBool
        LLVMLinkage)

@nasser
Copy link
Author

nasser commented Sep 15, 2015

This is running on Mono/ClojureCLR, using LLVMSharp library. It's a bit of a trick to get it set up, because you need a 64bit mono VM to run it. I am working on making it more portable/reproducible, maybe move it over to ClojureScript/node.js.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment