1964N/A(***********************************************************************)

1964N/A(* *)

1964N/A(* Objective Caml *)

1964N/A(* *)

1964N/A(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)

1964N/A(* *)

1964N/A(* Copyright 2009 Institut National de Recherche en Informatique et *)

1964N/A(* en Automatique. All rights reserved. This file is distributed *)

1964N/A(* under the terms of the GNU Library General Public License, with *)

1964N/A(* the special exception on linking described in file ../../LICENSE. *)

1964N/A(* *)

1964N/A(***********************************************************************)

1964N/A

1964N/A(* $Id: ocamlbyteinfo.ml,v 1.1 2010/01/11 18:45:03 rjones Exp $ *)

1964N/A

1964N/A(* Dumps a bytecode binary file *)

1964N/A

1964N/Aopen Sys

1964N/Aopen Dynlinkaux

1964N/A

1964N/Alet input_stringlist ic len =

1964N/A let get_string_list sect len =

1964N/A let rec fold s e acc =

1964N/A if e != len then

1964N/A if sect.[e] = '\000' then

1964N/A fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)

1964N/A else fold s (e+1) acc

1964N/A else acc

1964N/A in fold 0 0 []

1964N/A in

1964N/A let sect = String.create len in

1964N/A let _ = really_input ic sect 0 len in

1964N/A get_string_list sect len

1964N/A

1964N/Alet print = Printf.printf

1964N/Alet perr s =

1964N/A Printf.eprintf "%s\n" s;

1964N/A exit(1)

1964N/Alet p_title title = print "%s:\n" title

1964N/A

1964N/Alet p_section title format pdata = function

1964N/A | [] -> ()

1964N/A | l ->

1964N/A p_title title;

1964N/A List.iter

1964N/A (fun (name, data) -> print format (pdata data) name)

1964N/A l

1964N/A

1964N/Alet p_list title format = function

1964N/A | [] -> ()

1964N/A | l ->

1964N/A p_title title;

1964N/A List.iter

1964N/A (fun name -> print format name)

1964N/A l

1964N/A

1964N/Alet _ =

1964N/A try

1964N/A let input_name = Sys.argv.(1) in

1964N/A let ic = open_in_bin input_name in

1964N/A Bytesections.read_toc ic;

1964N/A List.iter

1964N/A (fun section ->

1964N/A try

1964N/A let len = Bytesections.seek_section ic section in

1964N/A if len > 0 then match section with

1964N/A | "CRCS" ->

1964N/A p_section

1964N/A "Imported Units"

1964N/A "\t%s\t%s\n"

1964N/A Digest.to_hex

1964N/A (input_value ic : (string * Digest.t) list)

1964N/A | "DLLS" ->

1964N/A p_list

1964N/A "Used Dlls" "\t%s\n"

1964N/A (input_stringlist ic len)

1964N/A | "DLPT" ->

1964N/A p_list

1964N/A "Additional Dll paths"

1964N/A "\t%s\n"

1964N/A (input_stringlist ic len)

1964N/A | "PRIM" ->

1964N/A let prims = (input_stringlist ic len) in

1964N/A print "Uses unsafe features: ";

1964N/A begin match prims with

1964N/A [] -> print "no\n"

1964N/A | l -> print "YES\n";

1964N/A p_list "Primitives declared in this module"

1964N/A "\t%s\n"

1964N/A l

1964N/A end

1964N/A | _ -> ()

1964N/A with Not_found | Failure _ | Invalid_argument _ -> ()

1964N/A )

1964N/A ["CRCS"; "DLLS"; "DLPT"; "PRIM"];

1964N/A close_in ic

1964N/A with

1964N/A | Sys_error msg ->

1964N/A perr msg

1964N/A | Invalid_argument("index out of bounds") ->

1964N/A perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0))