From: Mehdi Dogguy Date: Mon, 20 Jul 2009 14:45:19 +0000 (+0200) Subject: Some enhancements to ocamlbyteinfo and add ocamlplugininfo X-Git-Tag: archive/raspbian/4.08.1-4+rpi1~3^2~397 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=93ed89edc4b057c39dc3e4a7696256e362f4a043;p=ocaml.git 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 18e2f83e..32b1b292 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 e789a733..eb9a293e 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 00000000..e28800f3 --- /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@." name; + printf "CRC of implementation: %s@." (Digest.to_hex crc); + printf "@[Globals defined:"; + List.iter (fun s -> printf "@ %s" s) defines; + printf "@]@."; + printf "@[Interfaces imported:%a@]@." pr_imports cmi; + printf "@[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