1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1996 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16(* Link a set of .cmo files and produce a bytecode executable. *) 17 18open Misc 19open Config 20open Cmo_format 21 22type error = 23 File_not_found of string 24 | Not_an_object_file of string 25 | Wrong_object_name of string 26 | Symbol_error of string * Symtable.error 27 | Inconsistent_import of string * string * string 28 | Custom_runtime 29 | File_exists of string 30 | Cannot_open_dll of string 31 | Not_compatible_32 32 | Required_module_unavailable of string 33 34exception Error of error 35 36type link_action = 37 Link_object of string * compilation_unit 38 (* Name of .cmo file and descriptor of the unit *) 39 | Link_archive of string * compilation_unit list 40 (* Name of .cma file and descriptors of the units to be linked. *) 41 42(* Add C objects and options from a library descriptor *) 43(* Ignore them if -noautolink or -use-runtime or -use-prim was given *) 44 45let lib_ccobjs = ref [] 46let lib_ccopts = ref [] 47let lib_dllibs = ref [] 48 49let add_ccobjs origin l = 50 if not !Clflags.no_auto_link then begin 51 if 52 String.length !Clflags.use_runtime = 0 53 && String.length !Clflags.use_prims = 0 54 then begin 55 if l.lib_custom then Clflags.custom_runtime := true; 56 lib_ccobjs := l.lib_ccobjs @ !lib_ccobjs; 57 let replace_origin = 58 Misc.replace_substring ~before:"$CAMLORIGIN" ~after:origin 59 in 60 lib_ccopts := List.map replace_origin l.lib_ccopts @ !lib_ccopts; 61 end; 62 lib_dllibs := l.lib_dllibs @ !lib_dllibs 63 end 64 65(* A note on ccobj ordering: 66 - Clflags.ccobjs is in reverse order w.r.t. what was given on the 67 ocamlc command line; 68 - l.lib_ccobjs is also in reverse order w.r.t. what was given on the 69 ocamlc -a command line when the library was created; 70 - Clflags.ccobjs is reversed just before calling the C compiler for the 71 custom link; 72 - .cma files on the command line of ocamlc are scanned right to left; 73 - Before linking, we add lib_ccobjs after Clflags.ccobjs. 74 Thus, for ocamlc a.cma b.cma obj1 obj2 75 where a.cma was built with ocamlc -i ... obja1 obja2 76 and b.cma was built with ocamlc -i ... objb1 objb2 77 lib_ccobjs starts as [], 78 becomes objb2 objb1 when b.cma is scanned, 79 then obja2 obja1 objb2 objb1 when a.cma is scanned. 80 Clflags.ccobjs was initially obj2 obj1. 81 and is set to obj2 obj1 obja2 obja1 objb2 objb1. 82 Finally, the C compiler is given objb1 objb2 obja1 obja2 obj1 obj2, 83 which is what we need. (If b depends on a, a.cma must appear before 84 b.cma, but b's C libraries must appear before a's C libraries.) 85*) 86 87(* First pass: determine which units are needed *) 88 89module IdentSet = Lambda.IdentSet 90 91let missing_globals = ref IdentSet.empty 92 93let is_required (rel, _pos) = 94 match rel with 95 Reloc_setglobal id -> 96 IdentSet.mem id !missing_globals 97 | _ -> false 98 99let add_required compunit = 100 let add_required_by_reloc (rel, _pos) = 101 match rel with 102 Reloc_getglobal id -> 103 missing_globals := IdentSet.add id !missing_globals 104 | _ -> () 105 in 106 let add_required_for_effects id = 107 missing_globals := IdentSet.add id !missing_globals 108 in 109 List.iter add_required_by_reloc compunit.cu_reloc; 110 List.iter add_required_for_effects compunit.cu_required_globals 111 112let remove_required (rel, _pos) = 113 match rel with 114 Reloc_setglobal id -> 115 missing_globals := IdentSet.remove id !missing_globals 116 | _ -> () 117 118let scan_file obj_name tolink = 119 let file_name = 120 try 121 find_in_path !load_path obj_name 122 with Not_found -> 123 raise(Error(File_not_found obj_name)) in 124 let ic = open_in_bin file_name in 125 try 126 let buffer = really_input_string ic (String.length cmo_magic_number) in 127 if buffer = cmo_magic_number then begin 128 (* This is a .cmo file. It must be linked in any case. 129 Read the relocation information to see which modules it 130 requires. *) 131 let compunit_pos = input_binary_int ic in (* Go to descriptor *) 132 seek_in ic compunit_pos; 133 let compunit = (input_value ic : compilation_unit) in 134 close_in ic; 135 add_required compunit; 136 List.iter remove_required compunit.cu_reloc; 137 Link_object(file_name, compunit) :: tolink 138 end 139 else if buffer = cma_magic_number then begin 140 (* This is an archive file. Each unit contained in it will be linked 141 in only if needed. *) 142 let pos_toc = input_binary_int ic in (* Go to table of contents *) 143 seek_in ic pos_toc; 144 let toc = (input_value ic : library) in 145 close_in ic; 146 add_ccobjs (Filename.dirname file_name) toc; 147 let required = 148 List.fold_right 149 (fun compunit reqd -> 150 if compunit.cu_force_link 151 || !Clflags.link_everything 152 || List.exists is_required compunit.cu_reloc 153 then begin 154 add_required compunit; 155 List.iter remove_required compunit.cu_reloc; 156 compunit :: reqd 157 end else 158 reqd) 159 toc.lib_units [] in 160 Link_archive(file_name, required) :: tolink 161 end 162 else raise(Error(Not_an_object_file file_name)) 163 with 164 End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name)) 165 | x -> close_in ic; raise x 166 167(* Second pass: link in the required units *) 168 169(* Consistency check between interfaces *) 170 171let crc_interfaces = Consistbl.create () 172let interfaces = ref ([] : string list) 173let implementations_defined = ref ([] : (string * string) list) 174 175let check_consistency ppf file_name cu = 176 begin try 177 List.iter 178 (fun (name, crco) -> 179 interfaces := name :: !interfaces; 180 match crco with 181 None -> () 182 | Some crc -> 183 if name = cu.cu_name 184 then Consistbl.set crc_interfaces name crc file_name 185 else Consistbl.check crc_interfaces name crc file_name) 186 cu.cu_imports 187 with Consistbl.Inconsistency(name, user, auth) -> 188 raise(Error(Inconsistent_import(name, user, auth))) 189 end; 190 begin try 191 let source = List.assoc cu.cu_name !implementations_defined in 192 Location.print_warning (Location.in_file file_name) ppf 193 (Warnings.Multiple_definition(cu.cu_name, 194 Location.show_filename file_name, 195 Location.show_filename source)) 196 with Not_found -> () 197 end; 198 implementations_defined := 199 (cu.cu_name, file_name) :: !implementations_defined 200 201let extract_crc_interfaces () = 202 Consistbl.extract !interfaces crc_interfaces 203 204let clear_crc_interfaces () = 205 Consistbl.clear crc_interfaces; 206 interfaces := [] 207 208(* Record compilation events *) 209 210let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list) 211 212(* Link in a compilation unit *) 213 214let link_compunit ppf output_fun currpos_fun inchan file_name compunit = 215 check_consistency ppf file_name compunit; 216 seek_in inchan compunit.cu_pos; 217 let code_block = LongString.input_bytes inchan compunit.cu_codesize in 218 Symtable.ls_patch_object code_block compunit.cu_reloc; 219 if !Clflags.debug && compunit.cu_debug > 0 then begin 220 seek_in inchan compunit.cu_debug; 221 let debug_event_list : Instruct.debug_event list = input_value inchan in 222 let debug_dirs : string list = input_value inchan in 223 let file_path = Filename.dirname (Location.absolute_path file_name) in 224 let debug_dirs = 225 if List.mem file_path debug_dirs 226 then debug_dirs 227 else file_path :: debug_dirs in 228 debug_info := (currpos_fun(), debug_event_list, debug_dirs) :: !debug_info 229 end; 230 Array.iter output_fun code_block; 231 if !Clflags.link_everything then 232 List.iter Symtable.require_primitive compunit.cu_primitives 233 234(* Link in a .cmo file *) 235 236let link_object ppf output_fun currpos_fun file_name compunit = 237 let inchan = open_in_bin file_name in 238 try 239 link_compunit ppf output_fun currpos_fun inchan file_name compunit; 240 close_in inchan 241 with 242 Symtable.Error msg -> 243 close_in inchan; raise(Error(Symbol_error(file_name, msg))) 244 | x -> 245 close_in inchan; raise x 246 247(* Link in a .cma file *) 248 249let link_archive ppf output_fun currpos_fun file_name units_required = 250 let inchan = open_in_bin file_name in 251 try 252 List.iter 253 (fun cu -> 254 let name = file_name ^ "(" ^ cu.cu_name ^ ")" in 255 try 256 link_compunit ppf output_fun currpos_fun inchan name cu 257 with Symtable.Error msg -> 258 raise(Error(Symbol_error(name, msg)))) 259 units_required; 260 close_in inchan 261 with x -> close_in inchan; raise x 262 263(* Link in a .cmo or .cma file *) 264 265let link_file ppf output_fun currpos_fun = function 266 Link_object(file_name, unit) -> 267 link_object ppf output_fun currpos_fun file_name unit 268 | Link_archive(file_name, units) -> 269 link_archive ppf output_fun currpos_fun file_name units 270 271(* Output the debugging information *) 272(* Format is: 273 <int32> number of event lists 274 <int32> offset of first event list 275 <output_value> first event list 276 ... 277 <int32> offset of last event list 278 <output_value> last event list *) 279 280let output_debug_info oc = 281 output_binary_int oc (List.length !debug_info); 282 List.iter 283 (fun (ofs, evl, debug_dirs) -> 284 output_binary_int oc ofs; 285 output_value oc evl; 286 output_value oc debug_dirs) 287 !debug_info; 288 debug_info := [] 289 290(* Output a list of strings with 0-termination *) 291 292let output_stringlist oc l = 293 List.iter (fun s -> output_string oc s; output_byte oc 0) l 294 295(* Transform a file name into an absolute file name *) 296 297let make_absolute file = 298 if Filename.is_relative file 299 then Filename.concat (Sys.getcwd()) file 300 else file 301 302(* Create a bytecode executable file *) 303 304let link_bytecode ppf tolink exec_name standalone = 305 (* Avoid the case where the specified exec output file is the same as 306 one of the objects to be linked *) 307 List.iter (function 308 | Link_object(file_name, _) when file_name = exec_name -> 309 raise (Error (Wrong_object_name exec_name)); 310 | _ -> ()) tolink; 311 Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *) 312 let outchan = 313 open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] 314 0o777 exec_name in 315 try 316 if standalone then begin 317 (* Copy the header *) 318 try 319 let header = 320 if String.length !Clflags.use_runtime > 0 321 then "camlheader_ur" else "camlheader" ^ !Clflags.runtime_variant in 322 let inchan = open_in_bin (find_in_path !load_path header) in 323 copy_file inchan outchan; 324 close_in inchan 325 with Not_found | Sys_error _ -> () 326 end; 327 Bytesections.init_record outchan; 328 (* The path to the bytecode interpreter (in use_runtime mode) *) 329 if String.length !Clflags.use_runtime > 0 then begin 330 output_string outchan (make_absolute !Clflags.use_runtime); 331 output_char outchan '\n'; 332 Bytesections.record outchan "RNTM" 333 end; 334 (* The bytecode *) 335 let start_code = pos_out outchan in 336 Symtable.init(); 337 clear_crc_interfaces (); 338 let sharedobjs = List.map Dll.extract_dll_name !Clflags.dllibs in 339 let check_dlls = standalone && Config.target = Config.host in 340 if check_dlls then begin 341 (* Initialize the DLL machinery *) 342 Dll.init_compile !Clflags.no_std_include; 343 Dll.add_path !load_path; 344 try Dll.open_dlls Dll.For_checking sharedobjs 345 with Failure reason -> raise(Error(Cannot_open_dll reason)) 346 end; 347 let output_fun = output_bytes outchan 348 and currpos_fun () = pos_out outchan - start_code in 349 List.iter (link_file ppf output_fun currpos_fun) tolink; 350 if check_dlls then Dll.close_all_dlls(); 351 (* The final STOP instruction *) 352 output_byte outchan Opcodes.opSTOP; 353 output_byte outchan 0; output_byte outchan 0; output_byte outchan 0; 354 Bytesections.record outchan "CODE"; 355 (* DLL stuff *) 356 if standalone then begin 357 (* The extra search path for DLLs *) 358 output_stringlist outchan !Clflags.dllpaths; 359 Bytesections.record outchan "DLPT"; 360 (* The names of the DLLs *) 361 output_stringlist outchan sharedobjs; 362 Bytesections.record outchan "DLLS" 363 end; 364 (* The names of all primitives *) 365 Symtable.output_primitive_names outchan; 366 Bytesections.record outchan "PRIM"; 367 (* The table of global data *) 368 begin try 369 Marshal.to_channel outchan (Symtable.initial_global_table()) 370 (if !Clflags.bytecode_compatible_32 371 then [Marshal.Compat_32] else []) 372 with Failure _ -> 373 raise (Error Not_compatible_32) 374 end; 375 Bytesections.record outchan "DATA"; 376 (* The map of global identifiers *) 377 Symtable.output_global_map outchan; 378 Bytesections.record outchan "SYMB"; 379 (* CRCs for modules *) 380 output_value outchan (extract_crc_interfaces()); 381 Bytesections.record outchan "CRCS"; 382 (* Debug info *) 383 if !Clflags.debug then begin 384 output_debug_info outchan; 385 Bytesections.record outchan "DBUG" 386 end; 387 (* The table of contents and the trailer *) 388 Bytesections.write_toc_and_trailer outchan; 389 close_out outchan 390 with x -> 391 close_out outchan; 392 remove_file exec_name; 393 raise x 394 395(* Output a string as a C array of unsigned ints *) 396 397let output_code_string_counter = ref 0 398 399let output_code_string outchan code = 400 let pos = ref 0 in 401 let len = Bytes.length code in 402 while !pos < len do 403 let c1 = Char.code(Bytes.get code !pos) in 404 let c2 = Char.code(Bytes.get code (!pos + 1)) in 405 let c3 = Char.code(Bytes.get code (!pos + 2)) in 406 let c4 = Char.code(Bytes.get code (!pos + 3)) in 407 pos := !pos + 4; 408 Printf.fprintf outchan "0x%02x%02x%02x%02x, " c4 c3 c2 c1; 409 incr output_code_string_counter; 410 if !output_code_string_counter >= 6 then begin 411 output_char outchan '\n'; 412 output_code_string_counter := 0 413 end 414 done 415 416(* Output a string as a C string *) 417 418let output_data_string outchan data = 419 let counter = ref 0 in 420 for i = 0 to String.length data - 1 do 421 Printf.fprintf outchan "%d, " (Char.code(data.[i])); 422 incr counter; 423 if !counter >= 12 then begin 424 output_string outchan "\n"; 425 counter := 0 426 end 427 done 428 429(* Output a debug stub *) 430 431let output_cds_file outfile = 432 Misc.remove_file outfile; 433 let outchan = 434 open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] 435 0o777 outfile in 436 try 437 Bytesections.init_record outchan; 438 (* The map of global identifiers *) 439 Symtable.output_global_map outchan; 440 Bytesections.record outchan "SYMB"; 441 (* Debug info *) 442 output_debug_info outchan; 443 Bytesections.record outchan "DBUG"; 444 (* The table of contents and the trailer *) 445 Bytesections.write_toc_and_trailer outchan; 446 close_out outchan 447 with x -> 448 close_out outchan; 449 remove_file outfile; 450 raise x 451 452(* Output a bytecode executable as a C file *) 453 454let link_bytecode_as_c ppf tolink outfile = 455 let outchan = open_out outfile in 456 begin try 457 (* The bytecode *) 458 output_string outchan "\ 459#ifdef __cplusplus\ 460\nextern \"C\" {\ 461\n#endif\ 462\n#include <caml/mlvalues.h>\ 463\nCAMLextern void caml_startup_code(\ 464\n code_t code, asize_t code_size,\ 465\n char *data, asize_t data_size,\ 466\n char *section_table, asize_t section_table_size,\ 467\n char **argv);\n"; 468 output_string outchan "static int caml_code[] = {\n"; 469 Symtable.init(); 470 clear_crc_interfaces (); 471 let currpos = ref 0 in 472 let output_fun code = 473 output_code_string outchan code; 474 currpos := !currpos + Bytes.length code 475 and currpos_fun () = !currpos in 476 List.iter (link_file ppf output_fun currpos_fun) tolink; 477 (* The final STOP instruction *) 478 Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP; 479 (* The table of global data *) 480 output_string outchan "static char caml_data[] = {\n"; 481 output_data_string outchan 482 (Marshal.to_string (Symtable.initial_global_table()) []); 483 output_string outchan "\n};\n\n"; 484 (* The sections *) 485 let sections = 486 [ "SYMB", Symtable.data_global_map(); 487 "PRIM", Obj.repr(Symtable.data_primitive_names()); 488 "CRCS", Obj.repr(extract_crc_interfaces()) ] in 489 output_string outchan "static char caml_sections[] = {\n"; 490 output_data_string outchan 491 (Marshal.to_string sections []); 492 output_string outchan "\n};\n\n"; 493 (* The table of primitives *) 494 Symtable.output_primitive_table outchan; 495 (* The entry point *) 496 output_string outchan "\ 497\nvoid caml_startup(char ** argv)\ 498\n{\ 499\n caml_startup_code(caml_code, sizeof(caml_code),\ 500\n caml_data, sizeof(caml_data),\ 501\n caml_sections, sizeof(caml_sections),\ 502\n argv);\ 503\n}\ 504\nvalue caml_startup_exn(char ** argv)\ 505\n{\ 506\n return caml_startup_code_exn(caml_code, sizeof(caml_code),\ 507\n caml_data, sizeof(caml_data),\ 508\n caml_sections, sizeof(caml_sections),\ 509\n argv);\ 510\n}\ 511\n#ifdef __cplusplus\ 512\n}\ 513\n#endif\n"; 514 close_out outchan 515 with x -> 516 close_out outchan; 517 remove_file outfile; 518 raise x 519 end; 520 if !Clflags.debug then 521 output_cds_file ((Filename.chop_extension outfile) ^ ".cds") 522 523(* Build a custom runtime *) 524 525let build_custom_runtime prim_name exec_name = 526 let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in 527 Ccomp.call_linker Ccomp.Exe exec_name 528 ([prim_name] @ List.rev !Clflags.ccobjs @ [runtime_lib]) 529 (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries) 530 531let append_bytecode_and_cleanup bytecode_name exec_name prim_name = 532 let oc = open_out_gen [Open_wronly; Open_append; Open_binary] 0 exec_name in 533 let ic = open_in_bin bytecode_name in 534 copy_file ic oc; 535 close_in ic; 536 close_out oc; 537 remove_file bytecode_name; 538 remove_file prim_name 539 540(* Fix the name of the output file, if the C compiler changes it behind 541 our back. *) 542 543let fix_exec_name name = 544 match Sys.os_type with 545 "Win32" | "Cygwin" -> 546 if String.contains name '.' then name else name ^ ".exe" 547 | _ -> name 548 549(* Main entry point (build a custom runtime if needed) *) 550 551let link ppf objfiles output_name = 552 let objfiles = 553 if !Clflags.nopervasives then objfiles 554 else if !Clflags.output_c_object then "stdlib.cma" :: objfiles 555 else "stdlib.cma" :: (objfiles @ ["std_exit.cmo"]) in 556 let tolink = List.fold_right scan_file objfiles [] in 557 let missing_modules = 558 IdentSet.filter (fun id -> not (Ident.is_predef_exn id)) !missing_globals 559 in 560 begin 561 match IdentSet.elements missing_modules with 562 | [] -> () 563 | id :: _ -> raise (Error (Required_module_unavailable (Ident.name id))) 564 end; 565 Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *) 566 Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; 567 (* put user's opts first *) 568 Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *) 569 if not !Clflags.custom_runtime then 570 link_bytecode ppf tolink output_name true 571 else if not !Clflags.output_c_object then begin 572 let bytecode_name = Filename.temp_file "camlcode" "" in 573 let prim_name = Filename.temp_file "camlprim" ".c" in 574 try 575 link_bytecode ppf tolink bytecode_name false; 576 let poc = open_out prim_name in 577 output_string poc "\ 578 #ifdef __cplusplus\n\ 579 extern \"C\" {\n\ 580 #endif\n\ 581 #ifdef _WIN64\n\ 582 #ifdef __MINGW32__\n\ 583 typedef long long value;\n\ 584 #else\n\ 585 typedef __int64 value;\n\ 586 #endif\n\ 587 #else\n\ 588 typedef long value;\n\ 589 #endif\n"; 590 Symtable.output_primitive_table poc; 591 output_string poc "\ 592 #ifdef __cplusplus\n\ 593 }\n\ 594 #endif\n"; 595 close_out poc; 596 let exec_name = fix_exec_name output_name in 597 if not (build_custom_runtime prim_name exec_name) 598 then raise(Error Custom_runtime); 599 if !Clflags.make_runtime 600 then (remove_file bytecode_name; remove_file prim_name) 601 else append_bytecode_and_cleanup bytecode_name exec_name prim_name 602 with x -> 603 remove_file bytecode_name; 604 remove_file prim_name; 605 raise x 606 end else begin 607 let basename = Filename.chop_extension output_name in 608 let c_file = 609 if !Clflags.output_complete_object 610 then Filename.temp_file "camlobj" ".c" 611 else basename ^ ".c" 612 and obj_file = 613 if !Clflags.output_complete_object 614 then Filename.temp_file "camlobj" Config.ext_obj 615 else basename ^ Config.ext_obj 616 in 617 if Sys.file_exists c_file then raise(Error(File_exists c_file)); 618 let temps = ref [] in 619 try 620 link_bytecode_as_c ppf tolink c_file; 621 if not (Filename.check_suffix output_name ".c") then begin 622 temps := c_file :: !temps; 623 if Ccomp.compile_file c_file <> 0 then 624 raise(Error Custom_runtime); 625 if not (Filename.check_suffix output_name Config.ext_obj) || 626 !Clflags.output_complete_object then begin 627 temps := obj_file :: !temps; 628 let mode, c_libs = 629 if Filename.check_suffix output_name Config.ext_obj 630 then Ccomp.Partial, "" 631 else Ccomp.MainDll, Config.bytecomp_c_libraries 632 in 633 if not ( 634 let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in 635 Ccomp.call_linker mode output_name 636 ([obj_file] @ List.rev !Clflags.ccobjs @ [runtime_lib]) 637 c_libs 638 ) then raise (Error Custom_runtime); 639 end 640 end; 641 List.iter remove_file !temps 642 with x -> 643 List.iter remove_file !temps; 644 raise x 645 end 646 647(* Error report *) 648 649open Format 650 651let report_error ppf = function 652 | File_not_found name -> 653 fprintf ppf "Cannot find file %a" Location.print_filename name 654 | Not_an_object_file name -> 655 fprintf ppf "The file %a is not a bytecode object file" 656 Location.print_filename name 657 | Wrong_object_name name -> 658 fprintf ppf "The output file %s has the wrong name. The extension implies\ 659 \ an object file but the link step was requested" name 660 | Symbol_error(name, err) -> 661 fprintf ppf "Error while linking %a:@ %a" Location.print_filename name 662 Symtable.report_error err 663 | Inconsistent_import(intf, file1, file2) -> 664 fprintf ppf 665 "@[<hov>Files %a@ and %a@ \ 666 make inconsistent assumptions over interface %s@]" 667 Location.print_filename file1 668 Location.print_filename file2 669 intf 670 | Custom_runtime -> 671 fprintf ppf "Error while building custom runtime system" 672 | File_exists file -> 673 fprintf ppf "Cannot overwrite existing file %a" 674 Location.print_filename file 675 | Cannot_open_dll file -> 676 fprintf ppf "Error on dynamically loaded library: %a" 677 Location.print_filename file 678 | Not_compatible_32 -> 679 fprintf ppf "Generated bytecode executable cannot be run\ 680 \ on a 32-bit platform" 681 | Required_module_unavailable s -> 682 fprintf ppf "Required module `%s' is unavailable" s 683 684let () = 685 Location.register_error_of_exn 686 (function 687 | Error err -> Some (Location.error_of_printer_file report_error err) 688 | _ -> None 689 ) 690 691let reset () = 692 lib_ccobjs := []; 693 lib_ccopts := []; 694 lib_dllibs := []; 695 missing_globals := IdentSet.empty; 696 Consistbl.clear crc_interfaces; 697 implementations_defined := []; 698 debug_info := []; 699 output_code_string_counter := 0 700