Complier: -compat-32 flag when building cmo/cma.

Compiler: refactor -compat-32 support

Update Changes

Complier: more -compat-32 checks in emitcode.

.depend

@@ -493,24 +493,24 @@ bytecomp/bytegen.cmx : typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \
     utils/config.cmx parsing/asttypes.cmi bytecomp/bytegen.cmi
 bytecomp/bytegen.cmi : bytecomp/lambda.cmi bytecomp/instruct.cmi
 bytecomp/bytelibrarian.cmo : utils/misc.cmi parsing/location.cmi \
-    utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \
-    bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi
+    bytecomp/emitcode.cmi utils/config.cmi bytecomp/cmo_format.cmi \
+    utils/clflags.cmi bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi
 bytecomp/bytelibrarian.cmx : utils/misc.cmx parsing/location.cmx \
-    utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \
-    bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmi
+    bytecomp/emitcode.cmx utils/config.cmx bytecomp/cmo_format.cmi \
+    utils/clflags.cmx bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmi
 bytecomp/bytelibrarian.cmi :
 bytecomp/bytelink.cmo : utils/warnings.cmi bytecomp/symtable.cmi \
     bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi \
     bytecomp/lambda.cmi bytecomp/instruct.cmi typing/ident.cmi \
-    bytecomp/dll.cmi utils/consistbl.cmi utils/config.cmi \
-    bytecomp/cmo_format.cmi utils/clflags.cmi utils/ccomp.cmi \
-    bytecomp/bytesections.cmi bytecomp/bytelink.cmi
+    bytecomp/emitcode.cmi bytecomp/dll.cmi utils/consistbl.cmi \
+    utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \
+    utils/ccomp.cmi bytecomp/bytesections.cmi bytecomp/bytelink.cmi
 bytecomp/bytelink.cmx : utils/warnings.cmx bytecomp/symtable.cmx \
     bytecomp/opcodes.cmx utils/misc.cmx parsing/location.cmx \
     bytecomp/lambda.cmx bytecomp/instruct.cmx typing/ident.cmx \
-    bytecomp/dll.cmx utils/consistbl.cmx utils/config.cmx \
-    bytecomp/cmo_format.cmi utils/clflags.cmx utils/ccomp.cmx \
-    bytecomp/bytesections.cmx bytecomp/bytelink.cmi
+    bytecomp/emitcode.cmx bytecomp/dll.cmx utils/consistbl.cmx \
+    utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \
+    utils/ccomp.cmx bytecomp/bytesections.cmx bytecomp/bytelink.cmi
 bytecomp/bytelink.cmi : bytecomp/symtable.cmi bytecomp/cmo_format.cmi
 bytecomp/bytepackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \
     typing/subst.cmi bytecomp/printlambda.cmi typing/path.cmi utils/misc.cmi \

Changes

@@ -52,6 +52,9 @@ Working version
 
 ### Compiler user-interface and warnings:
 
+- GPR#896: "-compat-32" is now taken into account when building .cmo/.cma
+  (Hugo Heuzard)
+
 - GPR#948: the compiler now reports warnings-as-errors by prefixing
   them with "Error (warning ..):", instead of "Warning ..:" and
   a trailing "Error: Some fatal warnings were triggered" message.

bytecomp/bytelibrarian.ml

@@ -103,7 +103,9 @@ let create_archive ppf file_list lib_name =
         lib_ccopts = !Clflags.all_ccopts @ !lib_ccopts;
         lib_dllibs = !Clflags.dllibs @ !lib_dllibs } in
     let pos_toc = pos_out outchan in
-    output_value outchan toc;
+    Emitcode.marshal_to_channel_with_possibly_32bit_compat
+      ~filename:lib_name ~kind:"bytecode library"
+      outchan toc;
     seek_out outchan ofs_pos_toc;
     output_binary_int outchan pos_toc;
     close_out outchan

bytecomp/bytelink.ml

@@ -28,7 +28,6 @@ type error =
   | Custom_runtime
   | File_exists of string
   | Cannot_open_dll of string
-  | Not_compatible_32
   | Required_module_unavailable of string
 
 exception Error of error
@@ -365,13 +364,9 @@ let link_bytecode ppf tolink exec_name standalone =
     Symtable.output_primitive_names outchan;
     Bytesections.record outchan "PRIM";
     (* The table of global data *)
-    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;
+    Emitcode.marshal_to_channel_with_possibly_32bit_compat
+      ~filename:exec_name ~kind:"bytecode executable"
+      outchan (Symtable.initial_global_table());
     Bytesections.record outchan "DATA";
     (* The map of global identifiers *)
     Symtable.output_global_map outchan;
@@ -692,9 +687,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"
   | Required_module_unavailable s ->
       fprintf ppf "Required module `%s' is unavailable" s
 

bytecomp/bytelink.mli

@@ -32,7 +32,6 @@ type error =
   | Custom_runtime
   | File_exists of string
   | Cannot_open_dll of string
-  | Not_compatible_32
   | Required_module_unavailable of string
 
 exception Error of error

bytecomp/bytepackager.ml

@@ -266,7 +266,9 @@ let package_object_files ppf files targetfile targetname coercion =
         cu_force_link = !force_link;
         cu_debug = if pos_final > pos_debug then pos_debug else 0;
         cu_debugsize = pos_final - pos_debug } in
-    output_value oc compunit;
+    Emitcode.marshal_to_channel_with_possibly_32bit_compat
+      ~filename:targetfile ~kind:"bytecode unit"
+      oc compunit;
     seek_out oc pos_depl;
     output_binary_int oc pos_final;
     close_out oc

bytecomp/emitcode.ml

@@ -25,6 +25,28 @@ open Cmo_format
 
 module StringSet = Set.Make(String)
 
+type error = Not_compatible_32 of (string * string)
+exception Error of error
+
+(* marshal and possibly check 32bit compat *)
+let marshal_to_channel_with_possibly_32bit_compat ~filename ~kind outchan obj =
+  try
+    Marshal.to_channel outchan obj
+      (if !Clflags.bytecode_compatible_32
+       then [Marshal.Compat_32] else [])
+  with Failure _ ->
+    raise (Error (Not_compatible_32 (filename, kind)))
+
+
+let report_error ppf (file, kind) =
+  Format.fprintf ppf "Generated %s %S cannot be used on a 32-bit platform" kind file
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error (Not_compatible_32 info) -> Some (Location.error_of_printer_file report_error info)
+      | _ -> None
+    )
+
 (* Buffering of bytecode *)
 
 let out_buffer = ref(LongString.create 1024)
@@ -400,7 +422,9 @@ let to_file outchan unit_name objfile ~required_globals code =
   Btype.cleanup_abbrev ();              (* Remove any cached abbreviation
                                            expansion before saving *)
   let pos_compunit = pos_out outchan in
-  output_value outchan compunit;
+  marshal_to_channel_with_possibly_32bit_compat
+    ~filename:objfile ~kind:"bytecode unit"
+    outchan compunit;
   seek_out outchan pos_depl;
   output_binary_int outchan pos_compunit
 

bytecomp/emitcode.mli

@@ -46,3 +46,5 @@ val to_packed_file:
              relocation information (reversed) *)
 
 val reset: unit -> unit
+
+val marshal_to_channel_with_possibly_32bit_compat : filename:string -> kind:string -> out_channel -> 'a -> unit