-
Notifications
You must be signed in to change notification settings - Fork 94
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add first-class support for cross-compiling.
Specifically, do not try to run any freshly compiled binaries. Instead, let compiler run the expansions and calculations whose result we need, put it into .rodata surrounded by markers, and then extract that.
- Loading branch information
1 parent
b40107d
commit cb8291d
Showing
7 changed files
with
217 additions
and
195 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,100 @@ | ||
| (* | ||
| * Copyright (c) 2016 whitequark. | ||
| * | ||
| * This file is distributed under the terms of the MIT License. | ||
| * See the file LICENSE for details. | ||
| *) | ||
|
|
||
| let getenv ~default name = | ||
| try Sys.getenv name | ||
| with Not_found -> default | ||
|
|
||
| let nsplit sep str = Str.(split (regexp_string sep)) str | ||
|
|
||
| let read_output program = | ||
| let input_filename = Filename.temp_file "ctypes_libffi_config" ".c" in | ||
| let channel = open_out input_filename in | ||
| output_string channel program; | ||
| close_out channel; | ||
| let output_filename = (Filename.chop_suffix input_filename ".c") ^ ".o" in | ||
| let cwd = Sys.getcwd () in | ||
| let cmd = | ||
| Printf.sprintf "%s ocamlc -verbose %s %s -c 1>&2" | ||
| (getenv ~default:"ocamlfind" "OCAMLFIND") | ||
| ((getenv ~default:"" "CFLAGS") |> | ||
| (nsplit " ") |> | ||
| (List.map (fun s -> "-ccopt '"^s^"'")) |> | ||
| (String.concat " ")) | ||
| input_filename | ||
| in | ||
| prerr_endline cmd; | ||
| Sys.chdir (Filename.dirname input_filename); | ||
| ignore (Sys.command cmd); | ||
| Sys.chdir cwd; | ||
| Sys.remove input_filename; | ||
| if not (Sys.file_exists output_filename) then | ||
| raise Not_found; | ||
| let channel = open_in_bin output_filename in | ||
| let length = in_channel_length channel in | ||
| let result = Bytes.create length in | ||
| really_input channel result 0 length; | ||
| close_in channel; | ||
| Sys.remove output_filename; | ||
| result | ||
|
|
||
| let find_from haystack pos needle = Str.(search_forward (regexp_string needle) haystack pos) | ||
|
|
||
| let prefix = Bytes.of_string "BEGIN-" | ||
| let suffix = Bytes.of_string "-END" | ||
| let extract bytes = | ||
| let begin_pos = find_from bytes 0 prefix + Bytes.length prefix in | ||
| let end_pos = find_from bytes 0 suffix in | ||
| Bytes.to_string (Bytes.sub bytes begin_pos (end_pos - begin_pos)) | ||
|
|
||
| let headers = "\ | ||
| #include <stdint.h> | ||
| #include <stdbool.h> | ||
| #include <complex.h> | ||
| #include <inttypes.h> | ||
| #include <caml/mlvalues.h> | ||
| #include <ffi.h> | ||
| " | ||
|
|
||
| let integer expression = | ||
| let code = Printf.sprintf "%s | ||
| #define alignof(T) (offsetof(struct { char c; T t; }, t)) | ||
| #define D0(x) ('0'+(x/1 )%%10) | ||
| #define D1(x) ('0'+(x/10 )%%10), D0(x) | ||
| #define D2(x) ('0'+(x/100 )%%10), D1(x) | ||
| #define D3(x) ('0'+(x/1000 )%%10), D2(x) | ||
| #define D4(x) ('0'+(x/10000 )%%10), D3(x) | ||
| #define D5(x) ('0'+(x/100000 )%%10), D4(x) | ||
| #define D6(x) ('0'+(x/1000000 )%%10), D5(x) | ||
| #define D7(x) ('0'+(x/10000000 )%%10), D6(x) | ||
| #define D8(x) ('0'+(x/100000000 )%%10), D7(x) | ||
| #define D9(x) ('0'+(x/1000000000)%%10), D8(x) | ||
| const char s[] = { | ||
| 'B', 'E', 'G', 'I', 'N', '-', | ||
| D9((%s)), | ||
| '-', 'E', 'N', 'D' | ||
| }; | ||
| " headers expression in | ||
| int_of_string (extract (read_output code)) | ||
|
|
||
| let string expression = | ||
| let code = Printf.sprintf "%s | ||
| #define STRINGIFY1(x) #x | ||
| #define STRINGIFY(x) STRINGIFY1(x) | ||
| #if __USE_MINGW_ANSI_STDIO && defined(__MINGW64__) | ||
| #define REAL_ARCH_INTNAT_PRINTF_FORMAT \"ll\" | ||
| #else | ||
| #define REAL_ARCH_INTNAT_PRINTF_FORMAT ARCH_INTNAT_PRINTF_FORMAT | ||
| #endif | ||
| const char *s = \"BEGIN-\" %s \"-END\"; | ||
| " headers expression in | ||
| extract (read_output code) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,96 @@ | ||
| let header ="\ | ||
| (* | ||
| * Copyright (c) 2016 whitequark | ||
| * | ||
| * This file is distributed under the terms of the MIT License. | ||
| * See the file LICENSE for details. | ||
| *) | ||
| open Ctypes_primitive_types | ||
| " | ||
|
|
||
| type c_format = | ||
| | No_format | ||
| | Known_format of string | ||
| | Defined_format of string | ||
|
|
||
| type c_primitive = { | ||
| constructor : string; | ||
| typ : string; | ||
| format : c_format; | ||
| size : string; | ||
| alignment : string; | ||
| } | ||
|
|
||
| let c_primitive constructor typ format = | ||
| { constructor; typ; format; | ||
| size = "sizeof("^typ^")"; | ||
| alignment = "alignof("^typ^")"; } | ||
|
|
||
| let c_primitives = [ | ||
| c_primitive "Char" "char" (Known_format "d"); | ||
| c_primitive "Schar" "signed char" (Known_format "d"); | ||
| c_primitive "Uchar" "unsigned char" (Known_format "d"); | ||
| c_primitive "Bool" "bool" (Known_format "d"); | ||
| c_primitive "Short" "short" (Known_format "hd"); | ||
| c_primitive "Int" "int" (Known_format "d"); | ||
| c_primitive "Long" "long" (Known_format "ld"); | ||
| c_primitive "Llong" "long long" (Known_format "lld"); | ||
| c_primitive "Ushort" "unsigned short" (Known_format "hu"); | ||
| c_primitive "Uint" "unsigned int" (Known_format "u"); | ||
| c_primitive "Ulong" "unsigned long" (Known_format "lu"); | ||
| c_primitive "Ullong" "unsigned long long" (Known_format "llu"); | ||
| c_primitive "Size_t" "size_t" (Known_format "zu"); | ||
| c_primitive "Int8_t" "int8_t" (Defined_format "PRId8"); | ||
| c_primitive "Int16_t" "int16_t" (Defined_format "PRId16"); | ||
| c_primitive "Int32_t" "int32_t" (Defined_format "PRId32"); | ||
| c_primitive "Int64_t" "int64_t" (Defined_format "PRId64"); | ||
| c_primitive "Uint8_t" "uint8_t" (Defined_format "PRIu8"); | ||
| c_primitive "Uint16_t" "uint16_t" (Defined_format "PRIu16"); | ||
| c_primitive "Uint32_t" "uint32_t" (Defined_format "PRIu32"); | ||
| c_primitive "Uint64_t" "uint64_t" (Defined_format "PRIu64"); | ||
| c_primitive "Float" "float" (Known_format ".12g"); | ||
| c_primitive "Double" "double" (Known_format ".12g"); | ||
| c_primitive "Complex32" "float complex" (No_format); | ||
| c_primitive "Complex64" "double complex" (No_format); | ||
| c_primitive "Nativeint" "intnat" (Defined_format "REAL_ARCH_INTNAT_PRINTF_FORMAT \"d\""); | ||
| { constructor = "Camlint"; | ||
| typ = "camlint"; | ||
| format = Defined_format "REAL_ARCH_INTNAT_PRINTF_FORMAT \"d\""; | ||
| size = "sizeof(intnat)"; | ||
| alignment = "alignof(intnat)" }; | ||
| ] | ||
|
|
||
| let printf = Printf.printf | ||
|
|
||
| let generate name typ f = | ||
| printf "let %s : type a. a prim -> %s = function\n" name typ; | ||
| List.iter (fun c_primitive -> | ||
| printf " | %s -> " c_primitive.constructor; | ||
| begin try | ||
| f c_primitive | ||
| with Not_found -> | ||
| failwith (name^": "^c_primitive.constructor) | ||
| end; | ||
| printf "\n") c_primitives | ||
|
|
||
| let () = | ||
| begin | ||
| print_string header; | ||
| generate "sizeof" "int" (fun { size } -> | ||
| printf "%d" (Extract_from_c.integer size)); | ||
| generate "alignment" "int" (fun { alignment } -> | ||
| printf "%d" (Extract_from_c.integer alignment)); | ||
| generate "name" "string" (fun { typ } -> | ||
| printf "%S" (Extract_from_c.string ("STRINGIFY("^typ^")"))); | ||
| generate "format_string" "string option" (fun { format } -> | ||
| match format with | ||
| | Known_format str -> | ||
| printf "Some %S" ("%"^str) | ||
| | Defined_format str -> | ||
| printf "Some %S" ("%"^Extract_from_c.string str) | ||
| | No_format -> | ||
| printf "None"); | ||
| printf "let pointer_size = %d\n" (Extract_from_c.integer "sizeof(void*)"); | ||
| printf "let pointer_alignment = %d\n" (Extract_from_c.integer "alignof(void*)"); | ||
| end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file was deleted.
Oops, something went wrong.
Oops, something went wrong.