rpms/ocaml
5
0
Fork 0
Code Issues Pull Requests Releases Activity
42b3c165c6
ocaml/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch
Richard W.M. Jones 725d4a96c7 Revert "New upstream version 4.05.0." 
It's been decided to allow the Fedora 27 Mass Rebuild to take place
before OCaml 4.05.0 is added to Fedora.  To avoid this package
accidentally getting included in the mass rebuild, this commit reverts
the new upstream version, and then it will be un-re-verted after the
Mass Rebuild.

This reverts commit 40c060b8ec.
2017-07-21 11:00:11 +01:00

241 lines
7.7 KiB
Diff
Raw Blame History

From c047077c1c8a2acdc1d9bfe502c1a9b910ac3b9d Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 29 May 2012 20:40:36 +0100
Subject: [PATCH 2/9] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
Debian, sent upstream.
See:
http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
---
ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++
ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 210 insertions(+)
create mode 100644 ocamlbyteinfo.ml
create mode 100644 ocamlplugininfo.ml
diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml
new file mode 100644
index 000000000..eb9a293e3
--- /dev/null
+++ b/ocamlbyteinfo.ml
@@ -0,0 +1,101 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2009 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Dumps a bytecode binary file *)
+
+open Sys
+open Dynlinkaux
+
+let input_stringlist ic len =
+ let get_string_list sect len =
+ let rec fold s e acc =
+ if e != len then
+ if sect.[e] = '\000' then
+ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
+ else fold s (e+1) acc
+ else acc
+ in fold 0 0 []
+ in
+ let sect = String.create len in
+ let _ = really_input ic sect 0 len in
+ get_string_list sect len
+
+let print = Printf.printf
+let perr s =
+ Printf.eprintf "%s\n" s;
+ exit(1)
+let p_title title = print "%s:\n" title
+
+let p_section title format pdata = function
+ | [] -> ()
+ | l ->
+ p_title title;
+ List.iter
+ (fun (name, data) -> print format (pdata data) name)
+ l
+
+let p_list title format = function
+ | [] -> ()
+ | l ->
+ p_title title;
+ List.iter
+ (fun name -> print format name)
+ l
+
+let _ =
+ try
+ let input_name = Sys.argv.(1) in
+ let ic = open_in_bin input_name in
+ Bytesections.read_toc ic;
+ List.iter
+ (fun section ->
+ try
+ let len = Bytesections.seek_section ic section in
+ if len > 0 then match section with
+ | "CRCS" ->
+ p_section
+ "Imported Units"
+ "\t%s\t%s\n"
+ Digest.to_hex
+ (input_value ic : (string * Digest.t) list)
+ | "DLLS" ->
+ p_list
+ "Used Dlls" "\t%s\n"
+ (input_stringlist ic len)
+ | "DLPT" ->
+ p_list
+ "Additional Dll paths"
+ "\t%s\n"
+ (input_stringlist ic len)
+ | "PRIM" ->
+ let prims = (input_stringlist ic len) in
+ print "Uses unsafe features: ";
+ begin match prims with
+ [] -> print "no\n"
+ | l -> print "YES\n";
+ p_list "Primitives declared in this module"
+ "\t%s\n"
+ l
+ end
+ | _ -> ()
+ with Not_found | Failure _ | Invalid_argument _ -> ()
+ )
+ ["CRCS"; "DLLS"; "DLPT"; "PRIM"];
+ close_in ic
+ with
+ | Sys_error msg ->
+ perr msg
+ | Invalid_argument("index out of bounds") ->
+ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0))
diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml
new file mode 100644
index 000000000..e28800f31
--- /dev/null
+++ b/ocamlplugininfo.ml
@@ -0,0 +1,109 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2009 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Dumps a .cmxs file *)
+
+open Natdynlink
+open Format
+
+let file =
+ try
+ Sys.argv.(1)
+ with _ -> begin
+ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
+ exit(1)
+ end
+
+exception Abnormal_exit
+
+let error s e =
+ let eprint = Printf.eprintf in
+ let print_exc s = function
+ | End_of_file ->
+ eprint "%s: %s\n" s file
+ | Abnormal_exit ->
+ eprint "%s\n" s
+ | e -> eprint "%s\n" (Printexc.to_string e)
+ in
+ print_exc s e;
+ exit(1)
+
+let read_in command =
+ let cmd = Printf.sprintf command file in
+ let ic = Unix.open_process_in cmd in
+ try
+ let line = input_line ic in
+ begin match (Unix.close_process_in ic) with
+ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
+ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ error
+ (Printf.sprintf
+ "Command \"%s\" exited abnormally"
+ cmd
+ )
+ Abnormal_exit
+ end
+ with e -> error "File is empty" e
+
+let get_offset adr_off adr_sec =
+ try
+ let adr = List.nth adr_off 4 in
+ let off = List.nth adr_off 5 in
+ let sec = List.hd adr_sec in
+
+ let (!) x = Int64.of_string ("0x" ^ x) in
+ let (+) = Int64.add in
+ let (-) = Int64.sub in
+
+ Int64.to_int (!off + !sec - !adr)
+
+ with Failure _ | Invalid_argument _ ->
+ error
+ "Command output doesn't have the expected format"
+ Abnormal_exit
+
+let print_infos name crc defines cmi cmx =
+ let print_name_crc (name, crc) =
+ printf "@ %s (%s)" name (Digest.to_hex crc)
+ in
+ let pr_imports ppf imps = List.iter print_name_crc imps in
+ printf "Name: %s@." name;
+ printf "CRC of implementation: %s@." (Digest.to_hex crc);
+ printf "@[<hov 2>Globals defined:";
+ List.iter (fun s -> printf "@ %s" s) defines;
+ printf "@]@.";
+ printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
+ printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx
+
+let _ =
+ let adr_off = read_in "objdump -h %s | grep ' .data '" in
+ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in
+
+ let ic = open_in file in
+ let _ = seek_in ic (get_offset adr_off adr_sec) in
+ let header = (input_value ic : Natdynlink.dynheader) in
+ if header.magic <> Natdynlink.dyn_magic_number then
+ raise(Error(Natdynlink.Not_a_bytecode_file file))
+ else begin
+ List.iter
+ (fun ui ->
+ print_infos
+ ui.name
+ ui.crc
+ ui.defines
+ ui.imports_cmi
+ ui.imports_cmx)
+ header.units
+ end
--
2.13.1
Reference in New Issue View Git Blame Copy Permalink