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
-cd lib; \
$(OCAMLDOC) $(OCAMLDOCFLAGS) -d ../html \
-I +extlib -I +bitmatch \
- diskimage.mli diskimage.ml
+ int63.mli diskimage.mli diskimage.ml
endif
# Distribution.
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
INSTALL := @INSTALL@
HAVE_PERLDOC := @HAVE_PERLDOC@
+OCAML_WORD_SIZE := @OCAML_WORD_SIZE@
+
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
#----------------------------------------------------------------------
# Build up the list of object files.
-OBJS := diskimage_utils.cmo
+OBJS := int63.cmo \
+ diskimage_utils.cmo
# Plugin objects.
OBJS += diskimage_ext2.cmo \
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
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. *)
--- /dev/null
+(** 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. *)
--- /dev/null
+(* 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
--- /dev/null
+(* 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
--- /dev/null
+open Printf
+open Int63.Operators
+
+let () =
+ let a = ~^3 *^ ~^500 in
+ let b = a <<^ 3 in
+ printf "result = %s\n" (Int63.to_string b)
git.annexia.org / virt-df.git / commitdiff