l4/pkg/ocaml/contrib/bytecomp/bytesections.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 2000 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: bytesections.ml 6130 2004-02-22 15:07:51Z xleroy $ *)
  14
  15 (* Handling of sections in bytecode executable files *)
  16
  17 (* List of all sections, in reverse order *)
  18
  19 let section_table = ref ([] : (string * int) list)
  20
  21 (* Recording sections *)
  22
  23 let section_beginning = ref 0
  24
  25 let init_record outchan =
  26   section_beginning := pos_out outchan;
  27   section_table := []
  28
  29 let record outchan name =
  30   let pos = pos_out outchan in
  31   section_table := (name, pos - !section_beginning) :: !section_table;
  32   section_beginning := pos
  33
  34 let write_toc_and_trailer outchan =
  35   List.iter
  36     (fun (name, len) ->
  37       output_string outchan name; output_binary_int outchan len)
  38     (List.rev !section_table);
  39   output_binary_int outchan (List.length !section_table);
  40   output_string outchan Config.exec_magic_number;
  41   section_table := [];
  42
  43 (* Read the table of sections from a bytecode executable *)
  44
  45 exception Bad_magic_number
  46
  47 let read_toc ic =
  48   let pos_trailer = in_channel_length ic - 16 in
  49   seek_in ic pos_trailer;
  50   let num_sections = input_binary_int ic in
  51   let header = String.create(String.length Config.exec_magic_number) in
  52   really_input ic header 0 (String.length Config.exec_magic_number);
  53   if header <> Config.exec_magic_number then raise Bad_magic_number;
  54   seek_in ic (pos_trailer - 8 * num_sections);
  55   section_table := [];
  56   for i = 1 to num_sections do
  57     let name = String.create 4 in
  58     really_input ic name 0 4;
  59     let len = input_binary_int ic in
  60     section_table := (name, len) :: !section_table
  61   done
  62
  63 (* Return the current table of contents *)
  64
  65 let toc () = List.rev !section_table
  66
  67 (* Position ic at the beginning of the section named "name",
  68    and return the length of that section.  Raise Not_found if no
  69    such section exists. *)
  70
  71 let seek_section ic name =
  72   let rec seek_sec curr_ofs = function
  73     [] -> raise Not_found
  74   | (n, len) :: rem ->
  75       if n = name
  76       then begin seek_in ic (curr_ofs - len); len end
  77       else seek_sec (curr_ofs - len) rem in
  78   seek_sec (in_channel_length ic - 16 - 8 * List.length !section_table)
  79            !section_table
  80
  81 (* Return the contents of a section, as a string *)
  82
  83 let read_section_string ic name =
  84   let len = seek_section ic name in
  85   let res = String.create len in
  86   really_input ic res 0 len;
  87   res
  88
  89 (* Return the contents of a section, as marshalled data *)
  90
  91 let read_section_struct ic name =
  92   ignore (seek_section ic name);
  93   input_value ic
  94
  95 (* Return the position of the beginning of the first section *)
  96
  97 let pos_first_section ic =
  98   in_channel_length ic - 16 - 8 * List.length !section_table -
  99   List.fold_left (fun total (name, len) -> total + len) 0 !section_table