[Pkg-ocaml-maint-commits] [SCM] OCaml packaging branch, master, updated. debian/3.11.1-2-3-g2b7703f
Mehdi Dogguy
dogguy at pps.jussieu.fr
Mon Jul 20 16:15:44 UTC 2009
The following commit has been merged in the master branch:
commit 93ed89edc4b057c39dc3e4a7696256e362f4a043
Author: Mehdi Dogguy <dogguy at pps.jussieu.fr>
Date: Mon Jul 20 16:45:19 2009 +0200
Some enhancements to ocamlbyteinfo and add ocamlplugininfo
* Enhance ocamlbyteinfo so that it reads only interesting parts
in the bytecode binary and use Dynlinkaux module which embeds
all used dependencies.
* Add ocamlplugininfo to read the content of .cmxs files.
* Enhance the Makefile
diff --git a/debian/ocamlbyteinfo/Makefile b/debian/ocamlbyteinfo/Makefile
index 18e2f83..32b1b29 100644
--- a/debian/ocamlbyteinfo/Makefile
+++ b/debian/ocamlbyteinfo/Makefile
@@ -1,19 +1,33 @@
-EXE=ocamlbyteinfo
-OCAMLC=./ocamlc
+DIR=debian/ocamlbyteinfo
+BEXE=ocamlbyteinfo
+NEXE=ocamlplugininfo
+OCAMLC=./boot/ocamlrun ./ocamlc
+OCAMLOPT=./boot/ocamlrun ./ocamlopt
+OCAMLLEX=./boot/ocamlrun ./lex/ocamllex
-DEPS=utils/misc.cmo utils/tbl.cmo \
- utils/config.cmo utils/clflags.cmo \
- typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \
- typing/predef.cmo bytecomp/instruct.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \
- bytecomp/dll.cmo bytecomp/meta.cmo bytecomp/symtable.cmo
+GENERATED=$(BEXE) $(NEXE) *.cm* natdynlink.* *.a *.o
-INCLUDES= -I stdlib -I utils -I typing -I bytecomp
+BDEPS=otherlibs/dynlink/dynlinkaux.cmo
+NDEPS=$(DIR)/natdynlink.cmxa
+INCLUDES= -I stdlib -I utils -I typing -I bytecomp -I otherlibs/dynlink -I $(DIR)
-all: $(EXE)
+all: $(BEXE) $(NEXE)
-$(EXE): $(DEPS)
- $(OCAMLC) -o debian/$(EXE)/$(EXE) $(INCLUDES) $(DEPS) debian/$(EXE)/$(EXE).ml
+$(DIR)/natdynlink.ml:
+ cp otherlibs/dynlink/natdynlink.ml $(DIR)/
+
+$(DIR)/natdynlink.cmx: $(DIR)/natdynlink.ml
+ $(OCAMLOPT) -c $(INCLUDES) $(DIR)/natdynlink.ml
+
+$(DIR)/natdynlink.cmxa: $(DIR)/natdynlink.cmx
+ $(OCAMLOPT) $(INCLUDES) -ccopt "-Wl,-E" $^ -a -o $@
+
+$(NEXE): $(NDEPS)
+ $(OCAMLOPT) unix.cmxa str.cmxa -o $(DIR)/$(NEXE) $(INCLUDES) $(NDEPS) $(DIR)/$(NEXE).ml
+
+$(BEXE): $(BDEPS)
+ $(OCAMLC) -o $(DIR)/$(BEXE) $(INCLUDES) $(BDEPS) $(DIR)/$(BEXE).ml
clean:
- rm -f $(addprefix debian/$(EXE)/, $(EXE) $(EXE).cmo $(EXE).cmi)
+ rm -f $(addprefix $(DIR)/, $(GENERATED))
diff --git a/debian/ocamlbyteinfo/ocamlbyteinfo.ml b/debian/ocamlbyteinfo/ocamlbyteinfo.ml
index e789a73..eb9a293 100644
--- a/debian/ocamlbyteinfo/ocamlbyteinfo.ml
+++ b/debian/ocamlbyteinfo/ocamlbyteinfo.ml
@@ -1,76 +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. *)
+(* *)
+(***********************************************************************)
-(*
- * Copyright (C) 2009 Mehdi Dogguy
- * You have permission to copy, modify, and redistribute under the
- * terms of the LGPL-2.1.
- *)
+(* $Id$ *)
-open Sys
+(* Dumps a bytecode binary file *)
-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 []
+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
+ 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
-type prefix = C | P | M | S | R | D
-let p_prefix = function
- | C -> "DLLS"
- | M -> "UNIT"
- | P -> "DLPT"
- | S -> "SYMB"
- | R -> "PRIM"
- | D -> "DBUG"
+let p_section title format pdata = function
+ | [] -> ()
+ | l ->
+ p_title title;
+ List.iter
+ (fun (name, data) -> print format (pdata data) name)
+ l
-let p_section prefix =
- List.iter
- (fun name -> print "%s %s\n" (p_prefix prefix) name)
+let p_list title format = function
+ | [] -> ()
+ | l ->
+ p_title title;
+ List.iter
+ (fun name -> print format name)
+ l
let _ =
- let input_name = Sys.argv.(1) in
- let ic = open_in_bin input_name in
- let _ = Bytesections.read_toc ic in
- let toc = Bytesections.toc () in
+ try
+ let input_name = Sys.argv.(1) in
+ let ic = open_in_bin input_name in
+ Bytesections.read_toc ic;
List.iter
- (fun (sec, len) ->
- if len > 0 then
- let _ = Bytesections.seek_section ic sec in
- match sec with
- | "CRCS" ->
- let crcs = (input_value ic : (string * Digest.t) list)
- in List.iter
- (fun (name, dig) -> print "%s %s %s\n"
- (p_prefix M)
- (Digest.to_hex dig)
- name
- ) crcs
- | "DLLS" -> p_section C (input_stringlist ic len)
- | "DLPT" -> p_section P (input_stringlist ic len)
- | "SYMB" ->
- let (_, sym_table) = (input_value ic
- : int * (Ident.t, int) Tbl.t)
- in let list = ref []
- in let _ = Tbl.map
- (fun id pos -> list := (id,pos) :: !list) sym_table
- in List.iter (fun (id, pos) -> print "%s %.10d %s\n"
- (p_prefix S)
- pos
- (Ident.name id))
- (List.sort
- (fun (_, pos) (_,pos') -> Pervasives.compare pos pos')
- !list)
- | "PRIM" -> p_section R (input_stringlist ic len)
- | _ -> ()
+ (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 _ -> ()
)
- toc;
+ ["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/debian/ocamlbyteinfo/ocamlplugininfo.ml b/debian/ocamlbyteinfo/ocamlplugininfo.ml
new file mode 100644
index 0000000..e28800f
--- /dev/null
+++ b/debian/ocamlbyteinfo/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 at ." name;
+ printf "CRC of implementation: %s at ." (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
--
OCaml packaging
More information about the Pkg-ocaml-maint-commits
mailing list