diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | asmcomp/asmpackager.ml | 302 | ||||
| -rw-r--r-- | asmcomp/asmpackager.mli | 2 | ||||
| -rw-r--r-- | asmcomp/cmmgen.ml | 5 | ||||
| -rw-r--r-- | asmcomp/compilenv.ml | 69 | ||||
| -rw-r--r-- | asmcomp/compilenv.mli | 11 | ||||
| -rw-r--r-- | config/Makefile.mingw | 4 | ||||
| -rw-r--r-- | config/Makefile.msvc | 4 | ||||
| -rwxr-xr-x | configure | 50 | ||||
| -rw-r--r-- | driver/main_args.ml | 2 | ||||
| -rw-r--r-- | driver/optcompile.ml | 2 | ||||
| -rw-r--r-- | driver/optmain.ml | 3 | ||||
| -rw-r--r-- | tools/Makefile | 5 | ||||
| -rw-r--r-- | utils/clflags.ml | 1 | ||||
| -rw-r--r-- | utils/config.mli | 6 | ||||
| -rw-r--r-- | utils/config.mlp | 8 |
16 files changed, 134 insertions, 342 deletions
@@ -334,9 +334,7 @@ utils/config.ml: utils/config.mlp config/Makefile -e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \ -e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \ -e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \ - -e 's|%%BINUTILS_NM%%|$(BINUTILS_NM)|' \ -e 's|%%CC_PROFILE%%|$(CC_PROFILE)|' \ - -e 's|%%BINUTILS_OBJCOPY%%|$(BINUTILS_OBJCOPY)|' \ -e 's|%%ARCH%%|$(ARCH)|' \ -e 's|%%MODEL%%|$(MODEL)|' \ -e 's|%%SYSTEM%%|$(SYSTEM)|' \ diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index 8b7c153644..71ffa9b1a8 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -24,10 +24,11 @@ open Compilenv type error = Illegal_renaming of string * string | Forward_reference of string * string + | Wrong_for_pack of string * string | Linking_error | Assembler_error of string | File_not_found of string - | No_binutils + exception Error of error @@ -40,7 +41,7 @@ type pack_member = pm_name: string; pm_kind: pack_member_kind } -let read_member_info file = +let read_member_info pack_path file = let name = String.capitalize(Filename.basename(chop_extension_if_any file)) in let kind = @@ -48,6 +49,9 @@ let read_member_info file = let (info, crc) = Compilenv.read_unit_info file in if info.ui_name <> name then raise(Error(Illegal_renaming(file, info.ui_name))); + if info.ui_symbol <> + (Compilenv.current_unit_infos()).ui_symbol ^ "__" ^ info.ui_name + then raise(Error(Wrong_for_pack(file, pack_path))); Asmlink.check_consistency file info crc; PM_impl info end else @@ -72,240 +76,10 @@ let check_units members = check (list_remove mb.pm_name forbidden) tl in check (List.map (fun mb -> mb.pm_name) members) members -(* Rename symbols in an object file. All defined symbols of the form - caml[T] or caml[T]__xxx, where [T] belongs to the list [units], are - replaced by caml[pref]__[T]__xxx . Return the list of renamed symbols. *) - -let extract_symbols units symbolfile = - let symbs = ref [] in - let ic = open_in symbolfile in - begin try - while true do - let l = input_line ic in - try - let i = 3 + (try search_substring " T " l 0 with Not_found -> - try search_substring " D " l 0 with Not_found -> - try search_substring " R " l 0 with Not_found -> - search_substring " S " l 0) in - let j = try search_substring "__" l i - with Not_found -> String.length l in - let k = if l.[i] = '_' then i + 1 else i in - if j - k > 4 && String.sub l k 4 = "caml" - && List.mem (String.sub l (k + 4) (j - k - 4)) units then - symbs := (String.sub l i (String.length l - i)) :: !symbs - with Not_found -> - () - done - with End_of_file -> close_in ic - | x -> close_in ic; raise x - end; - !symbs - -let max_cmdline_length = 3500 (* safe approximation *) - -(* Turn a low-level ident (with leading "caml" or "_caml") back into - a high-level ident. -*) -let remove_leading_caml s = - if String.length s > 0 && s.[0] = '_' - then String.sub s 5 (String.length s - 5) - else String.sub s 4 (String.length s - 4) - -(* Insert prefix [p] in a low-level ident (after the "caml" or "_caml" - prefix). -*) -let prefix_symbol p s = - if String.length s > 0 && s.[0] = '_' then begin - assert (String.length s > 5 && String.sub s 0 5 = "_caml"); - "_caml" ^ p ^ "__" ^ String.sub s 5 (String.length s - 5) - end else begin - assert (String.length s > 4 && String.sub s 0 4 = "caml"); - "caml" ^ p ^ "__" ^ String.sub s 4 (String.length s - 4) - end - -(* Strip leading _ from a low-level ident *) - -let strip_underscore s = - if String.length s > 0 && s.[0] = '_' - then String.sub s 1 (String.length s - 1) - else s - -(* return the list of symbols to rename in low-level form - (with the leading "_caml" or "caml") -*) -let rename_in_object_file members pref objfile = - let units = List.map (fun m -> m.pm_name) members in - let symbolfile = Filename.temp_file "camlsymbols" "" in - try - let nm_cmdline = - sprintf "%s %s > %s" - Config.binutils_nm - (Filename.quote objfile) (Filename.quote symbolfile) in - if Ccomp.command nm_cmdline <> 0 then raise(Error Linking_error); - let symbols_to_rename = - extract_symbols units symbolfile in - let cmdline = - Buffer.create max_cmdline_length in - let rec call_objcopy = function - [] -> - Buffer.add_char cmdline ' '; - Buffer.add_string cmdline (Filename.quote objfile); - if Ccomp.command (Buffer.contents cmdline) <> 0 - then raise(Error Linking_error) - | s :: rem -> - if Buffer.length cmdline >= max_cmdline_length then begin - Buffer.add_char cmdline ' '; - Buffer.add_string cmdline (Filename.quote objfile); - if Ccomp.command (Buffer.contents cmdline) <> 0 - then raise(Error Linking_error); - Buffer.reset cmdline; - Buffer.add_string cmdline Config.binutils_objcopy - end; - bprintf cmdline " --redefine-sym '%s=%s'" s (prefix_symbol pref s); - call_objcopy rem in - Buffer.add_string cmdline Config.binutils_objcopy; - call_objcopy symbols_to_rename; - remove_file symbolfile; - symbols_to_rename - with x -> - remove_file symbolfile; - raise x - -(* Rename function symbols and global symbols in value approximations *) - -let rename_approx mapping_lbl mapping_id approx = - - let ren_label lbl = - try Tbl.find lbl mapping_lbl with Not_found -> lbl in - let ren_ident id = - if Ident.persistent id - then - let lbl = Ident.name id in - let newlbl = try Tbl.find lbl mapping_id with Not_found -> lbl in - Ident.create_persistent newlbl - else id in - - let rec ren_ulambda = function - Uvar id -> - Uvar(ren_ident id) - | Uconst cst -> - Uconst cst - | Udirect_apply(lbl, args) -> - Udirect_apply(ren_label lbl, List.map ren_ulambda args) - | Ugeneric_apply(fn, args) -> - Ugeneric_apply(ren_ulambda fn, List.map ren_ulambda args) - | Uclosure(fns, env) -> - (* never present in an inlined function body *) - assert false - | Uoffset(lam, ofs) -> Uoffset(ren_ulambda lam, ofs) - | Ulet(id, u, body) -> Ulet(id, ren_ulambda u, ren_ulambda body) - | Uletrec(defs, body) -> - (* never present in an inlined function body *) - assert false - | Uprim(prim, args) -> - let prim' = - match prim with - Pgetglobal id -> Pgetglobal(ren_ident id) - | Psetglobal id -> assert false (* never present in inlined fn body *) - | _ -> prim in - Uprim(prim', List.map ren_ulambda args) - | Uswitch(u, cases) -> - Uswitch(ren_ulambda u, - {cases with - us_actions_consts = Array.map ren_ulambda cases.us_actions_consts; - us_actions_blocks = Array.map ren_ulambda cases.us_actions_blocks}) - | Ustaticfail(tag, args) -> - Ustaticfail(tag, List.map ren_ulambda args) - | Ucatch(nfail, ids, u1, u2) -> - Ucatch(nfail, ids, ren_ulambda u1, ren_ulambda u2) - | Utrywith(u1, id, u2) -> - Utrywith(ren_ulambda u1, id, ren_ulambda u2) - | Uifthenelse(u1, u2, u3) -> - Uifthenelse(ren_ulambda u1, ren_ulambda u2, ren_ulambda u3) - | Usequence(u1, u2) -> - Usequence(ren_ulambda u1, ren_ulambda u2) - | Uwhile(u1, u2) -> - Uwhile(ren_ulambda u1, ren_ulambda u2) - | Ufor(id, u1, u2, dir, u3) -> - Ufor(id, ren_ulambda u1, ren_ulambda u2, dir, ren_ulambda u3) - | Uassign(id, u) -> - Uassign(id, ren_ulambda u) - | Usend(k, u1, u2, ul) -> - Usend(k, ren_ulambda u1, ren_ulambda u2, List.map ren_ulambda ul) in - - let rec ren_approx = function - Value_closure(fd, res) -> - let fd' = - {fd with - fun_label = ren_label fd.fun_label; - fun_inline = - match fd.fun_inline with - None -> None - | Some(params, body) -> Some(params, ren_ulambda body)} in - Value_closure(fd', ren_approx res) - | Value_tuple comps -> - Value_tuple (Array.map ren_approx comps) - | app -> app - - in ren_approx approx - -(* Make the .cmx file for the package *) - -let build_package_cmx members target symbols_to_rename cmxfile = - let unit_names = - List.map (fun m -> m.pm_name) members in - let filter lst = - List.filter (fun (name, crc) -> not (List.mem name unit_names)) lst in - let union lst = - List.fold_left - (List.fold_left - (fun accu n -> if List.mem n accu then accu else n :: accu)) - [] lst in - let mapping_id = - let map_id tbl s = - let high_s = remove_leading_caml s in - Tbl.add high_s (target ^ "__" ^ high_s) tbl - in - List.fold_left map_id Tbl.empty symbols_to_rename - in - let mapping_lbl = - List.fold_left - (fun tbl s -> - let s = strip_underscore s in Tbl.add s (prefix_symbol target s) tbl) - Tbl.empty symbols_to_rename in - let member_defines m = - match m.pm_kind with PM_intf -> [] | PM_impl info -> info.ui_defines in - let defines = - map_end (fun s -> target ^ "__" ^ s) - (List.concat (List.map member_defines members)) - [target] in - let units = - List.fold_left - (fun accu m -> - match m.pm_kind with PM_intf -> accu | PM_impl info -> info :: accu) - [] members in - let approx = - Compilenv.global_approx (Ident.create_persistent target) in - let pkg_infos = - { ui_name = target; - ui_defines = defines; - ui_imports_cmi = (target, Env.crc_of_unit target) :: - filter(Asmlink.extract_crc_interfaces()); - ui_imports_cmx = filter(Asmlink.extract_crc_implementations()); - ui_approx = rename_approx mapping_lbl mapping_id approx; - ui_curry_fun = union(List.map (fun info -> info.ui_curry_fun) units); - ui_apply_fun = union(List.map (fun info -> info.ui_apply_fun) units); - ui_send_fun = union(List.map (fun info -> info.ui_send_fun) units); - ui_force_link = List.exists (fun info -> info.ui_force_link) units - } in - Compilenv.write_unit_info pkg_infos cmxfile - -(* Make the .o file for the package (not renamed yet) *) +(* Make the .o file for the package *) let make_package_object ppf members targetobj targetname coercion = let objtemp = Filename.temp_file "camlpackage" Config.ext_obj in - Location.input_name := targetname; (* set the name of the "current" input *) - Compilenv.reset targetname; (* set the name of the "current" compunit *) let components = List.map (fun m -> @@ -331,21 +105,63 @@ let make_package_object ppf members targetobj targetname coercion = remove_file objtemp; if retcode <> 0 then raise(Error Linking_error) +(* Make the .cmx file for the package *) + +let build_package_cmx members cmxfile = + let unit_names = + List.map (fun m -> m.pm_name) members in + let filter lst = + List.filter (fun (name, crc) -> not (List.mem name unit_names)) lst in + let union lst = + List.fold_left + (List.fold_left + (fun accu n -> if List.mem n accu then accu else n :: accu)) + [] lst in + let units = + List.fold_left + (fun accu m -> + match m.pm_kind with PM_intf -> accu | PM_impl info -> info :: accu) + [] members in + let ui = Compilenv.current_unit_infos() in + let pkg_infos = + { ui_name = ui.ui_name; + ui_symbol = ui.ui_symbol; + ui_defines = + ui.ui_symbol :: + union (List.map (fun info -> info.ui_defines) units); + ui_imports_cmi = + (ui.ui_name, Env.crc_of_unit ui.ui_name) :: + filter(Asmlink.extract_crc_interfaces()); + ui_imports_cmx = + filter(Asmlink.extract_crc_implementations()); + ui_approx = ui.ui_approx; + ui_curry_fun = + union(List.map (fun info -> info.ui_curry_fun) units); + ui_apply_fun = + union(List.map (fun info -> info.ui_apply_fun) units); + ui_send_fun = + union(List.map (fun info -> info.ui_send_fun) units); + ui_force_link = + List.exists (fun info -> info.ui_force_link) units + } in + Compilenv.write_unit_info pkg_infos cmxfile + (* Make the .cmx and the .o for the package *) let package_object_files ppf files targetcmx targetobj targetname coercion = - let members = map_left_right read_member_info files in + let pack_path = + match !Clflags.for_package with + | None -> targetname + | Some p -> p ^ "." ^ targetname in + let members = map_left_right (read_member_info pack_path) files in check_units members; make_package_object ppf members targetobj targetname coercion; - let symbols = rename_in_object_file members targetname targetobj in - build_package_cmx members targetname symbols targetcmx + build_package_cmx members targetcmx (* The entry point *) let package_files ppf files targetcmx = - if not Config.pack_option_supported - then raise (Error No_binutils); let files = List.map (fun f -> @@ -356,6 +172,10 @@ let package_files ppf files targetcmx = let targetcmi = prefix ^ ".cmi" in let targetobj = prefix ^ Config.ext_obj in let targetname = String.capitalize(Filename.basename prefix) in + (* Set the name of the current "input" *) + Location.input_name := targetcmx; + (* Set the name of the current compunit *) + Compilenv.reset ?packname:!Clflags.for_package targetname; try let coercion = Typemod.package_units files targetcmi targetname in package_object_files ppf files targetcmx targetobj targetname coercion @@ -373,12 +193,12 @@ let report_error ppf = function file id | Forward_reference(file, ident) -> fprintf ppf "Forward reference to %s in file %s" ident file + | Wrong_for_pack(file, path) -> + fprintf ppf "File %s@ was not compiled with the `-pack %s' option" + file path | File_not_found file -> fprintf ppf "File %s not found" file | Assembler_error file -> fprintf ppf "Error while assembling %s" file | Linking_error -> fprintf ppf "Error during partial linking" - | No_binutils -> - fprintf ppf "ocamlopt -pack is not supported on this platform.@ \ - Reason: the GNU `binutils' tools are not available" diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli index ae16e198e4..7d0bb588b5 100644 --- a/asmcomp/asmpackager.mli +++ b/asmcomp/asmpackager.mli @@ -20,10 +20,10 @@ val package_files: Format.formatter -> string list -> string -> unit type error = Illegal_renaming of string * string | Forward_reference of string * string + | Wrong_for_pack of string * string | Linking_error | Assembler_error of string | File_not_found of string - | No_binutils exception Error of error diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 8fdb2e2f28..1a3824f22e 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -853,10 +853,7 @@ let rec transl = function | Uprim(prim, args) -> begin match (simplif_primitive prim, args) with (Pgetglobal id, []) -> - if Ident.is_predef_exn id - then Cconst_symbol ("caml_exn_" ^ (Ident.name id)) - else Cconst_symbol (Compilenv.make_symbol ~unitname:(Ident.name id) - None) + Cconst_symbol (Compilenv.symbol_for_global id) | (Pmakeblock(tag, mut), []) -> transl_constant(Const_block(tag, [])) | (Pmakeblock(tag, mut), args) -> diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml index 351bed8acd..85c12d2662 100644 --- a/asmcomp/compilenv.ml +++ b/asmcomp/compilenv.ml @@ -37,6 +37,7 @@ exception Error of error type unit_infos = { mutable ui_name: string; (* Name of unit implemented *) + mutable ui_symbol: string; (* Prefix for symbols *) mutable ui_defines: string list; (* Unit and sub-units implemented *) mutable ui_imports_cmi: (string * Digest.t) list; (* Interfaces imported *) mutable ui_imports_cmx: (string * Digest.t) list; (* Infos imported *) @@ -54,11 +55,12 @@ type library_infos = lib_ccobjs: string list; (* C object files needed *) lib_ccopts: string list } (* Extra opts to C compiler *) -let global_approx_table = - (Hashtbl.create 17 : (string, value_approximation) Hashtbl.t) +let global_infos_table = + (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t) let current_unit = { ui_name = ""; + ui_symbol = ""; ui_defines = []; ui_imports_cmi = []; ui_imports_cmx = []; @@ -68,10 +70,26 @@ let current_unit = ui_send_fun = []; ui_force_link = false } -let reset name = - Hashtbl.clear global_approx_table; +let symbolname_for_pack pack name = + match pack with + | None -> name + | Some p -> + let b = Buffer.create 64 in + for i = 0 to String.length p - 1 do + match p.[i] with + | '.' -> Buffer.add_string b "__" + | c -> Buffer.add_char b c + done; + Buffer.add_string b "__"; + Buffer.add_string b name; + Buffer.contents b + +let reset ?packname name = + Hashtbl.clear global_infos_table; + let symbol = symbolname_for_pack packname name in current_unit.ui_name <- name; - current_unit.ui_defines <- [name]; + current_unit.ui_symbol <- symbol; + current_unit.ui_defines <- [symbol]; current_unit.ui_imports_cmi <- []; current_unit.ui_imports_cmx <- []; current_unit.ui_curry_fun <- []; @@ -79,10 +97,13 @@ let reset name = current_unit.ui_send_fun <- []; current_unit.ui_force_link <- false +let current_unit_infos () = + current_unit + let current_unit_name () = current_unit.ui_name -let make_symbol ?(unitname = current_unit.ui_name) idopt = +let make_symbol ?(unitname = current_unit.ui_symbol) idopt = let prefix = "caml" ^ unitname in match idopt with | None -> prefix @@ -105,33 +126,51 @@ let read_unit_info filename = close_in ic; raise(Error(Corrupted_unit_info(filename))) -(* Return the approximation of a global identifier *) +(* Read and cache info on global identifiers *) let cmx_not_found_crc = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" -let global_approx global_ident = +let get_global_info global_ident = let modname = Ident.name global_ident in if modname = current_unit.ui_name then - current_unit.ui_approx + Some current_unit else begin try - Hashtbl.find global_approx_table modname + Hashtbl.find global_infos_table modname with Not_found -> - let (approx, crc) = + let (infos, crc) = try let filename = find_in_path_uncap !load_path (modname ^ ".cmx") in let (ui, crc) = read_unit_info filename in if ui.ui_name <> modname then raise(Error(Illegal_renaming(ui.ui_name, filename))); - (ui.ui_approx, crc) + (Some ui, crc) with Not_found -> - (Value_unknown, cmx_not_found_crc) in + (None, cmx_not_found_crc) in current_unit.ui_imports_cmx <- (modname, crc) :: current_unit.ui_imports_cmx; - Hashtbl.add global_approx_table modname approx; - approx + Hashtbl.add global_infos_table modname infos; + infos + end + +(* Return the approximation of a global identifier *) + +let global_approx id = + match get_global_info id with + | None -> Value_unknown + | Some ui -> ui.ui_approx + +(* Return the symbol used to refer to a global identifier *) + +let symbol_for_global id = + if Ident.is_predef_exn id then + "caml_exn_" ^ Ident.name id + else begin + match get_global_info id with + | None -> make_symbol ~unitname:(Ident.name id) None + | Some ui -> make_symbol ~unitname:ui.ui_symbol None end (* Register the approximation of the module being compiled *) diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli index 477ab99e8e..42136060f6 100644 --- a/asmcomp/compilenv.mli +++ b/asmcomp/compilenv.mli @@ -28,6 +28,7 @@ open Clambda type unit_infos = { mutable ui_name: string; (* Name of unit implemented *) + mutable ui_symbol: string; (* Prefix for symbols *) mutable ui_defines: string list; (* Unit and sub-units implemented *) mutable ui_imports_cmi: (string * Digest.t) list; (* Interfaces imported *) mutable ui_imports_cmx: (string * Digest.t) list; (* Infos imported *) @@ -45,9 +46,12 @@ type library_infos = lib_ccobjs: string list; (* C object files needed *) lib_ccopts: string list } (* Extra opts to C compiler *) -val reset: string -> unit +val reset: ?packname:string -> string -> unit (* Reset the environment and record the name of the unit being - compiled (arg). *) + compiled (arg). Optional argument is [-for-pack] prefix. *) + +val current_unit_infos: unit -> unit_infos + (* Return the infos for the unit being compiled *) val current_unit_name: unit -> string (* Return the name of the unit being compiled *) @@ -59,6 +63,9 @@ val make_symbol: ?unitname:string -> string option -> string corresponds to symbol [id] in the compilation unit [u] (or the current unit). *) +val symbol_for_global: Ident.t -> string + (* Return the asm symbol that refers to the given global identifier *) + val global_approx: Ident.t -> Clambda.value_approximation (* Return the approximation for the given global identifier *) val set_global_approx: Clambda.value_approximation -> unit diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 5f6a6767cf..00adcd30a9 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -99,10 +99,6 @@ NATIVECCLINKOPTS= PARTIALLD=ld -r $(NATIVECCLINKOPTS) PACKLD=$(PARTIALLD) -### nm and objcopy from GNU binutils -BINUTILS_NM=nm -BINUTILS_OBJCOPY=objcopy - ############# Configuration for the contributed libraries OTHERLIBRARIES=win32unix systhreads str num win32graph dynlink bigarray labltk diff --git a/config/Makefile.msvc b/config/Makefile.msvc index e5c3f51c19..e4dab5a6be 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -99,10 +99,6 @@ NATIVECCLINKOPTS=/MT PARTIALLD=lib /nologo /debugtype:cv PACKLD=ld -r --oformat pe-i386 -### nm and objcopy are missing -BINUTILS_NM=nm -BINUTILS_OBJCOPY=objcopy - ############# Configuration for the contributed libraries OTHERLIBRARIES=win32unix systhreads str num win32graph dynlink bigarray labltk @@ -38,7 +38,6 @@ dl_defs='' verbose=no withcurses=yes withsharedlibs=yes -binutils_dir='' gcc_warnings="-Wall" # Try to turn internationalization off, can cause config.guess to malfunction! @@ -99,8 +98,6 @@ while : ; do dl_defs="$2"; shift;; -dllibs*|--dllibs*) dllib="$2"; shift;; - -binutils*|--binutils*) - binutils_dir=$2; shift;; -verbose|--verbose) verbose=yes;; *) echo "Unknown option \"$1\"." 1>&2; exit 2;; @@ -660,45 +657,6 @@ case "$arch,$model,$system" in *) profiling='noprof';; esac -# Where are GNU binutils? - -binutils_objcopy='' -binutils_install_objcopy=':' -binutils_nm='' - -case "$host" in - powerpc-*-darwin*) - binutils_objcopy='$(LIBDIR)/ocaml-objcopy' - binutils_install_objcopy=cp - binutils_nm=/usr/bin/nm - ;; - *) - if test "$arch" != "none"; then - binutils_path="${binutils_dir}:${PATH}:/usr/libexec/binutils" - old_IFS="$IFS" - IFS=':' - for d in ${binutils_path}; do - if test -z "$d"; then continue; fi - if test -f "$d/objcopy" && test -f "$d/nm"; then - echo "objcopy and nm found in $d" - if test `$d/objcopy --help | grep -s -c 'redefine-sym'` -eq 0; then - echo "$d/objcopy does not support option --redefine-sym, discarded" - continue; - fi - if test `$d/nm --version | grep -s -c 'GNU nm'` -eq 0; then - echo "$d/nm is not from GNU binutils, discarded" - continue; - fi - binutils_objcopy="$d/objcopy" - binutils_nm="$d/nm" - break - fi - done - IFS="$old_IFS" - fi - ;; -esac - # Where is ranlib? if sh ./searchpath ranlib; then @@ -1457,9 +1415,6 @@ echo "ASPP=$aspp" >> Makefile echo "ASPPFLAGS=$asppflags" >> Makefile echo "ASPPPROFFLAGS=$asppprofflags" >> Makefile echo "PROFILING=$profiling" >> Makefile -echo "BINUTILS_OBJCOPY=$binutils_objcopy" >> Makefile -echo "BINUTILS_INSTALL_OBJCOPY=$binutils_install_objcopy" >> Makefile -echo "BINUTILS_NM=$binutils_nm" >> Makefile echo "DYNLINKOPTS=$dllib" >> Makefile echo "OTHERLIBRARIES=$otherlibraries" >> Makefile echo "DEBUGGER=$debugger" >> Makefile @@ -1514,11 +1469,6 @@ else else echo " profiling with gprof ..... not supported" fi - if test -n "$binutils_objcopy" && test -n "$binutils_nm"; then - echo " ocamlopt -pack ........... supported" - else - echo " ocamlopt -pack ........... not supported (no binutils)" - fi fi if test "$debugger" = "ocamldebugger"; then diff --git a/driver/main_args.ml b/driver/main_args.ml index 4c7ba7cfa0..84e61e59c1 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -79,6 +79,8 @@ struct "-dllpath", Arg.String F._dllpath, "<dir> Add <dir> to the run-time search path for shared libraries"; "-dtypes", Arg.Unit F._dtypes, " Save type information in <filename>.annot"; + "-for-pack", Arg.String (fun s -> ()), + "<ident> Ignored (for compatibility with ocamlopt)"; "-g", Arg.Unit F._g, " Save debugging information"; "-i", Arg.Unit F._i, " Print inferred interface"; "-I", Arg.String F._I, diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 3989ca03f0..56f7d16073 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -85,7 +85,7 @@ let implementation ppf sourcefile outputprefix = Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in let env = initial_env() in - Compilenv.reset modulename; + Compilenv.reset ?packname:!Clflags.for_package modulename; try if !Clflags.print_types then ignore( Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number diff --git a/driver/optmain.ml b/driver/optmain.ml index 900381402f..4ca0c20585 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -111,6 +111,9 @@ let main () = " print configuration values and exit"; "-dtypes", Arg.Set save_types, " Save type information in <filename>.annot"; + "-for-pack", Arg.String (fun s -> for_package := Some s), + "<ident> Generate code that can later be `packed' with\n + \t\t\tocamlopt -pack -o <ident>.cmx"; "-i", Arg.Unit (fun () -> print_types := true; compile_only := true), " Print inferred interface"; "-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs), diff --git a/tools/Makefile b/tools/Makefile index 810558870c..9bc1646efd 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -112,11 +112,6 @@ beforedepend:: ocamlmklib.ml clean:: rm -f ocamlmklib.ml -# ocamlopt -pack support for Mac OS X: objcopy emulator - -install:: - $(BINUTILS_INSTALL_OBJCOPY) ocaml-objcopy-macosx $(BINUTILS_OBJCOPY) - # Converter olabl/ocaml 2.99 to ocaml 3 OCAML299TO3= lexer299.cmo ocaml299to3.cmo diff --git a/utils/clflags.ml b/utils/clflags.ml index e51e430c9a..516ea8f290 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -51,6 +51,7 @@ and c_linker = ref Config.bytecomp_c_linker (* -cc *) and no_auto_link = ref false (* -noautolink *) and dllpaths = ref ([] : string list) (* -dllpath *) and make_package = ref false (* -pack *) +and for_package = ref (None: string option) (* -for-pack *) let dump_parsetree = ref false (* -dparsetree *) and dump_rawlambda = ref false (* -drawlambda *) and dump_lambda = ref false (* -dlambda *) diff --git a/utils/config.mli b/utils/config.mli index dc960f7723..b7d47f3316 100644 --- a/utils/config.mli +++ b/utils/config.mli @@ -48,10 +48,6 @@ val native_pack_linker: string (* The linker to use for packaging (ocamlopt -pack) *) val ranlib: string (* Command to randomize a library, or "" if not needed *) -val binutils_nm: string - (* The "nm" command from GNU binutils, or "" if not available *) -val binutils_objcopy: string - (* The "objcopy" command from GNU binutils, or "" if not available *) val cc_profile : string (* The command line option to the C compiler to enable profiling. *) @@ -110,8 +106,6 @@ val default_executable_name: string (* Name of executable produced by linking if none is given with -o, e.g. [a.out] under Unix. *) -val pack_option_supported : bool - (* Whether option -pack is implemented *) val systhread_supported : bool (* Whether the system thread library is implemented *) diff --git a/utils/config.mlp b/utils/config.mlp index ce73e24dc3..97e6b2256a 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -37,15 +37,13 @@ let native_c_libraries = "%%NATIVECCLIBS%%" let native_partial_linker = "%%PARTIALLD%%" let native_pack_linker = "%%PACKLD%%" let ranlib = "%%RANLIBCMD%%" -let binutils_nm = "%%BINUTILS_NM%%" -let binutils_objcopy = "%%BINUTILS_OBJCOPY%%" let cc_profile = "%%CC_PROFILE%%" let exec_magic_number = "Caml1999X008" and cmi_magic_number = "Caml1999I010" and cmo_magic_number = "Caml1999O006" and cma_magic_number = "Caml1999A007" -and cmx_magic_number = "Caml1999Y009" +and cmx_magic_number = "Caml1999Y010" and cmxa_magic_number = "Caml1999Z010" and ast_impl_magic_number = "Caml1999M010" and ast_intf_magic_number = "Caml1999N009" @@ -78,7 +76,6 @@ let default_executable_name = | "Win32" | "Cygwin" -> "camlprog.exe" | _ -> "camlprog" -let pack_option_supported = binutils_objcopy <> "" && binutils_nm <> "";; let systhread_supported = %%SYSTHREAD_SUPPORT%%;; let print_config oc = @@ -97,9 +94,6 @@ let print_config oc = p "native_c_libraries" native_c_libraries; p "native_partial_linker" native_partial_linker; p "ranlib" ranlib; - p "binutils_nm" binutils_nm; - p "binutils_objcopy" binutils_objcopy; - p_bool "pack_option_supported" pack_option_supported; p "cc_profile" cc_profile; p "architecture" architecture; p "model" model; |