- Add ocamlbyteinfo and ocamlplugininfo programs from Debian.
This commit is contained in:
parent
7f67559c7f
commit
a06adc6ba0
22
ocaml.spec
22
ocaml.spec
@ -2,7 +2,7 @@
|
||||
|
||||
Name: ocaml
|
||||
Version: 3.11.1
|
||||
Release: 2%{?dist}
|
||||
Release: 3%{?dist}
|
||||
|
||||
Summary: Objective Caml compiler and programming environment
|
||||
|
||||
@ -18,6 +18,11 @@ Source3: http://caml.inria.fr/distrib/ocaml-3.11/ocaml-3.11-refman.info.t
|
||||
Source4: ocaml-find-requires.sh
|
||||
Source5: ocaml-find-provides.sh
|
||||
|
||||
# Useful utilities from Debian, and sent upstream.
|
||||
# http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
|
||||
Source6: ocamlbyteinfo.ml
|
||||
Source7: ocamlplugininfo.ml
|
||||
|
||||
Patch0: ocaml-3.11.0-rpath.patch
|
||||
Patch1: ocaml-user-cflags.patch
|
||||
|
||||
@ -212,6 +217,13 @@ make -C emacs ocamltags
|
||||
# make -C tools objinfo
|
||||
(cd tools; ../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib -I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp -I ../driver -o objinfo config.cmx objinfo.ml)
|
||||
|
||||
# Currently these tools are supplied by Debian, but are expected
|
||||
# to go upstream at some point.
|
||||
cp %{SOURCE6} %{SOURCE7} .
|
||||
boot/ocamlrun ./ocamlc -I otherlibs/dynlink dynlinkaux.cmo ocamlbyteinfo.ml -o ocamlbyteinfo
|
||||
cp otherlibs/dynlink/natdynlink.ml .
|
||||
boot/ocamlrun ./ocamlopt unix.cmxa str.cmxa natdynlink.ml ocamlplugininfo.ml -o ocamlplugininfo
|
||||
|
||||
|
||||
%install
|
||||
rm -rf $RPM_BUILD_ROOT
|
||||
@ -248,6 +260,9 @@ echo %{version} > $RPM_BUILD_ROOT%{_libdir}/ocaml/fedora-ocaml-release
|
||||
# Remove rpaths from stublibs .so files.
|
||||
chrpath --delete $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs/*.so
|
||||
|
||||
install -m 0755 ocamlbyteinfo $RPM_BUILD_ROOT%{_bindir}
|
||||
install -m 0755 ocamlplugininfo $RPM_BUILD_ROOT%{_bindir}
|
||||
|
||||
|
||||
%clean
|
||||
rm -rf $RPM_BUILD_ROOT
|
||||
@ -270,6 +285,7 @@ fi
|
||||
%files
|
||||
%defattr(-,root,root,-)
|
||||
%{_bindir}/ocaml
|
||||
%{_bindir}/ocamlbyteinfo
|
||||
%{_bindir}/ocamlbuild
|
||||
%{_bindir}/ocamlbuild.byte
|
||||
%{_bindir}/ocamlbuild.native
|
||||
@ -286,6 +302,7 @@ fi
|
||||
%{_bindir}/ocamlobjinfo
|
||||
%{_bindir}/ocamlopt
|
||||
%{_bindir}/ocamlopt.opt
|
||||
%{_bindir}/ocamlplugininfo
|
||||
%{_bindir}/ocamlprof
|
||||
%{_bindir}/ocamlyacc
|
||||
%{_libdir}/ocaml/addlabels
|
||||
@ -433,6 +450,9 @@ fi
|
||||
|
||||
|
||||
%changelog
|
||||
* Fri Oct 16 2009 Richard W.M. Jones <rjones@redhat.com> - 3.11.1-3
|
||||
- Add ocamlbyteinfo and ocamlplugininfo programs from Debian.
|
||||
|
||||
* Sun Oct 4 2009 Richard W.M. Jones <rjones@redhat.com> - 3.11.1-2
|
||||
- ocaml-find-requires.sh: Calculate runtime version using ocamlrun
|
||||
-version instead of fedora-ocaml-release file.
|
||||
|
101
ocamlbyteinfo.ml
Normal file
101
ocamlbyteinfo.ml
Normal file
@ -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))
|
109
ocamlplugininfo.ml
Normal file
109
ocamlplugininfo.ml
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user