├── .gitignore ├── .gitmodules ├── Makefile ├── README.md ├── _tags ├── doc ├── abi.md └── cmm.md ├── lib ├── _tags ├── llvmcomp.ml └── llvmcomp.mli ├── lib_asm └── amd64.ll ├── lib_test ├── _tags ├── lexcmm.mli ├── lexcmm.mll ├── parsecmm.mly ├── parsecmmaux.ml ├── parsecmmaux.mli └── run_cmm.ml ├── myocamlbuild.ml ├── test ├── alloc-bench.ll ├── alloc.cmm ├── alloc.ll ├── integr.cmm ├── integr.ll ├── mlintegr.cmm ├── mlintegr.ll └── mlintegr.ml └── vendor └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | *.native 3 | *.byte 4 | *.sublime-project 5 | *.sublime-workspace 6 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "llvm"] 2 | path = llvm 3 | url = git://github.com/whitequark/llvm.git 4 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | JOBS = 4 2 | 3 | test: all 4 | for i in integr alloc; do \ 5 | ./run_cmm.native test/$$i.cmm test/$$i.ll; \ 6 | done 7 | 8 | all: 9 | ocamlbuild -j $(JOBS) -use-ocamlfind lib_test/run_cmm.native 10 | 11 | clean: 12 | ocamlbuild -clean 13 | 14 | llvm: 15 | git submodule update --init 16 | (cd llvm && \ 17 | ./configure --enable-targets=x86_64 --enable-bindings=ocaml --disable-optimized && \ 18 | make -j$(JOBS)) 19 | 20 | env: 21 | @echo "export PATH=$$(pwd)/llvm/Debug+Asserts/bin:$$PATH" 22 | @echo "export OCAMLPATH=$$(pwd)/llvm/Debug+Asserts/lib/ocaml:$$OCAMLPATH" 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | OCaml LLVM backend 2 | ================== 3 | 4 | Building 5 | -------- 6 | 7 | make llvm 8 | make all 9 | 10 | Using 11 | ----- 12 | 13 | ./run_cmm.native ./test/mlintegr.cmm ./test/mlintegr.ll 14 | opt -std-link-opts -disable-internalize \ 15 | -internalize -internalize-public-api-list=caml_program \ 16 | ./test/mlintegr.ll | \ 17 | llc ./test/mlintegr.ll 18 | 19 | Debugging 20 | --------- 21 | 22 | To get rid of noise in LLVM IR, run it through `opt -mem2reg`. This will 23 | perform an SSA transformation and remove all of the useless allocas/loads/stores. 24 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true: debug 2 | 3 | : -traverse 4 | : include 5 | -------------------------------------------------------------------------------- /doc/abi.md: -------------------------------------------------------------------------------- 1 | ABI of OCaml code 2 | ================= 3 | 4 | OCaml has a custom ABI, including an unique calling convention incompatible 5 | with the C calling convention. Unfortunately, none of this is documented. 6 | In this note, I'm describing the parts I have figured out. 7 | 8 | When linking to OCaml's assembly in `libasmrun`, I use the ARM support 9 | code as an example, because i386 is too arcane to serve as a generic 10 | example, and amd64 assembly is nearly incomprehensible. 11 | 12 | Common 13 | ------ 14 | 15 | In general, OCaml's calling conventions on different architectures have 16 | two common properties: 17 | 18 | * All registers are caller-save. 19 | * Several registers are pinned to certain global values. 20 | 21 | The implications of this are subtle and extremely important. 22 | 23 | ### Caller-save registers 24 | 25 | First, having all registers defined as caller-save enables OCaml to use 26 | its exception handling mechanism for control flow without a performance 27 | hit. 28 | 29 | While OCaml's exceptions cannot cause arbitrary code to execute in 30 | intermediate stack frames (like with C++'s RAII), simply modelling 31 | them with setjmp/longjmp would not be wise. Indeed, traditional 32 | setjmp/longjmp [implementation][sjlj] would be required to restore 33 | caller-save registers on every raise and, more importantly, save 34 | them on every enter of a try block. This is unacceptable. 35 | 36 | However, if there are no caller-save registers, a longjmp is just 37 | a long jump and restoration of a stack pointer. Conversely, a setjmp 38 | only requires to push the address of the frame (and its address 39 | is the saved stack pointer value); see the [implementation][sjljcaml]. 40 | 41 | [sjlj]: https://sourceware.org/git/?p=glibc.git;a=blob;f=sysdeps/x86_64/__longjmp.S;h=fbac0d91524698b3612526bbf5a3df8e1ed81393;hb=HEAD 42 | [sjljcaml]: https://github.com/ocaml/ocaml/blob/trunk/asmrun/arm.S#L283 43 | 44 | Second, OCaml has a precise GC. That is, the compiler outputs the map 45 | of the stack frame for every possible return address, indicating where 46 | the live pointers reside on stack. When the GC is called, it traverses 47 | the stack, and for every saved return address adds the corresponding 48 | pointers from the stack frame to the live set. 49 | 50 | If OCaml's calling convention included any callee-saved registers, how 51 | would the callee know whether the value in the register is live or not? 52 | But the caller is, by definition, aware of that. 53 | 54 | ### Pinned registers 55 | 56 | To reduce memory accesses as much as possible, OCaml pins some of its 57 | most commonly useful variables to registers. The set of pinned variables 58 | differs from architecture to architecture due to different amount 59 | of registers and register pressure. 60 | 61 | Obviously, the C code OCaml calls would neither preserve nor allow to 62 | access these registers in a portable way. As such, it is necessary to 63 | write-back the values in registers back to the C-accessible global 64 | variables they're pinned to. 65 | 66 | Tail call elimination 67 | --------------------- 68 | 69 | A fascinating tidbit is that OCaml is unable to make a call tail call 70 | if the call requires passing some parameters on the stack (the callee 71 | wouldn't know how much to pop from the stack). As such, every architecture 72 | has a specific limit on how much arguments one can pass while retaining 73 | TCO. Presently calls with at least 8 arguments are always TCO'd. 74 | 75 | Garbage collector 76 | ----------------- 77 | 78 | OCaml's ABI necessitates some very intricate code to interact with the 79 | garbage collector. The glue code resides in five functions, 80 | `caml_alloc1`, `caml_alloc2`, `caml_alloc3`, `caml_allocN` and 81 | `caml_call_gc`. 82 | 83 | All of the `caml_alloc*` functions are very similar (see the 84 | [implementation][camlalloc]). First, they check whether there is enough 85 | space in the young generation for the object they need to allocate. 86 | This is a simple bump-pointer allocator, and as such, the check is 87 | a single integer comparison. Second, if the young generation space is 88 | exhausted, they call the GC and try again. 89 | 90 | I'm not entirely sure why are there four of these functions, given 91 | they differ by a single constant, but my theory is that on architectures 92 | with very few registers, i.e. i386, this helps reduce the pressure 93 | on register allocator. 94 | 95 | Note that, unlike with regular OCaml or C function calls, the `caml_alloc*` 96 | functions do **not** require the caller to save any registers. Indeed, 97 | the common case (a single pointer bump) can be implemented so that it 98 | clobbers only a single register, which is also used for the return 99 | value. 100 | 101 | Based on the previous paragraph, you may guess that the `caml_call_gc` 102 | would need to save all registers. This is correct; [implementation][camlgc]. 103 | In addition, this means that while there are no roots in register 104 | *across procedure calls*, there can be roots in registers *across calls 105 | to allocator*. Indeed, OCaml's code generator will emit a map indicating whether 106 | there are any live values in registers, and the GC will [consume][gcreg] 107 | it. 108 | 109 | [camlalloc]: https://github.com/ocaml/ocaml/blob/trunk/asmrun/arm.S#L126 110 | [camlgc]: https://github.com/ocaml/ocaml/blob/trunk/asmrun/arm.S#L92 111 | [gcreg]: https://github.com/ocaml/ocaml/blob/trunk/asmrun/roots.c#L197 112 | 113 | AMD64 114 | ----- 115 | 116 | Pinned registers: 117 | 118 | r14 119 | : caml_exception_pointer 120 | 121 | r15 122 | : caml_young_ptr 123 | 124 | Maximum number of arguments for TCO: 10. 125 | 126 | ARM 127 | --- 128 | 129 | Pinned registers: 130 | 131 | r8 132 | : caml_exception_pointer 133 | 134 | r10 135 | : caml_young_ptr 136 | 137 | r11 138 | : caml_young_limit 139 | 140 | Maximum number of arguments for TCO: 8. 141 | 142 | i386 143 | ---- 144 | 145 | No pinned registers. 146 | 147 | Maximum number of arguments for TCO: 22. (6 of them are passed in registers. 148 | The rest are stuffed into a `caml_extra_params` global.) 149 | 150 | POWER 151 | ----- 152 | 153 | Pinned registers: 154 | 155 | r29 156 | : caml_exception_pointer 157 | 158 | r30 159 | : caml_young_limit 160 | 161 | r31 162 | : caml_young_ptr 163 | 164 | Maximum number of arguments for TCO: 8. 165 | 166 | SPARC 167 | ----- 168 | 169 | Pinned registers: 170 | 171 | %l5 172 | : caml_exception_pointer 173 | 174 | %l6 175 | : caml_young_limit 176 | 177 | %l7 178 | : caml_young_ptr 179 | 180 | Maximum number of arguments for TCO: 10. 181 | -------------------------------------------------------------------------------- /doc/cmm.md: -------------------------------------------------------------------------------- 1 | Cmm layer 2 | ========= 3 | 4 | Cmm (like C--) layer is OCaml's last machine-independent intermediate 5 | representation. In many respects it looks like an SSA IR, e.g. LLVM IR; 6 | indeed, the translation is almost 1:1, save for oddity of some Cmm 7 | constructs. 8 | 9 | Aggregates 10 | ---------- 11 | 12 | Cmm has a `type machtype = machtype_component list`, but it appears 13 | that the only values of this type are `[||]`, i.e. `unit`, 14 | and `[|Int|]`, `[|Float|]`, `[|Addr|]`. 15 | 16 | Tuple 17 | ----- 18 | 19 | Cmm has a `Ctuple elems` constructor. The name is a bit deceptive. In 20 | reality, Cmmgen only ever generates values of form `Ctuple []`, which 21 | are equivalent to OCaml's unit value `()`, or `Const_int 1`. 22 | 23 | Values of `Ctuple` with non-empty `elems` never directly appear in 24 | Cmm IR. Instead, they're used as constructor arguments for some Mach 25 | constructors; it appears that they're used for grouping arguments 26 | for the intermediate representation corresponding to LEA-like 27 | instructions on i386 and power. 28 | 29 | If/then/else 30 | ------------ 31 | 32 | Cmm has a `Cifthenelse` operation. It receives an integer which is either 33 | `0` or `1`. 34 | 35 | Load/store 36 | ---------- 37 | 38 | `Cop (Cload _)` and `Cop (Cstore _)` imply that a loaded/stored value 39 | is extended/truncated to fit one of the three basic data types, 40 | `Int`, `Float` and `Addr`. 41 | 42 | Exit/catch 43 | ---------- 44 | 45 | Cmm has a peculiar control flow construct, `Cexit`/`Ccatch`. It looks 46 | like exception raising/handling, but in reality it's a direct branch. 47 | Essentially, `Ccatch (id, vars, body, handler)` creates two basic 48 | blocks for `body` and `handler`, and `Cexit (id, vars)` creates a jump 49 | to `handler`. `vars` in `Ccatch` would correspond to a phi node using 50 | all of the `vars` from corresponding `Cexit`s. 51 | 52 | For example, consider the following Cmm IR (note that Cmmparse currently 53 | cannot parse it, even though it's valid): 54 | 55 | ``` 56 | (function "foo" (x: int) 57 | (catch 58 | (let (xbis 59 | (if (> x 10) (exit 0 10) 60 | (if (> x 20) (exit 0 20) x))) 61 | (app "bar" xbis int)) 62 | with(0 ret) ret)) 63 | ``` 64 | 65 | It is roughly equivalent to the following SSA-form LLVM IR: 66 | 67 | ``` 68 | define i32 @foo(i32 %x) { 69 | cmp1: 70 | %f1 = icmp gt i32 %x, 10 71 | br i1 %f1, label %catch, label %cmp2 72 | cmp2: 73 | %f2 = icmp gt i32 %x, 20 74 | br i1 %f2, label %catch, label %app 75 | app: 76 | %res = i32 call @bar(i32 %x) 77 | ret i32 %res 78 | catch: 79 | %x.phi = phi i32 [i32 10, %cmp1], [i32 20, %cmp2] 80 | ret i32 %x.phi 81 | } 82 | ``` 83 | 84 | Let/var/assign 85 | -------------- 86 | 87 | Cmm has three binding constructs: `Clet`, `Cvar` and `Cassign`. It is 88 | wrong to think of them as if they create mutable bindings. Rather, these 89 | constructs are creating SSA phi nodes, for a subset of all possible phi 90 | nodes and all possible control flow. 91 | 92 | First, consider an example implementation: 93 | 94 | ``` ocaml 95 | let compile env expr = 96 | match expr with 97 | | Cvar id -> 98 | Hashtbl.find env id 99 | | Clet (id, bind, body) -> 100 | Hashtbl.add env id (compile env bind); 101 | let result = compile env body in 102 | Hashtbl.remove env id; 103 | result 104 | | Cassign (id, bind) -> 105 | Hashtbl.replace env (compile env bind) 106 | | _ -> (* compile everything else *) 107 | ``` 108 | 109 | Consider the Cmm IR with the following structure: 110 | 111 | ``` 112 | (function "foo" () 113 | (let (x 0) 114 | (catch 115 | (loop 116 | (if (< x 5) 117 | (assign x (- x 1)) 118 | (exit 0)) 119 | with (0) [] 0i)))) 120 | ``` 121 | 122 | It is roughly equivalent to the following SSA-form LLVM IR: 123 | 124 | ``` 125 | define i32 @foo() { 126 | entry: 127 | %x.init = i32 0 128 | br label %loop 129 | loop: 130 | %x = phi i32 [ %x.init, %entry ], [ %x.sub, %loop.1 ] 131 | %f = icmp slt i32 %x, 5 132 | br i1 %f, label %loop.1, label %exit 133 | loop.1: 134 | %x.sub = sub i32 %x, 1 135 | br label %loop 136 | exit: 137 | ret i32 0 138 | } 139 | ``` 140 | -------------------------------------------------------------------------------- /lib/_tags: -------------------------------------------------------------------------------- 1 | : package(compiler-libs.optcomp), package(llvm) 2 | -------------------------------------------------------------------------------- /lib/llvmcomp.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Peter Zotov *) 6 | (* *) 7 | (* Copyright 2014 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | open Cmm 14 | 15 | let llctx = Llvm.global_context () 16 | 17 | let () = Llvm_X86.initialize () 18 | let lltarget = Llvm_target.Target.by_triple "x86_64-linux-gnu" 19 | let llmachine = Llvm_target.TargetMachine.create "x86_64-linux-gnu" lltarget 20 | let lldly = Llvm_target.TargetMachine.data_layout llmachine 21 | 22 | (* names of pinned registers. need to correspond to ocamlcc in llvm *) 23 | let llpinned = 24 | match Llvm_target.Target.name lltarget with 25 | | "x86-64" -> ["caml_exception_pointer"; "caml_young_ptr"] 26 | | _ -> assert false 27 | let llpinnedty = List.map (fun _ -> Llvm.pointer_type (Llvm.i8_type llctx)) llpinned 28 | let llpinidx = List.mapi (fun i _ -> i) llpinned 29 | 30 | let llicmp_of_comparison pred = 31 | match pred with 32 | | Ceq -> Llvm.Icmp.Eq 33 | | Cne -> Llvm.Icmp.Ne 34 | | Clt -> Llvm.Icmp.Slt 35 | | Cle -> Llvm.Icmp.Sle 36 | | Cgt -> Llvm.Icmp.Sgt 37 | | Cge -> Llvm.Icmp.Sge 38 | 39 | let llfcmp_of_comparison pred = 40 | match pred with 41 | | Ceq -> Llvm.Fcmp.Oeq 42 | | Cne -> Llvm.Fcmp.One 43 | | Clt -> Llvm.Fcmp.Olt 44 | | Cle -> Llvm.Fcmp.Ole 45 | | Cgt -> Llvm.Fcmp.Ogt 46 | | Cge -> Llvm.Fcmp.Oge 47 | 48 | let lltype_of_mcomp comp = 49 | match comp with 50 | | Addr -> Llvm.pointer_type (Llvm.i8_type llctx) 51 | | Int -> Llvm_target.DataLayout.intptr_type llctx lldly 52 | | Float -> Llvm.double_type llctx 53 | 54 | let lltype_of_mty ty = 55 | match ty with 56 | | [|comp|] -> lltype_of_mcomp comp 57 | | _ -> Llvm.struct_type llctx (Array.map lltype_of_mcomp ty) 58 | 59 | let load_store_params memory_chunk = 60 | let intptr_size = Llvm_target.DataLayout.pointer_size lldly in 61 | let align llty = llty, Llvm_target.DataLayout.preferred_align llty lldly in 62 | let integer size = Llvm.integer_type llctx size in 63 | match memory_chunk with 64 | | Byte_unsigned | Byte_signed -> align (integer 1) 65 | | Sixteen_unsigned | Sixteen_signed -> align (integer 2) 66 | | Thirtytwo_unsigned | Thirtytwo_signed -> align (integer 4) 67 | | Word -> align (Llvm.pointer_type (integer intptr_size)) 68 | | Single -> align (Llvm.float_type llctx) 69 | | Double -> align (Llvm.double_type llctx) 70 | | Double_u -> Llvm.double_type llctx, intptr_size 71 | 72 | let infer fun_args expr = 73 | let env = Hashtbl.create 16 in 74 | List.iter (fun (id, ty) -> Hashtbl.add env id (lltype_of_mty ty)) fun_args; 75 | let catches = Hashtbl.create 16 in 76 | let rec llty_of_expr expr = 77 | let multi lltys = 78 | match List.filter ((<>) (Llvm.void_type llctx)) lltys with 79 | | [] -> Llvm.void_type llctx 80 | | [llty] -> llty 81 | | llty::lltys -> assert (List.for_all ((=) llty) lltys); llty 82 | in 83 | match expr with 84 | | Cop (op, _) -> 85 | begin match op with 86 | | Capply(ty, _) -> lltype_of_mty ty 87 | | Cextcall(s, ty, alloc, _) -> lltype_of_mty ty 88 | | Cload c -> 89 | begin match c with 90 | | Word -> lltype_of_mcomp Addr 91 | | Single | Double | Double_u -> lltype_of_mcomp Float 92 | | _ -> lltype_of_mcomp Int 93 | end 94 | | Calloc -> lltype_of_mcomp Addr 95 | | Cstore c -> Llvm.void_type llctx 96 | | Caddi | Csubi | Cmuli | Cdivi | Cmodi 97 | | Cand | Cor | Cxor | Clsl | Clsr | Casr 98 | | Ccmpi _ | Ccmpa _ | Ccmpf _ -> lltype_of_mcomp Int 99 | | Cadda | Csuba -> lltype_of_mcomp Addr 100 | | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf -> lltype_of_mcomp Float 101 | | Cfloatofint -> lltype_of_mcomp Float 102 | | Cintoffloat -> lltype_of_mcomp Int 103 | | Craise _ -> Llvm.void_type llctx 104 | | Ccheckbound _ -> Llvm.void_type llctx 105 | end 106 | | Cconst_int _ -> lltype_of_mcomp Int 107 | | Cconst_natint _ -> lltype_of_mcomp Int 108 | | Cconst_float _ -> lltype_of_mcomp Float 109 | | Cconst_symbol _ -> lltype_of_mcomp Addr 110 | | Cconst_pointer _ -> lltype_of_mcomp Addr 111 | | Cconst_natpointer _ -> lltype_of_mcomp Addr 112 | | Cvar var -> Hashtbl.find env var 113 | | Clet (var, expr, body) -> 114 | Hashtbl.add env var (llty_of_expr expr); 115 | let llty = llty_of_expr body in 116 | Hashtbl.remove env var; 117 | llty 118 | | Cassign (id, expr) -> 119 | let llty = llty_of_expr expr in 120 | assert (llty = (Hashtbl.find env id)); 121 | Llvm.void_type llctx 122 | | Ctuple [] -> Llvm.void_type llctx 123 | | Ctuple _ -> assert false 124 | | Csequence (lhs, rhs) -> 125 | ignore (llty_of_expr lhs); 126 | llty_of_expr rhs 127 | | Cifthenelse (pred, iftrue, iffalse) -> 128 | ignore (llty_of_expr pred); 129 | multi [llty_of_expr iftrue; llty_of_expr iffalse] 130 | | Cswitch (pred, _, dests) -> 131 | ignore (llty_of_expr pred); 132 | multi (List.map llty_of_expr (Array.to_list dests)) 133 | | Cloop body -> ignore (llty_of_expr body); Llvm.void_type llctx 134 | | Ccatch (id, vars, body, handler) -> 135 | let llbodyty = llty_of_expr body in 136 | List.iter2 (Hashtbl.add env) vars (Hashtbl.find catches id); 137 | let llty = multi [llbodyty; llty_of_expr handler] in 138 | List.iter (Hashtbl.remove env) vars; 139 | llty 140 | | Cexit (id, vars) -> 141 | let llvarsty = List.map llty_of_expr vars in 142 | begin try 143 | let llvarsty' = Hashtbl.find catches id in 144 | assert (llvarsty = llvarsty') 145 | with Not_found -> 146 | Hashtbl.add catches id llvarsty; 147 | end; 148 | Llvm.void_type llctx 149 | | Ctrywith (body, var, handler) -> 150 | Hashtbl.add env var (lltype_of_mcomp Addr); 151 | let llty = multi [llty_of_expr body; llty_of_expr handler] in 152 | Hashtbl.remove env var; 153 | llty 154 | in 155 | llty_of_expr expr 156 | 157 | (* See doc/cmm.md first. 158 | 159 | Note that while let bindings are immutable, we model them as mutable 160 | cells anyway. This is because the way Cmm represents control flow is 161 | weird, and compiling them directly to phis would require us to reproduce 162 | half of an SSA transform. Hence, it is left to LLVM's mem2reg. *) 163 | let rec compile llmod llfun fun_args fun_body = 164 | let build_trap = 165 | let llblock = ref None in fun () -> 166 | match !llblock with 167 | | None -> 168 | let llbuilder = Llvm.builder llctx in 169 | let llblock' = Llvm.append_block llctx "trap" llfun in 170 | Llvm.position_at_end llblock' llbuilder; 171 | let lltrapty = Llvm.function_type (Llvm.void_type llctx) [||] in 172 | let lltrap = Llvm.declare_function "llvm.trap" lltrapty llmod in 173 | (* Could be skipped for "Release" builds *) 174 | ignore (Llvm.build_call lltrap [||] "" llbuilder); 175 | ignore (Llvm.build_unreachable llbuilder); 176 | llblock := Some llblock'; 177 | llblock' 178 | | Some llblock' -> llblock' 179 | in 180 | let build_phi incoming name llbuilder = 181 | let incoming' = incoming |> List.filter (fun (llval, _) -> 182 | Llvm.classify_type (Llvm.type_of llval) <> Llvm.TypeKind.Void) in 183 | match incoming' with 184 | | [] -> Llvm.undef (Llvm.void_type llctx) 185 | | [llval, _] -> llval 186 | | incoming' -> Llvm.build_phi incoming' name llbuilder 187 | in 188 | (* create cells for arguments *) 189 | let env = ((Hashtbl.create 16) : (string, Llvm.llvalue) Hashtbl.t) in 190 | let catches = Hashtbl.create 16 in 191 | let llbuilder = Llvm.builder llctx in 192 | Llvm.position_at_end (Llvm.append_block llctx "entry" llfun) llbuilder; 193 | List.iter2 (fun name llarg -> 194 | if List.exists ((=) name) llpinned then 195 | Llvm.set_value_name ("pinned." ^ name) llarg 196 | else 197 | Llvm.set_value_name ("arg." ^ name) llarg; 198 | let llalloca = Llvm.build_alloca (Llvm.type_of llarg) ("alloca." ^ name) llbuilder in 199 | ignore (Llvm.build_store llarg llalloca llbuilder); 200 | Hashtbl.add env name llalloca) 201 | (llpinned @ (List.map (fun (id, _) -> Ident.name id) fun_args)) 202 | (Array.to_list (Llvm.params llfun)); 203 | (* translate body *) 204 | let rec llvalue_of_expr expr = 205 | let unop mcomp f name args = 206 | match args with 207 | | [arg] -> 208 | let arg' = Llvm.build_pointercast (llvalue_of_expr arg) (lltype_of_mcomp mcomp) "" llbuilder in 209 | f arg' name llbuilder 210 | | _ -> assert false 211 | in 212 | let binop mcomp f name args = 213 | match args with 214 | | [lhs; rhs] -> 215 | let lhs' = Llvm.build_pointercast (llvalue_of_expr lhs) (lltype_of_mcomp mcomp) "" llbuilder in 216 | let rhs' = Llvm.build_pointercast (llvalue_of_expr rhs) (lltype_of_mcomp mcomp) "" llbuilder in 217 | f lhs' rhs' name llbuilder 218 | | _ -> assert false 219 | in 220 | match expr with 221 | (* Constants *) 222 | | Cconst_int const -> 223 | Llvm.const_int (lltype_of_mcomp Int) const 224 | | Cconst_natint const -> 225 | Llvm.const_of_int64 (lltype_of_mcomp Int) (Int64.of_nativeint const) (*signed:*)true 226 | | Cconst_pointer const -> 227 | let integer = Llvm.const_int (lltype_of_mcomp Int) const in 228 | Llvm.build_inttoptr integer (lltype_of_mcomp Addr) "" llbuilder 229 | | Cconst_natpointer const -> 230 | let integer = Llvm.const_of_int64 (lltype_of_mcomp Int) 231 | (Int64.of_nativeint const) (*signed:*)true in 232 | Llvm.build_inttoptr integer (lltype_of_mcomp Addr) "" llbuilder 233 | | Cconst_float const -> 234 | Llvm.const_float_of_string (lltype_of_mcomp Float) const 235 | | Cconst_symbol sym -> 236 | let global = 237 | begin match Llvm.lookup_global sym llmod with 238 | | Some g -> g 239 | | None -> 240 | begin match Llvm.lookup_function sym llmod with 241 | | Some f -> f 242 | | None -> Llvm.declare_global (lltype_of_mcomp Addr) sym llmod 243 | end 244 | end 245 | in 246 | Llvm.const_pointercast global (lltype_of_mcomp Addr) 247 | | Ctuple [] -> 248 | Llvm.const_int (lltype_of_mcomp Int) 1 249 | | Ctuple _ -> assert false 250 | (* Integer ops *) 251 | | Cop (Caddi, args) -> binop Int Llvm.build_add "addi" args 252 | | Cop (Csubi, args) -> binop Int Llvm.build_sub "subi" args 253 | | Cop (Cmuli, args) -> binop Int Llvm.build_mul "muli" args 254 | | Cop (Cdivi, args) -> binop Int Llvm.build_sdiv "divi" args 255 | | Cop (Cmodi, args) -> binop Int Llvm.build_srem "modi" args 256 | | Cop (Ccmpi pred, args) -> binop Int (Llvm.build_icmp (llicmp_of_comparison pred)) "cmpi" args 257 | (* Logical ops *) 258 | | Cop (Cand, args) -> binop Int Llvm.build_and "and" args 259 | | Cop (Cor, args) -> binop Int Llvm.build_or "or" args 260 | | Cop (Cxor, args) -> binop Int Llvm.build_xor "xor" args 261 | | Cop (Clsl, args) -> binop Int Llvm.build_shl "lsl" args 262 | | Cop (Clsr, args) -> binop Int Llvm.build_lshr "lsr" args 263 | | Cop (Casr, args) -> binop Int Llvm.build_ashr "asr" args 264 | (* Floating-point ops *) 265 | | Cop (Caddf, args) -> binop Float Llvm.build_fadd "addf" args 266 | | Cop (Csubf, args) -> binop Float Llvm.build_fsub "subf" args 267 | | Cop (Cmulf, args) -> binop Float Llvm.build_fmul "mulf" args 268 | | Cop (Cdivf, args) -> binop Float Llvm.build_fdiv "divf" args 269 | | Cop (Cnegf, args) -> unop Float Llvm.build_fneg "negf" args 270 | | Cop (Ccmpf pred, args) -> binop Float (Llvm.build_fcmp (llfcmp_of_comparison pred)) "cmpf" args 271 | | Cop (Cabsf, [arg]) -> 272 | let llfabsty = Llvm.function_type (Llvm.double_type llctx) [|Llvm.double_type llctx|] in 273 | let llfabs = Llvm.declare_function "llvm.fabs.f64" llfabsty llmod in 274 | Llvm.build_call llfabs [|llvalue_of_expr arg|] "absf" llbuilder 275 | | Cop (Cfloatofint, [arg]) -> 276 | Llvm.build_sitofp (llvalue_of_expr arg) (lltype_of_mcomp Float) "floatofint" llbuilder 277 | | Cop (Cintoffloat, [arg]) -> 278 | Llvm.build_fptosi (llvalue_of_expr arg) (lltype_of_mcomp Int) "intoffloat" llbuilder 279 | | Cop ((Cintoffloat | Cfloatofint | Cabsf), _) -> assert false 280 | (* Pointer ops *) 281 | | Cop ((Cadda | Csuba) as op, [base; disp]) -> 282 | let llvalue = llvalue_of_expr base in 283 | let lldisp, name = 284 | match op with 285 | | Cadda -> llvalue_of_expr disp, "adda" 286 | | Csuba -> Llvm.build_neg (llvalue_of_expr disp) "" llbuilder, "suba" 287 | | _ -> assert false 288 | in 289 | Llvm.build_in_bounds_gep llvalue [|lldisp|] name llbuilder 290 | | Cop (Ccmpa pred, [lhs; rhs]) -> 291 | let lhs' = Llvm.build_ptrtoint (llvalue_of_expr lhs) (lltype_of_mcomp Int) 292 | "cmpa.lhs" llbuilder in 293 | let rhs' = Llvm.build_ptrtoint (llvalue_of_expr rhs) (lltype_of_mcomp Int) 294 | "cmpa.rhs" llbuilder in 295 | Llvm.build_icmp (llicmp_of_comparison pred) lhs' rhs' "cmpa" llbuilder 296 | | Cop ((Cadda | Csuba | Ccmpa _), _) -> assert false 297 | (* Load/store *) 298 | | Cop (Cload ty, [addr]) -> 299 | let llty, align = load_store_params ty in 300 | let lladdr = llvalue_of_expr addr in 301 | let lladdr' = Llvm.build_bitcast lladdr (Llvm.pointer_type llty) "load.addr" llbuilder in 302 | let llvalue = Llvm.build_load lladdr' "load" llbuilder in 303 | begin match ty with 304 | | Word -> llvalue 305 | | Single | Double | Double_u -> Llvm.build_fpext llvalue (lltype_of_mcomp Float) "" llbuilder 306 | | _ -> Llvm.build_sext llvalue (lltype_of_mcomp Int) "" llbuilder 307 | end 308 | | Cop (Cstore ty, [addr; value]) -> 309 | let llty, align = load_store_params ty in 310 | let llvalue = llvalue_of_expr value in 311 | let llvalue' = 312 | match ty with 313 | | Word -> Llvm.build_bitcast llvalue llty "" llbuilder 314 | | Single | Double | Double_u -> Llvm.build_fptrunc llvalue llty "" llbuilder 315 | | _ -> Llvm.build_trunc llvalue llty "" llbuilder 316 | in 317 | let lladdr = llvalue_of_expr addr in 318 | let lladdr' = Llvm.build_bitcast lladdr (Llvm.pointer_type llty) "store.addr" llbuilder in 319 | Llvm.build_store llvalue' lladdr' llbuilder 320 | | Cop ((Cload _ | Cstore _), _) -> assert false 321 | (* Bindings *) 322 | | Cvar id -> 323 | let name = Ident.name id in 324 | Llvm.build_load (Hashtbl.find env name) ("local." ^ name) llbuilder 325 | | Clet (id, expr, body) -> 326 | let name = Ident.name id in 327 | let llvalue = llvalue_of_expr expr in 328 | let llalloca = Llvm.build_alloca (Llvm.type_of llvalue) 329 | ("alloca." ^ name) llbuilder in 330 | ignore (Llvm.build_store llvalue llalloca llbuilder); 331 | Hashtbl.add env name llalloca; 332 | let result = llvalue_of_expr body in 333 | Hashtbl.remove env name; 334 | result 335 | | Cassign (id, expr) -> 336 | let name = Ident.name id in 337 | let llexpr = llvalue_of_expr expr in 338 | Llvm.build_store llexpr (Hashtbl.find env name) llbuilder 339 | (* Control flow *) 340 | | Csequence (lhs, rhs) -> 341 | ignore (llvalue_of_expr lhs); 342 | llvalue_of_expr rhs 343 | | Cifthenelse (pred, iftrue, iffalse) -> 344 | let llentry = Llvm.insertion_block llbuilder in 345 | let llexit = Llvm.append_block llctx "if.exit" llfun in 346 | (* Compile iftrue *) 347 | let lliftrue = Llvm.append_block llctx "if.true" llfun in 348 | Llvm.position_at_end lliftrue llbuilder; 349 | let lltrueret = llvalue_of_expr iftrue in 350 | let lliftrue' = Llvm.insertion_block llbuilder in 351 | if Llvm.block_terminator lliftrue' = None then 352 | ignore (Llvm.build_br llexit llbuilder); 353 | (* Compile iffalse *) 354 | let lliffalse = Llvm.append_block llctx "if.false" llfun in 355 | Llvm.position_at_end lliffalse llbuilder; 356 | let llfalseret = llvalue_of_expr iffalse in 357 | let lliffalse' = Llvm.insertion_block llbuilder in 358 | if Llvm.block_terminator lliffalse' = None then 359 | ignore (Llvm.build_br llexit llbuilder); 360 | (* Compile entry *) 361 | Llvm.position_at_end llentry llbuilder; 362 | let llcond = llvalue_of_expr pred in 363 | let llcond' = Llvm.build_trunc llcond (Llvm.i1_type llctx) "" llbuilder in 364 | ignore (Llvm.build_cond_br llcond' lliftrue lliffalse llbuilder); 365 | (* Compile exit *) 366 | Llvm.position_at_end llexit llbuilder; 367 | build_phi [lltrueret, lliftrue'; llfalseret, lliffalse'] "if.value" llbuilder 368 | | Cloop body -> 369 | let llbody = Llvm.append_block llctx "loop" llfun in 370 | ignore (Llvm.build_br llbody llbuilder); 371 | Llvm.position_at_end llbody llbuilder; 372 | ignore (llvalue_of_expr body); 373 | begin match Llvm.block_terminator (Llvm.insertion_block llbuilder) with 374 | | None -> Llvm.build_br llbody llbuilder 375 | | Some i -> i 376 | end 377 | | Ccatch (id, vars, body, handler) -> 378 | let llbody = Llvm.insertion_block llbuilder in 379 | let llhandler = Llvm.append_block llctx (Printf.sprintf "catch.%d.with" id) llfun in 380 | let llexit = Llvm.append_block llctx (Printf.sprintf "catch.%d.exit" id) llfun in 381 | (* Compile handler *) 382 | Llvm.position_at_end llhandler llbuilder; 383 | let llphis = 384 | List.mapi (fun phiid var -> 385 | let llphi = Llvm.build_phi [] (Printf.sprintf "catch.%d.value.%d" id phiid) 386 | llbuilder in 387 | Hashtbl.add env (Ident.name var) llphi; 388 | llphi) 389 | vars 390 | in 391 | Hashtbl.add catches id (llphis, llhandler); 392 | let llhandlerret = llvalue_of_expr handler in 393 | let llhandler' = Llvm.insertion_block llbuilder in 394 | if Llvm.block_terminator llhandler' = None then 395 | ignore (Llvm.build_br llexit llbuilder); 396 | (* Compile body *) 397 | Llvm.position_at_end llbody llbuilder; 398 | let llbodyret = llvalue_of_expr body in 399 | let llbody' = Llvm.insertion_block llbuilder in 400 | if Llvm.block_terminator llbody' = None then 401 | ignore (Llvm.build_br llexit llbuilder); 402 | (* Prepare exit *) 403 | Llvm.position_at_end llexit llbuilder; 404 | build_phi [llbodyret, llbody'; llhandlerret, llhandler'] 405 | (Printf.sprintf "catch.%d.value" id) llbuilder 406 | | Cexit (id, vars) -> 407 | let llphis, llhandler = Hashtbl.find catches id in 408 | let llblock = Llvm.insertion_block llbuilder in 409 | List.iter2 (fun llphi var -> 410 | Llvm.add_incoming (llvalue_of_expr var, llblock) llphi) 411 | llphis vars; 412 | Llvm.build_br llhandler llbuilder 413 | | Cswitch (pred, cases, dests) -> 414 | assert ((Array.length cases) = (Array.length dests)); 415 | let llswitch = Llvm.build_switch (llvalue_of_expr pred) (build_trap ()) 416 | (Array.length cases) llbuilder in 417 | let llexit = Llvm.append_block llctx "switch.exit" llfun in 418 | Llvm.position_at_end llexit llbuilder; 419 | let llexitret = Llvm.build_phi [] "switch.value" llbuilder in 420 | List.iter2 (fun case dest -> 421 | let lldest = Llvm.append_block llctx (Printf.sprintf "switch.case.%d" case) llfun in 422 | Llvm.position_at_end lldest llbuilder; 423 | let llvalue = llvalue_of_expr dest in 424 | let lldest' = Llvm.insertion_block llbuilder in 425 | Llvm.add_case llswitch (Llvm.const_int (lltype_of_mcomp Int) case) lldest; 426 | Llvm.add_incoming (llvalue, lldest') llexitret) 427 | (Array.to_list cases) (Array.to_list dests); 428 | llexitret 429 | (* Function calls *) 430 | | Cop (Capply (retty, dbg), fn :: args) -> 431 | let llargs = List.map llvalue_of_expr args in 432 | let llretty = Llvm.struct_type llctx (Array.of_list (llpinnedty @ [lltype_of_mty retty])) in 433 | let llargsty = llpinnedty @ (List.map Llvm.type_of llargs) in 434 | let llfunty = Llvm.function_type llretty (Array.of_list llargsty) in 435 | let llfun = Llvm.build_bitcast (llvalue_of_expr fn) (Llvm.pointer_type llfunty) 436 | "apply.fn" llbuilder in 437 | let llargs' = (List.map (fun name -> 438 | Llvm.build_load (Hashtbl.find env name) ("pass."^name) llbuilder) 439 | llpinned) @ llargs in 440 | let llcall = Llvm.build_call llfun (Array.of_list llargs') "" llbuilder in 441 | Llvm.set_instruction_call_conv (*ocamlcc*)16 llcall; 442 | Llvm.set_tail_call true llcall; 443 | List.iteri (fun idx name -> 444 | let llvalue = Llvm.build_extractvalue llcall idx ("reload."^name) llbuilder in 445 | ignore (Llvm.build_store llvalue (Hashtbl.find env name) llbuilder)) 446 | llpinned; 447 | Llvm.build_extractvalue llcall (List.length llpinned) "apply" llbuilder 448 | | Cop (Cextcall (prim, ty, does_alloc, dbg), args) -> 449 | assert false 450 | | Cop (Capply _, _) -> assert false 451 | (* Allocation *) 452 | | Cop (Calloc, args) -> 453 | let llallocfn = 454 | match Llvm.lookup_function "caml_allocN" llmod with 455 | | Some fn -> fn 456 | | None -> 457 | let llallocfnty = Llvm.function_type (lltype_of_mcomp Addr) [|lltype_of_mcomp Int|] in 458 | let llallocfn = Llvm.declare_function "caml_allocN" llallocfnty llmod in 459 | Llvm.set_function_call_conv (*preserve_allcc*)15 llallocfn; 460 | llallocfn 461 | in 462 | let llargs = List.map llvalue_of_expr args in 463 | let llallocty = Llvm.struct_type llctx (Array.of_list 464 | (List.map Llvm.type_of llargs)) in 465 | let llsize = Llvm_target.DataLayout.store_size llallocty lldly in 466 | let llsize' = Llvm.const_of_int64 (lltype_of_mcomp Int) llsize true in 467 | let llalloc = Llvm.build_call llallocfn [|llsize'|] "alloc" llbuilder in 468 | let llalloc' = Llvm.build_bitcast llalloc (Llvm.pointer_type llallocty) "" llbuilder in 469 | List.iter2 (fun expr (idx, llvalue) -> 470 | let llfield = Llvm.build_struct_gep llalloc' idx 471 | (Printf.sprintf "field.%d" idx) llbuilder in 472 | ignore (Llvm.build_store llvalue llfield llbuilder)) 473 | args (List.mapi (fun idx llvalue -> idx, llvalue) llargs); 474 | let llbody = Llvm.build_struct_gep llalloc' 1 "" llbuilder in 475 | Llvm.build_bitcast llbody (lltype_of_mcomp Addr) "alloc.body" llbuilder 476 | (* Exception handling *) 477 | | Ctrywith (_, _, _) -> 478 | assert false 479 | | Cop (Craise dbg, args) -> 480 | assert false 481 | | Cop (Ccheckbound dbg, args) -> 482 | assert false 483 | in 484 | let llresult = llvalue_of_expr fun_body in 485 | let llreturn = 486 | List.fold_left2 (fun llpack name idx -> 487 | let llreg = Llvm.build_load (Hashtbl.find env name) ("reload." ^ name) llbuilder in 488 | Llvm.build_insertvalue llpack llreg idx "" llbuilder) 489 | (Llvm.undef (Llvm.struct_type llctx (Array.of_list (llpinnedty @ [Llvm.type_of llresult])))) 490 | llpinned llpinidx 491 | in 492 | let llreturn = Llvm.build_insertvalue llreturn llresult (List.length llpinned) "" llbuilder in 493 | ignore (Llvm.build_ret llreturn llbuilder) 494 | 495 | let fundecl llmod {fun_name; fun_args; fun_body} = 496 | let llargsty = List.map (fun (id, ty) -> lltype_of_mty ty) fun_args in 497 | let llargsty' = Array.of_list (llpinnedty @ llargsty) in 498 | let llretty = Llvm.struct_type llctx (Array.of_list (llpinnedty @ [infer fun_args fun_body])) in 499 | let llfunty = Llvm.function_type llretty llargsty' in 500 | let llfun = Llvm.declare_function fun_name llfunty llmod in 501 | Llvm.set_function_call_conv (*ocamlcc*)16 llfun; 502 | Llvm.set_gc (Some "ocaml") llfun; 503 | fun () -> 504 | compile llmod llfun fun_args fun_body; 505 | llfun 506 | 507 | let lltype_of_data_item item = 508 | match item with 509 | | Cdefine_label _ | Cdefine_symbol _ | Cglobal_symbol _ | Calign _ -> 510 | assert false 511 | | Cint8 _ -> Llvm.i8_type llctx 512 | | Cint16 _ -> Llvm.i16_type llctx 513 | | Cint32 _ -> Llvm.i32_type llctx 514 | | Cint _ -> lltype_of_mcomp Int 515 | | Csingle _ -> Llvm.float_type llctx 516 | | Cdouble _ -> Llvm.double_type llctx 517 | | Csymbol_address _ | Clabel_address _ -> 518 | lltype_of_mcomp Addr 519 | | Cstring s -> Llvm.array_type (Llvm.i8_type llctx) (String.length s) 520 | | Cskip len -> Llvm.array_type (Llvm.i8_type llctx) len 521 | 522 | let lltype_of_data items = 523 | let len, items = 524 | List.fold_left (fun (len, lltys) item -> 525 | match item with 526 | | Cdefine_label _ | Cdefine_symbol _ | Cglobal_symbol _ -> 527 | len, lltys 528 | | Calign size -> 529 | if len mod size = 0 then len, lltys 530 | else let skip_len = size - len mod size in 531 | len + skip_len, lltype_of_data_item (Cskip skip_len) :: lltys 532 | | _ -> 533 | let llty = lltype_of_data_item item in 534 | len + (Int64.to_int (Llvm_target.DataLayout.store_size llty lldly)), 535 | lltype_of_data_item item :: lltys) 536 | (0, []) items 537 | in 538 | Llvm.packed_struct_type llctx (Array.of_list (List.rev items)) 539 | 540 | let llvalue_of_data llmod items = 541 | let _, lldata = 542 | List.fold_left (fun (len, lldata) item -> 543 | let llitem = 544 | match item with 545 | | Cdefine_label _ | Cdefine_symbol _ | Cglobal_symbol _ -> None 546 | | Calign size -> 547 | if len mod size = 0 then None 548 | else let skip_len = size - len mod size in 549 | Some (Llvm.const_null (Llvm.array_type (Llvm.i8_type llctx) skip_len)) 550 | | Cint8 c -> Some (Llvm.const_int (Llvm.i8_type llctx) c) 551 | | Cint16 c -> Some (Llvm.const_int (Llvm.i16_type llctx) c) 552 | | Cint32 c -> Some (Llvm.const_of_int64 (lltype_of_mcomp Int) (Int64.of_nativeint c) true) 553 | | Cint c -> Some (Llvm.const_of_int64 (lltype_of_mcomp Int) (Int64.of_nativeint c) true) 554 | | Csingle c -> Some (Llvm.const_float_of_string (Llvm.float_type llctx) c) 555 | | Cdouble c -> Some (Llvm.const_float_of_string (Llvm.double_type llctx) c) 556 | | Csymbol_address sym -> 557 | begin match Llvm.lookup_global sym llmod with 558 | | Some gv -> Some gv 559 | | None -> 560 | match Llvm.lookup_function sym llmod with 561 | | Some fn -> Some (Llvm.const_bitcast fn (lltype_of_mcomp Addr)) 562 | | None -> assert false 563 | end 564 | | Clabel_address label -> 565 | begin match Llvm.lookup_global (Printf.sprintf "label.%d" label) llmod with 566 | | Some gv -> Some gv 567 | | None -> assert false 568 | end 569 | | Cstring s -> Some (Llvm.const_string llctx s) 570 | | Cskip len -> Some (Llvm.const_null (Llvm.array_type (Llvm.i8_type llctx) len)) 571 | in 572 | match llitem with 573 | | Some llitem -> 574 | let size = Llvm_target.DataLayout.store_size (Llvm.type_of llitem) lldly in 575 | let len' = len + (Int64.to_int size) in 576 | len', llitem :: lldata 577 | | None -> len, lldata) 578 | (0, []) items 579 | in 580 | Llvm.const_packed_struct llctx (Array.of_list (List.rev lldata)) 581 | 582 | let data llmod decl = 583 | let llty = lltype_of_data decl in 584 | let lldecl = Llvm.declare_global llty "" llmod in 585 | Llvm.set_linkage Llvm.Linkage.Private lldecl; 586 | (* pull out interior pointers *) 587 | ignore (List.fold_left (fun (externals, idx) item -> 588 | let name = 589 | match item with 590 | | Cdefine_label label -> Some (Printf.sprintf "label.%d" label) 591 | | Cdefine_symbol sym -> Some sym 592 | | _ -> None 593 | in 594 | match name, item with 595 | | Some name, _ -> 596 | let lllabel = Llvm.declare_global (lltype_of_mcomp Addr) name llmod in 597 | if not (List.exists ((=) name) externals) then 598 | Llvm.set_linkage Llvm.Linkage.Private lldecl; 599 | let llidxs = [|Llvm.const_int (Llvm.i32_type llctx) 0; 600 | Llvm.const_int (Llvm.i32_type llctx) idx|] in 601 | let llptr = Llvm.const_in_bounds_gep lldecl llidxs in 602 | let llptr' = Llvm.const_bitcast llptr (lltype_of_mcomp Addr) in 603 | Llvm.set_initializer llptr' lllabel; 604 | externals, idx 605 | | None, Cglobal_symbol sym -> sym :: externals, idx 606 | | None, _ -> externals, idx + 1) 607 | ([], 0) decl); 608 | fun () -> 609 | Llvm.set_initializer (llvalue_of_data llmod decl) lldecl; 610 | lldecl 611 | 612 | let transl_unit name = 613 | let llmod = Llvm.create_module llctx name in 614 | Llvm.set_data_layout (Llvm_target.DataLayout.as_string lldly) llmod; 615 | Llvm.set_target_triple (Llvm_target.TargetMachine.triple llmachine) llmod; 616 | llmod 617 | 618 | let phrase llmod phr = 619 | match phr with 620 | | Cfunction d -> fundecl llmod d 621 | | Cdata d -> data llmod d 622 | -------------------------------------------------------------------------------- /lib/llvmcomp.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Peter Zotov *) 6 | (* *) 7 | (* Copyright 2014 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | val transl_unit : string -> Llvm.llmodule 14 | val phrase : Llvm.llmodule -> Cmm.phrase -> (unit -> Llvm.llvalue) 15 | -------------------------------------------------------------------------------- /lib_asm/amd64.ll: -------------------------------------------------------------------------------- 1 | @caml_last_return_address = external global i8* 2 | @caml_bottom_of_stack = external global i8* 3 | @caml_gc_regs = external global i8* 4 | @caml_young_ptr = external global i8* 5 | @caml_young_limit = external global i8* 6 | @caml_exception_pointer = external global i8* 7 | 8 | declare void @caml_garbage_collection() 9 | 10 | define preserve_allcc void @caml_call_gc() { 11 | entry: 12 | call void @caml_garbage_collection() 13 | ret void 14 | } 15 | 16 | define preserve_allcc void @caml_allocN(i64 %size) { 17 | entry: 18 | br label %loop 19 | loop: 20 | 21 | call preserve_allcc void @caml_call_gc() 22 | ret void 23 | } 24 | -------------------------------------------------------------------------------- /lib_test/_tags: -------------------------------------------------------------------------------- 1 | <*.{ml,mli}> or : package(compiler-libs.optcomp), package(llvm), package(llvm.target), package(llvm_X86) 2 | -------------------------------------------------------------------------------- /lib_test/lexcmm.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | val token: Lexing.lexbuf -> Parsecmm.token 14 | 15 | type error = 16 | Illegal_character 17 | | Unterminated_comment 18 | | Unterminated_string 19 | 20 | exception Error of error 21 | 22 | val report_error: Lexing.lexbuf -> error -> unit 23 | -------------------------------------------------------------------------------- /lib_test/lexcmm.mll: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | { 14 | open Parsecmm 15 | 16 | type error = 17 | Illegal_character 18 | | Unterminated_comment 19 | | Unterminated_string 20 | 21 | exception Error of error 22 | 23 | (* For nested comments *) 24 | 25 | let comment_depth = ref 0 26 | 27 | (* The table of keywords *) 28 | 29 | let keyword_table = 30 | Misc.create_hashtable 149 [ 31 | "absf", ABSF; 32 | "addr", ADDR; 33 | "align", ALIGN; 34 | "alloc", ALLOC; 35 | "and", AND; 36 | "app", APPLY; 37 | "assign", ASSIGN; 38 | "byte", BYTE; 39 | "case", CASE; 40 | "catch", CATCH; 41 | "checkbound", CHECKBOUND; 42 | "data", DATA; 43 | "double", DOUBLE; 44 | "exit", EXIT; 45 | "extcall", EXTCALL; 46 | "float", FLOAT; 47 | "float32", FLOAT32; 48 | "float64", FLOAT64; 49 | "float64u", FLOAT64U; 50 | "floatofint", FLOATOFINT; 51 | "function", FUNCTION; 52 | "global", GLOBAL; 53 | "half", HALF; 54 | "if", IF; 55 | "int", INT; 56 | "int32", INT32; 57 | "intoffloat", INTOFFLOAT; 58 | "string", KSTRING; 59 | "let", LET; 60 | "load", LOAD; 61 | "mod", MODI; 62 | "or", OR; 63 | "proj", PROJ; 64 | "raise", RAISE; 65 | "seq", SEQ; 66 | "signed", SIGNED; 67 | "skip", SKIP; 68 | "store", STORE; 69 | "switch", SWITCH; 70 | "try", TRY; 71 | "unit", UNIT; 72 | "unsigned", UNSIGNED; 73 | "while", WHILE; 74 | "with", WITH; 75 | "xor", XOR; 76 | "addraref", ADDRAREF; 77 | "intaref", INTAREF; 78 | "floataref", FLOATAREF; 79 | "addraset", ADDRASET; 80 | "intaset", INTASET; 81 | "floataset", FLOATASET 82 | ] 83 | 84 | (* To buffer string literals *) 85 | 86 | let initial_string_buffer = String.create 256 87 | let string_buff = ref initial_string_buffer 88 | let string_index = ref 0 89 | 90 | let reset_string_buffer () = 91 | string_buff := initial_string_buffer; 92 | string_index := 0 93 | 94 | let store_string_char c = 95 | if !string_index >= String.length (!string_buff) then begin 96 | let new_buff = String.create (String.length (!string_buff) * 2) in 97 | String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff)); 98 | string_buff := new_buff 99 | end; 100 | String.unsafe_set (!string_buff) (!string_index) c; 101 | incr string_index 102 | 103 | let get_stored_string () = 104 | let s = String.sub (!string_buff) 0 (!string_index) in 105 | string_buff := initial_string_buffer; 106 | s 107 | 108 | (* To translate escape sequences *) 109 | 110 | let char_for_backslash = function 111 | 'n' -> '\010' 112 | | 'r' -> '\013' 113 | | 'b' -> '\008' 114 | | 't' -> '\009' 115 | | c -> c 116 | 117 | let char_for_decimal_code lexbuf i = 118 | Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + 119 | 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + 120 | (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48)) 121 | 122 | (* Error report *) 123 | 124 | let report_error lexbuf msg = 125 | prerr_string "Lexical error around character "; 126 | prerr_int (Lexing.lexeme_start lexbuf); 127 | match msg with 128 | Illegal_character -> 129 | prerr_string ": illegal character" 130 | | Unterminated_comment -> 131 | prerr_string ": unterminated comment" 132 | | Unterminated_string -> 133 | prerr_string ": unterminated string" 134 | 135 | } 136 | 137 | rule token = parse 138 | [' ' '\010' '\013' '\009' '\012'] + 139 | { token lexbuf } 140 | | "+a" { ADDA } 141 | | "+f" { ADDF } 142 | | "+" { ADDI } 143 | | ">>s" { ASR } 144 | | ":" { COLON } 145 | | "/f" { DIVF } 146 | | "/" { DIVI } 147 | | eof { EOF } 148 | | "==a" { EQA } 149 | | "==f" { EQF } 150 | | "==" { EQI } 151 | | ">=a" { GEA } 152 | | ">=f" { GEF } 153 | | ">=" { GEI } 154 | | ">a" { GTA } 155 | | ">f" { GTF } 156 | | ">" { GTI } 157 | | "[" { LBRACKET } 158 | | "<=a" { LEA } 159 | | "<=f" { LEF } 160 | | "<=" { LEI } 161 | | "(" { LPAREN } 162 | | "<<" { LSL } 163 | | ">>u" { LSR } 164 | | " 193 | IDENT s } 194 | | "\"" 195 | { reset_string_buffer(); 196 | string lexbuf; 197 | STRING (get_stored_string()) } 198 | | "(**" 199 | { comment_depth := 1; 200 | comment lexbuf; 201 | token lexbuf } 202 | | _ { raise(Error(Illegal_character)) } 203 | 204 | and comment = parse 205 | "(**" 206 | { comment_depth := succ !comment_depth; comment lexbuf } 207 | | "*)" 208 | { comment_depth := pred !comment_depth; 209 | if !comment_depth > 0 then comment lexbuf } 210 | | eof 211 | { raise (Error(Unterminated_comment)) } 212 | | _ 213 | { comment lexbuf } 214 | 215 | and string = parse 216 | '"' 217 | { () } 218 | | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] + 219 | { string lexbuf } 220 | | '\\' ['\\' '"' 'n' 't' 'b' 'r'] 221 | { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); 222 | string lexbuf } 223 | | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] 224 | { store_string_char(char_for_decimal_code lexbuf 1); 225 | string lexbuf } 226 | | eof 227 | { raise (Error(Unterminated_string)) } 228 | | _ 229 | { store_string_char(Lexing.lexeme_char lexbuf 0); 230 | string lexbuf } 231 | -------------------------------------------------------------------------------- /lib_test/parsecmm.mly: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* OCaml */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1996 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the Q Public License version 1.0. */ 10 | /* */ 11 | /***********************************************************************/ 12 | 13 | /* A simple parser for C-- */ 14 | 15 | %{ 16 | open Cmm 17 | open Parsecmmaux 18 | 19 | let rec make_letdef def body = 20 | match def with 21 | [] -> body 22 | | (id, def) :: rem -> 23 | unbind_ident id; 24 | Clet(id, def, make_letdef rem body) 25 | 26 | let make_switch n selector caselist = 27 | let index = Array.create n 0 in 28 | let casev = Array.of_list caselist in 29 | let actv = Array.create (Array.length casev) (Cexit(0,[])) in 30 | for i = 0 to Array.length casev - 1 do 31 | let (posl, e) = casev.(i) in 32 | List.iter (fun pos -> index.(pos) <- i) posl; 33 | actv.(i) <- e 34 | done; 35 | Cswitch(selector, index, actv) 36 | 37 | let access_array base numelt size = 38 | match numelt with 39 | Cconst_int 0 -> base 40 | | Cconst_int n -> Cop(Cadda, [base; Cconst_int(n * size)]) 41 | | _ -> Cop(Cadda, [base; 42 | Cop(Clsl, [numelt; Cconst_int(Misc.log2 size)])]) 43 | 44 | %} 45 | 46 | %token ABSF 47 | %token ADDA 48 | %token ADDF 49 | %token ADDI 50 | %token ADDR 51 | %token ALIGN 52 | %token ALLOC 53 | %token AND 54 | %token APPLY 55 | %token ASR 56 | %token ASSIGN 57 | %token BYTE 58 | %token CASE 59 | %token CATCH 60 | %token CHECKBOUND 61 | %token COLON 62 | %token DATA 63 | %token DIVF 64 | %token DIVI 65 | %token EOF 66 | %token EQA 67 | %token EQF 68 | %token EQI 69 | %token EXIT 70 | %token EXTCALL 71 | %token DOUBLE 72 | %token FLOAT 73 | %token FLOAT32 74 | %token FLOAT64 75 | %token FLOAT64U 76 | %token FLOATCONST 77 | %token FLOATOFINT 78 | %token FUNCTION 79 | %token GEA 80 | %token GEF 81 | %token GEI 82 | %token GLOBAL 83 | %token GTA 84 | %token GTF 85 | %token GTI 86 | %token HALF 87 | %token IDENT 88 | %token IF 89 | %token INT 90 | %token INT32 91 | %token INTCONST 92 | %token INTOFFLOAT 93 | %token KSTRING 94 | %token LBRACKET 95 | %token LEA 96 | %token LEF 97 | %token LEI 98 | %token LET 99 | %token LOAD 100 | %token LPAREN 101 | %token LSL 102 | %token LSR 103 | %token LTA 104 | %token LTF 105 | %token LTI 106 | %token MODI 107 | %token MULF 108 | %token MULI 109 | %token NEA 110 | %token NEF 111 | %token NEI 112 | %token OR 113 | %token POINTER 114 | %token PROJ 115 | %token RAISE 116 | %token RBRACKET 117 | %token RPAREN 118 | %token SEQ 119 | %token SIGNED 120 | %token SKIP 121 | %token STAR 122 | %token STORE 123 | %token STRING 124 | %token SUBA 125 | %token SUBF 126 | %token SUBI 127 | %token SWITCH 128 | %token TRY 129 | %token UNIT 130 | %token UNSIGNED 131 | %token WHILE 132 | %token WITH 133 | %token XOR 134 | %token ADDRAREF 135 | %token INTAREF 136 | %token FLOATAREF 137 | %token ADDRASET 138 | %token INTASET 139 | %token FLOATASET 140 | 141 | %start phrase 142 | %type phrase 143 | 144 | %% 145 | 146 | phrase: 147 | fundecl { Cfunction $1 } 148 | | datadecl { Cdata $1 } 149 | | EOF { raise End_of_file } 150 | ; 151 | fundecl: 152 | LPAREN FUNCTION IDENT LPAREN params RPAREN sequence RPAREN 153 | { List.iter (fun (id, ty) -> unbind_ident id) $5; 154 | {fun_name = $3; fun_args = $5; fun_body = $7; fun_fast = true; 155 | fun_dbg = Debuginfo.none} } 156 | ; 157 | params: 158 | oneparam params { $1 :: $2 } 159 | | /**/ { [] } 160 | ; 161 | oneparam: 162 | IDENT COLON machtype { (bind_ident $1, $3) } 163 | ; 164 | machtype: 165 | UNIT { [||] } 166 | | componentlist { Array.of_list(List.rev $1) } 167 | ; 168 | component: 169 | ADDR { Addr } 170 | | INT { Int } 171 | | FLOAT { Float } 172 | ; 173 | componentlist: 174 | component { [$1] } 175 | | componentlist STAR component { $3 :: $1 } 176 | ; 177 | expr: 178 | INTCONST { Cconst_int $1 } 179 | | FLOATCONST { Cconst_float $1 } 180 | | STRING { Cconst_symbol $1 } 181 | | POINTER { Cconst_pointer $1 } 182 | | IDENT { Cvar(find_ident $1) } 183 | | LBRACKET RBRACKET { Ctuple [] } 184 | | LPAREN LET letdef sequence RPAREN { make_letdef $3 $4 } 185 | | LPAREN ASSIGN IDENT expr RPAREN { Cassign(find_ident $3, $4) } 186 | | LPAREN APPLY expr exprlist machtype RPAREN 187 | { Cop(Capply($5, Debuginfo.none), $3 :: List.rev $4) } 188 | | LPAREN EXTCALL STRING exprlist machtype RPAREN 189 | { Cop(Cextcall($3, $5, false, Debuginfo.none), List.rev $4) } 190 | | LPAREN SUBF expr RPAREN { Cop(Cnegf, [$3]) } 191 | | LPAREN SUBF expr expr RPAREN { Cop(Csubf, [$3; $4]) } 192 | | LPAREN unaryop expr RPAREN { Cop($2, [$3]) } 193 | | LPAREN binaryop expr expr RPAREN { Cop($2, [$3; $4]) } 194 | | LPAREN SEQ sequence RPAREN { $3 } 195 | | LPAREN IF expr expr expr RPAREN { Cifthenelse($3, $4, $5) } 196 | | LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 } 197 | | LPAREN WHILE expr sequence RPAREN 198 | { let body = 199 | match $3 with 200 | Cconst_int x when x <> 0 -> $4 201 | | _ -> Cifthenelse($3, $4, (Cexit(0,[]))) in 202 | Ccatch(0, [], Cloop body, Ctuple []) } 203 | | LPAREN CATCH sequence WITH sequence RPAREN { Ccatch(0, [], $3, $5) } 204 | | EXIT { Cexit(0,[]) } 205 | | LPAREN TRY sequence WITH bind_ident sequence RPAREN 206 | { unbind_ident $5; Ctrywith($3, $5, $6) } 207 | | LPAREN ADDRAREF expr expr RPAREN 208 | { Cop(Cload Word, [access_array $3 $4 Arch.size_addr]) } 209 | | LPAREN INTAREF expr expr RPAREN 210 | { Cop(Cload Word, [access_array $3 $4 Arch.size_int]) } 211 | | LPAREN FLOATAREF expr expr RPAREN 212 | { Cop(Cload Double_u, [access_array $3 $4 Arch.size_float]) } 213 | | LPAREN ADDRASET expr expr expr RPAREN 214 | { Cop(Cstore Word, [access_array $3 $4 Arch.size_addr; $5]) } 215 | | LPAREN INTASET expr expr expr RPAREN 216 | { Cop(Cstore Word, [access_array $3 $4 Arch.size_int; $5]) } 217 | | LPAREN FLOATASET expr expr expr RPAREN 218 | { Cop(Cstore Double_u, [access_array $3 $4 Arch.size_float; $5]) } 219 | | LPAREN ALLOC INTCONST exprlist RPAREN 220 | { Cop(Calloc, Cconst_int $3 :: $4) } 221 | ; 222 | exprlist: 223 | exprlist expr { $2 :: $1 } 224 | | /**/ { [] } 225 | ; 226 | letdef: 227 | oneletdef { [$1] } 228 | | LPAREN letdefmult RPAREN { $2 } 229 | ; 230 | letdefmult: 231 | /**/ { [] } 232 | | oneletdef letdefmult { $1 :: $2 } 233 | ; 234 | oneletdef: 235 | IDENT expr { (bind_ident $1, $2) } 236 | ; 237 | chunk: 238 | UNSIGNED BYTE { Byte_unsigned } 239 | | SIGNED BYTE { Byte_signed } 240 | | UNSIGNED HALF { Sixteen_unsigned } 241 | | SIGNED HALF { Sixteen_signed } 242 | | UNSIGNED INT32 { Thirtytwo_unsigned } 243 | | SIGNED INT32 { Thirtytwo_signed } 244 | | INT { Word } 245 | | ADDR { Word } 246 | | FLOAT32 { Single } 247 | | FLOAT64 { Double } 248 | | FLOAT64U { Double_u } 249 | | /**/ { Word } 250 | 251 | ; 252 | unaryop: 253 | LOAD chunk { Cload $2 } 254 | | ALLOC { Calloc } 255 | | FLOATOFINT { Cfloatofint } 256 | | INTOFFLOAT { Cintoffloat } 257 | | RAISE { Craise Debuginfo.none } 258 | | ABSF { Cabsf } 259 | ; 260 | binaryop: 261 | STORE chunk { Cstore $2 } 262 | | ADDI { Caddi } 263 | | SUBI { Csubi } 264 | | MULI { Cmuli } 265 | | DIVI { Cdivi } 266 | | MODI { Cmodi } 267 | | AND { Cand } 268 | | OR { Cor } 269 | | XOR { Cxor } 270 | | LSL { Clsl } 271 | | LSR { Clsr } 272 | | ASR { Casr } 273 | | EQI { Ccmpi Ceq } 274 | | NEI { Ccmpi Cne } 275 | | LTI { Ccmpi Clt } 276 | | LEI { Ccmpi Cle } 277 | | GTI { Ccmpi Cgt } 278 | | GEI { Ccmpi Cge } 279 | | ADDA { Cadda } 280 | | SUBA { Csuba } 281 | | EQA { Ccmpa Ceq } 282 | | NEA { Ccmpa Cne } 283 | | LTA { Ccmpa Clt } 284 | | LEA { Ccmpa Cle } 285 | | GTA { Ccmpa Cgt } 286 | | GEA { Ccmpa Cge } 287 | | ADDF { Caddf } 288 | | MULF { Cmulf } 289 | | DIVF { Cdivf } 290 | | EQF { Ccmpf Ceq } 291 | | NEF { Ccmpf Cne } 292 | | LTF { Ccmpf Clt } 293 | | LEF { Ccmpf Cle } 294 | | GTF { Ccmpf Cgt } 295 | | GEF { Ccmpf Cge } 296 | | CHECKBOUND { Ccheckbound Debuginfo.none } 297 | ; 298 | sequence: 299 | expr sequence { Csequence($1, $2) } 300 | | expr { $1 } 301 | ; 302 | caselist: 303 | onecase sequence caselist { ($1, $2) :: $3 } 304 | | /**/ { [] } 305 | ; 306 | onecase: 307 | CASE INTCONST COLON onecase { $2 :: $4 } 308 | | CASE INTCONST COLON { [$2] } 309 | ; 310 | bind_ident: 311 | IDENT { bind_ident $1 } 312 | ; 313 | datadecl: 314 | LPAREN DATA datalist RPAREN { List.rev $3 } 315 | ; 316 | datalist: 317 | datalist dataitem { $2 :: $1 } 318 | | /**/ { [] } 319 | ; 320 | dataitem: 321 | STRING COLON { Cdefine_symbol $1 } 322 | | INTCONST COLON { Cdefine_label $1 } 323 | | GLOBAL STRING { Cglobal_symbol $2 } 324 | | BYTE INTCONST { Cint8 $2 } 325 | | HALF INTCONST { Cint16 $2 } 326 | | INT INTCONST { Cint(Nativeint.of_int $2) } 327 | | DOUBLE FLOATCONST { Cdouble $2 } 328 | | ADDR STRING { Csymbol_address $2 } 329 | | ADDR INTCONST { Clabel_address $2 } 330 | | KSTRING STRING { Cstring $2 } 331 | | SKIP INTCONST { Cskip $2 } 332 | | ALIGN INTCONST { Calign $2 } 333 | ; 334 | -------------------------------------------------------------------------------- /lib_test/parsecmmaux.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | (* Auxiliary functions for parsing *) 14 | 15 | type error = 16 | Unbound of string 17 | 18 | exception Error of error 19 | 20 | let tbl_ident = (Hashtbl.create 57 : (string, Ident.t) Hashtbl.t) 21 | 22 | let bind_ident s = 23 | let id = Ident.create s in 24 | Hashtbl.add tbl_ident s id; 25 | id 26 | 27 | let find_ident s = 28 | try 29 | Hashtbl.find tbl_ident s 30 | with Not_found -> 31 | raise(Error(Unbound s)) 32 | 33 | let unbind_ident id = 34 | Hashtbl.remove tbl_ident (Ident.name id) 35 | 36 | let report_error = function 37 | Unbound s -> 38 | prerr_string "Unbound identifier "; prerr_string s; prerr_endline "." 39 | -------------------------------------------------------------------------------- /lib_test/parsecmmaux.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | (* Auxiliary functions for parsing *) 14 | 15 | val bind_ident: string -> Ident.t 16 | val find_ident: string -> Ident.t 17 | val unbind_ident: Ident.t -> unit 18 | 19 | type error = 20 | Unbound of string 21 | 22 | exception Error of error 23 | 24 | val report_error: error -> unit 25 | -------------------------------------------------------------------------------- /lib_test/run_cmm.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Llvm.enable_pretty_stacktrace (); 3 | Llvm.install_fatal_error_handler prerr_endline; 4 | 5 | let llmod = Llvmcomp.transl_unit "caml" in 6 | 7 | let lexbuf = Lexing.from_channel (open_in Sys.argv.(1)) in 8 | let parse = fun () -> Parsecmm.phrase Lexcmm.token lexbuf in 9 | let rec translate rest = 10 | try 11 | let phrase = parse () in 12 | Printcmm.phrase Format.err_formatter phrase; 13 | Format.pp_print_newline Format.err_formatter (); 14 | translate ((Llvmcomp.phrase llmod phrase) :: rest) 15 | with End_of_file -> 16 | rest 17 | in 18 | List.iter (fun f -> ignore (f ())) (translate []); 19 | 20 | let out = open_out Sys.argv.(2) in 21 | output_string out (Llvm.string_of_llmodule llmod); 22 | close_out out 23 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | 3 | let () = (* :( *) 4 | Unix.putenv "OCAMLPATH" ("/home/whitequark/.opam/4.01.0/lib/llvm/" ^ 5 | (try ":" ^ (Unix.getenv "OCAMLPATH") with Not_found -> "")) 6 | 7 | let () = 8 | dispatch begin 9 | function 10 | | After_rules -> 11 | flag ["ocaml"; "compile"] (S[A"-w"; A"@5@8@10@11@12@14@23@24@26@29@40"]); 12 | | _ -> () 13 | end 14 | -------------------------------------------------------------------------------- /test/alloc-bench.ll: -------------------------------------------------------------------------------- 1 | target datalayout = "e-p:64:64:64-S128-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f16:16:16-f32:32:32-f64:64:64-f128:128:128-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64" 2 | target triple = "x86_64-linux-gnu" 3 | 4 | declare cc16 { i8*, i8*, i8* } @camlMlintegr__square_1010(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.x/1011") gc "ocaml" 5 | 6 | define i64 @main() { 7 | entry: 8 | %t = alloca <{ i64, double }> 9 | %t1 = getelementptr <{ i64, double }>* %t, i32 0, i32 1 10 | store double 2.0, double* %t1 11 | %t2 = bitcast double* %t1 to i8* 12 | %c = call cc16 { i8*, i8*, i8* } @camlMlintegr__square_1010(i8* null, i8* null, i8* %t2) 13 | %d = extractvalue { i8*, i8*, i8* } %c, 2 14 | %e = bitcast i8* %d to double* 15 | %f = load double* %e 16 | %g = fptosi double %f to i64 17 | ret i64 %g 18 | } 19 | -------------------------------------------------------------------------------- /test/alloc.cmm: -------------------------------------------------------------------------------- 1 | (data int 3072 global "camlMlintegr" "camlMlintegr": skip 24) 2 | 3 | (function camlMlintegr__square_1010 (x/1011: addr) 4 | (alloc 1277 (*f (load float64u x/1011) (load float64u x/1011)))) 5 | 6 | -------------------------------------------------------------------------------- /test/alloc.ll: -------------------------------------------------------------------------------- 1 | ; ModuleID = 'caml' 2 | target datalayout = "e-m:e-i64:64-f80:128-n8:16:32:64-S128" 3 | target triple = "x86_64-linux-gnu" 4 | 5 | @0 = private global <{ i64, [24 x i8] }> <{ i64 3072, [24 x i8] zeroinitializer }> 6 | @camlMlintegr = global i8* getelementptr inbounds (<{ i64, [24 x i8] }>* @0, i32 0, i32 1, i32 0) 7 | 8 | define cc16 { i8*, i8*, i8* } @camlMlintegr__square_1010(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.x/1011") gc "ocaml" { 9 | entry: 10 | %alloca.caml_exception_pointer = alloca i8* 11 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 12 | %alloca.caml_young_ptr = alloca i8* 13 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 14 | %"alloca.x/1011" = alloca i8* 15 | store i8* %"arg.x/1011", i8** %"alloca.x/1011" 16 | %"local.x/1011" = load i8** %"alloca.x/1011" 17 | %load.addr = bitcast i8* %"local.x/1011" to double* 18 | %load = load double* %load.addr 19 | %"local.x/10111" = load i8** %"alloca.x/1011" 20 | %load.addr2 = bitcast i8* %"local.x/10111" to double* 21 | %load3 = load double* %load.addr2 22 | %mulf = fmul double %load, %load3 23 | %alloc = call i8* @caml_allocN(i64 16) 24 | %0 = bitcast i8* %alloc to { i64, double }* 25 | %field.0 = getelementptr inbounds { i64, double }* %0, i32 0, i32 0 26 | store i64 1277, i64* %field.0 27 | %field.1 = getelementptr inbounds { i64, double }* %0, i32 0, i32 1 28 | store double %mulf, double* %field.1 29 | %1 = getelementptr inbounds { i64, double }* %0, i32 0, i32 1 30 | %alloc.body = bitcast double* %1 to i8* 31 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 32 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 33 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 34 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 35 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 36 | ret { i8*, i8*, i8* } %4 37 | } 38 | 39 | declare preserve_allcc i8* @caml_allocN(i64) 40 | -------------------------------------------------------------------------------- /test/integr.cmm: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (** *) 3 | (** OCaml *) 4 | (** *) 5 | (** Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (** *) 7 | (** Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (** en Automatique. All rights reserved. This file is distributed *) 9 | (** under the terms of the Q Public License version 1.0. *) 10 | (** *) 11 | (***********************************************************************) 12 | 13 | (function square (x: float) 14 | ( *f x x)) 15 | 16 | (function integr (f: addr low: float high: float n: int) 17 | (let (h (/f (-f high low) (floatofint n)) 18 | x low 19 | s 0.0 20 | i n) 21 | (while (> i 0) 22 | (assign s (+f s (app f x float))) 23 | (assign x (+f x h)) 24 | (assign i (- i 1))) 25 | ( *f s h))) 26 | 27 | (function test (n: int) 28 | (app "integr" "square" 0.0 1.0 n float)) 29 | -------------------------------------------------------------------------------- /test/integr.ll: -------------------------------------------------------------------------------- 1 | ; ModuleID = 'caml' 2 | target datalayout = "e-m:e-i64:64-f80:128-n8:16:32:64-S128" 3 | target triple = "x86_64-linux-gnu" 4 | 5 | define cc16 { i8*, i8*, double } @square(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, double %arg.x) gc "ocaml" { 6 | entry: 7 | %alloca.caml_exception_pointer = alloca i8* 8 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 9 | %alloca.caml_young_ptr = alloca i8* 10 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 11 | %alloca.x = alloca double 12 | store double %arg.x, double* %alloca.x 13 | %local.x = load double* %alloca.x 14 | %local.x1 = load double* %alloca.x 15 | %mulf = fmul double %local.x, %local.x1 16 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 17 | %0 = insertvalue { i8*, i8*, double } undef, i8* %reload.caml_exception_pointer, 0 18 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 19 | %1 = insertvalue { i8*, i8*, double } %0, i8* %reload.caml_young_ptr, 1 20 | %2 = insertvalue { i8*, i8*, double } %1, double %mulf, 2 21 | ret { i8*, i8*, double } %2 22 | } 23 | 24 | define cc16 { i8*, i8*, double } @integr(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %arg.f, double %arg.low, double %arg.high, i64 %arg.n) gc "ocaml" { 25 | entry: 26 | %alloca.caml_exception_pointer = alloca i8* 27 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 28 | %alloca.caml_young_ptr = alloca i8* 29 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 30 | %alloca.f = alloca i8* 31 | store i8* %arg.f, i8** %alloca.f 32 | %alloca.low = alloca double 33 | store double %arg.low, double* %alloca.low 34 | %alloca.high = alloca double 35 | store double %arg.high, double* %alloca.high 36 | %alloca.n = alloca i64 37 | store i64 %arg.n, i64* %alloca.n 38 | %local.high = load double* %alloca.high 39 | %local.low = load double* %alloca.low 40 | %subf = fsub double %local.high, %local.low 41 | %local.n = load i64* %alloca.n 42 | %floatofint = sitofp i64 %local.n to double 43 | %divf = fdiv double %subf, %floatofint 44 | %alloca.h = alloca double 45 | store double %divf, double* %alloca.h 46 | %local.low1 = load double* %alloca.low 47 | %alloca.x = alloca double 48 | store double %local.low1, double* %alloca.x 49 | %alloca.s = alloca double 50 | store double 0.000000e+00, double* %alloca.s 51 | %local.n2 = load i64* %alloca.n 52 | %alloca.i = alloca i64 53 | store i64 %local.n2, i64* %alloca.i 54 | br label %loop 55 | 56 | catch.0.with: ; preds = %if.false 57 | br label %catch.0.exit 58 | 59 | catch.0.exit: ; preds = %catch.0.with 60 | %local.s6 = load double* %alloca.s 61 | %local.h7 = load double* %alloca.h 62 | %mulf = fmul double %local.s6, %local.h7 63 | %reload.caml_exception_pointer8 = load i8** %alloca.caml_exception_pointer 64 | %0 = insertvalue { i8*, i8*, double } undef, i8* %reload.caml_exception_pointer8, 0 65 | %reload.caml_young_ptr9 = load i8** %alloca.caml_young_ptr 66 | %1 = insertvalue { i8*, i8*, double } %0, i8* %reload.caml_young_ptr9, 1 67 | %2 = insertvalue { i8*, i8*, double } %1, double %mulf, 2 68 | ret { i8*, i8*, double } %2 69 | 70 | loop: ; preds = %if.exit, %entry 71 | %local.i5 = load i64* %alloca.i 72 | %cmpi = icmp sgt i64 %local.i5, 0 73 | br i1 %cmpi, label %if.true, label %if.false 74 | 75 | if.exit: ; preds = %if.true 76 | br label %loop 77 | 78 | if.true: ; preds = %loop 79 | %local.s = load double* %alloca.s 80 | %local.x = load double* %alloca.x 81 | %local.f = load i8** %alloca.f 82 | %apply.fn = bitcast i8* %local.f to { i8*, i8*, double } (i8*, i8*, double)* 83 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 84 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 85 | %3 = tail call cc16 { i8*, i8*, double } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, double %local.x) 86 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, double } %3, 0 87 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 88 | %reload.caml_young_ptr = extractvalue { i8*, i8*, double } %3, 1 89 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 90 | %apply = extractvalue { i8*, i8*, double } %3, 2 91 | %addf = fadd double %local.s, %apply 92 | store double %addf, double* %alloca.s 93 | %local.x3 = load double* %alloca.x 94 | %local.h = load double* %alloca.h 95 | %addf4 = fadd double %local.x3, %local.h 96 | store double %addf4, double* %alloca.x 97 | %local.i = load i64* %alloca.i 98 | %subi = sub i64 %local.i, 1 99 | store i64 %subi, i64* %alloca.i 100 | br label %if.exit 101 | 102 | if.false: ; preds = %loop 103 | br label %catch.0.with 104 | } 105 | 106 | define cc16 { i8*, i8*, double } @test(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i64 %arg.n) gc "ocaml" { 107 | entry: 108 | %alloca.caml_exception_pointer = alloca i8* 109 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 110 | %alloca.caml_young_ptr = alloca i8* 111 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 112 | %alloca.n = alloca i64 113 | store i64 %arg.n, i64* %alloca.n 114 | %local.n = load i64* %alloca.n 115 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 116 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 117 | %0 = tail call cc16 { i8*, i8*, double } @integr(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* bitcast ({ i8*, i8*, double } (i8*, i8*, double)* @square to i8*), double 0.000000e+00, double 1.000000e+00, i64 %local.n) 118 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, double } %0, 0 119 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 120 | %reload.caml_young_ptr = extractvalue { i8*, i8*, double } %0, 1 121 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 122 | %apply = extractvalue { i8*, i8*, double } %0, 2 123 | %reload.caml_exception_pointer1 = load i8** %alloca.caml_exception_pointer 124 | %1 = insertvalue { i8*, i8*, double } undef, i8* %reload.caml_exception_pointer1, 0 125 | %reload.caml_young_ptr2 = load i8** %alloca.caml_young_ptr 126 | %2 = insertvalue { i8*, i8*, double } %1, i8* %reload.caml_young_ptr2, 1 127 | %3 = insertvalue { i8*, i8*, double } %2, double %apply, 2 128 | ret { i8*, i8*, double } %3 129 | } 130 | -------------------------------------------------------------------------------- /test/mlintegr.cmm: -------------------------------------------------------------------------------- 1 | (data int 3072 global "camlMlintegr" "camlMlintegr": skip 24) 2 | (data int 2295 "camlMlintegr__4": addr "camlMlintegr__test_1022" int 3) 3 | (data 4 | int 3319 5 | "camlMlintegr__5": 6 | addr "caml_curry4" 7 | int 9 8 | addr "camlMlintegr__integr_1012") 9 | (data int 2295 "camlMlintegr__6": addr "camlMlintegr__square_1010" int 3) 10 | (data global "camlMlintegr__1" int 1277 "camlMlintegr__1": double 0.0) 11 | (data global "camlMlintegr__2" int 1277 "camlMlintegr__2": double 0.0) 12 | (data global "camlMlintegr__3" int 1277 "camlMlintegr__3": double 1.0) 13 | 14 | (function camlMlintegr__square_1010 (x/1011: addr) 15 | (alloc 1277 (*f (load float64u x/1011) (load float64u x/1011)))) 16 | 17 | (function camlMlintegr__iter_1018 18 | (x/1019: addr s/1020: addr i/1021: int env/1038: addr) 19 | (if (> i/1021 1) 20 | (app "camlMlintegr__iter_1018" 21 | (alloc 1277 22 | (+f (load float64u s/1020) 23 | (let fun/1042 (load (+a env/1038 24)) 24 | (load float64u (app (load fun/1042) x/1019 fun/1042 addr))))) 25 | (alloc 1277 26 | (+f (load float64u x/1019) (load float64u (load (+a env/1038 32))))) 27 | (+ i/1021 -2) env/1038 addr) 28 | (alloc 1277 29 | (*f (load float64u s/1020) (load float64u (load (+a env/1038 32))))))) 30 | 31 | (function camlMlintegr__integr_1012 32 | (f/1013: addr low/1014: addr high/1015: addr n/1016: int) 33 | (let 34 | (h/1041 35 | (/f (-f (load float64u high/1015) (load float64u low/1014)) 36 | (floatofint (>>s n/1016 1))) 37 | h/1017 (alloc 1277 h/1041) 38 | clos/1039 39 | (alloc 5367 "caml_curry3" 7 "camlMlintegr__iter_1018" f/1013 h/1017)) 40 | (app "camlMlintegr__iter_1018" low/1014 "camlMlintegr__1" n/1016 clos/1039 41 | addr))) 42 | 43 | (function camlMlintegr__test_1022 (n/1023: int) 44 | (app "camlMlintegr__integr_1012" (load "camlMlintegr") "camlMlintegr__2" 45 | "camlMlintegr__3" n/1023 addr)) 46 | 47 | (function camlMlintegr__entry () 48 | (let square/1010 "camlMlintegr__6" (store "camlMlintegr" square/1010)) 49 | (let integr/1012 "camlMlintegr__5" 50 | (store (+a "camlMlintegr" 8) integr/1012)) 51 | (let test/1022 "camlMlintegr__4" (store (+a "camlMlintegr" 16) test/1022)) 52 | (app "camlMlintegr__integr_1012" (load "camlMlintegr") "camlMlintegr__2" 53 | "camlMlintegr__3" 21 unit) 54 | 1a) 55 | 56 | (data) 57 | (function caml_program () 58 | (app "camlMlintegr__entry" unit) 59 | (**(store "caml_globals_inited" (+ (load "caml_globals_inited") 1))*) 1) 60 | 61 | (function caml_curry4 (arg/1069: addr clos/1070: addr) 62 | (alloc 5367 "caml_curry4_1" 7 "caml_curry4_1_app" arg/1069 clos/1070)) 63 | 64 | (function caml_curry4_1_app 65 | (arg2/1071: addr arg3/1072: addr arg4/1073: addr clos/1070: addr) 66 | (let clos/1074 (load (+a clos/1070 32)) 67 | (app (load (+a clos/1074 16)) (load (+a clos/1070 24)) arg2/1071 arg3/1072 68 | arg4/1073 clos/1074 addr))) 69 | 70 | (function caml_curry4_1 (arg/1075: addr clos/1076: addr) 71 | (alloc 5367 "caml_curry4_2" 5 "caml_curry4_2_app" arg/1075 clos/1076)) 72 | 73 | (function caml_curry4_2_app (arg3/1077: addr arg4/1078: addr clos/1076: addr) 74 | (let (clos/1079 (load (+a clos/1076 32)) clos/1080 (load (+a clos/1079 32))) 75 | (app (load (+a clos/1080 16)) (load (+a clos/1079 24)) 76 | (load (+a clos/1076 24)) arg3/1077 arg4/1078 clos/1080 addr))) 77 | 78 | (function caml_curry4_2 (arg/1081: addr clos/1082: addr) 79 | (alloc 4343 "caml_curry4_3" 3 arg/1081 clos/1082)) 80 | 81 | (function caml_curry4_3 (arg/1083: addr clos/1084: addr) 82 | (let 83 | (clos/1085 (load (+a clos/1084 24)) clos/1086 (load (+a clos/1085 32)) 84 | clos/1087 (load (+a clos/1086 32))) 85 | (app (load (+a clos/1087 16)) (load (+a clos/1086 24)) 86 | (load (+a clos/1085 24)) (load (+a clos/1084 16)) arg/1083 clos/1087 87 | addr))) 88 | 89 | (function caml_curry3 (arg/1058: addr clos/1059: addr) 90 | (alloc 5367 "caml_curry3_1" 5 "caml_curry3_1_app" arg/1058 clos/1059)) 91 | 92 | (function caml_curry3_1_app (arg2/1060: addr arg3/1061: addr clos/1059: addr) 93 | (let clos/1062 (load (+a clos/1059 32)) 94 | (app (load (+a clos/1062 16)) (load (+a clos/1059 24)) arg2/1060 arg3/1061 95 | clos/1062 addr))) 96 | 97 | (function caml_curry3_1 (arg/1063: addr clos/1064: addr) 98 | (alloc 4343 "caml_curry3_2" 3 arg/1063 clos/1064)) 99 | 100 | (function caml_curry3_2 (arg/1065: addr clos/1066: addr) 101 | (let (clos/1067 (load (+a clos/1066 24)) clos/1068 (load (+a clos/1067 32))) 102 | (app (load (+a clos/1068 16)) (load (+a clos/1067 24)) 103 | (load (+a clos/1066 16)) arg/1065 clos/1068 addr))) 104 | 105 | -------------------------------------------------------------------------------- /test/mlintegr.ll: -------------------------------------------------------------------------------- 1 | ; ModuleID = 'caml' 2 | target datalayout = "e-m:e-i64:64-f80:128-n8:16:32:64-S128" 3 | target triple = "x86_64-linux-gnu" 4 | 5 | @0 = private global <{ i64, [24 x i8] }> <{ i64 3072, [24 x i8] zeroinitializer }> 6 | @camlMlintegr = global i8* getelementptr inbounds (<{ i64, [24 x i8] }>* @0, i32 0, i32 1, i32 0) 7 | @1 = private global <{ i64, i8*, i64 }> <{ i64 2295, i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i64)* @camlMlintegr__test_1022 to i8*), i64 3 }> 8 | @camlMlintegr__4 = global i8* bitcast (i8** getelementptr inbounds (<{ i64, i8*, i64 }>* @1, i32 0, i32 1) to i8*) 9 | @2 = private global <{ i64, i8*, i64, i8* }> <{ i64 3319, i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry4 to i8*), i64 9, i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i64)* @camlMlintegr__integr_1012 to i8*) }> 10 | @camlMlintegr__5 = global i8* bitcast (i8** getelementptr inbounds (<{ i64, i8*, i64, i8* }>* @2, i32 0, i32 1) to i8*) 11 | @3 = private global <{ i64, i8*, i64 }> <{ i64 2295, i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*)* @camlMlintegr__square_1010 to i8*), i64 3 }> 12 | @camlMlintegr__6 = global i8* bitcast (i8** getelementptr inbounds (<{ i64, i8*, i64 }>* @3, i32 0, i32 1) to i8*) 13 | @4 = private global <{ i64, double }> <{ i64 1277, double 0.000000e+00 }> 14 | @camlMlintegr__1 = global i8* bitcast (double* getelementptr inbounds (<{ i64, double }>* @4, i32 0, i32 1) to i8*) 15 | @5 = private global <{ i64, double }> <{ i64 1277, double 0.000000e+00 }> 16 | @camlMlintegr__2 = global i8* bitcast (double* getelementptr inbounds (<{ i64, double }>* @5, i32 0, i32 1) to i8*) 17 | @6 = private global <{ i64, double }> <{ i64 1277, double 1.000000e+00 }> 18 | @camlMlintegr__3 = global i8* bitcast (double* getelementptr inbounds (<{ i64, double }>* @6, i32 0, i32 1) to i8*) 19 | @7 = private global <{}> zeroinitializer 20 | 21 | define cc16 { i8*, i8*, i8* } @camlMlintegr__square_1010(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.x/1011") gc "ocaml" { 22 | entry: 23 | %alloca.caml_exception_pointer = alloca i8* 24 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 25 | %alloca.caml_young_ptr = alloca i8* 26 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 27 | %"alloca.x/1011" = alloca i8* 28 | store i8* %"arg.x/1011", i8** %"alloca.x/1011" 29 | %"local.x/1011" = load i8** %"alloca.x/1011" 30 | %load.addr = bitcast i8* %"local.x/1011" to double* 31 | %load = load double* %load.addr 32 | %"local.x/10111" = load i8** %"alloca.x/1011" 33 | %load.addr2 = bitcast i8* %"local.x/10111" to double* 34 | %load3 = load double* %load.addr2 35 | %mulf = fmul double %load, %load3 36 | %alloc = call i8* @caml_allocN(i64 16) 37 | %0 = bitcast i8* %alloc to { i64, double }* 38 | %field.0 = getelementptr inbounds { i64, double }* %0, i32 0, i32 0 39 | store i64 1277, i64* %field.0 40 | %field.1 = getelementptr inbounds { i64, double }* %0, i32 0, i32 1 41 | store double %mulf, double* %field.1 42 | %1 = getelementptr inbounds { i64, double }* %0, i32 0, i32 1 43 | %alloc.body = bitcast double* %1 to i8* 44 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 45 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 46 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 47 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 48 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 49 | ret { i8*, i8*, i8* } %4 50 | } 51 | 52 | define cc16 { i8*, i8*, i8* } @camlMlintegr__iter_1018(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.x/1019", i8* %"arg.s/1020", i64 %"arg.i/1021", i8* %"arg.env/1038") gc "ocaml" { 53 | entry: 54 | %alloca.caml_exception_pointer = alloca i8* 55 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 56 | %alloca.caml_young_ptr = alloca i8* 57 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 58 | %"alloca.x/1019" = alloca i8* 59 | store i8* %"arg.x/1019", i8** %"alloca.x/1019" 60 | %"alloca.s/1020" = alloca i8* 61 | store i8* %"arg.s/1020", i8** %"alloca.s/1020" 62 | %"alloca.i/1021" = alloca i64 63 | store i64 %"arg.i/1021", i64* %"alloca.i/1021" 64 | %"alloca.env/1038" = alloca i8* 65 | store i8* %"arg.env/1038", i8** %"alloca.env/1038" 66 | %"local.i/102141" = load i64* %"alloca.i/1021" 67 | %cmpi = icmp sgt i64 %"local.i/102141", 1 68 | br i1 %cmpi, label %if.true, label %if.false 69 | 70 | if.exit: ; preds = %if.false, %if.true 71 | %if.value = phi i8* [ %apply27, %if.true ], [ %alloc.body40, %if.false ] 72 | %reload.caml_exception_pointer42 = load i8** %alloca.caml_exception_pointer 73 | %0 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer42, 0 74 | %reload.caml_young_ptr43 = load i8** %alloca.caml_young_ptr 75 | %1 = insertvalue { i8*, i8*, i8* } %0, i8* %reload.caml_young_ptr43, 1 76 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %if.value, 2 77 | ret { i8*, i8*, i8* } %2 78 | 79 | if.true: ; preds = %entry 80 | %"local.s/1020" = load i8** %"alloca.s/1020" 81 | %load.addr = bitcast i8* %"local.s/1020" to double* 82 | %load = load double* %load.addr 83 | %"local.env/1038" = load i8** %"alloca.env/1038" 84 | %adda = getelementptr inbounds i8* %"local.env/1038", i64 24 85 | %load.addr1 = bitcast i8* %adda to i8** 86 | %load2 = load i8** %load.addr1 87 | %"alloca.fun/1042" = alloca i8* 88 | store i8* %load2, i8** %"alloca.fun/1042" 89 | %"local.x/1019" = load i8** %"alloca.x/1019" 90 | %"local.fun/1042" = load i8** %"alloca.fun/1042" 91 | %"local.fun/10423" = load i8** %"alloca.fun/1042" 92 | %load.addr4 = bitcast i8* %"local.fun/10423" to i8** 93 | %load5 = load i8** %load.addr4 94 | %apply.fn = bitcast i8* %load5 to { i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* 95 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 96 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 97 | %3 = tail call cc16 { i8*, i8*, i8* } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %"local.x/1019", i8* %"local.fun/1042") 98 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %3, 0 99 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 100 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %3, 1 101 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 102 | %apply = extractvalue { i8*, i8*, i8* } %3, 2 103 | %load.addr6 = bitcast i8* %apply to double* 104 | %load7 = load double* %load.addr6 105 | %addf = fadd double %load, %load7 106 | %alloc = call i8* @caml_allocN(i64 16) 107 | %4 = bitcast i8* %alloc to { i64, double }* 108 | %field.0 = getelementptr inbounds { i64, double }* %4, i32 0, i32 0 109 | store i64 1277, i64* %field.0 110 | %field.1 = getelementptr inbounds { i64, double }* %4, i32 0, i32 1 111 | store double %addf, double* %field.1 112 | %5 = getelementptr inbounds { i64, double }* %4, i32 0, i32 1 113 | %alloc.body = bitcast double* %5 to i8* 114 | %"local.x/10198" = load i8** %"alloca.x/1019" 115 | %load.addr9 = bitcast i8* %"local.x/10198" to double* 116 | %load10 = load double* %load.addr9 117 | %"local.env/103811" = load i8** %"alloca.env/1038" 118 | %adda12 = getelementptr inbounds i8* %"local.env/103811", i64 32 119 | %load.addr13 = bitcast i8* %adda12 to i8** 120 | %load14 = load i8** %load.addr13 121 | %load.addr15 = bitcast i8* %load14 to double* 122 | %load16 = load double* %load.addr15 123 | %addf17 = fadd double %load10, %load16 124 | %alloc18 = call i8* @caml_allocN(i64 16) 125 | %6 = bitcast i8* %alloc18 to { i64, double }* 126 | %field.019 = getelementptr inbounds { i64, double }* %6, i32 0, i32 0 127 | store i64 1277, i64* %field.019 128 | %field.120 = getelementptr inbounds { i64, double }* %6, i32 0, i32 1 129 | store double %addf17, double* %field.120 130 | %7 = getelementptr inbounds { i64, double }* %6, i32 0, i32 1 131 | %alloc.body21 = bitcast double* %7 to i8* 132 | %"local.i/1021" = load i64* %"alloca.i/1021" 133 | %addi = add i64 %"local.i/1021", -2 134 | %"local.env/103822" = load i8** %"alloca.env/1038" 135 | %pass.caml_exception_pointer23 = load i8** %alloca.caml_exception_pointer 136 | %pass.caml_young_ptr24 = load i8** %alloca.caml_young_ptr 137 | %8 = tail call cc16 { i8*, i8*, i8* } @camlMlintegr__iter_1018(i8* %pass.caml_exception_pointer23, i8* %pass.caml_young_ptr24, i8* %alloc.body, i8* %alloc.body21, i64 %addi, i8* %"local.env/103822") 138 | %reload.caml_exception_pointer25 = extractvalue { i8*, i8*, i8* } %8, 0 139 | store i8* %reload.caml_exception_pointer25, i8** %alloca.caml_exception_pointer 140 | %reload.caml_young_ptr26 = extractvalue { i8*, i8*, i8* } %8, 1 141 | store i8* %reload.caml_young_ptr26, i8** %alloca.caml_young_ptr 142 | %apply27 = extractvalue { i8*, i8*, i8* } %8, 2 143 | br label %if.exit 144 | 145 | if.false: ; preds = %entry 146 | %"local.s/102028" = load i8** %"alloca.s/1020" 147 | %load.addr29 = bitcast i8* %"local.s/102028" to double* 148 | %load30 = load double* %load.addr29 149 | %"local.env/103831" = load i8** %"alloca.env/1038" 150 | %adda32 = getelementptr inbounds i8* %"local.env/103831", i64 32 151 | %load.addr33 = bitcast i8* %adda32 to i8** 152 | %load34 = load i8** %load.addr33 153 | %load.addr35 = bitcast i8* %load34 to double* 154 | %load36 = load double* %load.addr35 155 | %mulf = fmul double %load30, %load36 156 | %alloc37 = call i8* @caml_allocN(i64 16) 157 | %9 = bitcast i8* %alloc37 to { i64, double }* 158 | %field.038 = getelementptr inbounds { i64, double }* %9, i32 0, i32 0 159 | store i64 1277, i64* %field.038 160 | %field.139 = getelementptr inbounds { i64, double }* %9, i32 0, i32 1 161 | store double %mulf, double* %field.139 162 | %10 = getelementptr inbounds { i64, double }* %9, i32 0, i32 1 163 | %alloc.body40 = bitcast double* %10 to i8* 164 | br label %if.exit 165 | } 166 | 167 | define cc16 { i8*, i8*, i8* } @camlMlintegr__integr_1012(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.f/1013", i8* %"arg.low/1014", i8* %"arg.high/1015", i64 %"arg.n/1016") gc "ocaml" { 168 | entry: 169 | %alloca.caml_exception_pointer = alloca i8* 170 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 171 | %alloca.caml_young_ptr = alloca i8* 172 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 173 | %"alloca.f/1013" = alloca i8* 174 | store i8* %"arg.f/1013", i8** %"alloca.f/1013" 175 | %"alloca.low/1014" = alloca i8* 176 | store i8* %"arg.low/1014", i8** %"alloca.low/1014" 177 | %"alloca.high/1015" = alloca i8* 178 | store i8* %"arg.high/1015", i8** %"alloca.high/1015" 179 | %"alloca.n/1016" = alloca i64 180 | store i64 %"arg.n/1016", i64* %"alloca.n/1016" 181 | %"local.high/1015" = load i8** %"alloca.high/1015" 182 | %load.addr = bitcast i8* %"local.high/1015" to double* 183 | %load = load double* %load.addr 184 | %"local.low/1014" = load i8** %"alloca.low/1014" 185 | %load.addr1 = bitcast i8* %"local.low/1014" to double* 186 | %load2 = load double* %load.addr1 187 | %subf = fsub double %load, %load2 188 | %"local.n/1016" = load i64* %"alloca.n/1016" 189 | %asr = ashr i64 %"local.n/1016", 1 190 | %floatofint = sitofp i64 %asr to double 191 | %divf = fdiv double %subf, %floatofint 192 | %"alloca.h/1041" = alloca double 193 | store double %divf, double* %"alloca.h/1041" 194 | %"local.h/1041" = load double* %"alloca.h/1041" 195 | %alloc = call i8* @caml_allocN(i64 16) 196 | %0 = bitcast i8* %alloc to { i64, double }* 197 | %field.0 = getelementptr inbounds { i64, double }* %0, i32 0, i32 0 198 | store i64 1277, i64* %field.0 199 | %field.1 = getelementptr inbounds { i64, double }* %0, i32 0, i32 1 200 | store double %"local.h/1041", double* %field.1 201 | %1 = getelementptr inbounds { i64, double }* %0, i32 0, i32 1 202 | %alloc.body = bitcast double* %1 to i8* 203 | %"alloca.h/1017" = alloca i8* 204 | store i8* %alloc.body, i8** %"alloca.h/1017" 205 | %"local.h/1017" = load i8** %"alloca.h/1017" 206 | %"local.f/1013" = load i8** %"alloca.f/1013" 207 | %alloc3 = call i8* @caml_allocN(i64 48) 208 | %2 = bitcast i8* %alloc3 to { i64, i8*, i8*, i8*, i64, i8* }* 209 | %field.04 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 0 210 | store i64 5367, i64* %field.04 211 | %field.15 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 1 212 | store i8* %"local.h/1017", i8** %field.15 213 | %field.2 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 2 214 | store i8* %"local.f/1013", i8** %field.2 215 | %field.3 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 3 216 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i64, i8*)* @camlMlintegr__iter_1018 to i8*), i8** %field.3 217 | %field.4 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 4 218 | store i64 7, i64* %field.4 219 | %field.5 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 5 220 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry3 to i8*), i8** %field.5 221 | %3 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %2, i32 0, i32 1 222 | %alloc.body6 = bitcast i8** %3 to i8* 223 | %"alloca.clos/1039" = alloca i8* 224 | store i8* %alloc.body6, i8** %"alloca.clos/1039" 225 | %"local.low/10147" = load i8** %"alloca.low/1014" 226 | %"local.n/10168" = load i64* %"alloca.n/1016" 227 | %"local.clos/1039" = load i8** %"alloca.clos/1039" 228 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 229 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 230 | %4 = tail call cc16 { i8*, i8*, i8* } @camlMlintegr__iter_1018(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %"local.low/10147", i8* bitcast (i8** @camlMlintegr__1 to i8*), i64 %"local.n/10168", i8* %"local.clos/1039") 231 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %4, 0 232 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 233 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %4, 1 234 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 235 | %apply = extractvalue { i8*, i8*, i8* } %4, 2 236 | %reload.caml_exception_pointer9 = load i8** %alloca.caml_exception_pointer 237 | %5 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer9, 0 238 | %reload.caml_young_ptr10 = load i8** %alloca.caml_young_ptr 239 | %6 = insertvalue { i8*, i8*, i8* } %5, i8* %reload.caml_young_ptr10, 1 240 | %7 = insertvalue { i8*, i8*, i8* } %6, i8* %apply, 2 241 | ret { i8*, i8*, i8* } %7 242 | } 243 | 244 | define cc16 { i8*, i8*, i8* } @camlMlintegr__test_1022(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i64 %"arg.n/1023") gc "ocaml" { 245 | entry: 246 | %alloca.caml_exception_pointer = alloca i8* 247 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 248 | %alloca.caml_young_ptr = alloca i8* 249 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 250 | %"alloca.n/1023" = alloca i64 251 | store i64 %"arg.n/1023", i64* %"alloca.n/1023" 252 | %load = load i8** @camlMlintegr 253 | %"local.n/1023" = load i64* %"alloca.n/1023" 254 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 255 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 256 | %0 = tail call cc16 { i8*, i8*, i8* } @camlMlintegr__integr_1012(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load, i8* bitcast (i8** @camlMlintegr__2 to i8*), i8* bitcast (i8** @camlMlintegr__3 to i8*), i64 %"local.n/1023") 257 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %0, 0 258 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 259 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %0, 1 260 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 261 | %apply = extractvalue { i8*, i8*, i8* } %0, 2 262 | %reload.caml_exception_pointer1 = load i8** %alloca.caml_exception_pointer 263 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer1, 0 264 | %reload.caml_young_ptr2 = load i8** %alloca.caml_young_ptr 265 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr2, 1 266 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %apply, 2 267 | ret { i8*, i8*, i8* } %3 268 | } 269 | 270 | define cc16 { i8*, i8*, i8* } @camlMlintegr__entry(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr) gc "ocaml" { 271 | entry: 272 | %alloca.caml_exception_pointer = alloca i8* 273 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 274 | %alloca.caml_young_ptr = alloca i8* 275 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 276 | %"alloca.square/1010" = alloca i8* 277 | store i8* bitcast (i8** @camlMlintegr__6 to i8*), i8** %"alloca.square/1010" 278 | %"local.square/1010" = load i8** %"alloca.square/1010" 279 | store i8* %"local.square/1010", i8** @camlMlintegr 280 | %"alloca.integr/1012" = alloca i8* 281 | store i8* bitcast (i8** @camlMlintegr__5 to i8*), i8** %"alloca.integr/1012" 282 | %"local.integr/1012" = load i8** %"alloca.integr/1012" 283 | store i8* %"local.integr/1012", i8** bitcast (i8* getelementptr inbounds (i8* bitcast (i8** @camlMlintegr to i8*), i64 8) to i8**) 284 | %"alloca.test/1022" = alloca i8* 285 | store i8* bitcast (i8** @camlMlintegr__4 to i8*), i8** %"alloca.test/1022" 286 | %"local.test/1022" = load i8** %"alloca.test/1022" 287 | store i8* %"local.test/1022", i8** bitcast (i8* getelementptr inbounds (i8* bitcast (i8** @camlMlintegr to i8*), i64 16) to i8**) 288 | %load = load i8** @camlMlintegr 289 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 290 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 291 | %0 = tail call cc16 { i8*, i8*, {} } bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i64)* @camlMlintegr__integr_1012 to { i8*, i8*, {} } (i8*, i8*, i8*, i8*, i8*, i64)*)(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load, i8* bitcast (i8** @camlMlintegr__2 to i8*), i8* bitcast (i8** @camlMlintegr__3 to i8*), i64 21) 292 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, {} } %0, 0 293 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 294 | %reload.caml_young_ptr = extractvalue { i8*, i8*, {} } %0, 1 295 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 296 | %apply = extractvalue { i8*, i8*, {} } %0, 2 297 | %reload.caml_exception_pointer1 = load i8** %alloca.caml_exception_pointer 298 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer1, 0 299 | %reload.caml_young_ptr2 = load i8** %alloca.caml_young_ptr 300 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr2, 1 301 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* inttoptr (i64 1 to i8*), 2 302 | ret { i8*, i8*, i8* } %3 303 | } 304 | 305 | define cc16 { i8*, i8*, i64 } @caml_program(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr) gc "ocaml" { 306 | entry: 307 | %alloca.caml_exception_pointer = alloca i8* 308 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 309 | %alloca.caml_young_ptr = alloca i8* 310 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 311 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 312 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 313 | %0 = tail call cc16 { i8*, i8*, {} } bitcast ({ i8*, i8*, i8* } (i8*, i8*)* @camlMlintegr__entry to { i8*, i8*, {} } (i8*, i8*)*)(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr) 314 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, {} } %0, 0 315 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 316 | %reload.caml_young_ptr = extractvalue { i8*, i8*, {} } %0, 1 317 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 318 | %apply = extractvalue { i8*, i8*, {} } %0, 2 319 | %reload.caml_exception_pointer1 = load i8** %alloca.caml_exception_pointer 320 | %1 = insertvalue { i8*, i8*, i64 } undef, i8* %reload.caml_exception_pointer1, 0 321 | %reload.caml_young_ptr2 = load i8** %alloca.caml_young_ptr 322 | %2 = insertvalue { i8*, i8*, i64 } %1, i8* %reload.caml_young_ptr2, 1 323 | %3 = insertvalue { i8*, i8*, i64 } %2, i64 1, 2 324 | ret { i8*, i8*, i64 } %3 325 | } 326 | 327 | define cc16 { i8*, i8*, i8* } @caml_curry4(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1069", i8* %"arg.clos/1070") gc "ocaml" { 328 | entry: 329 | %alloca.caml_exception_pointer = alloca i8* 330 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 331 | %alloca.caml_young_ptr = alloca i8* 332 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 333 | %"alloca.arg/1069" = alloca i8* 334 | store i8* %"arg.arg/1069", i8** %"alloca.arg/1069" 335 | %"alloca.clos/1070" = alloca i8* 336 | store i8* %"arg.clos/1070", i8** %"alloca.clos/1070" 337 | %"local.clos/1070" = load i8** %"alloca.clos/1070" 338 | %"local.arg/1069" = load i8** %"alloca.arg/1069" 339 | %alloc = call i8* @caml_allocN(i64 48) 340 | %0 = bitcast i8* %alloc to { i64, i8*, i8*, i8*, i64, i8* }* 341 | %field.0 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 0 342 | store i64 5367, i64* %field.0 343 | %field.1 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 344 | store i8* %"local.clos/1070", i8** %field.1 345 | %field.2 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 2 346 | store i8* %"local.arg/1069", i8** %field.2 347 | %field.3 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 3 348 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i8*)* @caml_curry4_1_app to i8*), i8** %field.3 349 | %field.4 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 4 350 | store i64 7, i64* %field.4 351 | %field.5 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 5 352 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry4_1 to i8*), i8** %field.5 353 | %1 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 354 | %alloc.body = bitcast i8** %1 to i8* 355 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 356 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 357 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 358 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 359 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 360 | ret { i8*, i8*, i8* } %4 361 | } 362 | 363 | define cc16 { i8*, i8*, i8* } @caml_curry4_1_app(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg2/1071", i8* %"arg.arg3/1072", i8* %"arg.arg4/1073", i8* %"arg.clos/1070") gc "ocaml" { 364 | entry: 365 | %alloca.caml_exception_pointer = alloca i8* 366 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 367 | %alloca.caml_young_ptr = alloca i8* 368 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 369 | %"alloca.arg2/1071" = alloca i8* 370 | store i8* %"arg.arg2/1071", i8** %"alloca.arg2/1071" 371 | %"alloca.arg3/1072" = alloca i8* 372 | store i8* %"arg.arg3/1072", i8** %"alloca.arg3/1072" 373 | %"alloca.arg4/1073" = alloca i8* 374 | store i8* %"arg.arg4/1073", i8** %"alloca.arg4/1073" 375 | %"alloca.clos/1070" = alloca i8* 376 | store i8* %"arg.clos/1070", i8** %"alloca.clos/1070" 377 | %"local.clos/1070" = load i8** %"alloca.clos/1070" 378 | %adda = getelementptr inbounds i8* %"local.clos/1070", i64 32 379 | %load.addr = bitcast i8* %adda to i8** 380 | %load = load i8** %load.addr 381 | %"alloca.clos/1074" = alloca i8* 382 | store i8* %load, i8** %"alloca.clos/1074" 383 | %"local.clos/10701" = load i8** %"alloca.clos/1070" 384 | %adda2 = getelementptr inbounds i8* %"local.clos/10701", i64 24 385 | %load.addr3 = bitcast i8* %adda2 to i8** 386 | %load4 = load i8** %load.addr3 387 | %"local.arg2/1071" = load i8** %"alloca.arg2/1071" 388 | %"local.arg3/1072" = load i8** %"alloca.arg3/1072" 389 | %"local.arg4/1073" = load i8** %"alloca.arg4/1073" 390 | %"local.clos/1074" = load i8** %"alloca.clos/1074" 391 | %"local.clos/10745" = load i8** %"alloca.clos/1074" 392 | %adda6 = getelementptr inbounds i8* %"local.clos/10745", i64 16 393 | %load.addr7 = bitcast i8* %adda6 to i8** 394 | %load8 = load i8** %load.addr7 395 | %apply.fn = bitcast i8* %load8 to { i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i8*, i8*)* 396 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 397 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 398 | %0 = tail call cc16 { i8*, i8*, i8* } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load4, i8* %"local.arg2/1071", i8* %"local.arg3/1072", i8* %"local.arg4/1073", i8* %"local.clos/1074") 399 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %0, 0 400 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 401 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %0, 1 402 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 403 | %apply = extractvalue { i8*, i8*, i8* } %0, 2 404 | %reload.caml_exception_pointer9 = load i8** %alloca.caml_exception_pointer 405 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer9, 0 406 | %reload.caml_young_ptr10 = load i8** %alloca.caml_young_ptr 407 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr10, 1 408 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %apply, 2 409 | ret { i8*, i8*, i8* } %3 410 | } 411 | 412 | define cc16 { i8*, i8*, i8* } @caml_curry4_1(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1075", i8* %"arg.clos/1076") gc "ocaml" { 413 | entry: 414 | %alloca.caml_exception_pointer = alloca i8* 415 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 416 | %alloca.caml_young_ptr = alloca i8* 417 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 418 | %"alloca.arg/1075" = alloca i8* 419 | store i8* %"arg.arg/1075", i8** %"alloca.arg/1075" 420 | %"alloca.clos/1076" = alloca i8* 421 | store i8* %"arg.clos/1076", i8** %"alloca.clos/1076" 422 | %"local.clos/1076" = load i8** %"alloca.clos/1076" 423 | %"local.arg/1075" = load i8** %"alloca.arg/1075" 424 | %alloc = call i8* @caml_allocN(i64 48) 425 | %0 = bitcast i8* %alloc to { i64, i8*, i8*, i8*, i64, i8* }* 426 | %field.0 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 0 427 | store i64 5367, i64* %field.0 428 | %field.1 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 429 | store i8* %"local.clos/1076", i8** %field.1 430 | %field.2 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 2 431 | store i8* %"local.arg/1075", i8** %field.2 432 | %field.3 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 3 433 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*)* @caml_curry4_2_app to i8*), i8** %field.3 434 | %field.4 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 4 435 | store i64 5, i64* %field.4 436 | %field.5 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 5 437 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry4_2 to i8*), i8** %field.5 438 | %1 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 439 | %alloc.body = bitcast i8** %1 to i8* 440 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 441 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 442 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 443 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 444 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 445 | ret { i8*, i8*, i8* } %4 446 | } 447 | 448 | define cc16 { i8*, i8*, i8* } @caml_curry4_2_app(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg3/1077", i8* %"arg.arg4/1078", i8* %"arg.clos/1076") gc "ocaml" { 449 | entry: 450 | %alloca.caml_exception_pointer = alloca i8* 451 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 452 | %alloca.caml_young_ptr = alloca i8* 453 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 454 | %"alloca.arg3/1077" = alloca i8* 455 | store i8* %"arg.arg3/1077", i8** %"alloca.arg3/1077" 456 | %"alloca.arg4/1078" = alloca i8* 457 | store i8* %"arg.arg4/1078", i8** %"alloca.arg4/1078" 458 | %"alloca.clos/1076" = alloca i8* 459 | store i8* %"arg.clos/1076", i8** %"alloca.clos/1076" 460 | %"local.clos/1076" = load i8** %"alloca.clos/1076" 461 | %adda = getelementptr inbounds i8* %"local.clos/1076", i64 32 462 | %load.addr = bitcast i8* %adda to i8** 463 | %load = load i8** %load.addr 464 | %"alloca.clos/1079" = alloca i8* 465 | store i8* %load, i8** %"alloca.clos/1079" 466 | %"local.clos/1079" = load i8** %"alloca.clos/1079" 467 | %adda1 = getelementptr inbounds i8* %"local.clos/1079", i64 32 468 | %load.addr2 = bitcast i8* %adda1 to i8** 469 | %load3 = load i8** %load.addr2 470 | %"alloca.clos/1080" = alloca i8* 471 | store i8* %load3, i8** %"alloca.clos/1080" 472 | %"local.clos/10794" = load i8** %"alloca.clos/1079" 473 | %adda5 = getelementptr inbounds i8* %"local.clos/10794", i64 24 474 | %load.addr6 = bitcast i8* %adda5 to i8** 475 | %load7 = load i8** %load.addr6 476 | %"local.clos/10768" = load i8** %"alloca.clos/1076" 477 | %adda9 = getelementptr inbounds i8* %"local.clos/10768", i64 24 478 | %load.addr10 = bitcast i8* %adda9 to i8** 479 | %load11 = load i8** %load.addr10 480 | %"local.arg3/1077" = load i8** %"alloca.arg3/1077" 481 | %"local.arg4/1078" = load i8** %"alloca.arg4/1078" 482 | %"local.clos/1080" = load i8** %"alloca.clos/1080" 483 | %"local.clos/108012" = load i8** %"alloca.clos/1080" 484 | %adda13 = getelementptr inbounds i8* %"local.clos/108012", i64 16 485 | %load.addr14 = bitcast i8* %adda13 to i8** 486 | %load15 = load i8** %load.addr14 487 | %apply.fn = bitcast i8* %load15 to { i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i8*, i8*)* 488 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 489 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 490 | %0 = tail call cc16 { i8*, i8*, i8* } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load7, i8* %load11, i8* %"local.arg3/1077", i8* %"local.arg4/1078", i8* %"local.clos/1080") 491 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %0, 0 492 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 493 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %0, 1 494 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 495 | %apply = extractvalue { i8*, i8*, i8* } %0, 2 496 | %reload.caml_exception_pointer16 = load i8** %alloca.caml_exception_pointer 497 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer16, 0 498 | %reload.caml_young_ptr17 = load i8** %alloca.caml_young_ptr 499 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr17, 1 500 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %apply, 2 501 | ret { i8*, i8*, i8* } %3 502 | } 503 | 504 | define cc16 { i8*, i8*, i8* } @caml_curry4_2(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1081", i8* %"arg.clos/1082") gc "ocaml" { 505 | entry: 506 | %alloca.caml_exception_pointer = alloca i8* 507 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 508 | %alloca.caml_young_ptr = alloca i8* 509 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 510 | %"alloca.arg/1081" = alloca i8* 511 | store i8* %"arg.arg/1081", i8** %"alloca.arg/1081" 512 | %"alloca.clos/1082" = alloca i8* 513 | store i8* %"arg.clos/1082", i8** %"alloca.clos/1082" 514 | %"local.clos/1082" = load i8** %"alloca.clos/1082" 515 | %"local.arg/1081" = load i8** %"alloca.arg/1081" 516 | %alloc = call i8* @caml_allocN(i64 40) 517 | %0 = bitcast i8* %alloc to { i64, i8*, i8*, i64, i8* }* 518 | %field.0 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 0 519 | store i64 4343, i64* %field.0 520 | %field.1 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 521 | store i8* %"local.clos/1082", i8** %field.1 522 | %field.2 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 2 523 | store i8* %"local.arg/1081", i8** %field.2 524 | %field.3 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 3 525 | store i64 3, i64* %field.3 526 | %field.4 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 4 527 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry4_3 to i8*), i8** %field.4 528 | %1 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 529 | %alloc.body = bitcast i8** %1 to i8* 530 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 531 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 532 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 533 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 534 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 535 | ret { i8*, i8*, i8* } %4 536 | } 537 | 538 | define cc16 { i8*, i8*, i8* } @caml_curry4_3(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1083", i8* %"arg.clos/1084") gc "ocaml" { 539 | entry: 540 | %alloca.caml_exception_pointer = alloca i8* 541 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 542 | %alloca.caml_young_ptr = alloca i8* 543 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 544 | %"alloca.arg/1083" = alloca i8* 545 | store i8* %"arg.arg/1083", i8** %"alloca.arg/1083" 546 | %"alloca.clos/1084" = alloca i8* 547 | store i8* %"arg.clos/1084", i8** %"alloca.clos/1084" 548 | %"local.clos/1084" = load i8** %"alloca.clos/1084" 549 | %adda = getelementptr inbounds i8* %"local.clos/1084", i64 24 550 | %load.addr = bitcast i8* %adda to i8** 551 | %load = load i8** %load.addr 552 | %"alloca.clos/1085" = alloca i8* 553 | store i8* %load, i8** %"alloca.clos/1085" 554 | %"local.clos/1085" = load i8** %"alloca.clos/1085" 555 | %adda1 = getelementptr inbounds i8* %"local.clos/1085", i64 32 556 | %load.addr2 = bitcast i8* %adda1 to i8** 557 | %load3 = load i8** %load.addr2 558 | %"alloca.clos/1086" = alloca i8* 559 | store i8* %load3, i8** %"alloca.clos/1086" 560 | %"local.clos/1086" = load i8** %"alloca.clos/1086" 561 | %adda4 = getelementptr inbounds i8* %"local.clos/1086", i64 32 562 | %load.addr5 = bitcast i8* %adda4 to i8** 563 | %load6 = load i8** %load.addr5 564 | %"alloca.clos/1087" = alloca i8* 565 | store i8* %load6, i8** %"alloca.clos/1087" 566 | %"local.clos/10867" = load i8** %"alloca.clos/1086" 567 | %adda8 = getelementptr inbounds i8* %"local.clos/10867", i64 24 568 | %load.addr9 = bitcast i8* %adda8 to i8** 569 | %load10 = load i8** %load.addr9 570 | %"local.clos/108511" = load i8** %"alloca.clos/1085" 571 | %adda12 = getelementptr inbounds i8* %"local.clos/108511", i64 24 572 | %load.addr13 = bitcast i8* %adda12 to i8** 573 | %load14 = load i8** %load.addr13 574 | %"local.clos/108415" = load i8** %"alloca.clos/1084" 575 | %adda16 = getelementptr inbounds i8* %"local.clos/108415", i64 16 576 | %load.addr17 = bitcast i8* %adda16 to i8** 577 | %load18 = load i8** %load.addr17 578 | %"local.arg/1083" = load i8** %"alloca.arg/1083" 579 | %"local.clos/1087" = load i8** %"alloca.clos/1087" 580 | %"local.clos/108719" = load i8** %"alloca.clos/1087" 581 | %adda20 = getelementptr inbounds i8* %"local.clos/108719", i64 16 582 | %load.addr21 = bitcast i8* %adda20 to i8** 583 | %load22 = load i8** %load.addr21 584 | %apply.fn = bitcast i8* %load22 to { i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i8*, i8*)* 585 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 586 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 587 | %0 = tail call cc16 { i8*, i8*, i8* } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load10, i8* %load14, i8* %load18, i8* %"local.arg/1083", i8* %"local.clos/1087") 588 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %0, 0 589 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 590 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %0, 1 591 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 592 | %apply = extractvalue { i8*, i8*, i8* } %0, 2 593 | %reload.caml_exception_pointer23 = load i8** %alloca.caml_exception_pointer 594 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer23, 0 595 | %reload.caml_young_ptr24 = load i8** %alloca.caml_young_ptr 596 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr24, 1 597 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %apply, 2 598 | ret { i8*, i8*, i8* } %3 599 | } 600 | 601 | define cc16 { i8*, i8*, i8* } @caml_curry3(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1058", i8* %"arg.clos/1059") gc "ocaml" { 602 | entry: 603 | %alloca.caml_exception_pointer = alloca i8* 604 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 605 | %alloca.caml_young_ptr = alloca i8* 606 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 607 | %"alloca.arg/1058" = alloca i8* 608 | store i8* %"arg.arg/1058", i8** %"alloca.arg/1058" 609 | %"alloca.clos/1059" = alloca i8* 610 | store i8* %"arg.clos/1059", i8** %"alloca.clos/1059" 611 | %"local.clos/1059" = load i8** %"alloca.clos/1059" 612 | %"local.arg/1058" = load i8** %"alloca.arg/1058" 613 | %alloc = call i8* @caml_allocN(i64 48) 614 | %0 = bitcast i8* %alloc to { i64, i8*, i8*, i8*, i64, i8* }* 615 | %field.0 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 0 616 | store i64 5367, i64* %field.0 617 | %field.1 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 618 | store i8* %"local.clos/1059", i8** %field.1 619 | %field.2 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 2 620 | store i8* %"local.arg/1058", i8** %field.2 621 | %field.3 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 3 622 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*)* @caml_curry3_1_app to i8*), i8** %field.3 623 | %field.4 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 4 624 | store i64 5, i64* %field.4 625 | %field.5 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 5 626 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry3_1 to i8*), i8** %field.5 627 | %1 = getelementptr inbounds { i64, i8*, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 628 | %alloc.body = bitcast i8** %1 to i8* 629 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 630 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 631 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 632 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 633 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 634 | ret { i8*, i8*, i8* } %4 635 | } 636 | 637 | define cc16 { i8*, i8*, i8* } @caml_curry3_1_app(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg2/1060", i8* %"arg.arg3/1061", i8* %"arg.clos/1059") gc "ocaml" { 638 | entry: 639 | %alloca.caml_exception_pointer = alloca i8* 640 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 641 | %alloca.caml_young_ptr = alloca i8* 642 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 643 | %"alloca.arg2/1060" = alloca i8* 644 | store i8* %"arg.arg2/1060", i8** %"alloca.arg2/1060" 645 | %"alloca.arg3/1061" = alloca i8* 646 | store i8* %"arg.arg3/1061", i8** %"alloca.arg3/1061" 647 | %"alloca.clos/1059" = alloca i8* 648 | store i8* %"arg.clos/1059", i8** %"alloca.clos/1059" 649 | %"local.clos/1059" = load i8** %"alloca.clos/1059" 650 | %adda = getelementptr inbounds i8* %"local.clos/1059", i64 32 651 | %load.addr = bitcast i8* %adda to i8** 652 | %load = load i8** %load.addr 653 | %"alloca.clos/1062" = alloca i8* 654 | store i8* %load, i8** %"alloca.clos/1062" 655 | %"local.clos/10591" = load i8** %"alloca.clos/1059" 656 | %adda2 = getelementptr inbounds i8* %"local.clos/10591", i64 24 657 | %load.addr3 = bitcast i8* %adda2 to i8** 658 | %load4 = load i8** %load.addr3 659 | %"local.arg2/1060" = load i8** %"alloca.arg2/1060" 660 | %"local.arg3/1061" = load i8** %"alloca.arg3/1061" 661 | %"local.clos/1062" = load i8** %"alloca.clos/1062" 662 | %"local.clos/10625" = load i8** %"alloca.clos/1062" 663 | %adda6 = getelementptr inbounds i8* %"local.clos/10625", i64 16 664 | %load.addr7 = bitcast i8* %adda6 to i8** 665 | %load8 = load i8** %load.addr7 666 | %apply.fn = bitcast i8* %load8 to { i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i8*)* 667 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 668 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 669 | %0 = tail call cc16 { i8*, i8*, i8* } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load4, i8* %"local.arg2/1060", i8* %"local.arg3/1061", i8* %"local.clos/1062") 670 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %0, 0 671 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 672 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %0, 1 673 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 674 | %apply = extractvalue { i8*, i8*, i8* } %0, 2 675 | %reload.caml_exception_pointer9 = load i8** %alloca.caml_exception_pointer 676 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer9, 0 677 | %reload.caml_young_ptr10 = load i8** %alloca.caml_young_ptr 678 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr10, 1 679 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %apply, 2 680 | ret { i8*, i8*, i8* } %3 681 | } 682 | 683 | define cc16 { i8*, i8*, i8* } @caml_curry3_1(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1063", i8* %"arg.clos/1064") gc "ocaml" { 684 | entry: 685 | %alloca.caml_exception_pointer = alloca i8* 686 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 687 | %alloca.caml_young_ptr = alloca i8* 688 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 689 | %"alloca.arg/1063" = alloca i8* 690 | store i8* %"arg.arg/1063", i8** %"alloca.arg/1063" 691 | %"alloca.clos/1064" = alloca i8* 692 | store i8* %"arg.clos/1064", i8** %"alloca.clos/1064" 693 | %"local.clos/1064" = load i8** %"alloca.clos/1064" 694 | %"local.arg/1063" = load i8** %"alloca.arg/1063" 695 | %alloc = call i8* @caml_allocN(i64 40) 696 | %0 = bitcast i8* %alloc to { i64, i8*, i8*, i64, i8* }* 697 | %field.0 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 0 698 | store i64 4343, i64* %field.0 699 | %field.1 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 700 | store i8* %"local.clos/1064", i8** %field.1 701 | %field.2 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 2 702 | store i8* %"local.arg/1063", i8** %field.2 703 | %field.3 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 3 704 | store i64 3, i64* %field.3 705 | %field.4 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 4 706 | store i8* bitcast ({ i8*, i8*, i8* } (i8*, i8*, i8*, i8*)* @caml_curry3_2 to i8*), i8** %field.4 707 | %1 = getelementptr inbounds { i64, i8*, i8*, i64, i8* }* %0, i32 0, i32 1 708 | %alloc.body = bitcast i8** %1 to i8* 709 | %reload.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 710 | %2 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer, 0 711 | %reload.caml_young_ptr = load i8** %alloca.caml_young_ptr 712 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %reload.caml_young_ptr, 1 713 | %4 = insertvalue { i8*, i8*, i8* } %3, i8* %alloc.body, 2 714 | ret { i8*, i8*, i8* } %4 715 | } 716 | 717 | define cc16 { i8*, i8*, i8* } @caml_curry3_2(i8* %pinned.caml_exception_pointer, i8* %pinned.caml_young_ptr, i8* %"arg.arg/1065", i8* %"arg.clos/1066") gc "ocaml" { 718 | entry: 719 | %alloca.caml_exception_pointer = alloca i8* 720 | store i8* %pinned.caml_exception_pointer, i8** %alloca.caml_exception_pointer 721 | %alloca.caml_young_ptr = alloca i8* 722 | store i8* %pinned.caml_young_ptr, i8** %alloca.caml_young_ptr 723 | %"alloca.arg/1065" = alloca i8* 724 | store i8* %"arg.arg/1065", i8** %"alloca.arg/1065" 725 | %"alloca.clos/1066" = alloca i8* 726 | store i8* %"arg.clos/1066", i8** %"alloca.clos/1066" 727 | %"local.clos/1066" = load i8** %"alloca.clos/1066" 728 | %adda = getelementptr inbounds i8* %"local.clos/1066", i64 24 729 | %load.addr = bitcast i8* %adda to i8** 730 | %load = load i8** %load.addr 731 | %"alloca.clos/1067" = alloca i8* 732 | store i8* %load, i8** %"alloca.clos/1067" 733 | %"local.clos/1067" = load i8** %"alloca.clos/1067" 734 | %adda1 = getelementptr inbounds i8* %"local.clos/1067", i64 32 735 | %load.addr2 = bitcast i8* %adda1 to i8** 736 | %load3 = load i8** %load.addr2 737 | %"alloca.clos/1068" = alloca i8* 738 | store i8* %load3, i8** %"alloca.clos/1068" 739 | %"local.clos/10674" = load i8** %"alloca.clos/1067" 740 | %adda5 = getelementptr inbounds i8* %"local.clos/10674", i64 24 741 | %load.addr6 = bitcast i8* %adda5 to i8** 742 | %load7 = load i8** %load.addr6 743 | %"local.clos/10668" = load i8** %"alloca.clos/1066" 744 | %adda9 = getelementptr inbounds i8* %"local.clos/10668", i64 16 745 | %load.addr10 = bitcast i8* %adda9 to i8** 746 | %load11 = load i8** %load.addr10 747 | %"local.arg/1065" = load i8** %"alloca.arg/1065" 748 | %"local.clos/1068" = load i8** %"alloca.clos/1068" 749 | %"local.clos/106812" = load i8** %"alloca.clos/1068" 750 | %adda13 = getelementptr inbounds i8* %"local.clos/106812", i64 16 751 | %load.addr14 = bitcast i8* %adda13 to i8** 752 | %load15 = load i8** %load.addr14 753 | %apply.fn = bitcast i8* %load15 to { i8*, i8*, i8* } (i8*, i8*, i8*, i8*, i8*, i8*)* 754 | %pass.caml_exception_pointer = load i8** %alloca.caml_exception_pointer 755 | %pass.caml_young_ptr = load i8** %alloca.caml_young_ptr 756 | %0 = tail call cc16 { i8*, i8*, i8* } %apply.fn(i8* %pass.caml_exception_pointer, i8* %pass.caml_young_ptr, i8* %load7, i8* %load11, i8* %"local.arg/1065", i8* %"local.clos/1068") 757 | %reload.caml_exception_pointer = extractvalue { i8*, i8*, i8* } %0, 0 758 | store i8* %reload.caml_exception_pointer, i8** %alloca.caml_exception_pointer 759 | %reload.caml_young_ptr = extractvalue { i8*, i8*, i8* } %0, 1 760 | store i8* %reload.caml_young_ptr, i8** %alloca.caml_young_ptr 761 | %apply = extractvalue { i8*, i8*, i8* } %0, 2 762 | %reload.caml_exception_pointer16 = load i8** %alloca.caml_exception_pointer 763 | %1 = insertvalue { i8*, i8*, i8* } undef, i8* %reload.caml_exception_pointer16, 0 764 | %reload.caml_young_ptr17 = load i8** %alloca.caml_young_ptr 765 | %2 = insertvalue { i8*, i8*, i8* } %1, i8* %reload.caml_young_ptr17, 1 766 | %3 = insertvalue { i8*, i8*, i8* } %2, i8* %apply, 2 767 | ret { i8*, i8*, i8* } %3 768 | } 769 | 770 | declare preserve_allcc i8* @caml_allocN(i64) 771 | -------------------------------------------------------------------------------- /test/mlintegr.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1996 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the Q Public License version 1.0. *) 10 | (* *) 11 | (***********************************************************************) 12 | 13 | external ( + ) : int -> int -> int = "%addint" 14 | external ( - ) : int -> int -> int = "%subint" 15 | external ( > ) : 'a -> 'a -> bool = "%greaterthan" 16 | 17 | external float_of_int : int -> float = "%floatofint" 18 | external ( +. ) : float -> float -> float = "%addfloat" 19 | external ( -. ) : float -> float -> float = "%subfloat" 20 | external ( *. ) : float -> float -> float = "%mulfloat" 21 | external ( /. ) : float -> float -> float = "%divfloat" 22 | 23 | let square x = x *. x 24 | 25 | let integr f low high n = 26 | let h = (high -. low) /. (float_of_int n) in 27 | let rec iter x s i = 28 | if i > 0 then iter (s +. (f x)) (x +. h) (i - 1) else s *. h 29 | in 30 | iter low 0.0 n 31 | 32 | let test n = 33 | integr square 0.0 1.0 n 34 | 35 | let _ = 36 | test 10 37 | -------------------------------------------------------------------------------- /vendor/README.md: -------------------------------------------------------------------------------- 1 | To rebuild, comment out `ASMOBJS=$(ARCH).o` in asmrun/Makefile 2 | and run `make -C asmrun/libasmrun.a`. 3 | --------------------------------------------------------------------------------