arch/bfd/util/bfd_flatten.ml

   1 (*
   2  * Once the label resolution has been performed,
   3  * build the actual binary data.
   4  *
   5  * ----------------------------------------------------------------
   6  *
   7  * @begin[license]
   8  * Copyright (C) 2001 Jason Hickey, Caltech
   9  *
  10  * This program is free software; you can redistribute it and/or
  11  * modify it under the terms of the GNU General Public License
  12  * as published by the Free Software Foundation; either version 2
  13  * of the License, or (at your option) any later version.
  14  *
  15  * This program is distributed in the hope that it will be useful,
  16  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  17  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18  * GNU General Public License for more details.
  19  *
  20  * You should have received a copy of the GNU General Public License
  21  * along with this program; if not, write to the Free Software
  22  * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23  *
  24  * Author: Jason Hickey
  25  * @email{jyh@cs.caltech.edu}
  26  * @end[license]
  27  *)
  28 open Format
  29 open Debug
  30 open Symbol
  31
  32 open Bfd
  33 open Bfd_type
  34 open Bfd_buf
  35 open Bfd_bfd
  36 open Bfd_util
  37 open Bfd_eval
  38 open Bfd_sizeof
  39 open Bfd_state
  40
  41 (*
  42  * Raw printers.
  43  *)
  44 let bfd_print_int8 data pos i =
  45    data.[pos] <- Char.chr (i land 0xff)
  46
  47 let bfd_print_int16 data pos i =
  48    data.[pos + 0] <- Char.chr ((i lsr 0) land 0xff);
  49    data.[pos + 1] <- Char.chr ((i lsr 8) land 0xff)
  50
  51 let bfd_print_int24 data pos i =
  52    data.[pos + 0] <- Char.chr ((i lsr 0) land 0xff);
  53    data.[pos + 1] <- Char.chr ((i lsr 8) land 0xff);
  54    data.[pos + 2] <- Char.chr ((i lsr 16) land 0xff)
  55
  56 let bfd_print_int32 data pos i =
  57    data.[pos + 0] <- Char.chr ((Int32.to_int (Int32.shift_right i 0)) land 0xff);
  58    data.[pos + 1] <- Char.chr ((Int32.to_int (Int32.shift_right i 8)) land 0xff);
  59    data.[pos + 2] <- Char.chr ((Int32.to_int (Int32.shift_right i 16)) land 0xff);
  60    data.[pos + 3] <- Char.chr ((Int32.to_int (Int32.shift_right i 24)) land 0xff)
  61
  62 let bfd_print_int64 data pos i =
  63    data.[pos + 0] <- Char.chr ((Int64.to_int (Int64.shift_right i 0)) land 0xff);
  64    data.[pos + 1] <- Char.chr ((Int64.to_int (Int64.shift_right i 8)) land 0xff);
  65    data.[pos + 2] <- Char.chr ((Int64.to_int (Int64.shift_right i 16)) land 0xff);
  66    data.[pos + 3] <- Char.chr ((Int64.to_int (Int64.shift_right i 24)) land 0xff);
  67    data.[pos + 4] <- Char.chr ((Int64.to_int (Int64.shift_right i 32)) land 0xff);
  68    data.[pos + 5] <- Char.chr ((Int64.to_int (Int64.shift_right i 40)) land 0xff);
  69    data.[pos + 6] <- Char.chr ((Int64.to_int (Int64.shift_right i 48)) land 0xff);
  70    data.[pos + 7] <- Char.chr ((Int64.to_int (Int64.shift_right i 56)) land 0xff)
  71
  72 (*
  73  * Make the choice, and print the buffer.
  74  *)
  75 let rec bfd_print_choice venv data pos e cases =
  76    let rec search = function
  77       choice :: cases ->
  78          let { choice_enabled = enabled;
  79                choice_interval = interval;
  80                choice_buffer = buf
  81              } = choice
  82          in
  83             if enabled then
  84                begin
  85                   assert (interval_test (eval_eager_exp venv e) interval);
  86                   bfd_print_buf venv data pos buf
  87                end
  88             else
  89                begin
  90                   if debug debug_bfd_choice && interval_test (eval_eager_exp venv e) interval then
  91                      eprintf "Bfd_flatten.bfd_print_choice: choice was mistaken@.";
  92                   search cases
  93                end
  94     | [] ->
  95          raise (Failure "Bfd_flatten.bfd_print_item.search")
  96    in
  97       search cases
  98
  99 (*
 100  * Print an item.
 101  *)
 102 and bfd_print_item venv data pos item =
 103    match item with
 104       BufAlign size ->
 105          do_align pos size
 106     | BufSkip (bfd_skip, fill) ->
 107          let fill = Char.chr fill in
 108             for i = 0 to pred bfd_skip do
 109                data.[pos + i] <- fill
 110             done;
 111             pos + bfd_skip
 112     | BufData s ->
 113          let len = String.length s in
 114             String.blit s 0 data pos len;
 115             pos + len
 116     | BufAscii s ->
 117          let len = String.length s in
 118             String.blit s 0 data pos len;
 119             data.[pos + len] <- '\000';
 120             pos + len + 1
 121     | BufInt8 i ->
 122          bfd_print_int8 data pos i;
 123          pos + sizeof_int8
 124     | BufInt16 i ->
 125          bfd_print_int16 data pos i;
 126          pos + sizeof_int16
 127     | BufInt24 i ->
 128          bfd_print_int24 data pos i;
 129          pos + sizeof_int24
 130     | BufInt32 i ->
 131          bfd_print_int32 data pos i;
 132          pos + sizeof_int32
 133     | BufInt64 i ->
 134          bfd_print_int64 data pos i;
 135          pos + sizeof_int64
 136     | BufFloat32 x ->
 137          Float80.blit_float32 x data pos;
 138          pos + sizeof_float32
 139     | BufFloat64 x ->
 140          Float80.blit_float64 x data pos;
 141          pos + sizeof_float64
 142     | BufFloat80 x ->
 143          Float80.blit_float80 x data pos;
 144          pos + sizeof_float80
 145     | BufCommon (_, _, size) ->
 146          pos + size
 147     | BufLabel _
 148     | BufEqu _ ->
 149          pos
 150     | BufReloc reloc ->
 151          reloc.reloc_pos <- reloc.reloc_offset + pos;
 152          pos
 153     | BufChoice (e, cases) ->
 154          bfd_print_choice venv data pos e cases
 155
 156 and bfd_print_items venv data pos items =
 157    List.fold_left (bfd_print_item venv data) pos items
 158
 159 and bfd_print_buf venv data pos buf =
 160    bfd_print_items venv data pos (buffer_items buf)
 161
 162 (*
 163  * Print the data for a section.
 164  *)
 165 let bfd_print_raw_section venv sect =
 166    let { sect_name = name;
 167          sect_length = len;
 168          sect_fill = fill
 169        } = sect
 170    in
 171    let data = String.make len fill in
 172    let len' = bfd_print_buf venv data 0 sect.sect_data in
 173    let len' = do_align len' 64 in
 174       assert (len' = len);
 175       sect.sect_object <- data
 176
 177 (*
 178  * Marshal a value section.
 179  *)
 180 let bfd_print_value_section sect =
 181    let { val_data = data } = sect in
 182       sect.val_object <- Marshal.to_string data []
 183
 184 (*
 185  * Produce the object for the BFD.
 186  *)
 187 let flatten_bfd bfd =
 188    List.iter (bfd_print_raw_section bfd.bfd_venv) (raw_sections bfd);
 189    List.iter bfd_print_value_section (val_sections bfd)
 190
 191 (*!
 192  * @docoff
 193  *
 194  * -*-
 195  * Local Variables:
 196  * Caml-master: "compile"
 197  * End:
 198  * -*-
 199  *)