diff options
Diffstat (limited to 'bytecomp/bytelink.ml')
| -rw-r--r-- | bytecomp/bytelink.ml | 43 |
1 files changed, 31 insertions, 12 deletions
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index a347aed77e..de7bfbfa16 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -10,8 +10,6 @@ (* *) (***********************************************************************) -(* $Id: bytelink.ml 12959 2012-09-27 13:12:51Z maranget $ *) - (* Link a set of .cmo files and produce a bytecode executable. *) open Misc @@ -21,12 +19,13 @@ open Cmo_format type error = File_not_found of string | Not_an_object_file of string + | Wrong_object_name of string | Symbol_error of string * Symtable.error | Inconsistent_import of string * string * string | Custom_runtime | File_exists of string | Cannot_open_dll of string - + | Not_compatible_32 exception Error of error @@ -175,7 +174,9 @@ let check_consistency ppf file_name cu = begin try let source = List.assoc cu.cu_name !implementations_defined in Location.print_warning (Location.in_file file_name) ppf - (Warnings.Multiple_definition(cu.cu_name, Location.show_filename file_name, Location.show_filename source)) + (Warnings.Multiple_definition(cu.cu_name, + Location.show_filename file_name, + Location.show_filename source)) with Not_found -> () end; implementations_defined := @@ -186,21 +187,21 @@ let extract_crc_interfaces () = (* Record compilation events *) -let debug_info = ref ([] : (int * string) list) +let debug_info = ref ([] : (int * LongString.t) list) (* Link in a compilation unit *) let link_compunit ppf output_fun currpos_fun inchan file_name compunit = check_consistency ppf file_name compunit; seek_in inchan compunit.cu_pos; - let code_block = input_bytes inchan compunit.cu_codesize in - Symtable.patch_object code_block compunit.cu_reloc; + let code_block = LongString.input_bytes inchan compunit.cu_codesize in + Symtable.ls_patch_object code_block compunit.cu_reloc; if !Clflags.debug && compunit.cu_debug > 0 then begin seek_in inchan compunit.cu_debug; - let buffer = input_bytes inchan compunit.cu_debugsize in + let buffer = LongString.input_bytes inchan compunit.cu_debugsize in debug_info := (currpos_fun(), buffer) :: !debug_info end; - output_fun code_block; + Array.iter output_fun code_block; if !Clflags.link_everything then List.iter Symtable.require_primitive compunit.cu_primitives @@ -253,7 +254,7 @@ let link_file ppf output_fun currpos_fun = function let output_debug_info oc = output_binary_int oc (List.length !debug_info); List.iter - (fun (ofs, evl) -> output_binary_int oc ofs; output_string oc evl) + (fun (ofs, evl) -> output_binary_int oc ofs; Array.iter (output_string oc) evl) !debug_info; debug_info := [] @@ -272,6 +273,12 @@ let make_absolute file = (* Create a bytecode executable file *) let link_bytecode ppf tolink exec_name standalone = + (* Avoid the case where the specified exec output file is the same as + one of the objects to be linked *) + List.iter (function + | Link_object(file_name, _) when file_name = exec_name -> + raise (Error (Wrong_object_name exec_name)); + | _ -> ()) tolink; Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *) let outchan = open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] @@ -328,7 +335,13 @@ let link_bytecode ppf tolink exec_name standalone = Symtable.output_primitive_names outchan; Bytesections.record outchan "PRIM"; (* The table of global data *) - output_value outchan (Symtable.initial_global_table()); + begin try + Marshal.to_channel outchan (Symtable.initial_global_table()) + (if !Clflags.bytecode_compatible_32 + then [Marshal.Compat_32] else []) + with Failure _ -> + raise (Error Not_compatible_32) + end; Bytesections.record outchan "DATA"; (* The map of global identifiers *) Symtable.output_global_map outchan; @@ -508,7 +521,7 @@ let link ppf objfiles output_name = else "stdlib.cma" :: (objfiles @ ["std_exit.cmo"]) in let tolink = List.fold_right scan_file objfiles [] in Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *) - Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* put user's opts first *) + Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; (* put user's opts first *) Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *) if not !Clflags.custom_runtime then link_bytecode ppf tolink output_name true @@ -584,6 +597,9 @@ let report_error ppf = function | Not_an_object_file name -> fprintf ppf "The file %a is not a bytecode object file" Location.print_filename name + | Wrong_object_name name -> + fprintf ppf "The output file %s has the wrong name. The extension implies\ + \ an object file but the link step was requested" name | Symbol_error(name, err) -> fprintf ppf "Error while linking %a:@ %a" Location.print_filename name Symtable.report_error err @@ -602,3 +618,6 @@ let report_error ppf = function | Cannot_open_dll file -> fprintf ppf "Error on dynamically loaded library: %a" Location.print_filename file + | Not_compatible_32 -> + fprintf ppf "Generated bytecode executable cannot be run\ + \ on a 32-bit platform" |