├── .gitignore ├── .merlin ├── .ocp-indent ├── CHANGES.md ├── LICENSE ├── META ├── Makefile ├── README.md ├── TODO.md ├── _tags ├── descr ├── doc ├── api.odocl └── style.css ├── examples ├── tut01_hellow_world.ml ├── tut02_square.ml └── tut03_sum_of_squares.ml ├── gccjit.install ├── lib ├── gccjit.ml ├── gccjit.mli ├── gccjit.mllib ├── gccjit_bindings.ml └── libgccjit_stubs.clib ├── lib_gen ├── gen_stubs.ml └── gen_types_generator.ml ├── lib_test └── square.ml ├── myocamlbuild.ml └── opam /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.native 3 | *.byte 4 | *.docdir 5 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG ctypes 2 | PKG ctypes.foreign 3 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | match_clause=4 2 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | #### v0.2.0 2015-04-18 Cambridge 2 | 3 | - Introduce a more idiomatic interface (modules Types, RValue, etc.) 4 | 5 | #### v0.1.0 2015-04-11 Paris 6 | 7 | - First release 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | (* The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. *) 22 | -------------------------------------------------------------------------------- /META: -------------------------------------------------------------------------------- 1 | version = "0.1.0" 2 | description = "Bindings to libgccjit, the GCC 5 JIT compiler" 3 | requires = "ctypes ctypes.foreign ctypes.stubs" 4 | archive(byte) = "gccjit.cma" 5 | archive(byte, plugin) = "gccjit.cma" 6 | archive(native) = "gccjit.cmxa" 7 | archive(native, plugin) = "gccjit.cmxs" 8 | exists_if = "gccjit.cma" 9 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -classic-display 2 | 3 | all: 4 | $(OCAMLBUILD) lib/gccjit.cma lib/gccjit.cmxa lib/gccjit.a lib/libgccjit_stubs.a lib/dllgccjit_stubs.so 5 | 6 | square: 7 | $(OCAMLBUILD) lib_test/square.byte 8 | 9 | clean: 10 | $(OCAMLBUILD) -clean 11 | 12 | doc: 13 | $(OCAMLBUILD) -docflags -colorize-code,-css-style,style.css doc/api.docdir/index.html 14 | cp doc/style.css api.docdir/ 15 | 16 | gh-pages: doc 17 | git clone `git config --get remote.origin.url` .gh-pages --reference . 18 | git -C .gh-pages checkout --orphan gh-pages 19 | git -C .gh-pages reset 20 | git -C .gh-pages clean -dxf 21 | cp api.docdir/* .gh-pages/ 22 | git -C .gh-pages add . 23 | git -C .gh-pages commit -m "Update Pages" 24 | git -C .gh-pages push origin gh-pages -f 25 | rm -rf .gh-pages 26 | 27 | .PHONY: clean doc 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | `ocaml-gccjit` is a OCaml library that provides bidings for 2 | [`libgccjit`](https://gcc.gnu.org/wiki/JIT). `libgccjit` is an embeddable 3 | shared library included in GCC 5 for adding compilation to existing programs 4 | using GCC as the backend. 5 | 6 | For example, consider this C function: 7 | 8 | ```c 9 | int square (int i) 10 | { 11 | return i * i; 12 | } 13 | ``` 14 | 15 | We can construct this function at runtime using `libgccjit`, as follows: 16 | 17 | ```ocaml 18 | open Gccjit 19 | 20 | let square = 21 | let ctx = Context.create () in 22 | 23 | (* Create parameter "i" *) 24 | let param_i = Param.create ctx Type.(get ctx Int) "i" in 25 | 26 | (* Create the function *) 27 | let fn = Function.create ctx Function.Exported Type.(get ctx Int) "square" [ param_i ] in 28 | 29 | (* Create a basic block within the function *) 30 | let block = Block.create ~name:"entry" fn in 31 | 32 | (* This basic block is relatively simple *) 33 | let expr = RValue.binary_op ctx Mult Type.(get ctx Int) (RValue.param param_i) (RValue.param param_i) in 34 | Block.return block expr; 35 | 36 | (* Having populated the context, compile it *) 37 | let jit_result = Context.compile ctx in 38 | 39 | (* Look up a specific machine code routine within the gccjit.Result, in this 40 | case, the function we created above: *) 41 | Result.code jit_result "square" Ctypes.(int @-> returning int) 42 | ``` 43 | 44 | We can now call the function by doing simply 45 | ```ocaml 46 | (* Now try running the code *) 47 | Printf.printf "square(5) = %d\n%!" (square 5) 48 | ``` 49 | 50 | ### Installation 51 | 52 | ```bash 53 | # Soon: opam install gccjit 54 | opam pin add gccjit git://github.com/nojb/ocaml-gccjit 55 | ``` 56 | 57 | In order for compilation to be successful the library `libgccjit` needs to be 58 | found by the C compiler using the `-lgccjit` flag. If the `libgccjit` library 59 | in your system is a non-standard location, please set the `LIBGCCJIT_DIR` 60 | environment variable before installing this package, like this: 61 | 62 | ```bash 63 | LIBGCCJIT_DIR= opam pin add gccjit git://github.com/nojb/ocaml-gccjit 64 | ``` 65 | 66 | ### Links 67 | 68 | - [API documentation](https://nojb.github.io/ocaml-gccjit) 69 | - [Tutorial](https://github.com/nojb/ocaml-gccjit/wiki) 70 | - [The C header file](https://github.com/gcc-mirror/gcc/blob/master/gcc/jit/libgccjit.h) 71 | - [libgccjit wiki](https://gcc.gnu.org/wiki/JIT) 72 | - [Experiments in JIT compilation](https://github.com/davidmalcolm/jittest) 73 | 74 | ### Contact 75 | 76 | Nicolas Ojeda Bar: 77 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | * Interface with GC 2 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true: package(ctypes) 2 | true: package(ctypes.stubs) 3 | true: package(ctypes.foreign) 4 | true: debug 5 | true: bin_annot 6 | : use_ctypes, use_ocaml 7 | : use_ctypes 8 | : use_gccjit 9 | : use_gccjit 10 | : use_gccjit 11 | : include 12 | -------------------------------------------------------------------------------- /descr: -------------------------------------------------------------------------------- 1 | Bindings for the GCC 5 `libgccjit` library 2 | 3 | `libgccjit` is an embeddable shared library being included in GCC 5 for adding 4 | compilation to existing programs using GCC as the backend. 5 | 6 | In order for compilation to be successful the library `libgccjit` needs to be 7 | found by the C compiler using the `-lgccjit` flag. If the `libgccjit` library in 8 | your system is a non-standard location, please set the `LIBGCCJIT_DIR` environment 9 | variable before installing this package, like this: 10 | 11 | ``` 12 | LIBGCCJIT_DIR= opam install gccjit 13 | ``` 14 | 15 | See https://gcc.gnu.org/wiki/JIT for instructions how to build `libgccjit`. 16 | 17 | See the homepage for examples and tutorial. 18 | -------------------------------------------------------------------------------- /doc/api.odocl: -------------------------------------------------------------------------------- 1 | Gccjit 2 | -------------------------------------------------------------------------------- /doc/style.css: -------------------------------------------------------------------------------- 1 | /* A style for ocamldoc. Daniel C. Buenzli */ 2 | 3 | /* Reset a few things. */ 4 | html,body,div,span,applet,object,iframe,h1,h2,h3,h4,h5,h6,p,blockquote,pre, 5 | a,abbr,acronym,address,big,cite,code,del,dfn,em,font,img,ins,kbd,q,s,samp, 6 | small,strike,strong,sub,sup,tt,var,b,u,i,center,dl,dt,dd,ol,ul,li,fieldset, 7 | form,label,legend,table,caption,tbody,tfoot,thead,tr,th,td 8 | { margin: 0; padding: 0; border: 0 none; outline: 0; font-size: 100%; 9 | font-weight: inherit; font-style:inherit; font-family:inherit; 10 | line-height: inherit; vertical-align: baseline; text-align:inherit; 11 | color:inherit; background: transparent; } 12 | 13 | table { border-collapse: collapse; border-spacing: 0; } 14 | 15 | /* Basic page layout */ 16 | 17 | body { font: normal 10pt/1.375em helvetica, arial, sans-serif; text-align:left; 18 | margin: 1.375em 10%; min-width: 40ex; max-width: 72ex; 19 | color: black; background: transparent /* url(line-height-22.gif) */; } 20 | 21 | b { font-weight: bold } 22 | em { font-style: italic } 23 | 24 | tt, code, pre { font-family: WorkAroundWebKitAndMozilla, monospace; 25 | font-size: 1em; } 26 | pre code { font-size : inherit; } 27 | .codepre { margin-bottom:1.375em /* after code example we introduce space. */ } 28 | 29 | .superscript,.subscript 30 | { font-size : 0.813em; line-height:0; margin-left:0.4ex;} 31 | .superscript { vertical-align: super; } 32 | .subscript { vertical-align: sub; } 33 | 34 | /* ocamldoc markup workaround hacks */ 35 | 36 | 37 | 38 | hr, hr + br, div + br, center + br, span + br, ul + br, ol + br, pre + br 39 | { display: none } /* annoying */ 40 | 41 | div.info + br { display:block} 42 | 43 | .codepre br + br { display: none } 44 | h1 + pre { margin-bottom:1.375em} /* Toplevel module description */ 45 | 46 | /* Sections and document divisions */ 47 | 48 | /* .navbar { margin-bottom: -1.375em } */ 49 | h1 { font-weight: bold; font-size: 1.5em; /* margin-top:1.833em; */ 50 | margin-top:0.917em; padding-top:0.875em; 51 | border-top-style:solid; border-width:1px; border-color:#AAA; } 52 | h2 { font-weight: bold; font-size: 1.313em; margin-top: 1.048em } 53 | h3 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } 54 | h3 { font-weight: bold; font-size: 1em; margin-top: 1.375em} 55 | h4 { font-style: italic; } 56 | 57 | /* Used by OCaml's own library documentation. */ 58 | h6 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } 59 | .h7 { font-weight: bold; font-size: 1em; margin-top: 1.375em } 60 | 61 | p { margin-top: 1.375em } 62 | pre { margin-top: 1.375em } 63 | .info { margin: 0.458em 0em -0.458em 2em;}/* Description of types values etc. */ 64 | td .info { margin:0; padding:0; margin-left: 2em;} /* Description in indexes */ 65 | 66 | ul, ol { margin-top:0.688em; padding-bottom:0.687em; 67 | list-style-position:outside} 68 | ul + p, ol + p { margin-top: 0em } 69 | ul { list-style-type: square } 70 | 71 | 72 | /* h2 + ul, h3 + ul, p + ul { } */ 73 | ul > li { margin-left: 1.375em; } 74 | ol > li { margin-left: 1.7em; } 75 | /* Links */ 76 | 77 | a, a:link, a:visited, a:active, a:hover { color : #00B; text-decoration: none } 78 | a:hover { text-decoration : underline } 79 | *:target {background-color: #FFFF99;} /* anchor highlight */ 80 | 81 | /* Code */ 82 | 83 | .keyword { font-weight: bold; } 84 | .comment { color : red } 85 | .constructor { color : green } 86 | .string { color : brown } 87 | .warning { color : red ; font-weight : bold } 88 | 89 | /* Functors */ 90 | 91 | .paramstable { border-style : hidden ; padding-bottom:1.375em} 92 | .paramstable code { margin-left: 1ex; margin-right: 1ex } 93 | .sig_block {margin-left: 1em} 94 | 95 | /* Images */ 96 | 97 | img { margin-top: 1.375em } 98 | -------------------------------------------------------------------------------- /examples/tut01_hellow_world.ml: -------------------------------------------------------------------------------- 1 | (* Smoketest example for libgccjit.so *) 2 | 3 | open Gccjit 4 | 5 | (* Let's try to inject the equivalent of: 6 | 7 | void 8 | greet (const char *name) 9 | { 10 | printf ("hello %s\n", name); 11 | } *) 12 | let create_code ctx = 13 | let param_name = Param.create ctx Type.(get ctx Const_char_ptr) "name" in 14 | let func = Function.create ctx Function.Exported Type.(get ctx Void) "greet" [ param_name ] in 15 | let param_format = Param.create ctx Type.(get ctx Const_char_ptr) "format" in 16 | let printf_func = 17 | Function.create ctx ~variadic:true Function.Imported Type.(get ctx Int) "printf" [ param_format ] 18 | in 19 | let hello = RValue.string_literal ctx "hello %s\n" in 20 | let block = Block.create func in 21 | Block.eval block (RValue.call ctx printf_func [ hello; RValue.param param_name ]); 22 | Block.return_void block 23 | 24 | let () = 25 | let ctx = Context.create () in 26 | 27 | (* Set some options on the context. 28 | Let's see the code being generated, in assembler form. *) 29 | Context.set_option ctx Context.Dump_generated_code true; 30 | 31 | (* Populate the context. *) 32 | create_code ctx; 33 | 34 | (* Compile the code. *) 35 | let result = Context.compile ctx in 36 | 37 | (* Extract the generated code from "result". *) 38 | let greet = Result.code result "greet" Ctypes.(string @-> returning void) in 39 | 40 | (* Now call the generated function: *) 41 | greet "world"; 42 | flush stdout; 43 | 44 | Context.release ctx; 45 | Result.release result 46 | -------------------------------------------------------------------------------- /examples/tut02_square.ml: -------------------------------------------------------------------------------- 1 | (* Usage example for libgccjit.so *) 2 | 3 | open Gccjit 4 | 5 | let create_code ctx = 6 | (* Let's try to inject the equivalent of: 7 | 8 | int square (int i) 9 | { 10 | return i * i; 11 | } 12 | *) 13 | let param_i = Param.create ctx Type.(get ctx Int) "i" in 14 | let func = Function.create ctx Function.Exported Type.(get ctx Int) "square" [ param_i ] in 15 | let block = Block.create func in 16 | let expr = RValue.binary_op ctx Mult Type.(get ctx Int) (RValue.param param_i) (RValue.param param_i) in 17 | Block.return block expr 18 | 19 | let () = 20 | let ctx = Context.create () in 21 | 22 | (* Set some options on the context. 23 | Let's see the code being generated, in assembler form. *) 24 | Context.set_option ctx Context.Dump_generated_code true; 25 | 26 | (* Populate the context. *) 27 | create_code ctx; 28 | 29 | (* Compile the code. *) 30 | let result = Context.compile ctx in 31 | 32 | (* We're done with the context; we can release it: *) 33 | Context.release ctx; 34 | 35 | (* Extract the generated code from "result". *) 36 | let square = Result.code result "square" Ctypes.(int @-> returning int) in 37 | Printf.printf "result: %d%!\n" (square 5); 38 | 39 | Result.release result 40 | -------------------------------------------------------------------------------- /examples/tut03_sum_of_squares.ml: -------------------------------------------------------------------------------- 1 | (* Usage example for libgccjit *) 2 | 3 | open Gccjit 4 | 5 | let create_code ctx = 6 | (* 7 | Simple sum-of-squares, to test conditionals and looping 8 | 9 | int loop_test (int n) 10 | { 11 | int i; 12 | int sum = 0; 13 | for (i = 0; i < n ; i ++) 14 | { 15 | sum += i * i; 16 | } 17 | return sum; 18 | *) 19 | 20 | let n = Param.create ctx Type.(get ctx Int) "n" in 21 | let func = Function.create ctx Function.Exported Type.(get ctx Int) "loop_test" [ n ] in 22 | 23 | (* Build locals: *) 24 | let i = Function.local func Type.(get ctx Int) "i" in 25 | let sum = Function.local func Type.(get ctx Int) "sum" in 26 | 27 | let b_initial = Block.create ~name:"initial" func in 28 | let b_loop_cond = Block.create ~name:"loop_cond" func in 29 | let b_loop_body = Block.create ~name:"loop_body" func in 30 | let b_after_loop = Block.create ~name:"after_loop" func in 31 | 32 | (* sum = 0; *) 33 | Block.assign b_initial sum (RValue.zero ctx Type.(get ctx Int)); 34 | 35 | (* i = 0; *) 36 | Block.assign b_initial i (RValue.zero ctx Type.(get ctx Int)); 37 | 38 | Block.jump b_initial b_loop_cond; 39 | 40 | (* if (i >= n) *) 41 | Block.cond_jump b_loop_cond (RValue.comparison ctx Ge (RValue.lvalue i) (RValue.param n)) 42 | b_after_loop b_loop_body; 43 | 44 | (* sum += i * i *) 45 | Block.assign_op b_loop_body sum Plus 46 | (RValue.binary_op ctx Mult Type.(get ctx Int) (RValue.lvalue i) (RValue.lvalue i)); 47 | 48 | (* i++ *) 49 | Block.assign_op b_loop_body i Plus (RValue.one ctx Type.(get ctx Int)); 50 | 51 | Block.jump b_loop_body b_loop_cond; 52 | 53 | (* return sum *) 54 | Block.return b_after_loop (RValue.lvalue sum) 55 | 56 | let () = 57 | let ctx = Context.create () in 58 | 59 | (* Set some options on the context. Let's see the code being generated, in 60 | assembler form. *) 61 | Context.set_option ctx Context.Dump_generated_code true; 62 | 63 | (* Populate the context. *) 64 | create_code ctx; 65 | 66 | (* Compile the code. *) 67 | let result = Context.compile ctx in 68 | 69 | (* Extract the generated code from "result". *) 70 | let loop_test = Result.code result "loop_test" Ctypes.(int @-> returning int) in 71 | 72 | (* Run the generated code. *) 73 | let v = loop_test 10 in 74 | Printf.printf "loop_test returned: %d\n%!" v; 75 | 76 | Context.release ctx; 77 | Result.release result 78 | -------------------------------------------------------------------------------- /gccjit.install: -------------------------------------------------------------------------------- 1 | lib: [ 2 | "META" 3 | "_build/lib/gccjit.mli" {"gccjit.mli"} 4 | "_build/lib/gccjit.cmi" {"gccjit.cmi"} 5 | "_build/lib/gccjit.cma" {"gccjit.cma"} 6 | "_build/lib/gccjit.a" {"gccjit.a"} 7 | "_build/lib/gccjit.cmxa" {"gccjit.cmxa"} 8 | "_build/lib/libgccjit_stubs.a" {"libgccjit_stubs.a"} 9 | ] 10 | stublibs: [ 11 | "_build/lib/dllgccjit_stubs.so" {"dllgccjit_stubs.so"} 12 | ] 13 | doc: [ 14 | "README.md" {"README.md"} 15 | "CHANGES.md" {"CHANGES.md"} 16 | ] 17 | -------------------------------------------------------------------------------- /lib/gccjit.ml: -------------------------------------------------------------------------------- 1 | (* The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. *) 22 | 23 | exception Error of string 24 | 25 | module B = Gccjit_bindings.Bindings (Gccjit_types_generated) (Gccjit_stubs_generated) 26 | 27 | open Gccjit_bindings 28 | open B 29 | 30 | type context = gcc_jit_context 31 | type result = gcc_jit_result 32 | type location = gcc_jit_location 33 | type param = gcc_jit_param 34 | type lvalue = gcc_jit_lvalue 35 | type rvalue = gcc_jit_rvalue 36 | type field = gcc_jit_field 37 | type struct_ = gcc_jit_struct 38 | type type_ = gcc_jit_type 39 | type function_ = gcc_jit_function 40 | type block = gcc_jit_block 41 | 42 | let null_loc = Ctypes.(coerce (ptr void) gcc_jit_location null) 43 | 44 | type unary_op = 45 | | Negate 46 | | Bitwise_negate 47 | | Logical_negate 48 | 49 | type binary_op = 50 | | Plus 51 | | Minus 52 | | Mult 53 | | Divide 54 | | Modulo 55 | | Bitwise_and 56 | | Bitwise_xor 57 | | Bitwise_or 58 | | Logical_and 59 | | Logical_or 60 | 61 | type comparison = Eq | Ne | Lt | Le | Gt | Ge 62 | 63 | let binary_op = function 64 | | Plus -> GCC_JIT_BINARY_OP_PLUS 65 | | Minus -> GCC_JIT_BINARY_OP_MINUS 66 | | Mult -> GCC_JIT_BINARY_OP_MULT 67 | | Divide -> GCC_JIT_BINARY_OP_DIVIDE 68 | | Modulo -> GCC_JIT_BINARY_OP_MODULO 69 | | Bitwise_and -> GCC_JIT_BINARY_OP_BITWISE_AND 70 | | Bitwise_xor -> GCC_JIT_BINARY_OP_BITWISE_XOR 71 | | Bitwise_or -> GCC_JIT_BINARY_OP_BITWISE_OR 72 | | Logical_and -> GCC_JIT_BINARY_OP_LOGICAL_AND 73 | | Logical_or -> GCC_JIT_BINARY_OP_LOGICAL_OR 74 | 75 | let comparison = function 76 | | Eq -> GCC_JIT_COMPARISON_EQ 77 | | Ne -> GCC_JIT_COMPARISON_NE 78 | | Lt -> GCC_JIT_COMPARISON_LT 79 | | Le -> GCC_JIT_COMPARISON_LE 80 | | Gt -> GCC_JIT_COMPARISON_GT 81 | | Ge -> GCC_JIT_COMPARISON_GE 82 | 83 | let unary_op = function 84 | | Negate -> GCC_JIT_UNARY_OP_MINUS 85 | | Bitwise_negate -> GCC_JIT_UNARY_OP_BITWISE_NEGATE 86 | | Logical_negate -> GCC_JIT_UNARY_OP_LOGICAL_NEGATE 87 | 88 | let wrap1 ctx f x1 = 89 | let y = f x1 in 90 | match gcc_jit_context_get_first_error ctx with 91 | | None -> y 92 | | Some err -> raise (Error err) 93 | 94 | let wrap2 ctx f x1 x2 = 95 | let y = f x1 x2 in 96 | match gcc_jit_context_get_first_error ctx with 97 | | None -> y 98 | | Some err -> raise (Error err) 99 | 100 | let wrap3 ctx f x1 x2 x3 = 101 | let y = f x1 x2 x3 in 102 | match gcc_jit_context_get_first_error ctx with 103 | | None -> y 104 | | Some err -> raise (Error err) 105 | 106 | let wrap4 ctx f x1 x2 x3 x4 = 107 | let y = f x1 x2 x3 x4 in 108 | match gcc_jit_context_get_first_error ctx with 109 | | None -> y 110 | | Some err -> raise (Error err) 111 | 112 | let wrap5 ctx f x1 x2 x3 x4 x5 = 113 | let y = f x1 x2 x3 x4 x5 in 114 | match gcc_jit_context_get_first_error ctx with 115 | | None -> y 116 | | Some err -> raise (Error err) 117 | 118 | let wrap6 ctx f x1 x2 x3 x4 x5 x6 = 119 | let y = f x1 x2 x3 x4 x5 x6 in 120 | match gcc_jit_context_get_first_error ctx with 121 | | None -> y 122 | | Some err -> raise (Error err) 123 | 124 | let wrap8 ctx f x1 x2 x3 x4 x5 x6 x7 x8 = 125 | let y = f x1 x2 x3 x4 x5 x6 x7 x8 in 126 | match gcc_jit_context_get_first_error ctx with 127 | | None -> y 128 | | Some err -> raise (Error err) 129 | 130 | let get_first_error ctx = 131 | gcc_jit_context_get_first_error ctx 132 | 133 | module Context = struct 134 | let create () = 135 | gcc_jit_context_acquire () 136 | 137 | let release ctx = 138 | gcc_jit_context_release ctx 139 | 140 | let create_child ctx = 141 | wrap1 ctx gcc_jit_context_new_child_context ctx 142 | 143 | let dump_to_file ctx ?(update_locs = false) path = 144 | wrap3 ctx gcc_jit_context_dump_to_file ctx path (if update_locs then 1 else 0) 145 | 146 | external int_of_file_descr : Unix.file_descr -> int = "%identity" 147 | 148 | let set_logfile ctx = function 149 | | None -> 150 | wrap4 ctx gcc_jit_context_set_logfile ctx Ctypes.null 0 0 151 | | Some fd -> 152 | let f = match fdopen (int_of_file_descr fd) "a" with 153 | | None -> raise (Error "fdopen") 154 | | Some f -> f 155 | in 156 | wrap4 ctx gcc_jit_context_set_logfile ctx f 0 0 157 | 158 | let dump_reproducer_to_file ctx path = 159 | wrap2 ctx gcc_jit_context_dump_reproducer_to_file ctx path 160 | 161 | type _ context_option = 162 | Progname : string context_option 163 | | Optimization_level : int context_option 164 | | Debuginfo : bool context_option 165 | | Dump_initial_tree : bool context_option 166 | | Dump_initial_gimple : bool context_option 167 | | Dump_generated_code : bool context_option 168 | | Dump_summary : bool context_option 169 | | Dump_everything : bool context_option 170 | | Selfcheck_gc : bool context_option 171 | | Keep_intermediates : bool context_option 172 | 173 | let set_option : type a. context -> a context_option -> a -> unit = fun ctx opt v -> 174 | match opt with 175 | | Progname -> 176 | wrap3 ctx gcc_jit_context_set_str_option ctx GCC_JIT_STR_OPTION_PROGNAME v 177 | | Optimization_level -> 178 | wrap3 ctx gcc_jit_context_set_int_option ctx GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL v 179 | | Debuginfo -> 180 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_DEBUGINFO v 181 | | Dump_initial_tree -> 182 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_DUMP_INITIAL_TREE v 183 | | Dump_initial_gimple -> 184 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_DUMP_INITIAL_GIMPLE v 185 | | Dump_generated_code -> 186 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_DUMP_GENERATED_CODE v 187 | | Dump_summary -> 188 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_DUMP_SUMMARY v 189 | | Dump_everything -> 190 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_DUMP_EVERYTHING v 191 | | Selfcheck_gc -> 192 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_SELFCHECK_GC v 193 | | Keep_intermediates -> 194 | wrap3 ctx gcc_jit_context_set_bool_option ctx GCC_JIT_BOOL_OPTION_KEEP_INTERMEDIATES v 195 | 196 | let compile ctx = 197 | let res = wrap1 ctx gcc_jit_context_compile ctx in 198 | (* Gc.finalise gcc_jit_result_release res; *) 199 | res 200 | 201 | type output_kind = 202 | Assembler 203 | | Object_file 204 | | Dynamic_library 205 | | Executable 206 | 207 | let output_kind = function 208 | | Assembler -> GCC_JIT_OUTPUT_KIND_ASSEMBLER 209 | | Object_file -> GCC_JIT_OUTPUT_KIND_OBJECT_FILE 210 | | Dynamic_library -> GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY 211 | | Executable -> GCC_JIT_OUTPUT_KIND_EXECUTABLE 212 | 213 | let compile_to_file ctx kind path = 214 | wrap3 ctx gcc_jit_context_compile_to_file ctx (output_kind kind) path 215 | end 216 | 217 | module Field = struct 218 | let create ctx ?(loc = null_loc) typ name = 219 | wrap4 ctx gcc_jit_context_new_field ctx loc typ name 220 | 221 | let to_string fld = 222 | gcc_jit_object_get_debug_string (gcc_jit_field_as_object fld) 223 | end 224 | 225 | module Struct = struct 226 | let create ctx ?(loc = null_loc) name fields = 227 | let a = Ctypes.CArray.of_list gcc_jit_field fields in 228 | wrap3 ctx gcc_jit_context_new_struct_type ctx loc name 229 | (List.length fields) (Ctypes.CArray.start a) 230 | 231 | let opaque ctx ?(loc = null_loc) name = 232 | wrap2 ctx gcc_jit_context_new_opaque_struct ctx loc name 233 | 234 | let set_fields ?(loc = null_loc) struc fields = 235 | let ctx = 236 | gcc_jit_object_get_context (gcc_jit_type_as_object (gcc_jit_struct_as_type struc)) 237 | in 238 | let a = Ctypes.CArray.of_list gcc_jit_field fields in 239 | wrap3 ctx gcc_jit_struct_set_fields struc loc (List.length fields) (Ctypes.CArray.start a) 240 | 241 | let to_string struc = 242 | gcc_jit_object_get_debug_string (gcc_jit_type_as_object (gcc_jit_struct_as_type struc)) 243 | end 244 | 245 | module Type = struct 246 | type type_kind = 247 | Void 248 | | Void_ptr 249 | | Bool 250 | | Char 251 | | Signed_char 252 | | Unsigned_char 253 | | Short 254 | | Unsigned_short 255 | | Int 256 | | Unsigned_int 257 | | Long 258 | | Unsigned_long 259 | | Long_long 260 | | Unsigned_long_long 261 | | Float 262 | | Double 263 | | Long_double 264 | | Const_char_ptr 265 | | Size_t 266 | | File_ptr 267 | | Complex_float 268 | | Complex_double 269 | | Complex_long_double 270 | 271 | let type_kind = function 272 | Void -> GCC_JIT_TYPE_VOID 273 | | Void_ptr -> GCC_JIT_TYPE_VOID_PTR 274 | | Bool -> GCC_JIT_TYPE_BOOL 275 | | Char -> GCC_JIT_TYPE_CHAR 276 | | Signed_char -> GCC_JIT_TYPE_SIGNED_CHAR 277 | | Unsigned_char -> GCC_JIT_TYPE_UNSIGNED_CHAR 278 | | Short -> GCC_JIT_TYPE_SHORT 279 | | Unsigned_short -> GCC_JIT_TYPE_UNSIGNED_SHORT 280 | | Int -> GCC_JIT_TYPE_INT 281 | | Unsigned_int -> GCC_JIT_TYPE_UNSIGNED_INT 282 | | Long -> GCC_JIT_TYPE_LONG 283 | | Unsigned_long -> GCC_JIT_TYPE_UNSIGNED_LONG 284 | | Long_long -> GCC_JIT_TYPE_LONG_LONG 285 | | Unsigned_long_long -> GCC_JIT_TYPE_UNSIGNED_LONG_LONG 286 | | Float -> GCC_JIT_TYPE_FLOAT 287 | | Double -> GCC_JIT_TYPE_DOUBLE 288 | | Long_double -> GCC_JIT_TYPE_LONG_DOUBLE 289 | | Const_char_ptr -> GCC_JIT_TYPE_CONST_CHAR_PTR 290 | | Size_t -> GCC_JIT_TYPE_SIZE_T 291 | | File_ptr -> GCC_JIT_TYPE_FILE_PTR 292 | | Complex_float -> GCC_JIT_TYPE_COMPLEX_FLOAT 293 | | Complex_double -> GCC_JIT_TYPE_COMPLEX_DOUBLE 294 | | Complex_long_double -> GCC_JIT_TYPE_COMPLEX_LONG_DOUBLE 295 | 296 | let get ctx kind = 297 | wrap2 ctx gcc_jit_context_get_type ctx (type_kind kind) 298 | 299 | let int ctx ?(signed = false) n = 300 | wrap3 ctx gcc_jit_context_get_int_type ctx (if signed then 1 else 0) n 301 | 302 | let pointer typ = 303 | let ctx = gcc_jit_object_get_context (gcc_jit_type_as_object typ) in 304 | wrap1 ctx gcc_jit_type_get_pointer typ 305 | 306 | let const typ = 307 | let ctx = gcc_jit_object_get_context (gcc_jit_type_as_object typ) in 308 | wrap1 ctx gcc_jit_type_get_const typ 309 | 310 | let volatile typ = 311 | let ctx = gcc_jit_object_get_context (gcc_jit_type_as_object typ) in 312 | wrap1 ctx gcc_jit_type_get_volatile typ 313 | 314 | let array ctx ?(loc = null_loc) typ n = 315 | wrap4 ctx gcc_jit_context_new_array_type ctx loc typ n 316 | 317 | let function_ptr ctx ?(loc = null_loc) ?(variadic = false) args ret = 318 | let a = Ctypes.CArray.of_list gcc_jit_type args in 319 | wrap5 ctx gcc_jit_context_new_function_ptr_type ctx 320 | loc ret (List.length args) (Ctypes.CArray.start a) 321 | (if variadic then 1 else 0) 322 | 323 | let struct_ str = 324 | let ctx = gcc_jit_object_get_context (gcc_jit_type_as_object (gcc_jit_struct_as_type str)) in 325 | wrap1 ctx gcc_jit_struct_as_type str 326 | 327 | let union ctx ?(loc = null_loc) name fields = 328 | let a = Ctypes.CArray.of_list gcc_jit_field fields in 329 | wrap3 ctx gcc_jit_context_new_union_type ctx loc name (List.length fields) (Ctypes.CArray.start a) 330 | 331 | let to_string typ = 332 | gcc_jit_object_get_debug_string (gcc_jit_type_as_object typ) 333 | end 334 | 335 | module RValue = struct 336 | let type_of rval = 337 | let ctx = gcc_jit_object_get_context (gcc_jit_rvalue_as_object rval) in 338 | wrap1 ctx gcc_jit_rvalue_get_type rval 339 | 340 | let int ctx typ n = 341 | wrap3 ctx gcc_jit_context_new_rvalue_from_int ctx typ n 342 | 343 | let zero ctx typ : rvalue = 344 | wrap2 ctx gcc_jit_context_zero ctx typ 345 | 346 | let one ctx typ = 347 | wrap2 ctx gcc_jit_context_one ctx typ 348 | 349 | let double ctx typ f = 350 | wrap3 ctx gcc_jit_context_new_rvalue_from_double ctx typ f 351 | 352 | let ptr ctx typ ptr = 353 | wrap3 ctx gcc_jit_context_new_rvalue_from_ptr ctx typ 354 | (Ctypes.to_voidp ptr) 355 | 356 | let null ctx typ = 357 | wrap2 ctx gcc_jit_context_null ctx typ 358 | 359 | let string_literal ctx str = 360 | wrap2 ctx gcc_jit_context_new_string_literal ctx str 361 | 362 | let unary_op ctx ?(loc = null_loc) op typ rval = 363 | wrap5 ctx gcc_jit_context_new_unary_op ctx 364 | loc (unary_op op) typ rval 365 | 366 | let binary_op ctx ?(loc = null_loc) op typ rval1 rval2 = 367 | wrap6 ctx gcc_jit_context_new_binary_op ctx loc (binary_op op) 368 | typ rval1 rval2 369 | 370 | let comparison ctx ?(loc = null_loc) cmp rval1 rval2 = 371 | wrap5 ctx gcc_jit_context_new_comparison ctx loc (comparison cmp) rval1 rval2 372 | 373 | let call ctx ?(loc = null_loc) fn args = 374 | let a = Ctypes.CArray.of_list gcc_jit_rvalue args in 375 | wrap5 ctx gcc_jit_context_new_call ctx loc fn (List.length args) (Ctypes.CArray.start a) 376 | 377 | let indirect_call ctx ?(loc = null_loc) rval args = 378 | let a = Ctypes.CArray.of_list gcc_jit_rvalue args in 379 | wrap5 ctx gcc_jit_context_new_call_through_ptr ctx 380 | loc rval (List.length args) (Ctypes.CArray.start a) 381 | 382 | let cast ctx ?(loc = null_loc) rval typ = 383 | wrap4 ctx gcc_jit_context_new_cast ctx loc rval typ 384 | 385 | let access_field ?(loc = null_loc) rval fld = 386 | let ctx = gcc_jit_object_get_context (gcc_jit_rvalue_as_object rval) in 387 | wrap3 ctx gcc_jit_rvalue_access_field rval loc fld 388 | 389 | let lvalue lval = 390 | let ctx = gcc_jit_object_get_context (gcc_jit_lvalue_as_object lval) in 391 | wrap1 ctx gcc_jit_lvalue_as_rvalue lval 392 | 393 | let param param = 394 | let ctx = gcc_jit_object_get_context (gcc_jit_param_as_object param) in 395 | wrap1 ctx gcc_jit_param_as_rvalue param 396 | 397 | let to_string rval = 398 | gcc_jit_object_get_debug_string (gcc_jit_rvalue_as_object rval) 399 | end 400 | 401 | module LValue = struct 402 | let address ?(loc = null_loc) lval = 403 | let ctx = gcc_jit_object_get_context (gcc_jit_lvalue_as_object lval) in 404 | wrap2 ctx gcc_jit_lvalue_get_address lval loc 405 | 406 | type global_kind = 407 | Exported 408 | | Internal 409 | | Imported 410 | 411 | let global_kind = function 412 | | Exported -> GCC_JIT_GLOBAL_EXPORTED 413 | | Imported -> GCC_JIT_GLOBAL_IMPORTED 414 | | Internal -> GCC_JIT_GLOBAL_INTERNAL 415 | 416 | let global ctx ?(loc = null_loc) kind typ name = 417 | wrap4 ctx gcc_jit_context_new_global ctx loc (global_kind kind) typ name 418 | 419 | let deref ?(loc = null_loc) rval = 420 | let ctx = gcc_jit_object_get_context (gcc_jit_rvalue_as_object rval) in 421 | wrap2 ctx gcc_jit_rvalue_dereference rval loc 422 | 423 | let deref_field ?(loc = null_loc) rval fld = 424 | let ctx = gcc_jit_object_get_context (gcc_jit_rvalue_as_object rval) in 425 | wrap3 ctx gcc_jit_rvalue_dereference_field rval loc fld 426 | 427 | let access_array ?(loc = null_loc) rval1 rval2 = 428 | let ctx = gcc_jit_object_get_context (gcc_jit_rvalue_as_object rval1) in 429 | wrap3 ctx gcc_jit_context_new_array_access ctx loc rval1 rval2 430 | 431 | let access_field ?(loc = null_loc) lval fld = 432 | let ctx = gcc_jit_object_get_context (gcc_jit_lvalue_as_object lval) in 433 | wrap3 ctx gcc_jit_lvalue_access_field lval loc fld 434 | 435 | let param param = 436 | let ctx = gcc_jit_object_get_context (gcc_jit_param_as_object param) in 437 | wrap1 ctx gcc_jit_param_as_lvalue param 438 | 439 | let to_string lval = 440 | gcc_jit_object_get_debug_string (gcc_jit_lvalue_as_object lval) 441 | end 442 | 443 | module Param = struct 444 | let create ctx ?(loc = null_loc) typ name = 445 | wrap4 ctx gcc_jit_context_new_param ctx loc typ name 446 | 447 | let to_string param = 448 | gcc_jit_object_get_debug_string (gcc_jit_param_as_object param) 449 | end 450 | 451 | module Function = struct 452 | 453 | type function_kind = 454 | Exported 455 | | Internal 456 | | Imported 457 | | Always_inline 458 | 459 | let function_kind = function 460 | Exported -> GCC_JIT_FUNCTION_EXPORTED 461 | | Internal -> GCC_JIT_FUNCTION_INTERNAL 462 | | Imported -> GCC_JIT_FUNCTION_IMPORTED 463 | | Always_inline -> GCC_JIT_FUNCTION_ALWAYS_INLINE 464 | 465 | let create ctx ?(loc = null_loc) ?(variadic = false) kind ret name args = 466 | let a = Ctypes.CArray.of_list gcc_jit_param args in 467 | wrap8 ctx gcc_jit_context_new_function 468 | ctx loc (function_kind kind) ret name (List.length args) (Ctypes.CArray.start a) 469 | (if variadic then 1 else 0) 470 | 471 | let builtin ctx name = 472 | wrap2 ctx gcc_jit_context_get_builtin_function ctx name 473 | 474 | let param fn i = 475 | let ctx = gcc_jit_object_get_context (gcc_jit_function_as_object fn) in 476 | wrap2 ctx gcc_jit_function_get_param fn i 477 | 478 | let dump_dot fn path = 479 | let ctx = gcc_jit_object_get_context (gcc_jit_function_as_object fn) in 480 | wrap2 ctx gcc_jit_function_dump_to_dot fn path 481 | 482 | let local ?(loc = null_loc) fn typ name = 483 | let ctx = gcc_jit_object_get_context (gcc_jit_function_as_object fn) in 484 | wrap4 ctx gcc_jit_function_new_local fn loc typ name 485 | 486 | let to_string fn = 487 | gcc_jit_object_get_debug_string (gcc_jit_function_as_object fn) 488 | end 489 | 490 | module Block = struct 491 | let create ?name fn = 492 | let ctx = gcc_jit_object_get_context (gcc_jit_function_as_object fn) in 493 | wrap2 ctx gcc_jit_function_new_block fn name 494 | 495 | let parent blk = 496 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 497 | wrap1 ctx gcc_jit_block_get_function blk 498 | 499 | let eval ?(loc = null_loc) blk rval = 500 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 501 | wrap3 ctx gcc_jit_block_add_eval blk loc rval 502 | 503 | let assign ?(loc = null_loc) blk lval rval = 504 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 505 | wrap4 ctx gcc_jit_block_add_assignment blk loc lval rval 506 | 507 | let assign_op ?(loc = null_loc) blk lval op rval = 508 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 509 | wrap5 ctx gcc_jit_block_add_assignment_op blk loc lval (binary_op op) rval 510 | 511 | let comment ?(loc = null_loc) blk str = 512 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 513 | wrap3 ctx gcc_jit_block_add_comment blk loc str 514 | 515 | let cond_jump ?(loc = null_loc) blk rval blk1 blk2 = 516 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 517 | wrap5 ctx gcc_jit_block_end_with_conditional blk loc rval blk1 blk2 518 | 519 | let jump ?(loc = null_loc) blk blk1 = 520 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 521 | wrap3 ctx gcc_jit_block_end_with_jump blk loc blk1 522 | 523 | let return ?(loc = null_loc) blk rval = 524 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 525 | wrap3 ctx gcc_jit_block_end_with_return blk loc rval 526 | 527 | let return_void ?(loc = null_loc) blk = 528 | let ctx = gcc_jit_object_get_context (gcc_jit_block_as_object blk) in 529 | wrap2 ctx gcc_jit_block_end_with_void_return blk loc 530 | 531 | let to_string blk = 532 | gcc_jit_object_get_debug_string (gcc_jit_block_as_object blk) 533 | end 534 | 535 | module Location = struct 536 | let create ctx path line col = 537 | wrap4 ctx gcc_jit_context_new_location ctx path line col 538 | 539 | let to_string loc = 540 | gcc_jit_object_get_debug_string (gcc_jit_location_as_object loc) 541 | end 542 | 543 | module Result = struct 544 | let code res name fn = 545 | let p = gcc_jit_result_get_code res name in 546 | Ctypes.(coerce (ptr void) (Foreign.funptr ~name fn) p) 547 | 548 | let global res name typ = 549 | let p = gcc_jit_result_get_global res name in 550 | Ctypes.(coerce (ptr void) (ptr typ)) p 551 | 552 | let release res = 553 | gcc_jit_result_release res 554 | end 555 | -------------------------------------------------------------------------------- /lib/gccjit.mli: -------------------------------------------------------------------------------- 1 | (* The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. *) 22 | 23 | (** OCaml bindings for [libgccjit]. 24 | 25 | See {{:https://gcc.gnu.org/wiki/JIT}GCC wiki page} for more information. *) 26 | 27 | exception Error of string 28 | (** This exception (containing an explanatory string) is raised if an error 29 | occurs. *) 30 | 31 | type context 32 | (** The type of compilation contexts. See {{!contexts}Compilation 33 | Contexts}. *) 34 | 35 | type result 36 | (** A {!result} encapsulates the result of an in-memory compilation. *) 37 | 38 | type location 39 | (** A {!location} encapsulates a source code location, so that you can 40 | (optionally) associate locations in your languages with statements in the 41 | JIT-compiled code, alowing the debugger to single-step through your 42 | language. See {{!locations}Source locations}. *) 43 | 44 | type param 45 | (** A {!param} is a function parameter. See {{!params}Parameters}. *) 46 | 47 | type lvalue 48 | (** An {!lvalue} is something that can of the left-hand side of an assignment. 49 | See {{!lvalues}Lvalues}. *) 50 | 51 | type rvalue 52 | (** A [rvalue] is an expression within your code, with some type. See 53 | {{!rvalues}RValues}. *) 54 | 55 | type field 56 | (** The type of fields of structs and unions. See {{!fields}Fields}. *) 57 | 58 | type struct_ 59 | (** The type of structure types. See {{!structs}Structure Types}. *) 60 | 61 | type type_ 62 | (** The type of C types, e.g. [int] or a [struct foo*]. See {{!types}Types}. *) 63 | 64 | type function_ 65 | (** The type of functios. See {{!functions}Functions}. *) 66 | 67 | type block 68 | (** The type of basic blocks. See {{!blocks}Basic Blocks}. *) 69 | 70 | type unary_op = 71 | Negate 72 | | Bitwise_negate 73 | | Logical_negate 74 | 75 | type binary_op = 76 | Plus 77 | | Minus 78 | | Mult 79 | | Divide 80 | | Modulo 81 | | Bitwise_and 82 | | Bitwise_xor 83 | | Bitwise_or 84 | | Logical_and 85 | | Logical_or 86 | 87 | type comparison = Eq | Ne | Lt | Le | Gt | Ge 88 | 89 | (** {1:contexts Compilation Contexts} 90 | 91 | A {!context} encapsulates the state of a compilation. You can 92 | {{!Context.set_option}set up options} on it, add {{!types}types}, 93 | {{!functions}functions} and {{!blocks}code}, using the API below. 94 | 95 | Invoking {!Context.compile} on it gives you a {!result}, representing 96 | in-memory machine-code. 97 | 98 | You can call {!Context.compile} repeatedly on one context, giving multiple 99 | independent results. 100 | 101 | Similarly, you can call {!Context.compile_to_file} on a context to compile 102 | to disk. 103 | 104 | Eventually you can call {!Context.release} to clean up the context; any 105 | in-memory results created from it are still usable. *) 106 | 107 | module Context : sig 108 | (** {1 Lifetime-management} *) 109 | 110 | val create : unit -> context 111 | (** Creates a new {!context} instance, which is independent of any others that 112 | may be present within this process. *) 113 | 114 | val release : context -> unit 115 | (** Releases all resources associated with the given context. Both the 116 | context itsel and all of its object instances are cleared up. It should 117 | be called exactly once on a given context. 118 | 119 | It is invalid to use the context or any of its {e contextual} objects 120 | after calling this. *) 121 | 122 | val create_child : context -> context 123 | (** Given an existing JIT context, create a child context. 124 | - The child inherits a copy of all option-settings from the parent. 125 | - The child can reference objects created within the parent, but not 126 | vice-versa. 127 | - The lifetime of the child context must be bounded by that of the parent: 128 | you should release a child context before releasing the parent context. 129 | 130 | If you use a function from a parent context within a child context, you 131 | have to compile the parent context before you can compile the child 132 | context, and the {!result} of the parent context must outlive the 133 | {!result} of the child context. 134 | 135 | This allows caching of shared initializations. For example, you could 136 | create types and declarations of global functions in a parent context once 137 | within a process, and then create child contexts whenever a function or 138 | loop becomes hot. Each such child context can be used for JIT-compiling 139 | just one function or loop, but can reference types and helper functions 140 | created within the parent context. 141 | 142 | Contexts can be arbitrarily nested, provided the above rules are followed, 143 | but it's probably not worth going above 2 or 3 levels, and there will likely 144 | be a performance hit for such nesting. *) 145 | 146 | (** {1 Thread-safety} 147 | 148 | Instances of {!context} created via {!create} are independent from each 149 | other: only one thread may use a given context at once, but multiple 150 | threads could each have their own contexts without needing locks. 151 | 152 | Contexts created via {!create_child} are related to their parent 153 | context. They can be partitioned by their ultimate ancestor into 154 | independent "family trees". Only one thread within a process may use a 155 | given "family tree" of such contexts at once, and if you're using multiple 156 | threads you should provide your own locking around entire such context 157 | partitions. *) 158 | 159 | (** {1 Debugging} *) 160 | 161 | val dump_to_file : context -> ?update_locs:bool -> string -> unit 162 | (** Dump a C-like representation to the given path, describing what's been set 163 | up on the context. If [~update_locs] true, then also set up {!location} 164 | information throughout the context, pointing at the dump file as if it 165 | were a source file. This may be of use in conjunction with 166 | {{!Context.context_option}[Debuginfo]} to allow stepping through the code 167 | in a debugger. *) 168 | 169 | val set_logfile : context -> Unix.file_descr option -> unit 170 | (** [set_logfile ctx logfile] enable ongoing logging of the context [ctx]'s 171 | activity to the given file descriptor [logfile]. Examples of information 172 | logged include: 173 | - API calls 174 | - the various steps involved within compilation 175 | - activity on any {!result} instances created by the context 176 | - activity within any child contexts 177 | - An example of a log can be seen here, though the precise format and kinds of 178 | information logged is subject to change. 179 | 180 | The caller remains responsible for closing [logfile], and it must not be 181 | closed until all users are released. In particular, note that child 182 | {{!context}contexts} and {!result} instances created by the {!context} 183 | will use [logfile]. 184 | 185 | There may a performance cost for logging. 186 | 187 | You can turn off logging on [ctx] by passing [None] for [logfile]. Doing 188 | so only affects the context; it does not affect child {{!context}contexts} 189 | or {!result} instances already created by the {!context}. *) 190 | 191 | val dump_reproducer_to_file : context -> string -> unit 192 | (** Write C source code into path that can be compiled into a self-contained 193 | executable (i.e. with [libgccjit] as the only dependency). The generated 194 | code will attempt to replay the API calls that have been made into the 195 | given context. 196 | 197 | This may be useful when debugging the library or client code, for reducing a 198 | complicated recipe for reproducing a bug into a simpler form. For example, 199 | consider client code that parses some source file into some internal 200 | representation, and then walks this IR, calling into [libgccjit]. If this 201 | encounters a bug, a call to {!dump_reproducer_to_file} will write out C code 202 | for a much simpler executable that performs the equivalent calls into 203 | [libgccjit], without needing the client code and its data. 204 | 205 | Typically you need to supply ["-Wno-unused-variable"] when compiling the 206 | generated file (since the result of each API call is assigned to a unique 207 | variable within the generated C source, and not all are necessarily then 208 | used). *) 209 | 210 | (** {1 Context Options} *) 211 | 212 | type _ context_option = 213 | Progname : string context_option 214 | (** The name of the program, for used as a prefix when printing error messages 215 | to stderr. If not set, ["libgccjit.so"] is used. *) 216 | 217 | | Optimization_level : int context_option 218 | (** How much to optimize the code. Valid values are [0-3], corresponding to 219 | GCC's command-line options -O0 through -O3. 220 | 221 | The default value is 0 (unoptimized). *) 222 | 223 | | Debuginfo : bool context_option 224 | (** If [true], {!Context.compile} will attempt to do the right thing so that 225 | if you attach a debugger to the process, it will be able to inspect 226 | variables and step through your code. Note that you can't step through 227 | code unless you set up source location information for the code (by 228 | creating and passing in {!location} instances). *) 229 | 230 | | Dump_initial_tree : bool context_option 231 | (** If [true], {!Context.compile} will dump its initial "tree" representation 232 | of your code to [stderr] (before any optimizations). *) 233 | 234 | | Dump_initial_gimple : bool context_option 235 | (** If [true], {!Context.compile} will dump the "gimple" representation of 236 | your code to stderr, before any optimizations are performed. The dump 237 | resembles C code. *) 238 | 239 | | Dump_generated_code : bool context_option 240 | (** If [true], {!Context.compile} will dump the final generated code to 241 | stderr, in the form of assembly language. *) 242 | 243 | | Dump_summary : bool context_option 244 | (** If [true], {!Context.compile} will print information to stderr on the 245 | actions it is performing, followed by a profile showing the time taken and 246 | memory usage of each phase. *) 247 | 248 | | Dump_everything : bool context_option 249 | (** If [true], {!Context.compile} will dump copious amount of information on 250 | what it's doing to various files within a temporary directory. Use 251 | [Keep_intermediates] (see below) to see the results. The files are 252 | intended to be human-readable, but the exact files and their formats are 253 | subject to change. *) 254 | 255 | | Selfcheck_gc : bool context_option 256 | (** If [true], [libgccjit] will aggressively run its garbage collector, 257 | to shake out bugs (greatly slowing down the compile). This is likely to 258 | only be of interest to developers *of* the library. It is used when 259 | running the selftest suite. *) 260 | 261 | | Keep_intermediates : bool context_option 262 | (** If [true], {!Context.release} will not clean up intermediate files written 263 | to the filesystem, and will display their location on stderr. *) 264 | 265 | val set_option : context -> 'a context_option -> 'a -> unit 266 | (** [set_option ctx opt v] sets the {!Context.context_option} [opt] of [ctx] 267 | to [v]. *) 268 | 269 | (** {1 Compilation} 270 | 271 | Once populated, a {!context} can be compiled to machine code, either 272 | in-memory via {!compile} or to disk via {!compile_to_file}. 273 | 274 | You can compile a context multiple times (using either form of compilation), 275 | although any errors that occur on the context will prevent any future 276 | compilation of that context. *) 277 | 278 | val compile : context -> result 279 | (** This calls into GCC and builds the code, returning a {!result}. See 280 | {{!inmemory}In-memory compilation}. *) 281 | 282 | (** Kinds of ahead-of-time compilation, for use with 283 | {!compile_to_file}. *) 284 | type output_kind = 285 | Assembler 286 | (** Compile the context to an assembly file. *) 287 | 288 | | Object_file 289 | (** Compile the context to an object file. *) 290 | 291 | | Dynamic_library 292 | (** Compile the context to a dynamic library. *) 293 | 294 | | Executable 295 | (** Compile the context to an executable. *) 296 | 297 | val compile_to_file : context -> output_kind -> string -> unit 298 | (** Compile the context to a file of the given kind. This can be called more 299 | that once on a given context, although any errors that occur will block 300 | further compilation. *) 301 | end 302 | 303 | (** {1:fields Fields} 304 | 305 | A [field] encapsulates a field within a struct; it is used when creating a 306 | struct type (using {!Struct.create}). Fields cannot be shared between 307 | structs. *) 308 | 309 | module Field : sig 310 | val create : context -> ?loc:location -> type_ -> string -> field 311 | (** Create a field, with the given type and name. *) 312 | 313 | val to_string : field -> string 314 | (** Get a human-readable description of this object. *) 315 | end 316 | 317 | (** {1:structs Structure Types} 318 | 319 | A [struct_] encapsulates a struct type, either one that we have the layout for, 320 | or an opaque type. 321 | 322 | You can model C struct types by creating [struct_] and [field] instances, in 323 | either order: 324 | 325 | - by creating the fields, then the structure. For example, to model: 326 | {[ 327 | struct coord {double x; double y; }; 328 | ]} 329 | you could call: 330 | {[ 331 | let field_x = Field.create ctx double_type "x" in 332 | let field_y = Field.create ctx double_type "y" in 333 | let coord = Struct.create ctx "coord" [ field_x ; field_y ] 334 | ]} 335 | - by creating the structure, then populating it with fields, typically to 336 | allow modelling self-referential structs such as: 337 | {[ 338 | struct node { int m_hash; struct node *m_next; }; 339 | ]} 340 | like this: 341 | {[ 342 | let node = Struct.create_opaque ctx "node" in 343 | let node_ptr = Type.pointer node in 344 | let field_hash = Field.create ctx int_type "m_hash" in 345 | let field_next = Field.create ctx node_ptr "m_next" in 346 | Struct.set_fields node [ field_hash; field_next ] 347 | ]} *) 348 | 349 | module Struct : sig 350 | val create : context -> ?loc:location -> string -> field list -> struct_ 351 | (** Create a struct type, with the given name and fields. *) 352 | 353 | val opaque : context -> ?loc:location -> string -> struct_ 354 | (** Construct a new struct type, with the given name, but without specifying the 355 | fields. The fields can be omitted (in which case the size of the struct is not 356 | known), or later specified using {!set_fields}. *) 357 | 358 | val set_fields : ?loc:location -> struct_ -> field list -> unit 359 | (** Populate the fields of a formerly-opaque struct type. 360 | 361 | This can only be called once on a given struct type. *) 362 | 363 | val to_string : struct_ -> string 364 | (** Get a human-readable description of this object. *) 365 | end 366 | 367 | (** {1:types Types} *) 368 | 369 | module Type : sig 370 | 371 | type type_kind = 372 | Void 373 | | Void_ptr 374 | | Bool 375 | | Char 376 | | Signed_char 377 | | Unsigned_char 378 | | Short 379 | | Unsigned_short 380 | | Int 381 | | Unsigned_int 382 | | Long 383 | | Unsigned_long 384 | | Long_long 385 | | Unsigned_long_long 386 | | Float 387 | | Double 388 | | Long_double 389 | | Const_char_ptr 390 | | Size_t 391 | | File_ptr 392 | | Complex_float 393 | | Complex_double 394 | | Complex_long_double 395 | 396 | val get : context -> type_kind -> type_ 397 | (** Access a standard type. See {!type_kind}. *) 398 | 399 | val int : context -> ?signed:bool -> int -> type_ 400 | (** Get the integer type of the given size and signedness. *) 401 | 402 | val pointer : type_ -> type_ 403 | (** Given type [T], get type [T*] *) 404 | 405 | val const : type_ -> type_ 406 | (** Given type [T], get type [const T]. *) 407 | 408 | val volatile : type_ -> type_ 409 | (** Given type [T], get type [volatile T]. *) 410 | 411 | val array : context -> ?loc:location -> type_ -> int -> type_ 412 | (** Given type [T], get type [T[N]] (for a constant [N]). *) 413 | 414 | val function_ptr : context -> ?loc:location -> ?variadic:bool -> type_ list -> type_ -> type_ 415 | 416 | val struct_ : struct_ -> type_ 417 | 418 | val union : context -> ?loc:location -> string -> field list -> type_ 419 | (** Unions work similarly to structs. *) 420 | 421 | val to_string : type_ -> string 422 | (** Get a human-readable description of this object. *) 423 | end 424 | 425 | (** {1:rvalues Rvalues} 426 | 427 | A {!rvalue} is an expression that can be computed. 428 | 429 | It can be simple, e.g.: 430 | - an integer value e.g. [0] or [42] 431 | - a string literal e.g. ["Hello world"] 432 | - a variable e.g. [i]. These are also {{!lvalues}lvalues} (see below). 433 | 434 | or compound e.g.: 435 | - a unary expression e.g. [!cond] 436 | - a binary expression e.g. [(a + b)] 437 | - a function call e.g. [get_distance (&player_ship, &target)] 438 | - etc. 439 | 440 | Every {!rvalue} has an associated {{!type_}type}, and the API will check to 441 | ensure that types match up correctly (otherwise the context will emit an 442 | error). *) 443 | 444 | module RValue : sig 445 | 446 | val type_of : rvalue -> type_ 447 | (** Get the type of this {!rvalue}. *) 448 | 449 | val int : context -> type_ -> int -> rvalue 450 | (** Given a numeric type (integer or floating point), build an {!rvalue} for the 451 | given constant int value. *) 452 | 453 | val zero : context -> type_ -> rvalue 454 | (** Given a numeric type (integer or floating point), get the {!rvalue} for 455 | zero. Essentially this is just a shortcut for: 456 | {[ 457 | new_rvalue_from_int ctx numeric_type 0 458 | ]} *) 459 | 460 | val one : context -> type_ -> rvalue 461 | (** Given a numeric type (integer or floating point), get the {!rvalue} for 462 | one. Essentially this is just a shortcut for: 463 | {[ 464 | new_rvalue_from_int ctx numeric_type 1 465 | ]} *) 466 | 467 | val double : context -> type_ -> float -> rvalue 468 | (** Given a numeric type (integer or floating point), build an {!rvalue} for the 469 | given constant double value. *) 470 | 471 | val ptr : context -> type_ -> 'a Ctypes.ptr -> rvalue 472 | (** Given a pointer type, build an {!rvalue} for the given address. *) 473 | 474 | val null : context -> type_ -> rvalue 475 | (** Given a pointer type, build an {!rvalue} for [NULL]. Essentially this is 476 | just a shortcut for: 477 | {[ 478 | new_rvalue_from_ptr ctx pointer_type Ctypes.null 479 | ]} *) 480 | 481 | val string_literal : context -> string -> rvalue 482 | (** Generate an {!rvalue} for the given [NIL]-terminated string, of type 483 | [Const_char_ptr]. *) 484 | 485 | val unary_op : context -> ?loc:location -> unary_op -> type_ -> rvalue -> rvalue 486 | (** Build a unary operation out of an input {!rvalue}. See {!unary_op}. *) 487 | 488 | val binary_op : context -> ?loc:location -> binary_op -> type_ -> rvalue -> rvalue -> rvalue 489 | (** Build a binary operation out of two constituent {{!rvalue}rvalues}. See 490 | {!binary_op}. *) 491 | 492 | val comparison : context -> ?loc:location -> comparison -> rvalue -> rvalue -> rvalue 493 | (** Build a boolean {!rvalue} out of the comparison of two other 494 | {{!rvalue}rvalues}. *) 495 | 496 | val call : context -> ?loc:location -> function_ -> rvalue list -> rvalue 497 | (** Given a function and the given table of argument rvalues, construct a call 498 | to the function, with the result as an {!rvalue}. 499 | 500 | {3 Note} 501 | 502 | [new_call] merely builds a [rvalue] i.e. an expression that can be 503 | evaluated, perhaps as part of a more complicated expression. The call won't 504 | happen unless you add a statement to a function that evaluates the expression. 505 | 506 | For example, if you want to call a function and discard the result (or to call a 507 | function with [void] return type), use [add_eval]: 508 | {[ 509 | (* Add "(void)printf (args);". *) 510 | add_eval block (new_call ctx printf_func args) 511 | ]} *) 512 | 513 | val indirect_call : context -> ?loc:location -> rvalue -> rvalue list -> rvalue 514 | (** Call through a function pointer. *) 515 | 516 | val cast : context -> ?loc:location -> rvalue -> type_ -> rvalue 517 | (** Given an {!rvalue} of [T], construct another {!rvalue} of another type. 518 | Currently only a limited set of conversions are possible: 519 | - [int <-> float] 520 | - [int <-> bool] 521 | - [P* <-> Q*], for pointer types [P] and [Q] *) 522 | 523 | val access_field : ?loc:location -> rvalue -> field -> rvalue 524 | 525 | val lvalue : lvalue -> rvalue 526 | 527 | val param : param -> rvalue 528 | 529 | val to_string : rvalue -> string 530 | (** Get a human-readable description of this object. *) 531 | end 532 | 533 | (** {1:lvalues Lvalues} 534 | 535 | An {!lvalue} is something that can of the left-hand side of an assignment: a 536 | storage area (such as a variable). It is also usable as an {!rvalue}, where 537 | the {!rvalue} is computed by reading from the storage area. *) 538 | 539 | module LValue : sig 540 | 541 | val address : ?loc:location -> lvalue -> rvalue 542 | (** Taking the address of an {!lvalue}; analogous to [&(EXPR)] in C. *) 543 | 544 | type global_kind = 545 | Exported 546 | | Internal 547 | | Imported 548 | 549 | val global : context -> ?loc:location -> global_kind -> type_ -> string -> lvalue 550 | (** Add a new global variable of the given type and name to the context. 551 | 552 | The {!global_kind} parameter determines the visibility of the {e global} 553 | outside of the {!result}. *) 554 | 555 | val deref : ?loc:location -> rvalue -> lvalue 556 | (** Dereferencing a pointer; analogous to [*(EXPR)] in C. *) 557 | 558 | val deref_field : ?loc:location -> rvalue -> field -> lvalue 559 | (** Accessing a field of an [rvalue] of pointer type, analogous [(EXPR)->field] 560 | in C, itself equivalent to [(\*EXPR).FIELD] *) 561 | 562 | val access_array : ?loc:location -> rvalue -> rvalue -> lvalue 563 | (** Given an rvalue of pointer type [T *], get at the element [T] at the given 564 | index, using standard C array indexing rules i.e. each increment of index 565 | corresponds to [sizeof(T)] bytes. Analogous to [PTR[INDEX]] in C (or, 566 | indeed, to [PTR + INDEX]). *) 567 | 568 | val access_field : ?loc:location -> lvalue -> field -> lvalue 569 | 570 | val param : param -> lvalue 571 | 572 | val to_string : lvalue -> string 573 | (** Get a human-readable description of this object. *) 574 | end 575 | 576 | (** {1:params Parameters} 577 | 578 | A value of type {!param} represents a parameter to a 579 | {{!functions}function}. *) 580 | 581 | module Param : sig 582 | 583 | val create : context -> ?loc:location -> type_ -> string -> param 584 | (** In preparation for creating a function, create a new parameter of the given 585 | type and name. *) 586 | 587 | val to_string : param -> string 588 | (** Get a human-readable description of this object. *) 589 | end 590 | 591 | (** {1:functions Functions} 592 | 593 | A values of type [function_] encapsulates a function: either one that you're 594 | creating yourself, or a reference to one that you're dynamically linking to 595 | within the rest of the process. *) 596 | 597 | module Function : sig 598 | 599 | (** Kinds of function. *) 600 | type function_kind = 601 | Exported 602 | (** Function is defined by the client code and visible by name outside of the 603 | JIT. *) 604 | 605 | | Internal 606 | (** Function is defined by the client code, but is invisible outside of the 607 | JIT. Analogous to a ["static"] function. *) 608 | 609 | | Imported 610 | (** Function is not defined by the client code; we're merely referring to it. 611 | Analogous to using an ["extern"] function from a header file. *) 612 | 613 | | Always_inline 614 | (** Function is only ever inlined into other functions, and is invisible 615 | outside of the JIT. Analogous to prefixing with ["inline"] and adding 616 | [__attribute__((always_inline))]. Inlining will only occur when the 617 | optimization level is above 0; when optimization is off, this is 618 | essentially the same as [FUNCTION_Internal]. *) 619 | 620 | val create : 621 | context -> ?loc:location -> ?variadic:bool -> function_kind -> type_ -> string -> param list -> function_ 622 | (** Create a function with the given name and parameters. *) 623 | 624 | val builtin : context -> string -> function_ 625 | (** Create a reference to a builtin function (sometimes called intrinsic 626 | functions). *) 627 | 628 | val param : function_ -> int -> param 629 | (** Get a specific param of a function by index (0-based). *) 630 | 631 | val dump_dot : function_ -> string -> unit 632 | (** Emit the function in graphviz format to the given path. *) 633 | 634 | val local : ?loc:location -> function_ -> type_ -> string -> lvalue 635 | (** Add a new local variable within the function, of the given type and name. *) 636 | 637 | val to_string : function_ -> string 638 | (** Get a human-readable description of this object. *) 639 | end 640 | 641 | (** {1:blocks Basic Blocks} 642 | 643 | A [block] encapsulates a {e basic block} of statements within a function 644 | (i.e. with one entry point and one exit point). 645 | - Every block within a function must be terminated with a conditional, a 646 | branch, or a return. 647 | - The blocks within a function form a directed graph. 648 | - The entrypoint to the function is the first block created within it. 649 | - All of the blocks in a function must be reachable via some path from the 650 | first block. 651 | - It's OK to have more than one {e return} from a function (i.e., multiple 652 | blocks that terminate by returning. *) 653 | 654 | module Block : sig 655 | 656 | val create : ?name:string -> function_ -> block 657 | (** Create a block. You can give it a meaningful name, which may show up in 658 | dumps of the internal representation, and in error messages. *) 659 | 660 | val parent : block -> function_ 661 | (** Which function is this block within? *) 662 | 663 | val eval : ?loc:location -> block -> rvalue -> unit 664 | (** Add evaluation of an {!rvalue}, discarding the result (e.g. a function 665 | call that {e returns} void). This is equivalent to this C code: 666 | {[ 667 | (void)expression; 668 | ]} *) 669 | 670 | val assign : ?loc:location -> block -> lvalue -> rvalue -> unit 671 | (** Add evaluation of an {!rvalue}, assigning the result to the given 672 | {!lvalue}. This is roughly equivalent to this C code: 673 | {[ 674 | lvalue = rvalue; 675 | ]} *) 676 | 677 | val assign_op : ?loc:location -> block -> lvalue -> binary_op -> rvalue -> unit 678 | (** Add evaluation of an {!rvalue}, using the result to modify an {!lvalue}. 679 | This is analogous to ["+="] and friends: 680 | {[ 681 | lvalue += rvalue; 682 | lvalue *= rvalue; 683 | lvalue /= rvalue; 684 | etc 685 | ]} 686 | For example: 687 | {[ 688 | (* "i++" *) 689 | add_assignment_op loop_body i Plus (one ctx int_type) 690 | ]} *) 691 | 692 | val comment : ?loc:location -> block -> string -> unit 693 | (** Add a no-op textual comment to the internal representation of the code. 694 | It will be optimized away, but will be visible in the dumps seen via 695 | {{!Context.context_option}[Dump_initial_tree]} and 696 | {{!Context.context_option}[Dump_initial_gimple]} and thus may be of use 697 | when debugging how your project's internal representation gets converted 698 | to the [libgccjit] IR. *) 699 | 700 | val cond_jump : ?loc:location -> block -> rvalue -> block -> block -> unit 701 | (** Terminate a block by adding evaluation of an rvalue, branching on the 702 | result to the appropriate successor block. This is roughly equivalent to 703 | this C code: 704 | {[ 705 | if (boolval) 706 | goto on_true; 707 | else 708 | goto on_false; 709 | ]} *) 710 | 711 | val jump : ?loc:location -> block -> block -> unit 712 | (** Terminate a block by adding a jump to the given target block. This is 713 | roughly equivalent to this C code: 714 | {[ 715 | goto target; 716 | ]} *) 717 | 718 | val return : ?loc:location -> block -> rvalue -> unit 719 | (** Terminate a block by adding evaluation of an {!rvalue}, returning the 720 | value. This is roughly equivalent to this C code: 721 | {[ 722 | return expression; 723 | ]} *) 724 | 725 | val return_void : ?loc:location -> block -> unit 726 | (** Terminate a block by adding a valueless return, for use within a function 727 | with [void] return type. This is equivalent to this C code: 728 | {[ 729 | return; 730 | ]} *) 731 | 732 | val to_string : block -> string 733 | (** Get a human-readable description of this object. *) 734 | end 735 | 736 | (** {1:locations Source Locations} 737 | 738 | A {!location} encapsulates a source code location, so that you can (optionally) 739 | associate locations in your language with statements in the JIT-compiled code, 740 | allowing the debugger to single-step through your language. 741 | - {!location} instances are optional: you can always omit them to any API 742 | entrypoint accepting one. 743 | - You can construct them using {!Location.create}. 744 | - You need to {{!Context.set_option}enable} 745 | {{!Context.context_option}[Debuginfo]} on the {!context} for these 746 | locations to actually be usable by the debugger. 747 | 748 | {2 Faking it} 749 | 750 | If you don't have source code for your internal representation, but need to 751 | debug, you can generate a C-like representation of the functions in your 752 | context using {!Context.dump_to_file}. This will dump C-like code to the 753 | given path. If the update_locations argument is true, this will also set up 754 | {!location} information throughout the context, pointing at the dump file as 755 | if it were a source file, giving you something you can step through in the 756 | debugger. *) 757 | 758 | module Location : sig 759 | val create : context -> string -> int -> int -> location 760 | (** Create a {!location} instance representing the given source location. *) 761 | 762 | val to_string : location -> string 763 | (** Get a human-readable description of this object. *) 764 | end 765 | 766 | (** {1:inmemory In-memory compilation} *) 767 | 768 | module Result : sig 769 | 770 | val code : result -> string -> ('a -> 'b) Ctypes.fn -> 'a -> 'b 771 | (** Locate a given function within the built machine code. 772 | - Functions are looked up by name. For this to succeed, a function with a 773 | name matching funcname must have been created on result's context (or a 774 | parent context) via a call to {!Function.create} with kind 775 | {{!Function.function_kind}[Exported]}. 776 | - If such a function is not found, an error will be raised. 777 | - If the function is found, the result is cast to the given Ctypes 778 | signature. Care must be taken to pass a signature compatible with that 779 | of function being extracted. 780 | - The resulting machine code becomes invalid after {!release} is called on 781 | the {!result}; attempting to call it after that may lead to a 782 | segmentation fault. *) 783 | 784 | val global : result -> string -> 'a Ctypes.typ -> 'a Ctypes.ptr 785 | (** Locate a given global within the built machine code. 786 | - Globals are looked up by name. For this to succeed, a global with a name 787 | matching name must have been created on result's context (or a parent 788 | context) via a call to {!LValue.global} with kind 789 | {{!LValue.global_kind}[Exported]}. 790 | - If the global is found, the result is cast to the Given [Ctypes] type. 791 | - This is a pointer to the global, so e.g. for an [int] this is an [int *]. 792 | - If such a global is not found, an error will be raised. 793 | - The resulting address becomes invalid after {!release} is called on the 794 | {!result}; attempting to use it after that may lead to a segmentation 795 | fault. *) 796 | 797 | val release : result -> unit 798 | (** Once we're done with the code, this unloads the built [.so] file. This 799 | cleans up the result; after calling this, it's no longer valid to use the 800 | result, or any code or globals that were obtained by calling {!code} or 801 | {!global} on it. *) 802 | end 803 | -------------------------------------------------------------------------------- /lib/gccjit.mllib: -------------------------------------------------------------------------------- 1 | Gccjit 2 | Gccjit_bindings 3 | Gccjit_stubs_generated 4 | Gccjit_types_generated 5 | -------------------------------------------------------------------------------- /lib/gccjit_bindings.ml: -------------------------------------------------------------------------------- 1 | (* The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Nicolas Ojeda Bar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. *) 22 | 23 | open Ctypes 24 | 25 | type gcc_jit_context_t 26 | type gcc_jit_result_t 27 | type gcc_jit_object_t 28 | type gcc_jit_location_t 29 | type gcc_jit_type_t 30 | type gcc_jit_field_t 31 | type gcc_jit_struct_t 32 | type gcc_jit_param_t 33 | type gcc_jit_lvalue_t 34 | type gcc_jit_rvalue_t 35 | type gcc_jit_function_t 36 | type gcc_jit_block_t 37 | 38 | type gcc_jit_str_option = 39 | | GCC_JIT_STR_OPTION_PROGNAME 40 | 41 | type gcc_jit_int_option = 42 | | GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL 43 | 44 | type gcc_jit_bool_option = 45 | | GCC_JIT_BOOL_OPTION_DEBUGINFO 46 | | GCC_JIT_BOOL_OPTION_DUMP_INITIAL_TREE 47 | | GCC_JIT_BOOL_OPTION_DUMP_INITIAL_GIMPLE 48 | | GCC_JIT_BOOL_OPTION_DUMP_GENERATED_CODE 49 | | GCC_JIT_BOOL_OPTION_DUMP_SUMMARY 50 | | GCC_JIT_BOOL_OPTION_DUMP_EVERYTHING 51 | | GCC_JIT_BOOL_OPTION_SELFCHECK_GC 52 | | GCC_JIT_BOOL_OPTION_KEEP_INTERMEDIATES 53 | 54 | type gcc_jit_output_kind = 55 | | GCC_JIT_OUTPUT_KIND_ASSEMBLER 56 | | GCC_JIT_OUTPUT_KIND_OBJECT_FILE 57 | | GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY 58 | | GCC_JIT_OUTPUT_KIND_EXECUTABLE 59 | 60 | type gcc_jit_types = 61 | | GCC_JIT_TYPE_VOID 62 | | GCC_JIT_TYPE_VOID_PTR 63 | | GCC_JIT_TYPE_BOOL 64 | | GCC_JIT_TYPE_CHAR 65 | | GCC_JIT_TYPE_SIGNED_CHAR 66 | | GCC_JIT_TYPE_UNSIGNED_CHAR 67 | | GCC_JIT_TYPE_SHORT 68 | | GCC_JIT_TYPE_UNSIGNED_SHORT 69 | | GCC_JIT_TYPE_INT 70 | | GCC_JIT_TYPE_UNSIGNED_INT 71 | | GCC_JIT_TYPE_LONG 72 | | GCC_JIT_TYPE_UNSIGNED_LONG 73 | | GCC_JIT_TYPE_LONG_LONG 74 | | GCC_JIT_TYPE_UNSIGNED_LONG_LONG 75 | | GCC_JIT_TYPE_FLOAT 76 | | GCC_JIT_TYPE_DOUBLE 77 | | GCC_JIT_TYPE_LONG_DOUBLE 78 | | GCC_JIT_TYPE_CONST_CHAR_PTR 79 | | GCC_JIT_TYPE_SIZE_T 80 | | GCC_JIT_TYPE_FILE_PTR 81 | | GCC_JIT_TYPE_COMPLEX_FLOAT 82 | | GCC_JIT_TYPE_COMPLEX_DOUBLE 83 | | GCC_JIT_TYPE_COMPLEX_LONG_DOUBLE 84 | 85 | type gcc_jit_function_kind = 86 | | GCC_JIT_FUNCTION_EXPORTED 87 | | GCC_JIT_FUNCTION_INTERNAL 88 | | GCC_JIT_FUNCTION_IMPORTED 89 | | GCC_JIT_FUNCTION_ALWAYS_INLINE 90 | 91 | type gcc_jit_global_kind = 92 | | GCC_JIT_GLOBAL_EXPORTED 93 | | GCC_JIT_GLOBAL_INTERNAL 94 | | GCC_JIT_GLOBAL_IMPORTED 95 | 96 | type gcc_jit_unary_op = 97 | | GCC_JIT_UNARY_OP_MINUS 98 | | GCC_JIT_UNARY_OP_BITWISE_NEGATE 99 | | GCC_JIT_UNARY_OP_LOGICAL_NEGATE 100 | | GCC_JIT_UNARY_OP_ABS 101 | 102 | type gcc_jit_binary_op = 103 | | GCC_JIT_BINARY_OP_PLUS 104 | | GCC_JIT_BINARY_OP_MINUS 105 | | GCC_JIT_BINARY_OP_MULT 106 | | GCC_JIT_BINARY_OP_DIVIDE 107 | | GCC_JIT_BINARY_OP_MODULO 108 | | GCC_JIT_BINARY_OP_BITWISE_AND 109 | | GCC_JIT_BINARY_OP_BITWISE_XOR 110 | | GCC_JIT_BINARY_OP_BITWISE_OR 111 | | GCC_JIT_BINARY_OP_LOGICAL_AND 112 | | GCC_JIT_BINARY_OP_LOGICAL_OR 113 | | GCC_JIT_BINARY_OP_LSHIFT 114 | | GCC_JIT_BINARY_OP_RSHIFT 115 | 116 | type gcc_jit_comparison = 117 | | GCC_JIT_COMPARISON_EQ 118 | | GCC_JIT_COMPARISON_NE 119 | | GCC_JIT_COMPARISON_LT 120 | | GCC_JIT_COMPARISON_LE 121 | | GCC_JIT_COMPARISON_GT 122 | | GCC_JIT_COMPARISON_GE 123 | 124 | type gcc_jit_context = gcc_jit_context_t structure ptr 125 | type gcc_jit_result = gcc_jit_result_t structure ptr 126 | type gcc_jit_object = gcc_jit_object_t structure ptr 127 | type gcc_jit_location = gcc_jit_location_t structure ptr 128 | type gcc_jit_type = gcc_jit_type_t structure ptr 129 | type gcc_jit_field = gcc_jit_field_t structure ptr 130 | type gcc_jit_struct = gcc_jit_struct_t structure ptr 131 | type gcc_jit_param = gcc_jit_param_t structure ptr 132 | type gcc_jit_lvalue = gcc_jit_lvalue_t structure ptr 133 | type gcc_jit_rvalue = gcc_jit_rvalue_t structure ptr 134 | type gcc_jit_function = gcc_jit_function_t structure ptr 135 | type gcc_jit_block = gcc_jit_block_t structure ptr 136 | 137 | let gcc_jit_context : gcc_jit_context typ = ptr (structure "gcc_jit_context") 138 | let gcc_jit_result : gcc_jit_result typ = ptr (structure "gcc_jit_result") 139 | let gcc_jit_object : gcc_jit_object typ = ptr (structure "gcc_jit_object") 140 | let gcc_jit_location : gcc_jit_location typ = ptr (structure "gcc_jit_location") 141 | let gcc_jit_type : gcc_jit_type typ = ptr (structure "gcc_jit_type") 142 | let gcc_jit_field : gcc_jit_field typ = ptr (structure "gcc_jit_field") 143 | let gcc_jit_struct : gcc_jit_struct typ = ptr (structure "gcc_jit_struct") 144 | let gcc_jit_param : gcc_jit_param typ = ptr (structure "gcc_jit_param") 145 | let gcc_jit_lvalue : gcc_jit_lvalue typ = ptr (structure "gcc_jit_lvalue") 146 | let gcc_jit_rvalue : gcc_jit_rvalue typ = ptr (structure "gcc_jit_rvalue") 147 | let gcc_jit_function : gcc_jit_function typ = ptr (structure "gcc_jit_function") 148 | let gcc_jit_block : gcc_jit_block typ = ptr (structure "gcc_jit_block") 149 | 150 | module Enums (T : Cstubs_structs.TYPE) = struct 151 | 152 | let gcc_jit_str_option_progname = T.constant "GCC_JIT_STR_OPTION_PROGNAME" T.int64_t 153 | 154 | let gcc_jit_str_option = 155 | T.enum "gcc_jit_str_option" [ GCC_JIT_STR_OPTION_PROGNAME, gcc_jit_str_option_progname ] 156 | 157 | let gcc_jit_int_option_optimization_level = 158 | T.constant "GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL" T.int64_t 159 | 160 | let gcc_jit_int_option = 161 | T.enum "gcc_jit_int_option" [ GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL, gcc_jit_int_option_optimization_level ] 162 | 163 | let gcc_jit_bool_option_debuginfo = T.constant "GCC_JIT_BOOL_OPTION_DEBUGINFO" T.int64_t 164 | let gcc_jit_bool_option_dump_initial_tree = T.constant "GCC_JIT_BOOL_OPTION_DUMP_INITIAL_TREE" T.int64_t 165 | let gcc_jit_bool_option_dump_initial_gimple = T.constant "GCC_JIT_BOOL_OPTION_DUMP_INITIAL_GIMPLE" T.int64_t 166 | let gcc_jit_bool_option_dump_generated_code = T.constant "GCC_JIT_BOOL_OPTION_DUMP_GENERATED_CODE" T.int64_t 167 | let gcc_jit_bool_option_dump_summary = T.constant "GCC_JIT_BOOL_OPTION_DUMP_SUMMARY" T.int64_t 168 | let gcc_jit_bool_option_dump_everything = T.constant "GCC_JIT_BOOL_OPTION_DUMP_EVERYTHING" T.int64_t 169 | let gcc_jit_bool_option_selfcheck_gc = T.constant "GCC_JIT_BOOL_OPTION_SELFCHECK_GC" T.int64_t 170 | let gcc_jit_bool_option_keep_intermediates = T.constant "GCC_JIT_BOOL_OPTION_KEEP_INTERMEDIATES" T.int64_t 171 | 172 | let gcc_jit_bool_option = 173 | T.enum "gcc_jit_bool_option" 174 | [ GCC_JIT_BOOL_OPTION_DEBUGINFO, gcc_jit_bool_option_debuginfo; 175 | GCC_JIT_BOOL_OPTION_DUMP_INITIAL_TREE, gcc_jit_bool_option_dump_initial_tree; 176 | GCC_JIT_BOOL_OPTION_DUMP_INITIAL_GIMPLE, gcc_jit_bool_option_dump_initial_gimple; 177 | GCC_JIT_BOOL_OPTION_DUMP_GENERATED_CODE, gcc_jit_bool_option_dump_generated_code; 178 | GCC_JIT_BOOL_OPTION_DUMP_SUMMARY, gcc_jit_bool_option_dump_summary; 179 | GCC_JIT_BOOL_OPTION_DUMP_EVERYTHING, gcc_jit_bool_option_dump_everything; 180 | GCC_JIT_BOOL_OPTION_KEEP_INTERMEDIATES, gcc_jit_bool_option_keep_intermediates ] 181 | 182 | let gcc_jit_output_kind_assembler = T.constant "GCC_JIT_OUTPUT_KIND_ASSEMBLER" T.int64_t 183 | let gcc_jit_output_kind_object_file = T.constant "GCC_JIT_OUTPUT_KIND_OBJECT_FILE" T.int64_t 184 | let gcc_jit_output_kind_dynamic_library = T.constant "GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY" T.int64_t 185 | let gcc_jit_output_kind_executable = T.constant "GCC_JIT_OUTPUT_KIND_EXECUTABLE" T.int64_t 186 | 187 | let gcc_jit_output_kind = 188 | T.enum "gcc_jit_output_kind" 189 | [ GCC_JIT_OUTPUT_KIND_ASSEMBLER, gcc_jit_output_kind_assembler; 190 | GCC_JIT_OUTPUT_KIND_OBJECT_FILE, gcc_jit_output_kind_object_file; 191 | GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY, gcc_jit_output_kind_dynamic_library; 192 | GCC_JIT_OUTPUT_KIND_EXECUTABLE, gcc_jit_output_kind_executable ] 193 | 194 | let gcc_jit_type_void = T.constant "GCC_JIT_TYPE_VOID" T.int64_t 195 | let gcc_jit_type_void_ptr = T.constant "GCC_JIT_TYPE_VOID_PTR" T.int64_t 196 | let gcc_jit_type_bool = T.constant "GCC_JIT_TYPE_BOOL" T.int64_t 197 | let gcc_jit_type_char = T.constant "GCC_JIT_TYPE_CHAR" T.int64_t 198 | let gcc_jit_type_signed_char = T.constant "GCC_JIT_TYPE_SIGNED_CHAR" T.int64_t 199 | let gcc_jit_type_unsigned_char = T.constant "GCC_JIT_TYPE_UNSIGNED_CHAR" T.int64_t 200 | let gcc_jit_type_short = T.constant "GCC_JIT_TYPE_SHORT" T.int64_t 201 | let gcc_jit_type_unsigned_short = T.constant "GCC_JIT_TYPE_UNSIGNED_SHORT" T.int64_t 202 | let gcc_jit_type_int = T.constant "GCC_JIT_TYPE_INT" T.int64_t 203 | let gcc_jit_type_unsigned_int = T.constant "GCC_JIT_TYPE_UNSIGNED_INT" T.int64_t 204 | let gcc_jit_type_long = T.constant "GCC_JIT_TYPE_LONG" T.int64_t 205 | let gcc_jit_type_unsigned_long = T.constant "GCC_JIT_TYPE_UNSIGNED_LONG" T.int64_t 206 | let gcc_jit_type_long_long = T.constant "GCC_JIT_TYPE_LONG_LONG" T.int64_t 207 | let gcc_jit_type_unsigned_long_long = T.constant "GCC_JIT_TYPE_UNSIGNED_LONG_LONG" T.int64_t 208 | let gcc_jit_type_float = T.constant "GCC_JIT_TYPE_FLOAT" T.int64_t 209 | let gcc_jit_type_double = T.constant "GCC_JIT_TYPE_DOUBLE" T.int64_t 210 | let gcc_jit_type_long_double = T.constant "GCC_JIT_TYPE_LONG_DOUBLE" T.int64_t 211 | let gcc_jit_type_const_char_ptr = T.constant "GCC_JIT_TYPE_CONST_CHAR_PTR" T.int64_t 212 | let gcc_jit_type_size_t = T.constant "GCC_JIT_TYPE_SIZE_T" T.int64_t 213 | let gcc_jit_type_file_ptr = T.constant "GCC_JIT_TYPE_FILE_PTR" T.int64_t 214 | let gcc_jit_type_complex_float = T.constant "GCC_JIT_TYPE_COMPLEX_FLOAT" T.int64_t 215 | let gcc_jit_type_complex_double = T.constant "GCC_JIT_TYPE_COMPLEX_DOUBLE" T.int64_t 216 | let gcc_jit_type_complex_long_double = T.constant "GCC_JIT_TYPE_COMPLEX_LONG_DOUBLE" T.int64_t 217 | 218 | let gcc_jit_types = 219 | T.enum "gcc_jit_types" 220 | [ GCC_JIT_TYPE_VOID, gcc_jit_type_void; 221 | GCC_JIT_TYPE_VOID_PTR, gcc_jit_type_void_ptr; 222 | GCC_JIT_TYPE_BOOL, gcc_jit_type_bool; 223 | GCC_JIT_TYPE_CHAR, gcc_jit_type_char; 224 | GCC_JIT_TYPE_SIGNED_CHAR, gcc_jit_type_signed_char; 225 | GCC_JIT_TYPE_UNSIGNED_CHAR, gcc_jit_type_unsigned_char; 226 | GCC_JIT_TYPE_SHORT, gcc_jit_type_short; 227 | GCC_JIT_TYPE_UNSIGNED_SHORT, gcc_jit_type_unsigned_short; 228 | GCC_JIT_TYPE_INT, gcc_jit_type_int; 229 | GCC_JIT_TYPE_UNSIGNED_INT, gcc_jit_type_unsigned_int; 230 | GCC_JIT_TYPE_LONG, gcc_jit_type_long; 231 | GCC_JIT_TYPE_UNSIGNED_LONG, gcc_jit_type_unsigned_long; 232 | GCC_JIT_TYPE_LONG_LONG, gcc_jit_type_long_long; 233 | GCC_JIT_TYPE_UNSIGNED_LONG_LONG, gcc_jit_type_unsigned_long_long; 234 | GCC_JIT_TYPE_FLOAT, gcc_jit_type_float; 235 | GCC_JIT_TYPE_DOUBLE, gcc_jit_type_double; 236 | GCC_JIT_TYPE_LONG_DOUBLE, gcc_jit_type_long_double; 237 | GCC_JIT_TYPE_CONST_CHAR_PTR, gcc_jit_type_const_char_ptr; 238 | GCC_JIT_TYPE_SIZE_T, gcc_jit_type_size_t; 239 | GCC_JIT_TYPE_FILE_PTR, gcc_jit_type_file_ptr; 240 | GCC_JIT_TYPE_COMPLEX_FLOAT, gcc_jit_type_complex_float; 241 | GCC_JIT_TYPE_COMPLEX_DOUBLE, gcc_jit_type_complex_double; 242 | GCC_JIT_TYPE_COMPLEX_LONG_DOUBLE, gcc_jit_type_complex_long_double ] 243 | 244 | let gcc_jit_function_exported = T.constant "GCC_JIT_FUNCTION_EXPORTED" T.int64_t 245 | let gcc_jit_function_internal = T.constant "GCC_JIT_FUNCTION_INTERNAL" T.int64_t 246 | let gcc_jit_function_imported = T.constant "GCC_JIT_FUNCTION_IMPORTED" T.int64_t 247 | let gcc_jit_function_always_inline = T.constant "GCC_JIT_FUNCTION_ALWAYS_INLINE" T.int64_t 248 | 249 | let gcc_jit_function_kind = 250 | T.enum "gcc_jit_function_kind" 251 | [ GCC_JIT_FUNCTION_EXPORTED, gcc_jit_function_exported; 252 | GCC_JIT_FUNCTION_INTERNAL, gcc_jit_function_internal; 253 | GCC_JIT_FUNCTION_IMPORTED, gcc_jit_function_imported; 254 | GCC_JIT_FUNCTION_ALWAYS_INLINE, gcc_jit_function_always_inline ] 255 | 256 | let gcc_jit_global_exported = T.constant "GCC_JIT_GLOBAL_EXPORTED" T.int64_t 257 | let gcc_jit_global_internal = T.constant "GCC_JIT_GLOBAL_INTERNAL" T.int64_t 258 | let gcc_jit_global_imported = T.constant "GCC_JIT_GLOBAL_IMPORTED" T.int64_t 259 | 260 | let gcc_jit_global_kind = 261 | T.enum "gcc_jit_global_kind" 262 | [ GCC_JIT_GLOBAL_EXPORTED, gcc_jit_global_exported; 263 | GCC_JIT_GLOBAL_INTERNAL, gcc_jit_global_internal; 264 | GCC_JIT_GLOBAL_IMPORTED, gcc_jit_global_imported ] 265 | 266 | let gcc_jit_unary_op_minus = T.constant "GCC_JIT_UNARY_OP_MINUS" T.int64_t 267 | let gcc_jit_unary_op_bitwise_negate = T.constant "GCC_JIT_UNARY_OP_BITWISE_NEGATE" T.int64_t 268 | let gcc_jit_unary_op_logical_negate = T.constant "GCC_JIT_UNARY_OP_LOGICAL_NEGATE" T.int64_t 269 | let gcc_jit_unary_op_abs = T.constant "GCC_JIT_UNARY_OP_ABS" T.int64_t 270 | 271 | let gcc_jit_unary_op = 272 | T.enum "gcc_jit_unary_op" 273 | [ GCC_JIT_UNARY_OP_MINUS, gcc_jit_unary_op_minus; 274 | GCC_JIT_UNARY_OP_BITWISE_NEGATE, gcc_jit_unary_op_bitwise_negate; 275 | GCC_JIT_UNARY_OP_LOGICAL_NEGATE, gcc_jit_unary_op_logical_negate; 276 | GCC_JIT_UNARY_OP_ABS, gcc_jit_unary_op_abs ] 277 | 278 | let gcc_jit_binary_op_plus = T.constant "GCC_JIT_BINARY_OP_PLUS" T.int64_t 279 | let gcc_jit_binary_op_minus = T.constant "GCC_JIT_BINARY_OP_MINUS" T.int64_t 280 | let gcc_jit_binary_op_mult = T.constant "GCC_JIT_BINARY_OP_MULT" T.int64_t 281 | let gcc_jit_binary_op_divide = T.constant "GCC_JIT_BINARY_OP_DIVIDE" T.int64_t 282 | let gcc_jit_binary_op_modulo = T.constant "GCC_JIT_BINARY_OP_MODULO" T.int64_t 283 | let gcc_jit_binary_op_bitwise_and = T.constant "GCC_JIT_BINARY_OP_BITWISE_AND" T.int64_t 284 | let gcc_jit_binary_op_bitwise_xor = T.constant "GCC_JIT_BINARY_OP_BITWISE_XOR" T.int64_t 285 | let gcc_jit_binary_op_bitwise_or = T.constant "GCC_JIT_BINARY_OP_BITWISE_OR" T.int64_t 286 | let gcc_jit_binary_op_logical_and = T.constant "GCC_JIT_BINARY_OP_LOGICAL_AND" T.int64_t 287 | let gcc_jit_binary_op_logical_or = T.constant "GCC_JIT_BINARY_OP_LOGICAL_OR" T.int64_t 288 | let gcc_jit_binary_op_lshift = T.constant "GCC_JIT_BINARY_OP_LSHIFT" T.int64_t 289 | let gcc_jit_binary_op_rshift = T.constant "GCC_JIT_BINARY_OP_RSHIFT" T.int64_t 290 | 291 | let gcc_jit_binary_op = 292 | T.enum "gcc_jit_binary_op" 293 | [ GCC_JIT_BINARY_OP_PLUS, gcc_jit_binary_op_plus; 294 | GCC_JIT_BINARY_OP_MINUS, gcc_jit_binary_op_minus; 295 | GCC_JIT_BINARY_OP_MULT, gcc_jit_binary_op_mult; 296 | GCC_JIT_BINARY_OP_DIVIDE, gcc_jit_binary_op_divide; 297 | GCC_JIT_BINARY_OP_MODULO, gcc_jit_binary_op_modulo; 298 | GCC_JIT_BINARY_OP_BITWISE_AND, gcc_jit_binary_op_bitwise_and; 299 | GCC_JIT_BINARY_OP_BITWISE_XOR, gcc_jit_binary_op_bitwise_xor; 300 | GCC_JIT_BINARY_OP_BITWISE_OR, gcc_jit_binary_op_bitwise_or; 301 | GCC_JIT_BINARY_OP_LOGICAL_AND, gcc_jit_binary_op_logical_and; 302 | GCC_JIT_BINARY_OP_LOGICAL_OR, gcc_jit_binary_op_logical_or; 303 | GCC_JIT_BINARY_OP_LSHIFT, gcc_jit_binary_op_lshift; 304 | GCC_JIT_BINARY_OP_RSHIFT, gcc_jit_binary_op_rshift ] 305 | 306 | let gcc_jit_comparison_eq = T.constant "GCC_JIT_COMPARISON_EQ" T.int64_t 307 | let gcc_jit_comparison_ne = T.constant "GCC_JIT_COMPARISON_NE" T.int64_t 308 | let gcc_jit_comparison_lt = T.constant "GCC_JIT_COMPARISON_LT" T.int64_t 309 | let gcc_jit_comparison_le = T.constant "GCC_JIT_COMPARISON_LE" T.int64_t 310 | let gcc_jit_comparison_gt = T.constant "GCC_JIT_COMPARISON_GT" T.int64_t 311 | let gcc_jit_comparison_ge = T.constant "GCC_JIT_COMPARISON_GE" T.int64_t 312 | 313 | let gcc_jit_comparison = 314 | T.enum "gcc_jit_comparison" 315 | [ GCC_JIT_COMPARISON_EQ, gcc_jit_comparison_eq; 316 | GCC_JIT_COMPARISON_NE, gcc_jit_comparison_ne; 317 | GCC_JIT_COMPARISON_LT, gcc_jit_comparison_lt; 318 | GCC_JIT_COMPARISON_LE, gcc_jit_comparison_le; 319 | GCC_JIT_COMPARISON_GT, gcc_jit_comparison_gt; 320 | GCC_JIT_COMPARISON_GE, gcc_jit_comparison_ge ] 321 | 322 | end 323 | 324 | module Bindings (T : Cstubs_structs.TYPE with type 'a typ = 'a typ) (F : Cstubs.FOREIGN) = struct 325 | 326 | module E = Enums (T) 327 | 328 | let gcc_jit_context_acquire = 329 | F.foreign "gcc_jit_context_acquire" 330 | F.(void @-> returning gcc_jit_context) 331 | 332 | let gcc_jit_context_release = 333 | F.foreign "gcc_jit_context_release" 334 | F.(gcc_jit_context @-> returning void) 335 | 336 | let gcc_jit_context_set_str_option = 337 | F.foreign "gcc_jit_context_set_str_option" 338 | F.(gcc_jit_context @-> E.gcc_jit_str_option @-> string @-> returning void) 339 | 340 | let gcc_jit_context_set_int_option = 341 | F.foreign "gcc_jit_context_set_int_option" 342 | F.(gcc_jit_context @-> E.gcc_jit_int_option @-> int @-> returning void) 343 | 344 | let gcc_jit_context_set_bool_option = 345 | F.foreign "gcc_jit_context_set_bool_option" 346 | F.(gcc_jit_context @-> E.gcc_jit_bool_option @-> bool @-> returning void) 347 | 348 | let gcc_jit_context_compile = 349 | F.foreign "gcc_jit_context_compile" 350 | F.(gcc_jit_context @-> returning gcc_jit_result) 351 | 352 | let gcc_jit_context_compile_to_file = 353 | F.foreign "gcc_jit_context_compile_to_file" 354 | F.(gcc_jit_context @-> E.gcc_jit_output_kind @-> string @-> returning void) 355 | 356 | let gcc_jit_context_dump_to_file = 357 | F.foreign "gcc_jit_context_dump_to_file" 358 | F.(gcc_jit_context @-> string @-> int @-> returning void) 359 | 360 | let gcc_jit_context_set_logfile = 361 | F.foreign "gcc_jit_context_set_logfile" 362 | F.(gcc_jit_context @-> ptr void @-> int @-> int @-> returning void) 363 | 364 | let gcc_jit_context_get_first_error = 365 | F.foreign "gcc_jit_context_get_first_error" 366 | F.(gcc_jit_context @-> returning string_opt) 367 | 368 | let gcc_jit_context_get_last_error = 369 | F.foreign "gcc_jit_context_get_last_error" 370 | F.(gcc_jit_context @-> returning string_opt) 371 | 372 | let gcc_jit_result_get_code = 373 | F.foreign "gcc_jit_result_get_code" 374 | F.(gcc_jit_result @-> string @-> returning (ptr void)) 375 | 376 | let gcc_jit_result_get_global = 377 | F.foreign "gcc_jit_result_get_global" 378 | F.(gcc_jit_result @-> string @-> returning (ptr void)) 379 | 380 | let gcc_jit_result_release = 381 | F.foreign "gcc_jit_result_release" 382 | F.(gcc_jit_result @-> returning void) 383 | 384 | let gcc_jit_object_get_context = 385 | F.foreign "gcc_jit_object_get_context" 386 | F.(gcc_jit_object @-> returning gcc_jit_context) 387 | 388 | let gcc_jit_object_get_debug_string = 389 | F.foreign "gcc_jit_object_get_debug_string" 390 | F.(gcc_jit_object @-> returning string) (* CHECK string NULL ? *) 391 | 392 | let gcc_jit_context_new_location = 393 | F.foreign "gcc_jit_context_new_location" 394 | F.(gcc_jit_context @-> string @-> int @-> int @-> returning gcc_jit_location) 395 | 396 | let gcc_jit_location_as_object = 397 | F.foreign "gcc_jit_location_as_object" 398 | F.(gcc_jit_location @-> returning gcc_jit_object) 399 | 400 | let gcc_jit_type_as_object = 401 | F.foreign "gcc_jit_type_as_object" 402 | F.(gcc_jit_type @-> returning gcc_jit_object) 403 | 404 | let gcc_jit_context_get_type = 405 | F.foreign "gcc_jit_context_get_type" 406 | F.(gcc_jit_context @-> E.gcc_jit_types @-> returning gcc_jit_type) 407 | 408 | let gcc_jit_context_get_int_type = 409 | F.foreign "gcc_jit_context_get_int_type" 410 | F.(gcc_jit_context @-> int @-> int @-> returning gcc_jit_type) 411 | 412 | let gcc_jit_type_get_pointer = 413 | F.foreign "gcc_jit_type_get_pointer" 414 | F.(gcc_jit_type @-> returning gcc_jit_type) 415 | 416 | let gcc_jit_type_get_const = 417 | F.foreign "gcc_jit_type_get_const" 418 | F.(gcc_jit_type @-> returning gcc_jit_type) 419 | 420 | let gcc_jit_type_get_volatile = 421 | F.foreign "gcc_jit_type_get_volatile" 422 | F.(gcc_jit_type @-> returning gcc_jit_type) 423 | 424 | let gcc_jit_context_new_array_type = 425 | F.foreign "gcc_jit_context_new_array_type" 426 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_type @-> int @-> returning gcc_jit_type) 427 | 428 | let gcc_jit_context_new_field = 429 | F.foreign "gcc_jit_context_new_field" 430 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_type @-> string @-> returning gcc_jit_field) 431 | 432 | let gcc_jit_field_as_object = 433 | F.foreign "gcc_jit_field_as_object" 434 | F.(gcc_jit_field @-> returning gcc_jit_object) 435 | 436 | let gcc_jit_context_new_struct_type = 437 | F.foreign "gcc_jit_context_new_struct_type" 438 | F.(gcc_jit_context @-> gcc_jit_location @-> string @-> int @-> ptr gcc_jit_field @-> returning gcc_jit_struct) 439 | 440 | let gcc_jit_context_new_opaque_struct = 441 | F.foreign "gcc_jit_context_new_opaque_struct" 442 | F.(gcc_jit_context @-> gcc_jit_location @-> string @-> returning gcc_jit_struct) 443 | 444 | let gcc_jit_struct_as_type = 445 | F.foreign "gcc_jit_struct_as_type" 446 | F.(gcc_jit_struct @-> returning gcc_jit_type) 447 | 448 | let gcc_jit_struct_set_fields = 449 | F.foreign "gcc_jit_struct_set_fields" 450 | F.(gcc_jit_struct @-> gcc_jit_location @-> int @-> ptr gcc_jit_field @-> returning void) 451 | 452 | let gcc_jit_context_new_union_type = 453 | F.foreign "gcc_jit_context_new_union_type" 454 | F.(gcc_jit_context @-> gcc_jit_location @-> string @-> int @-> ptr gcc_jit_field @-> returning gcc_jit_type) 455 | 456 | let gcc_jit_context_new_function_ptr_type = 457 | F.foreign "gcc_jit_context_new_function_ptr_type" 458 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_type @-> int @-> ptr gcc_jit_type @-> int @-> 459 | returning gcc_jit_type) 460 | 461 | let gcc_jit_context_new_param = 462 | F.foreign "gcc_jit_context_new_param" 463 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_type @-> string @-> returning gcc_jit_param) 464 | 465 | let gcc_jit_param_as_object = 466 | F.foreign "gcc_jit_param_as_object" 467 | F.(gcc_jit_param @-> returning gcc_jit_object) 468 | 469 | let gcc_jit_param_as_lvalue = 470 | F.foreign "gcc_jit_param_as_lvalue" 471 | F.(gcc_jit_param @-> returning gcc_jit_lvalue) 472 | 473 | let gcc_jit_param_as_rvalue = 474 | F.foreign "gcc_jit_param_as_rvalue" 475 | F.(gcc_jit_param @-> returning gcc_jit_rvalue) 476 | 477 | let gcc_jit_context_new_function = 478 | F.foreign "gcc_jit_context_new_function" 479 | F.(gcc_jit_context @-> gcc_jit_location @-> E.gcc_jit_function_kind @-> 480 | gcc_jit_type @-> string @-> int @-> ptr gcc_jit_param @-> int @-> returning gcc_jit_function) 481 | 482 | let gcc_jit_context_get_builtin_function = 483 | F.foreign "gcc_jit_context_get_builtin_function" 484 | F.(gcc_jit_context @-> string @-> returning gcc_jit_function) 485 | 486 | let gcc_jit_function_as_object = 487 | F.foreign "gcc_jit_function_as_object" 488 | F.(gcc_jit_function @-> returning gcc_jit_object) 489 | 490 | let gcc_jit_function_get_param = 491 | F.foreign "gcc_jit_function_get_param" 492 | F.(gcc_jit_function @-> int @-> returning gcc_jit_param) 493 | 494 | let gcc_jit_function_dump_to_dot = 495 | F.foreign "gcc_jit_function_dump_to_dot" 496 | F.(gcc_jit_function @-> string @-> returning void) 497 | 498 | let gcc_jit_function_new_block = 499 | F.foreign "gcc_jit_function_new_block" 500 | F.(gcc_jit_function @-> string_opt @-> returning gcc_jit_block) 501 | 502 | let gcc_jit_block_as_object = 503 | F.foreign "gcc_jit_block_as_object" 504 | F.(gcc_jit_block @-> returning gcc_jit_object) 505 | 506 | let gcc_jit_block_get_function = 507 | F.foreign "gcc_jit_block_get_function" 508 | F.(gcc_jit_block @-> returning gcc_jit_function) 509 | 510 | let gcc_jit_context_new_global = 511 | F.foreign "gcc_jit_context_new_global" 512 | F.(gcc_jit_context @-> gcc_jit_location @-> E.gcc_jit_global_kind @-> gcc_jit_type @-> string @-> 513 | returning gcc_jit_lvalue) 514 | 515 | let gcc_jit_lvalue_as_object = 516 | F.foreign "gcc_jit_lvalue_as_object" 517 | F.(gcc_jit_lvalue @-> returning gcc_jit_object) 518 | 519 | let gcc_jit_lvalue_as_rvalue = 520 | F.foreign "gcc_jit_lvalue_as_rvalue" 521 | F.(gcc_jit_lvalue @-> returning gcc_jit_rvalue) 522 | 523 | let gcc_jit_rvalue_as_object = 524 | F.foreign "gcc_jit_rvalue_as_object" 525 | F.(gcc_jit_rvalue @-> returning gcc_jit_object) 526 | 527 | let gcc_jit_rvalue_get_type = 528 | F.foreign "gcc_jit_rvalue_get_type" 529 | F.(gcc_jit_rvalue @-> returning gcc_jit_type) 530 | 531 | let gcc_jit_context_new_rvalue_from_int = 532 | F.foreign "gcc_jit_context_new_rvalue_from_int" 533 | F.(gcc_jit_context @-> gcc_jit_type @-> int @-> returning gcc_jit_rvalue) (* CHECK int *) 534 | 535 | let gcc_jit_context_new_rvalue_from_long = 536 | F.foreign "gcc_jit_context_new_rvalue_from_long" 537 | F.(gcc_jit_context @-> gcc_jit_type @-> int @-> returning gcc_jit_rvalue) (* CHECK int *) 538 | 539 | let gcc_jit_context_zero = 540 | F.foreign "gcc_jit_context_zero" 541 | F.(gcc_jit_context @-> gcc_jit_type @-> returning gcc_jit_rvalue) 542 | 543 | let gcc_jit_context_one = 544 | F.foreign "gcc_jit_context_one" 545 | F.(gcc_jit_context @-> gcc_jit_type @-> returning gcc_jit_rvalue) 546 | 547 | let gcc_jit_context_new_rvalue_from_double = 548 | F.foreign "gcc_jit_context_new_rvalue_from_double" 549 | F.(gcc_jit_context @-> gcc_jit_type @-> float @-> returning gcc_jit_rvalue) 550 | 551 | let gcc_jit_context_new_rvalue_from_ptr = 552 | F.foreign "gcc_jit_context_new_rvalue_from_ptr" 553 | F.(gcc_jit_context @-> gcc_jit_type @-> ptr void @-> returning gcc_jit_rvalue) 554 | 555 | let gcc_jit_context_null = 556 | F.foreign "gcc_jit_context_null" 557 | F.(gcc_jit_context @-> gcc_jit_type @-> returning gcc_jit_rvalue) 558 | 559 | let gcc_jit_context_new_string_literal = 560 | F.foreign "gcc_jit_context_new_string_literal" 561 | F.(gcc_jit_context @-> string @-> returning gcc_jit_rvalue) 562 | 563 | let gcc_jit_context_new_unary_op = 564 | F.foreign "gcc_jit_context_new_unary_op" 565 | F.(gcc_jit_context @-> gcc_jit_location @-> E.gcc_jit_unary_op @-> gcc_jit_type @-> gcc_jit_rvalue @-> 566 | returning gcc_jit_rvalue) 567 | 568 | let gcc_jit_context_new_binary_op = 569 | F.foreign "gcc_jit_context_new_binary_op" 570 | F.(gcc_jit_context @-> gcc_jit_location @-> E.gcc_jit_binary_op @-> gcc_jit_type @-> gcc_jit_rvalue @-> 571 | gcc_jit_rvalue @-> returning gcc_jit_rvalue) 572 | 573 | let gcc_jit_context_new_comparison = 574 | F.foreign "gcc_jit_context_new_comparison" 575 | F.(gcc_jit_context @-> gcc_jit_location @-> E.gcc_jit_comparison @-> gcc_jit_rvalue @-> gcc_jit_rvalue @-> 576 | returning gcc_jit_rvalue) 577 | 578 | let gcc_jit_context_new_call = 579 | F.foreign "gcc_jit_context_new_call" 580 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_function @-> int @-> ptr gcc_jit_rvalue @-> 581 | returning gcc_jit_rvalue) 582 | 583 | let gcc_jit_context_new_call_through_ptr = 584 | F.foreign "gcc_jit_context_new_call_through_ptr" 585 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_rvalue @-> int @-> ptr gcc_jit_rvalue @-> 586 | returning gcc_jit_rvalue) 587 | 588 | let gcc_jit_context_new_cast = 589 | F.foreign "gcc_jit_context_new_cast" 590 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_rvalue @-> gcc_jit_type @-> returning gcc_jit_rvalue) 591 | 592 | let gcc_jit_context_new_array_access = 593 | F.foreign "gcc_jit_context_new_array_access" 594 | F.(gcc_jit_context @-> gcc_jit_location @-> gcc_jit_rvalue @-> gcc_jit_rvalue @-> returning gcc_jit_lvalue) 595 | 596 | let gcc_jit_lvalue_access_field = 597 | F.foreign "gcc_jit_lvalue_access_field" 598 | F.(gcc_jit_lvalue @-> gcc_jit_location @-> gcc_jit_field @-> returning gcc_jit_lvalue) 599 | 600 | let gcc_jit_rvalue_access_field = 601 | F.foreign "gcc_jit_rvalue_access_field" 602 | F.(gcc_jit_rvalue @-> gcc_jit_location @-> gcc_jit_field @-> returning gcc_jit_rvalue) 603 | 604 | let gcc_jit_rvalue_dereference_field = 605 | F.foreign "gcc_jit_rvalue_dereference_field" 606 | F.(gcc_jit_rvalue @-> gcc_jit_location @-> gcc_jit_field @-> returning gcc_jit_lvalue) 607 | 608 | let gcc_jit_rvalue_dereference = 609 | F.foreign "gcc_jit_rvalue_dereference" 610 | F.(gcc_jit_rvalue @-> gcc_jit_location @-> returning gcc_jit_lvalue) 611 | 612 | let gcc_jit_lvalue_get_address = 613 | F.foreign "gcc_jit_lvalue_get_address" 614 | F.(gcc_jit_lvalue @-> gcc_jit_location @-> returning gcc_jit_rvalue) 615 | 616 | let gcc_jit_function_new_local = 617 | F.foreign "gcc_jit_function_new_local" 618 | F.(gcc_jit_function @-> gcc_jit_location @-> gcc_jit_type @-> string @-> returning gcc_jit_lvalue) 619 | 620 | let gcc_jit_block_add_eval = 621 | F.foreign "gcc_jit_block_add_eval" 622 | F.(gcc_jit_block @-> gcc_jit_location @-> gcc_jit_rvalue @-> returning void) 623 | 624 | let gcc_jit_block_add_assignment = 625 | F.foreign "gcc_jit_block_add_assignment" 626 | F.(gcc_jit_block @-> gcc_jit_location @-> gcc_jit_lvalue @-> gcc_jit_rvalue @-> returning void) 627 | 628 | let gcc_jit_block_add_assignment_op = 629 | F.foreign "gcc_jit_block_add_assignment_op" 630 | F.(gcc_jit_block @-> gcc_jit_location @-> gcc_jit_lvalue @-> E.gcc_jit_binary_op @-> gcc_jit_rvalue @-> 631 | returning void) 632 | 633 | let gcc_jit_block_add_comment = 634 | F.foreign "gcc_jit_block_add_comment" 635 | F.(gcc_jit_block @-> gcc_jit_location @-> string @-> returning void) 636 | 637 | let gcc_jit_block_end_with_conditional = 638 | F.foreign "gcc_jit_block_end_with_conditional" 639 | F.(gcc_jit_block @-> gcc_jit_location @-> gcc_jit_rvalue @-> gcc_jit_block @-> gcc_jit_block @-> 640 | returning void) 641 | 642 | let gcc_jit_block_end_with_jump = 643 | F.foreign "gcc_jit_block_end_with_jump" 644 | F.(gcc_jit_block @-> gcc_jit_location @-> gcc_jit_block @-> returning void) 645 | 646 | let gcc_jit_block_end_with_return = 647 | F.foreign "gcc_jit_block_end_with_return" 648 | F.(gcc_jit_block @-> gcc_jit_location @-> gcc_jit_rvalue @-> returning void) 649 | 650 | let gcc_jit_block_end_with_void_return = 651 | F.foreign "gcc_jit_block_end_with_void_return" 652 | F.(gcc_jit_block @-> gcc_jit_location @-> returning void) 653 | 654 | let gcc_jit_context_new_child_context = 655 | F.foreign "gcc_jit_context_new_child_context" 656 | F.(gcc_jit_context @-> returning gcc_jit_context) 657 | 658 | let gcc_jit_context_dump_reproducer_to_file = 659 | F.foreign "gcc_jit_context_dump_reproducer_to_file" 660 | F.(gcc_jit_context @-> string @-> returning void) 661 | 662 | external int_of_fd : Unix.file_descr -> int = "%identity" 663 | 664 | let fdopen = 665 | F.foreign "fdopen" 666 | F.(int @-> string @-> returning (ptr_opt void)) 667 | 668 | (* let gcc_jit_context_enable_dump = *) 669 | (* F.foreign "gcc_jit_context_enable_dump" (gcc_jit_context @-> string @-> ptr char @-> returning void) *) 670 | end 671 | -------------------------------------------------------------------------------- /lib/libgccjit_stubs.clib: -------------------------------------------------------------------------------- 1 | gccjit_stubs.o 2 | -------------------------------------------------------------------------------- /lib_gen/gen_stubs.ml: -------------------------------------------------------------------------------- 1 | let c_headers = "#include " 2 | 3 | module B = Gccjit_bindings.Bindings (Gccjit_types_generated) 4 | 5 | let prefix = "caml" 6 | 7 | let main () = 8 | let ml_out = open_out "lib/gccjit_stubs_generated.ml" 9 | and c_out = open_out "lib/gccjit_stubs.c" in 10 | let ml_fmt = Format.formatter_of_out_channel ml_out 11 | and c_fmt = Format.formatter_of_out_channel c_out in 12 | Format.fprintf c_fmt "%s@\n" c_headers; 13 | Cstubs.write_c c_fmt ~prefix (module B); 14 | Cstubs.write_ml ml_fmt ~prefix (module B); 15 | Format.pp_print_flush ml_fmt (); 16 | Format.pp_print_flush c_fmt (); 17 | close_out ml_out; 18 | close_out c_out 19 | 20 | let () = main () 21 | -------------------------------------------------------------------------------- /lib_gen/gen_types_generator.ml: -------------------------------------------------------------------------------- 1 | let c_headers = "#include " 2 | 3 | let main () = 4 | Format.fprintf Format.std_formatter "%s@\n" c_headers; 5 | Cstubs_structs.write_c Format.std_formatter (module Gccjit_bindings.Enums); 6 | Format.pp_print_flush Format.std_formatter () 7 | 8 | let () = main () 9 | -------------------------------------------------------------------------------- /lib_test/square.ml: -------------------------------------------------------------------------------- 1 | open Gccjit 2 | 3 | let main () = 4 | let ctx = Context.create () in 5 | 6 | (* Turn these on to get various kinds of debugging *) 7 | Context.set_option ctx Context.Dump_initial_tree true; 8 | Context.set_option ctx Context.Dump_initial_gimple true; 9 | Context.set_option ctx Context.Dump_generated_code true; 10 | 11 | (* Adjust this to control optimization level of the generated code *) 12 | Context.set_option ctx Context.Optimization_level 3; 13 | 14 | (* Create parameter "i" *) 15 | let param_i = Param.create ctx Type.(get ctx Int) "i" in 16 | 17 | (* Create the function *) 18 | let fn = Function.create ctx Function.Exported Type.(get ctx Int) "square" [ param_i ] in 19 | 20 | (* Create a basic block within the function *) 21 | let block = Block.create fn in 22 | 23 | (* This basic block is relatively simple *) 24 | let expr = RValue.binary_op ctx Mult Type.(get ctx Int) (RValue.param param_i) (RValue.param param_i) in 25 | 26 | Block.return block expr; 27 | 28 | (* Having populated the context, compile it *) 29 | let res = Context.compile ctx in 30 | 31 | (* Look up a specific machine code routine within the gccjit.Result, in this 32 | case, the function we created above: *) 33 | let callable = Result.code res "square" Ctypes.(int @-> returning int) in 34 | 35 | (* Now try running the code *) 36 | assert (25 = callable 5) 37 | 38 | let _ = 39 | main () 40 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | 3 | let ctypes_lib = let ctypes = Findlib.query "ctypes" in ctypes.Findlib.location 4 | let ocaml_stdlib = run_and_read "ocamlfind printconf stdlib" 5 | let cc = "cc" (* C compiler *) 6 | 7 | let c_headers tag dir = 8 | flag [ "compile"; "c"; tag ] (S [ A "-I"; P dir ]) 9 | 10 | let libgccjit_dir = 11 | try S [A "-L"; P (Sys.getenv "LIBGCCJIT_DIR")] with Not_found -> N 12 | 13 | let ldopt = 14 | try S [A "-ccopt"; A "-L"; A"-ccopt"; P (Sys.getenv "LIBGCCJIT_DIR")] with Not_found -> N 15 | 16 | let () = 17 | dispatch begin function 18 | | Before_options -> 19 | Options.use_ocamlfind := true 20 | | After_rules -> 21 | rule "gccjit c types generator" 22 | ~dep:"lib_gen/gen_types_generator.byte" 23 | ~prod:"lib_gen/gccjit_types_generator.c" 24 | (fun _ _ -> Cmd (S [P "lib_gen/gen_types_generator.byte"; Sh ">"; A "lib_gen/gccjit_types_generator.c"])); 25 | 26 | rule "gccjit bin types generator" 27 | ~dep:"lib_gen/gccjit_types_generator.o" 28 | ~prod:"lib_gen/gccjit_types_generator" 29 | (fun _ _ -> 30 | Cmd (S [P cc; A "-o"; P "lib_gen/gccjit_types_generator"; A "lib_gen/gccjit_types_generator.o"])); 31 | 32 | rule "gccjit ml generated types" 33 | ~dep:"lib_gen/gccjit_types_generator" 34 | ~prod:"lib/gccjit_types_generated.ml" 35 | (fun _ _ -> Cmd (S [P "lib_gen/gccjit_types_generator"; Sh ">"; A "lib/gccjit_types_generated.ml"])); 36 | 37 | rule "gccjit c & ml generated stubs" 38 | ~deps:["lib/gccjit_types_generated.ml"; "lib_gen/gen_stubs.byte"] 39 | ~prods:["lib/gccjit_stubs_generated.ml"; "lib/gccjit_stubs.c"] 40 | (fun _ _ -> Cmd (S [P "lib_gen/gen_stubs.byte"])); 41 | 42 | c_headers "use_ctypes" ctypes_lib; 43 | c_headers "use_ocaml" ocaml_stdlib; 44 | 45 | flag [ "c"; "ocamlmklib"; "use_gccjit" ] (S [libgccjit_dir; A "-lgccjit"]); 46 | 47 | flag [ "ocaml"; "link"; "use_gccjit"; "byte" ] (S [A"-dllib"; A"-lgccjit_stubs"]); 48 | 49 | flag [ "ocaml"; "link"; "use_gccjit"; "library"; "native" ] 50 | (S [ A "-cclib"; A "-lgccjit_stubs"; ldopt; A "-cclib"; A"-lgccjit"]); 51 | 52 | | _ -> 53 | () 54 | end 55 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "Nicolas Ojeda Bar " 3 | authors: "Nicolas Ojeda Bar " 4 | homepage: "https://www.github.com/nojb/ocaml-gccjit" 5 | bug-reports: "https://www.github.com/nojb/ocaml-gccjit/issues" 6 | license: "MIT" 7 | dev-repo: "https://www.github.com/nojb/ocaml-gccjit.git" 8 | build: [make] 9 | build-doc: [make "doc"] 10 | depends: [ 11 | "ctypes" {>= "0.4"} 12 | "ocamlfind" {build} 13 | ] 14 | available: [ocaml-version >= "4.01.0"] 15 | depexts: [ 16 | ["linux" "source"] 17 | ["https://gist.githubusercontent.com/nojb/774a5debc6ffcc4acb99/raw/e4e57b14826b03a522c08bbd5cfac891aefe649a/install-libgccjit-from-source.sh"] 18 | ] 19 | post-messages: [ 20 | 21 | "In order for compilation to be successful the library `libgccjit` needs to be 22 | found by the C compiler using the `-lgccjit` flag. If the `libgccjit` library in 23 | your system is a non-standard location, please set the `LIBGCCJIT_DIR` environment 24 | variable before installing this package, like this: 25 | 26 | ``` 27 | LIBGCCJIT_DIR= opam install gccjit 28 | ``` 29 | 30 | See https://gcc.gnu.org/wiki/JIT for instructions how to build `libgccjit`. 31 | " {failure} 32 | 33 | ] 34 | --------------------------------------------------------------------------------