From 8c2be1f021e65637f24b0ecd1907f7a069e347a2 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 1970 00:00:00 +0000 Subject: [PATCH] Add int63 type. --- .hgignore | 3 +- Makefile.in | 2 +- lib/.depend | 4 ++ lib/Makefile.in | 19 ++++++- lib/diskimage.mli | 11 ++++ lib/int63.mli | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/int63_on_32.ml | 85 +++++++++++++++++++++++++++++++ lib/int63_on_64.ml | 82 ++++++++++++++++++++++++++++++ lib/test_int63.ml | 7 +++ 9 files changed, 355 insertions(+), 3 deletions(-) create mode 100644 lib/int63.mli create mode 100644 lib/int63_on_32.ml create mode 100644 lib/int63_on_64.ml create mode 100644 lib/test_int63.ml diff --git a/.hgignore b/.hgignore index d688cb3..d9e44d7 100644 --- a/.hgignore +++ b/.hgignore @@ -35,4 +35,5 @@ po/*.mo po/*.po.bak lib/diskimage_lvm2_lexer.ml lib/diskimage_lvm2_parser.ml -lib/diskimage_lvm2_parser.mli \ No newline at end of file +lib/diskimage_lvm2_parser.mli +lib/int63.ml \ No newline at end of file diff --git a/Makefile.in b/Makefile.in index 127a260..1eda991 100644 --- a/Makefile.in +++ b/Makefile.in @@ -53,7 +53,7 @@ doc: -cd lib; \ $(OCAMLDOC) $(OCAMLDOCFLAGS) -d ../html \ -I +extlib -I +bitmatch \ - diskimage.mli diskimage.ml + int63.mli diskimage.mli diskimage.ml endif # Distribution. diff --git a/lib/.depend b/lib/.depend index a2677bf..580dcca 100644 --- a/lib/.depend +++ b/lib/.depend @@ -33,3 +33,7 @@ diskimage.cmx: diskimage_utils.cmx diskimage_mbr.cmx diskimage_lvm2.cmx \ diskimage_linux_swap.cmx diskimage_ext2.cmx diskimage.cmi diskimage_utils.cmo: diskimage_utils.cmi diskimage_utils.cmx: diskimage_utils.cmi +int63.cmo: int63.cmi +int63.cmx: int63.cmi +test_int63.cmo: int63.cmi +test_int63.cmx: int63.cmx diff --git a/lib/Makefile.in b/lib/Makefile.in index 9dae7b9..185969e 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -21,6 +21,8 @@ VERSION := @PACKAGE_VERSION@ INSTALL := @INSTALL@ HAVE_PERLDOC := @HAVE_PERLDOC@ +OCAML_WORD_SIZE := @OCAML_WORD_SIZE@ + prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ @@ -31,7 +33,8 @@ OCAMLCPACKAGES := -package unix,extlib -I +bitmatch #---------------------------------------------------------------------- # Build up the list of object files. -OBJS := diskimage_utils.cmo +OBJS := int63.cmo \ + diskimage_utils.cmo # Plugin objects. OBJS += diskimage_ext2.cmo \ @@ -83,6 +86,20 @@ diskimage_lvm2_parser.cmo: diskimage_lvm2_parser.cmi diskimage_lvm2_parser.cmx: diskimage_lvm2_parser.cmi diskimage_lvm2_parser.cmi: diskimage_lvm2_parser.mli +# Int63 module implementation is defined differently on +# 32 and 64 bit platforms. +int63.ml: int63_on_$(OCAML_WORD_SIZE).ml Makefile + rm -f $@ + echo "(* WARNING: THIS FILE IS GENERATED FROM $< *)" | \ + cat - $< > $@ + +int63.cmo: int63.cmi +int63.cmx: int63.cmi +int63.cmi: int63.ml + +#test_int63.opt: int63.cmx test_int63.cmx +# $(OCAMLFIND) ocamlopt $^ -o $@ + install: ocamlfind install diskimage *.mli *.cma *.cmx *.cmxa *.a diff --git a/lib/diskimage.mli b/lib/diskimage.mli index 7d51e93..3f59bad 100644 --- a/lib/diskimage.mli +++ b/lib/diskimage.mli @@ -108,6 +108,17 @@ class offset_device : string -> int64 -> int64 -> int -> device -> Useful for things like partitions. *) +class blocksize_overlay : int -> device -> + object + method name : string + method size : int64 + method read : int64 -> int -> string + method read_bitstring : int64 -> int -> Bitmatch.bitstring + method blocksize : int + method mapblock : int64 -> (device * int64) list + end + (** Change the blocksize of an existing device. *) + val null_device : device (** The null device. Any attempt to read generates an error. *) diff --git a/lib/int63.mli b/lib/int63.mli new file mode 100644 index 0000000..3209d08 --- /dev/null +++ b/lib/int63.mli @@ -0,0 +1,145 @@ +(** 63 bit signed integer type *) +(* (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(** This module deals with creating an efficient 63 bit signed integer + type. + + In OCaml, the basic [int] type is fast because it is unboxed, but + it has a different size on 32 and 64 bit platforms (31 and 63 bits + respectively). If we want a large integer type we can use the + OCaml [int64] type, but that is boxed and hence operations are + slow, even on 64 bit platforms. + + This type gives us a large integer (up to 63 bits, therefore fine + for things involving eg. large disk file sizes), but retains + efficiency. On 64 bit platforms it degenerates into just a normal + [int], hence unboxed and fast. On 32 bit platforms it degenerates + to a kind of [int64], which is boxed and slow but hey 32 bit + platforms are going the way of all things anyway. + + The implementation of this type is in the files [int63_on_32.ml] + or [int63_on_64.ml] for 32 bit and 64 bit platforms respectively. + The appropriate implementation is copied by the Makefile to + [int63.ml]. +*) + +(** {2 Type Int63.t} + + OCaml cross-module inlining means that the compiler gets to + inline [int] operations directly and efficiently on 64 bit + platforms. However we still need to hide the actual type + to prevent people from writing code that accidentally depends + on 32/64-bit platform differences. +*) + +type t + +(** {2 Operators} + + It is recommended to do [open Int63.Operators] in your code + so that you get the operators [+^], [-^] .. and the type [int63] + directly, and can still use the less frequent functions + as [Int63.logand] etc. +*) + +module Operators : sig + type int63 = t + + val ( +^ ) : t -> t -> t + val ( -^ ) : t -> t -> t + val ( *^ ) : t -> t -> t + val ( /^ ) : t -> t -> t + (** Arithmetic operators. *) + + val ( <<^ ) : t -> int -> t + val ( >>^ ) : t -> int -> t + (** Shift left and logical shift right. *) + + val ( ~^ ) : int -> t + (** Constant, eg. [~^0] is the constant zero. *) + val ( ~^~ ) : int -> t + (** Negative constant, eg. [~^~1] is the constant minus one. *) +end + +(** {2 Functions} + + These functions are analogous to the similarly named + functions available in the standard library [Int32] and + [Int64] modules. *) + +val zero : t +val one : t +val minus_one : t + (** Some constants. *) + +val neg : t -> t + (** Negate. *) + +val add : t -> t -> t +val sub : t -> t -> t +val mul : t -> t -> t +val div : t -> t -> t +val rem : t -> t -> t + (** Arithmetic. *) + +val succ : t -> t + (** Successor. *) +val pred : t -> t + (** Predecessor. *) + +val abs : t -> t + (** Absolute value. *) + +val max_int : t + (** The constant [2{^62}-1]. *) +val min_int : t + (** The constant [-2{^62}]. *) + +val logand : t -> t -> t +val logor : t -> t -> t +val logxor : t -> t -> t +val lognot : t -> t + (** Bitwise logical and, or, xor and not. *) + +val shift_left : t -> int -> t + (** Shift the number left by the integer number of bits. *) +val shift_right : t -> int -> t + (** Arithmetic shift the number right by the integer number of bits. + The sign bit is replicated into the vacated bits. *) +val shift_right_logical : t -> int -> t + (** Logical shift the number right by the integer number of bits. + The vacated bits are filled with bit [0] regardless of sign. *) + +val of_int : int -> t +val to_int : t -> int +val of_float : float -> t +val to_float : t -> float +val of_int32 : int32 -> t +val to_int32 : t -> int32 +val of_int64 : int64 -> t +val to_int64 : t -> int64 +val of_nativeint : nativeint -> t +val to_nativeint : t -> nativeint + (** Convert between t and various standard types. *) + +val of_string : string -> t +val to_string : t -> string + (** Convert between string. *) + +val compare : t -> t -> int + (** Compare two numbers. *) diff --git a/lib/int63_on_32.ml b/lib/int63_on_32.ml new file mode 100644 index 0000000..37349ad --- /dev/null +++ b/lib/int63_on_32.ml @@ -0,0 +1,85 @@ +(* 63 bit signed integer type. + (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This is the 32 bit implementation so we have to use the boxed + * and rather slow int64. + * + * Note that this code isn't quite correct, although not in a way + * that anyone is likely to notice, in that we don't truncate the + * underlying int64 to 63 bits on overflow. + *) +type t = int64 + +module Operators = struct + type int63 = t + + external ( +^ ) : int64 -> int64 -> int64 = "%int64_add" + external ( -^ ) : int64 -> int64 -> int64 = "%int64_sub" + external ( *^ ) : int64 -> int64 -> int64 = "%int64_mul" + external ( /^ ) : int64 -> int64 -> int64 = "%int64_div" + external ( <<^ ) : int64 -> int -> int64 = "%int64_lsl" + external ( >>^ ) : int64 -> int -> int64 = "%int64_lsr" + external ( ~^ ) : int -> int64 = "%int64_of_int" + let ( ~^~ ) i = Int64.neg (Int64.of_int i) +end + +let zero = Int64.zero +let one = Int64.one +let minus_one = Int64.minus_one + +external neg : int64 -> int64 = "%int64_neg" + +external add : int64 -> int64 -> int64 = "%int64_add" +external sub : int64 -> int64 -> int64 = "%int64_sub" +external mul : int64 -> int64 -> int64 = "%int64_mul" +external div : int64 -> int64 -> int64 = "%int64_div" +external rem : int64 -> int64 -> int64 = "%int64_mod" + +let succ = Int64.succ +let pred = Int64.pred + +let abs = Int64.abs + +(* XXX Should these return the 'real' 64 bit max/min int? *) +let max_int = Int64.pred (Int64.shift_left Int64.one 62) +let min_int = Int64.neg (Int64.shift_left Int64.one 62) + +external logand : int64 -> int64 -> int64 = "%int64_and" +external logor : int64 -> int64 -> int64 = "%int64_or" +external logxor : int64 -> int64 -> int64 = "%int64_xor" +let lognot = Int64.lognot + +external shift_left : int64 -> int -> int64 = "%int64_lsl" +external shift_right : int64 -> int -> int64 = "%int64_asr" +external shift_right_logical : int64 -> int -> int64 = "%int64_lsr" + +external of_int : int -> int64 = "%int64_of_int" +external to_int : int64 -> int = "%int64_to_int" +external of_float : float -> int64 = "caml_int64_of_float" +external to_float : int64 -> float = "caml_int64_to_float" +external of_int32 : int32 -> int64 = "%int64_of_int32" +external to_int32 : int64 -> int32 = "%int64_to_int32" +external of_int64 : int64 -> int64 = "%identity" +external to_int64 : int64 -> int64 = "%identity" +external of_nativeint : nativeint -> int64 = "%int64_of_nativeint" +external to_nativeint : int64 -> nativeint = "%int64_to_nativeint" + +external of_string : string -> int64 = "caml_int64_of_string" +let to_string = Int64.to_string + +let compare : int64 -> int64 -> int = Int64.compare diff --git a/lib/int63_on_64.ml b/lib/int63_on_64.ml new file mode 100644 index 0000000..5679294 --- /dev/null +++ b/lib/int63_on_64.ml @@ -0,0 +1,82 @@ +(* 63 bit signed integer type. + (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This is the 64 bit implementation so for efficiency we used the + * unboxed int type directly. + *) +type t = int + +module Operators = struct + type int63 = t + + external ( +^ ) : int -> int -> int = "%addint" + external ( -^ ) : int -> int -> int = "%subint" + external ( *^ ) : int -> int -> int = "%mulint" + external ( /^ ) : int -> int -> int = "%divint" + external ( <<^ ) : int -> int -> int = "%lslint" + external ( >>^ ) : int -> int -> int = "%lsrint" + external ( ~^ ) : int -> int = "%identity" + external ( ~^~ ) : int -> int = "%negint" +end + +let zero = 0 +let one = 1 +let minus_one = ~1 + +external neg : int -> int = "%negint" + +external add : int -> int -> int = "%addint" +external sub : int -> int -> int = "%subint" +external mul : int -> int -> int = "%mulint" +external div : int -> int -> int = "%divint" +external rem : int -> int -> int = "%modint" + +external succ : int -> int = "%succint" +external pred : int -> int = "%predint" + +let abs = abs + +let max_int = max_int +let min_int = min_int + +external logand : int -> int -> int = "%andint" +external logor : int -> int -> int = "%orint" +external logxor : int -> int -> int = "%xorint" +let lognot = lnot + +external shift_left : int -> int -> int = "%lslint" +external shift_right : int -> int -> int = "%asrint" +external shift_right_logical : int -> int -> int = "%lsrint" + +external of_int : int -> int = "%identity" +external to_int : int -> int = "%identity" +external of_float : float -> int = "%intoffloat" +external to_float : int -> float = "%floatofint" +external of_int32 : int32 -> int = "%int32_to_int" +external to_int32 : int -> int32 = "%int32_of_int" +external of_int64 : int64 -> int = "%int64_to_int" +external to_int64 : int -> int64 = "%int64_of_int" +external of_nativeint : nativeint -> int = "%nativeint_to_int" +external to_nativeint : int -> nativeint = "%nativeint_of_int" + +external of_string : string -> int = "caml_int_of_string" +let to_string = string_of_int + +(*external compare : int -> int -> int = "%compare"*) +(* I think it should be faster to use a specialized compare: *) +let compare : int -> int -> int = compare diff --git a/lib/test_int63.ml b/lib/test_int63.ml new file mode 100644 index 0000000..6ce121b --- /dev/null +++ b/lib/test_int63.ml @@ -0,0 +1,7 @@ +open Printf +open Int63.Operators + +let () = + let a = ~^3 *^ ~^500 in + let b = a <<^ 3 in + printf "result = %s\n" (Int63.to_string b) -- 1.8.3.1