Docs GODI Archive
Projects Blog Knowledge

Look up function:

(e.g. "List.find" or "keysym")
More options
File ocamlnet-3.6.5/src/netstring/netnumber.mlp GODI Source ocamlnet-3.6.5
 
   netnumber.mlp  
(* $Id: netnumber.mlp 1701 2012-02-14 14:48:46Z gerd $ *)

(* NOTE: Parts of this implementation depend very much of representation
 * details of O'Caml 3.xx. It is not guaranteed that this works in future
 * versions of O'Caml as well.
 *)

(* representation types *)

IFDEF WORDSIZE_64 THEN
type int4 = int   (* faster on 64 bit platforms! *)
type uint4 = int
  (* Note that values >= 0x8000_0000 are represented as negative ints, i.e.
     the bits 32-62 are all set to 1.
   *)
ELSE
type int4 = int32
type uint4 = int32
END

type int8 = int64
type uint8 = int64

type fp4 = int32 (* string;; *)    (* IEEE representation of fp numbers *)
type fp8 = int64

exception Cannot_represent of string
(* raised if numbers are too big to map them to other type *)

exception Out_of_range

module type ENCDEC = sig
  val read_int4 : string -> int -> int4
  val read_int8 : string -> int -> int8
  val read_uint4 : string -> int -> uint4
  val read_uint8 : string -> int -> uint8

  val read_int4_unsafe : string -> int -> int4
  val read_int8_unsafe : string -> int -> int8
  val read_uint4_unsafe : string -> int -> uint4
  val read_uint8_unsafe : string -> int -> uint8

  val write_int4 : string -> int -> int4 -> unit
  val write_int8 : string -> int -> int8 -> unit
  val write_uint4 : string -> int -> uint4 -> unit
  val write_uint8 : string -> int -> uint8 -> unit

  val write_int4_unsafe : string -> int -> int4 -> unit
  val write_int8_unsafe : string -> int -> int8 -> unit
  val write_uint4_unsafe : string -> int -> uint4 -> unit
  val write_uint8_unsafe : string -> int -> uint8 -> unit

  val int4_as_string : int4 -> string
  val int8_as_string : int8 -> string
  val uint4_as_string : uint4 -> string
  val uint8_as_string : uint8 -> string

  val write_fp4 : string -> int -> fp4 -> unit
  val write_fp8 : string -> int -> fp8 -> unit

  val fp4_as_string : fp4 -> string
  val fp8_as_string : fp8 -> string
    
  val read_fp4 : string -> int -> fp4
  val read_fp8 : string -> int -> fp8
    
end


let rec cannot_represent s = 
  (* "rec" because this prevents this function from being inlined *)
  raise (Cannot_represent s)


(**********************************************************************)
(* cmp                                                                *)
(**********************************************************************)

IFDEF WORDSIZE_64 THEN
let lt_uint4 x y =
  if x < y then x >= 0 else y < x && y < 0
ELSE
let lt_uint4 x y =
  if x < y then 
    x >= 0l
      (* because:
         - if x < 0  && y < 0   ==> x >u y
         - if x < 0  && y >= 0  ==> x >u y
         - if x >= 0 && y => 0  ==> x <u y
       *)
  else (* ==>  y <= x *) 
    y < x && y < 0l
      (* because:
         - if y < 0  && x < 0  ==> x <u y
         - if y < 0  && x >= 0 ==> x <u y
         - if y >= 0 && x >= 0 ==> x >u y
       *)
END

let le_uint4 x y = not(lt_uint4 y x)
let gt_uint4 x y = lt_uint4 y x
let ge_uint4 x y = not(lt_uint4 x y)


let lt_uint8 x y =
  if x < y then x >= 0L else y < x && y < 0L

let le_uint8 x y = not(lt_uint8 y x)
let gt_uint8 x y = lt_uint8 y x
let ge_uint8 x y = not(lt_uint8 x y)


(**********************************************************************)
(* mk_[u]intn                                                         *)
(**********************************************************************)

(* compatibility interface *)

IFDEF WORDSIZE_64 THEN
let mk_int4 (c3,c2,c1,c0) =
  let n3 = (Char.code c3) in
  let n2 = (Char.code c2) in
  let n1 = (Char.code c1) in
  let n0 = (Char.code c0) in
  (* be careful to set the sign correctly: *)
  ((n3 lsl 55) asr 31) lor (n2 lsl 16) lor (n1 lsl 8) lor n0
ELSE
let mk_int4 (c3,c2,c1,c0) =
  let n3 = Int32.of_int (Char.code c3) in
  let n2 = Int32.of_int (Char.code c2) in
  let n1 = Int32.of_int (Char.code c1) in
  let n0 = Int32.of_int (Char.code c0) in
  Int32.logor
    (Int32.shift_left n3 24)
    (Int32.logor
       (Int32.shift_left n2 16)
       (Int32.logor
	  (Int32.shift_left n1 8)
	  n0))
END


let mk_int8 (c7,c6,c5,c4,c3,c2,c1,c0) =
  let n7 = Int64.of_int (Char.code c7) in
  let n6 = Int64.of_int (Char.code c6) in
  let n5 = Int64.of_int (Char.code c5) in
  let n4 = Int64.of_int (Char.code c4) in
  let n3 = Int64.of_int (Char.code c3) in
  let n2 = Int64.of_int (Char.code c2) in
  let n1 = Int64.of_int (Char.code c1) in
  let n0 = Int64.of_int (Char.code c0) in

  Int64.logor
    (Int64.shift_left n7 56)
    (Int64.logor
       (Int64.shift_left n6 48)
       (Int64.logor
	  (Int64.shift_left n5 40)
	  (Int64.logor
	     (Int64.shift_left n4 32)
	     (Int64.logor
		(Int64.shift_left n3 24)
		(Int64.logor
		   (Int64.shift_left n2 16)
		   (Int64.logor
		      (Int64.shift_left n1 8)
		      n0))))))


let mk_uint4 = mk_int4
let mk_uint8 = mk_int8

(**********************************************************************)
(* dest_[u]intn                                                       *)
(**********************************************************************)

(* compatibility interface *)

IFDEF WORDSIZE_64 THEN
let dest_int4 x =
  let n3 = (x lsr 24) land 0xff in
  let n2 = (x lsr 16) land 0xff in
  let n1 = (x lsr 8) land 0xff in
  let n0 = x land 0xff in
  (Char.chr n3, Char.chr n2, Char.chr n1, Char.chr n0)
ELSE
let dest_int4 x =
  let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in
  let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in
  let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in
  let n0 = Int32.to_int (Int32.logand x 0xffl) in
  (Char.chr n3, Char.chr n2, Char.chr n1, Char.chr n0)
END

let dest_int8 x =
  let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
			   0xffL) in
  let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
			   0xffL) in
  let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
			   0xffL) in
  let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
			   0xffL) in
  let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
			   0xffL) in
  let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
			   0xffL) in
  let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
			   0xffL) in
  let n0 = Int64.to_int (Int64.logand x 0xffL) in
  (Char.chr n7, Char.chr n6, Char.chr n5, Char.chr n4,
   Char.chr n3, Char.chr n2, Char.chr n1, Char.chr n0)



let dest_uint4 = dest_int4
let dest_uint8 = dest_int8

(**********************************************************************)
(* int_of_[u]intn                                                     *)
(**********************************************************************)

let c_max_int_64 = Int64.of_int max_int
let c_min_int_64 = Int64.of_int min_int


let name_int_of_int4 = "int_of_int4"

IFDEF WORDSIZE_64 THEN
let int_of_int4 x = x
ELSE
let int_of_int4 x =
  if x < (-0x4000_0000l) || x > 0x3fff_ffffl then
    cannot_represent name_int_of_int4;
  Int32.to_int x
END


let name_int_of_uint4 = "int_of_uint4"

IFDEF WORDSIZE_64 THEN
let int_of_uint4 x =
  (* x land 0xffff_ffff - "Integer literal exceeds the range..." grrrmpf *)
  (x lsl 31) lsr 31
ELSE
let int_of_uint4 x =
  if x >= 0l && x <= 0x3fff_ffffl then
    Int32.to_int x
  else
    cannot_represent name_int_of_uint4
END


let name_int_of_int8 = "int_of_int8"

let int_of_int8 x =
  if x >= c_min_int_64 && x <= c_max_int_64 then
    Int64.to_int x
  else
    cannot_represent name_int_of_int8



let name_int_of_uint8 = "int_of_uint8"

let int_of_uint8 x =
  if x >= Int64.zero && x <= c_max_int_64 then
    Int64.to_int x
  else
    cannot_represent name_int_of_uint8


(**********************************************************************)
(* intn_of_int                                                        *)
(**********************************************************************)

let name_int4_of_int = "int4_of_int"

IFDEF WORDSIZE_64 THEN
let int4_of_int i =
  let j = i asr 31 in
  if j = 0 || j = (-1) then 
    i
  else
    cannot_represent name_int4_of_int
ELSE
let int4_of_int i =
  Int32.of_int i
END


let name_uint4_of_int = "uint4_of_int"

IFDEF WORDSIZE_64 THEN
let uint4_of_int i =
  let j = i asr 32 in
  if j = 0 then
    (i lsl 31) asr 31  (* fix sign *)
  else
    cannot_represent name_uint4_of_int
ELSE
let uint4_of_int i =
  if i >= 0 then
    Int32.of_int i
  else
    cannot_represent name_uint4_of_int
END


let int8_of_int = Int64.of_int 


let name_uint8_of_int = "uint8_of_int"

let uint8_of_int i =
  if i >= 0 then
    Int64.of_int i
  else
    cannot_represent name_uint8_of_int



(**********************************************************************)
(* Int32 and Int64 support: int[32|64]_of_[u]intn                     *)
(**********************************************************************)

IFDEF WORDSIZE_64 THEN
let int32_of_int4 x = Int32.of_int x 
ELSE
let int32_of_int4 x = x 
END

let name_int32_of_uint4 = "int32_of_uint4"

IFDEF WORDSIZE_64 THEN
let int32_of_uint4 x =
  if x >= 0 then
    Int32.of_int x
  else
    cannot_represent name_int32_of_uint4
ELSE
let int32_of_uint4 x =
  if x >= 0l then
    x
  else
    cannot_represent name_int32_of_uint4
END


let c_int32_min_int_64 = Int64.of_int32 Int32.min_int 
let c_int32_max_int_64 = Int64.of_int32 Int32.max_int 

let name_int32_of_int8 = "int32_of_int8"

let int32_of_int8 x =
  if x >= (-0x8000_0000L) && x <= 0x7fff_0000L then
    Int64.to_int32 x
  else
    cannot_represent name_int32_of_int8



let name_int32_of_uint8 = "int32_of_uint8"

let int32_of_uint8 x =
  if x >= 0L && x <= 0x7fff_0000L then
    Int64.to_int32 x
  else
    cannot_represent name_int32_of_uint8


IFDEF WORDSIZE_64 THEN
let int64_of_int4 = Int64.of_int
ELSE
let int64_of_int4 = Int64.of_int32 
END


IFDEF WORDSIZE_64 THEN
let int64_of_uint4 x =
if x >= 0 then
    Int64.of_int x
  else
    Int64.add (Int64.of_int x) 0x1_0000_0000L
ELSE
let int64_of_uint4 x =
  if x >= 0l then
    Int64.of_int32 x
  else
    Int64.add (Int64.of_int32 x) 0x1_0000_0000L
END


let int64_of_int8 x = x 

let name_int64_of_uint8 = "int64_of_uint8"

let int64_of_uint8 x =
  if x >= 0L then
    x
  else
    cannot_represent name_int64_of_uint8



(**********************************************************************)
(* Int32 and Int64 support: [u]intn_of_int[32|64]                     *)
(**********************************************************************)

IFDEF WORDSIZE_64 THEN
let int4_of_int32 = Int32.to_int
ELSE
let int4_of_int32 x = x
END


let name_uint4_of_int32 = "uint4_of_int32"

let uint4_of_int32 i =
  if i < 0l then
    cannot_represent name_uint4_of_int32;
  int4_of_int32 i


let int8_of_int32 =
  Int64.of_int32


let name_uint8_of_int32 = "uint8_of_int32"

let uint8_of_int32 i =
  if i < 0l then
    cannot_represent name_uint8_of_int32;
  Int64.of_int32 i


let name_int4_of_int64 = "int4_of_int64"

IFDEF WORDSIZE_64 THEN
let int4_of_int64 i =
  if i >= (-0x8000_0000L) && i <= 0x7fff_ffffL then
    Int64.to_int i
  else cannot_represent name_int4_of_int64
ELSE
let int4_of_int64 i =
  if i >= (-0x8000_0000L) && i <= 0x7fff_ffffL then
    Int64.to_int32 i
  else cannot_represent name_int4_of_int64
END

let name_uint4_of_int64 = "uint4_of_int64"

let uint4_of_int64 i =
  if i < 0L || i > 0xffff_ffffL then
    cannot_represent name_uint4_of_int64;
IFDEF WORDSIZE_64 THEN
  Int64.to_int(Int64.shift_right (Int64.shift_left i 32) 32)  (* sign! *)
ELSE
  Int64.to_int32 i
END


let int8_of_int64 i = i 

let name_uint8_of_int64 = "uint8_of_int64"

let uint8_of_int64 i =
  if i < 0L then
    cannot_represent name_uint8_of_int64;
  i


(**********************************************************************)
(* logical_xxx_of_xxx                                                 *)
(**********************************************************************)

IFDEF WORDSIZE_64 THEN
let logical_uint4_of_int32 x = Int32.to_int x
let logical_int32_of_uint4 x = Int32.of_int x
ELSE
let logical_uint4_of_int32 x = x
let logical_int32_of_uint4 x = x
END

let logical_uint8_of_int64 x = x
let logical_int64_of_uint8 x = x

(**********************************************************************)
(* min/max                                                            *)
(**********************************************************************)

let min_int4 = int4_of_int32 Int32.min_int
let min_uint4 = uint4_of_int 0
let min_int8 = int8_of_int64 Int64.min_int
let min_uint8 = uint8_of_int 0

let max_int4 = int4_of_int32 Int32.max_int
let max_uint4 = logical_uint4_of_int32 (-1l)
let max_int8 = int8_of_int64 Int64.max_int
let max_uint8 = logical_uint8_of_int64 (-1L)


(**********************************************************************)
(* floating point                                                     *)
(**********************************************************************)

let fp8_of_fp4 x =
  (* Requires O'Caml >= 3.08 *)
  Int64.bits_of_float (Int32.float_of_bits x)

let fp4_of_fp8 x =
  (* Requires O'Caml >= 3.08 *)
  Int32.bits_of_float (Int64.float_of_bits x)

let float_of_fp8 x =
  (* Requires O'Caml >= 3.01 *)
  Int64.float_of_bits x



let float_of_fp4 x =
  (* Requires O'Caml >= 3.08 *)
  Int32.float_of_bits x
  (* Old:
   *  float_of_fp8 (fp8_of_fp4 x)
   *)



let fp8_of_float x =
  (* Requires O'Caml >= 3.01 *)
  Int64.bits_of_float x



let fp4_of_float x =
  (* Requires O'Caml >= 3.08 *)
  Int32.bits_of_float x
  (* Old:
   * fp4_of_fp8 (fp8_of_float x)
   *)


let mk_fp4 x = int32_of_int4 (mk_int4 x)
let mk_fp8 = mk_int8
let dest_fp4 x = dest_int4 (int4_of_int32 x)
let dest_fp8 = dest_int8


module BE : ENCDEC = struct
  (**********************************************************************)
  (* read_[u]intn                                                       *)
  (**********************************************************************)
  
  IFDEF WORDSIZE_64 THEN
    IFDEF USE_NETSYS_XDR THEN
  let read_int4_unsafe =
    Netsys_xdr.s_read_int4_64_unsafe
    ELSE
  let read_int4_unsafe s pos =
    let n3 = Char.code (String.unsafe_get s pos) in
    let x = (n3 lsl 55) asr 31 in  (* sign! *)
    let n2 = Char.code (String.unsafe_get s (pos+1)) in
    let x = x lor (n2 lsl 16) in
    let n1 = Char.code (String.unsafe_get s (pos+2)) in
    let x = x lor (n1 lsl 8) in
    let n0 = Char.code (String.unsafe_get s (pos+3)) in
    x lor n0
     END
   ELSE
  let read_int4_unsafe s pos =
    let n3 = Int32.of_int (Char.code (String.unsafe_get s pos)) in
    let x = Int32.shift_left n3 24 in
    let n2 = Int32.of_int (Char.code (String.unsafe_get s (pos+1))) in
    let x = Int32.logor x (Int32.shift_left n2 16) in
    let n1 = Int32.of_int (Char.code (String.unsafe_get s (pos+2))) in
    let x = Int32.logor x (Int32.shift_left n1 8) in
    let n0 = Int32.of_int (Char.code (String.unsafe_get s (pos+3))) in
    Int32.logor x n0
   END
(*
  seems to be slightly better than

  Int32.logor
    (Int32.shift_left n3 24)
    (Int32.logor
       (Int32.shift_left n2 16)
       (Int32.logor
	  (Int32.shift_left n1 8)
	  n0))
*)


  let read_int4 s pos =
    if pos < 0 || pos + 4 > String.length s then
      raise Out_of_range;
    read_int4_unsafe s pos
      

  IFDEF WORDSIZE_64 THEN
    IFDEF USE_NETSYS_XDR THEN
      DEFINE FAST_READ_INT8
    END
  END

  IFDEF FAST_READ_INT8 THEN
  let read_int8_unsafe s pos =
    let x1 = Netsys_xdr.s_read_int4_64_unsafe s pos in
    let x0 = Netsys_xdr.s_read_int4_64_unsafe s (pos+4) in
    Int64.logor
      (Int64.logand (Int64.of_int x0) 0xFFFF_FFFFL)
      (Int64.shift_left (Int64.of_int x1) 32)
  ELSE
  let read_int8_unsafe s pos =
    let n7 = Int64.of_int (Char.code (String.unsafe_get s pos)) in
    let x = Int64.shift_left n7 56 in
    
    let n6 = Int64.of_int (Char.code (String.unsafe_get s (pos+1))) in
    let x = Int64.logor x (Int64.shift_left n6 48) in
    
    let n5 = Int64.of_int (Char.code (String.unsafe_get s (pos+2))) in
    let x = Int64.logor x (Int64.shift_left n5 40) in
    
    let n4 = Int64.of_int (Char.code (String.unsafe_get s (pos+3))) in
    let x = Int64.logor x (Int64.shift_left n4 32) in
    
    let n3 = Int64.of_int (Char.code (String.unsafe_get s (pos+4))) in
    let x = Int64.logor x (Int64.shift_left n3 24) in
    
    let n2 = Int64.of_int (Char.code (String.unsafe_get s (pos+5))) in
    let x = Int64.logor x (Int64.shift_left n2 16) in
    
    let n1 = Int64.of_int (Char.code (String.unsafe_get s (pos+6))) in
    let x = Int64.logor x (Int64.shift_left n1 8) in
    
    let n0 = Int64.of_int (Char.code (String.unsafe_get s (pos+7))) in
    Int64.logor x n0
  END      


  let read_int8 s pos =
    if pos < 0 || pos + 8 > String.length s then
      raise Out_of_range;
    read_int8_unsafe s pos
      

  let read_uint4 = read_int4
  let read_uint8 = read_int8
  let read_uint4_unsafe = read_int4_unsafe
  let read_uint8_unsafe = read_int8_unsafe;;
    

  (**********************************************************************)
  (* write_[u]intn                                                      *)
  (**********************************************************************)

  IFDEF WORDSIZE_64 THEN
    IFDEF USE_NETSYS_XDR THEN
  let write_int4_unsafe =
    Netsys_xdr.s_write_int4_64_unsafe
    ELSE
  let write_int4_unsafe s pos x =
    let n3 = (x lsr 24) land 0xff in
    String.unsafe_set s pos (Char.unsafe_chr n3);
    let n2 = (x lsr 16) land 0xff in
    String.unsafe_set s (pos+1) (Char.unsafe_chr n2);
    let n1 = (x lsr 8) land 0xff in
    String.unsafe_set s (pos+2) (Char.unsafe_chr n1);
    let n0 = x land 0xff in
    String.unsafe_set s (pos+3) (Char.unsafe_chr n0);
    ()
    END
  ELSE
  let write_int4_unsafe s pos x =
    let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in
    String.unsafe_set s pos (Char.unsafe_chr n3);
    let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in
    String.unsafe_set s (pos+1) (Char.unsafe_chr n2);
    let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in
    String.unsafe_set s (pos+2) (Char.unsafe_chr n1);
    let n0 = Int32.to_int (Int32.logand x 0xffl) in
    String.unsafe_set s (pos+3) (Char.unsafe_chr n0);
    ()
   END ;;


  let write_int4 s pos x =
    if pos < 0 || pos + 4 > String.length s then
      raise Out_of_range;
    write_int4_unsafe s pos x

  IFDEF WORDSIZE_64 THEN
    IFDEF USE_NETSYS_XDR THEN
      DEFINE FAST_WRITE_INT8
    END
  END

  IFDEF FAST_WRITE_INT8 THEN
  let write_int8_unsafe s pos x =
    Netsys_xdr.s_write_int4_64_unsafe s pos
      (Int64.to_int (Int64.shift_right x 32));
    Netsys_xdr.s_write_int4_64_unsafe s (pos+4)
      (Int64.to_int (Int64.logand x 0xFFFF_FFFFL))
  ELSE
  let write_int8_unsafe s pos x =
    let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
			     0xffL) in
    String.unsafe_set s pos (Char.unsafe_chr n7);
    
    let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
			     0xffL) in
    String.unsafe_set s (pos+1) (Char.unsafe_chr n6);
    
    let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
			     0xffL) in
    String.unsafe_set s (pos+2) (Char.unsafe_chr n5);
    
    let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
			     0xffL) in
    String.unsafe_set s (pos+3) (Char.unsafe_chr n4);
    
    let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
			     0xffL) in
    String.unsafe_set s (pos+4) (Char.unsafe_chr n3);
    
    let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
			     0xffL) in
    String.unsafe_set s (pos+5) (Char.unsafe_chr n2);
    
    let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
			     0xffL) in
    String.unsafe_set s (pos+6) (Char.unsafe_chr n1);
    
    let n0 = Int64.to_int (Int64.logand x 0xffL) in
    String.unsafe_set s (pos+7) (Char.unsafe_chr n0);
    ()
  END


  let write_int8 s pos x =
    if pos < 0 || pos + 8 > String.length s then
      raise Out_of_range;
    write_int8_unsafe s pos x
      


  let write_uint4 = write_int4
  let write_uint8 = write_int8
  let write_uint4_unsafe = write_int4_unsafe
  let write_uint8_unsafe = write_int8_unsafe
    
  (**********************************************************************)
  (* [u]intn_as_string                                                  *)
  (**********************************************************************)
    
  let int4_as_string x =
    let s = String.create 4 in
    write_int4 s 0 x;
    s


  let uint4_as_string x =
    let s = String.create 4 in
    write_uint4 s 0 x;
    s


  let int8_as_string x =
    let s = String.create 8 in
    write_int8 s 0 x;
    s


  let uint8_as_string x =
    let s = String.create 8 in
    write_int8 s 0 x;
    s


  (**********************************************************************)
  (* floating-point numbers                                             *)
  (**********************************************************************)
      
  let fp4_as_string x = int4_as_string (int4_of_int32 x)
  let fp8_as_string x = int8_as_string (int8_of_int64 x)
    
  let read_fp4 s pos =
    int32_of_int4(read_int4 s pos)

  let read_fp8 s pos =
    int64_of_int8(read_int8 s pos)

  let write_fp4 s pos x =
    write_int4 s pos (int4_of_int32 x)

  let write_fp8 s pos x =
    write_int8 s pos (int8_of_int64 x)
end


module LE : ENCDEC = struct
  (**********************************************************************)
  (* read_[u]intn                                                       *)
  (**********************************************************************)
  
  IFDEF WORDSIZE_64 THEN
(*
    IFDEF USE_NETSYS_XDR THEN
  let read_int4_unsafe =
    Netsys_xdr.s_read_int4_64_unsafe  (* FIXME *)
    ELSE
 *)
  let read_int4_unsafe s pos =
    let n3 = Char.code (String.unsafe_get s (pos+3)) in
    let x = (n3 lsl 55) asr 31 in  (* sign! *)
    let n2 = Char.code (String.unsafe_get s (pos+2)) in
    let x = x lor (n2 lsl 16) in
    let n1 = Char.code (String.unsafe_get s (pos+1)) in
    let x = x lor (n1 lsl 8) in
    let n0 = Char.code (String.unsafe_get s pos) in
    x lor n0
    (* END *)
   ELSE
  let read_int4_unsafe s pos =
    let n3 = Int32.of_int (Char.code (String.unsafe_get s (pos+3))) in
    let x = Int32.shift_left n3 24 in
    let n2 = Int32.of_int (Char.code (String.unsafe_get s (pos+2))) in
    let x = Int32.logor x (Int32.shift_left n2 16) in
    let n1 = Int32.of_int (Char.code (String.unsafe_get s (pos+1))) in
    let x = Int32.logor x (Int32.shift_left n1 8) in
    let n0 = Int32.of_int (Char.code (String.unsafe_get s pos)) in
    Int32.logor x n0
   END

  let read_int4 s pos =
    if pos < 0 || pos + 4 > String.length s then
      raise Out_of_range;
    read_int4_unsafe s pos
      


  let read_int8_unsafe s pos =
    let n7 = Int64.of_int (Char.code (String.unsafe_get s (pos+7))) in
    let x = Int64.shift_left n7 56 in
    
    let n6 = Int64.of_int (Char.code (String.unsafe_get s (pos+6))) in
    let x = Int64.logor x (Int64.shift_left n6 48) in
    
    let n5 = Int64.of_int (Char.code (String.unsafe_get s (pos+5))) in
    let x = Int64.logor x (Int64.shift_left n5 40) in
    
    let n4 = Int64.of_int (Char.code (String.unsafe_get s (pos+4))) in
    let x = Int64.logor x (Int64.shift_left n4 32) in
    
    let n3 = Int64.of_int (Char.code (String.unsafe_get s (pos+3))) in
    let x = Int64.logor x (Int64.shift_left n3 24) in
    
    let n2 = Int64.of_int (Char.code (String.unsafe_get s (pos+2))) in
    let x = Int64.logor x (Int64.shift_left n2 16) in
    
    let n1 = Int64.of_int (Char.code (String.unsafe_get s (pos+1))) in
    let x = Int64.logor x (Int64.shift_left n1 8) in
    
    let n0 = Int64.of_int (Char.code (String.unsafe_get s pos)) in
    Int64.logor x n0
      


  let read_int8 s pos =
    if pos < 0 || pos + 8 > String.length s then
      raise Out_of_range;
    read_int8_unsafe s pos
      

  let read_uint4 = read_int4
  let read_uint8 = read_int8
  let read_uint4_unsafe = read_int4_unsafe
  let read_uint8_unsafe = read_int8_unsafe;;
    

  (**********************************************************************)
  (* write_[u]intn                                                      *)
  (**********************************************************************)

  IFDEF WORDSIZE_64 THEN
(*
    IFDEF USE_NETSYS_XDR THEN
  let write_int4_unsafe =
    Netsys_xdr.s_write_int4_64_unsafe
    ELSE
 *)
  let write_int4_unsafe s pos x =
    let n3 = (x lsr 24) land 0xff in
    String.unsafe_set s (pos+3) (Char.unsafe_chr n3);
    let n2 = (x lsr 16) land 0xff in
    String.unsafe_set s (pos+2) (Char.unsafe_chr n2);
    let n1 = (x lsr 8) land 0xff in
    String.unsafe_set s (pos+1) (Char.unsafe_chr n1);
    let n0 = x land 0xff in
    String.unsafe_set s pos (Char.unsafe_chr n0);
    ()
   (* END *)
  ELSE
  let write_int4_unsafe s pos x =
    let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in
    String.unsafe_set s (pos+3) (Char.unsafe_chr n3);
    let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in
    String.unsafe_set s (pos+2) (Char.unsafe_chr n2);
    let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in
    String.unsafe_set s (pos+1) (Char.unsafe_chr n1);
    let n0 = Int32.to_int (Int32.logand x 0xffl) in
    String.unsafe_set s pos (Char.unsafe_chr n0);
    ()
   END ;;


  let write_int4 s pos x =
    if pos < 0 || pos + 4 > String.length s then
      raise Out_of_range;
    write_int4_unsafe s pos x



  let write_int8_unsafe s pos x =
    let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
			     0xffL) in
    String.unsafe_set s (pos+7) (Char.unsafe_chr n7);
    
    let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
			     0xffL) in
    String.unsafe_set s (pos+6) (Char.unsafe_chr n6);
    
    let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
			     0xffL) in
    String.unsafe_set s (pos+5) (Char.unsafe_chr n5);
    
    let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
			     0xffL) in
    String.unsafe_set s (pos+4) (Char.unsafe_chr n4);
    
    let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
			     0xffL) in
    String.unsafe_set s (pos+3) (Char.unsafe_chr n3);
    
    let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
			     0xffL) in
    String.unsafe_set s (pos+2) (Char.unsafe_chr n2);
    
    let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
			     0xffL) in
    String.unsafe_set s (pos+1) (Char.unsafe_chr n1);
    
    let n0 = Int64.to_int (Int64.logand x 0xffL) in
    String.unsafe_set s pos (Char.unsafe_chr n0);
    ()



  let write_int8 s pos x =
    if pos < 0 || pos + 8 > String.length s then
      raise Out_of_range;
    write_int8_unsafe s pos x
      


  let write_uint4 = write_int4
  let write_uint8 = write_int8
  let write_uint4_unsafe = write_int4_unsafe
  let write_uint8_unsafe = write_int8_unsafe
    
  (**********************************************************************)
  (* [u]intn_as_string                                                  *)
  (**********************************************************************)
    
  let int4_as_string x =
    let s = String.create 4 in
    write_int4 s 0 x;
    s


  let uint4_as_string x =
    let s = String.create 4 in
    write_uint4 s 0 x;
    s


  let int8_as_string x =
    let s = String.create 8 in
    write_int8 s 0 x;
    s


  let uint8_as_string x =
    let s = String.create 8 in
    write_int8 s 0 x;
    s


  (**********************************************************************)
  (* floating-point numbers                                             *)
  (**********************************************************************)
      
  let fp4_as_string x = int4_as_string (int4_of_int32 x)
  let fp8_as_string x = int8_as_string (int8_of_int64 x)
    
  let read_fp4 s pos =
    int32_of_int4(read_int4 s pos)

  let read_fp8 s pos =
    int64_of_int8(read_int8 s pos)

  let write_fp4 s pos x =
    write_int4 s pos (int4_of_int32 x)

  let write_fp8 s pos x =
    write_int8 s pos (int8_of_int64 x)
end


IFDEF HOST_IS_BIG_ENDIAN THEN
module HO = BE
ELSE
module HO = LE
END

This web site is published by Informatikbüro Gerd Stolpmann
Powered by Caml