New branch binary-annot by Fabrice Le Fessant from r10789

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/binary-annot@10790 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 99 insertions, 0 deletions

diff --git a/ocaml-binary-annot/bytecomp/bytesections.ml b/ocaml-binary-annot/bytecomp/bytesections.ml
new file mode 100644
index 0000000000..16eaf23776
--- /dev/null
+++ b/ocaml-binary-annot/bytecomp/bytesections.ml
@@ -0,0 +1,99 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Handling of sections in bytecode executable files *)
+
+(* List of all sections, in reverse order *)
+
+let section_table = ref ([] : (string * int) list)
+
+(* Recording sections *)
+
+let section_beginning = ref 0
+
+let init_record outchan =
+  section_beginning := pos_out outchan;
+  section_table := []
+
+let record outchan name =
+  let pos = pos_out outchan in
+  section_table := (name, pos - !section_beginning) :: !section_table;
+  section_beginning := pos
+
+let write_toc_and_trailer outchan =
+  List.iter
+    (fun (name, len) ->
+      output_string outchan name; output_binary_int outchan len)
+    (List.rev !section_table);
+  output_binary_int outchan (List.length !section_table);
+  output_string outchan Config.exec_magic_number;
+  section_table := [];
+
+(* Read the table of sections from a bytecode executable *)
+
+exception Bad_magic_number
+
+let read_toc ic =
+  let pos_trailer = in_channel_length ic - 16 in
+  seek_in ic pos_trailer;
+  let num_sections = input_binary_int ic in
+  let header = String.create(String.length Config.exec_magic_number) in
+  really_input ic header 0 (String.length Config.exec_magic_number);
+  if header <> Config.exec_magic_number then raise Bad_magic_number;
+  seek_in ic (pos_trailer - 8 * num_sections);
+  section_table := [];
+  for i = 1 to num_sections do
+    let name = String.create 4 in
+    really_input ic name 0 4;
+    let len = input_binary_int ic in
+    section_table := (name, len) :: !section_table
+  done
+
+(* Return the current table of contents *)
+
+let toc () = List.rev !section_table
+
+(* Position ic at the beginning of the section named "name",
+   and return the length of that section.  Raise Not_found if no
+   such section exists. *)
+
+let seek_section ic name =
+  let rec seek_sec curr_ofs = function
+    [] -> raise Not_found
+  | (n, len) :: rem ->
+      if n = name
+      then begin seek_in ic (curr_ofs - len); len end
+      else seek_sec (curr_ofs - len) rem in
+  seek_sec (in_channel_length ic - 16 - 8 * List.length !section_table)
+           !section_table
+
+(* Return the contents of a section, as a string *)
+
+let read_section_string ic name =
+  let len = seek_section ic name in
+  let res = String.create len in
+  really_input ic res 0 len;
+  res
+
+(* Return the contents of a section, as marshalled data *)
+
+let read_section_struct ic name =
+  ignore (seek_section ic name);
+  input_value ic
+
+(* Return the position of the beginning of the first section *)
+
+let pos_first_section ic =
+  in_channel_length ic - 16 - 8 * List.length !section_table -
+  List.fold_left (fun total (name, len) -> total + len) 0 !section_table