Blob Blame History Raw
(**************************************************************************)
(*  ocaml-gettext: a library to translate messages                        *)
(*                                                                        *)
(*  Copyright (C) 2003-2008 Sylvain Le Gall <sylvain@le-gall.net>         *)
(*                                                                        *)
(*  This library is free software; you can redistribute it and/or         *)
(*  modify it under the terms of the GNU Lesser General Public            *)
(*  License as published by the Free Software Foundation; either          *)
(*  version 2.1 of the License, or (at your option) any later version;    *)
(*  with the OCaml static compilation exception.                          *)
(*                                                                        *)
(*  This library is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Lesser General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Lesser General Public      *)
(*  License along with this library; if not, write to the Free Software   *)
(*  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307   *)
(*  USA                                                                   *)
(**************************************************************************)

(**
    @author Sylvain Le Gall
  *)

open GettextTypes;;

let int32_of_byte (a0,a1,a2,a3) = 
  Int32.add 
    (Int32.shift_left (Int32.of_int a0) 24) 
    (Int32.of_int 
      ( 
        (a1 lsl 16) + 
        (a2 lsl  8) +
        a3
      )
    )
;;

let byte_of_int32 i = 
  let one_byte = Int32.of_int 0xFF
  in
  let extract_byte sb = 
    let mask = 
      Int32.shift_left one_byte ( sb * 8 ) 
    in
    let i_masked = 
      Int32.logand i mask
    in
    Int32.to_int (Int32.shift_right i_masked ( sb * 8 ))
  in
  ( extract_byte 3, extract_byte 2, extract_byte 1, extract_byte 0 )
;;

let input_int32 chn endian = 
  let (a0,a1,a2,a3) = 
    (
      input_byte chn, 
      input_byte chn, 
      input_byte chn, 
      input_byte chn 
    )
  in
  match endian with 
    BigEndian ->
      int32_of_byte (a0,a1,a2,a3)
  | LittleEndian ->
      int32_of_byte (a3,a2,a1,a0)
;;

let output_int32 chn endian vl =
  let (a0,a1,a2,a3) = 
    byte_of_int32 vl
  in
  let order = 
    match endian with
      BigEndian ->
        [a0;a1;a2;a3]
    | LittleEndian ->
        [a3;a2;a1;a0]
  in
  List.iter (output_byte chn) order
;;

let input_int32_pair chn endian =  
   let a = input_int32 chn endian
   in
   let b = input_int32 chn endian
   in
   (a, b)
;;

let output_int32_pair chn endian (a,b) = 
  output_int32 chn endian a;
  output_int32 chn endian b
;;

let input_int32_pair_string chn endian =
   let (length,offset) = 
     input_int32_pair chn endian
   in
   let (ilength,ioffset) = 
     (Int32.to_int length,Int32.to_int offset)
   in
   if 0 <= ioffset + ilength && ioffset + ilength < in_channel_length chn then
     let str = Bytes.make ilength 'X'
     in
     seek_in chn ioffset;
     really_input chn str 0 ilength;
     Bytes.to_string str
   else
     (* We use this exception, because that what should happen if we try to 
        read the string *)
     raise End_of_file
;;