zarith-1.2.1/0000755000175000017540000000000012156017667011475 5ustar mineminezarith-1.2.1/big_int_Z.mli0000644000175000017540000000526112156017667014110 0ustar minemine(** [Big_int] interface for Z module. This modules provides an interface compatible with [Big_int], but using [Z] functions internally. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) (* note: generated with ocamlc -i *) type big_int = Z.t val zero_big_int : Z.t val unit_big_int : Z.t val minus_big_int : Z.t -> Z.t val abs_big_int : Z.t -> Z.t val add_big_int : Z.t -> Z.t -> Z.t val succ_big_int : Z.t -> Z.t val add_int_big_int : int -> Z.t -> Z.t val sub_big_int : Z.t -> Z.t -> Z.t val pred_big_int : Z.t -> Z.t val mult_big_int : Z.t -> Z.t -> Z.t val mult_int_big_int : int -> Z.t -> Z.t val square_big_int : Z.t -> Z.t val sqrt_big_int : Z.t -> Z.t val quomod_big_int : Z.t -> Z.t -> Z.t * Z.t val div_big_int : Z.t -> Z.t -> Z.t val mod_big_int : Z.t -> Z.t -> Z.t val gcd_big_int : Z.t -> Z.t -> Z.t val power : Z.t -> int -> Z.t val power_big : Z.t -> Z.t -> Z.t val power_int_positive_int : int -> int -> Z.t val power_big_int_positive_int : Z.t -> int -> Z.t val power_int_positive_big_int : int -> Z.t -> Z.t val power_big_int_positive_big_int : Z.t -> Z.t -> Z.t val sign_big_int : Z.t -> int val compare_big_int : Z.t -> Z.t -> int val eq_big_int : Z.t -> Z.t -> bool val le_big_int : Z.t -> Z.t -> bool val ge_big_int : Z.t -> Z.t -> bool val lt_big_int : Z.t -> Z.t -> bool val gt_big_int : Z.t -> Z.t -> bool val max_big_int : Z.t -> Z.t -> Z.t val min_big_int : Z.t -> Z.t -> Z.t val num_digits_big_int : Z.t -> int val string_of_big_int : Z.t -> string val big_int_of_string : string -> Z.t val big_int_of_int : int -> Z.t val is_int_big_int : Z.t -> bool val int_of_big_int : Z.t -> int val big_int_of_int32 : int32 -> Z.t val big_int_of_nativeint : nativeint -> Z.t val big_int_of_int64 : int64 -> Z.t val int32_of_big_int : Z.t -> int32 val nativeint_of_big_int : Z.t -> nativeint val int64_of_big_int : Z.t -> int64 val float_of_big_int : Z.t -> float val and_big_int : Z.t -> Z.t -> Z.t val or_big_int : Z.t -> Z.t -> Z.t val xor_big_int : Z.t -> Z.t -> Z.t val shift_left_big_int : Z.t -> int -> Z.t val shift_right_big_int : Z.t -> int -> Z.t val shift_right_towards_zero_big_int : Z.t -> int -> Z.t val extract_big_int : Z.t -> int -> int -> Z.t zarith-1.2.1/caml_z_x86_64.S0000644000175000017540000001655512156017667014120 0ustar minemine/* Assembly version for the fast path of some functions in Z: - x86_64 target - System 5 ABI and assembly syntax - GNU as This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). */ /* helper functions */ /* **************** */ /* optional underscope prefix for symbols */ #ifdef Z_UNDERSCORE_PREFIX #define SYMB(x) _##x #else #define SYMB(x) x #endif /* optional dot prefix for local labels */ #ifdef Z_DOT_LABEL_PREFIX #define L(x) .L##x #else #define L(x) L##x #endif /* function prolog & epilog */ #if defined(Z_ELF) #define FUNCTION_ALIGN 16 #endif #if defined(Z_MACOS) #define FUNCTION_ALIGN 4 #endif #if defined(Z_ELF) #define PROLOG(proc) \ .text; \ .globl SYMB(ml_as_z_##proc); \ .type SYMB(ml_as_z_##proc), @function; \ .align FUNCTION_ALIGN; \ SYMB(ml_as_z_##proc): #define EPILOG(proc) \ .size SYMB(ml_as_z_##proc), .-SYMB(ml_as_z_##proc) #endif #if defined(Z_MACOS) #define PROLOG(proc) \ .text; \ .globl SYMB(ml_as_z_##proc); \ .align FUNCTION_ALIGN; \ SYMB(ml_as_z_##proc): #define EPILOG(proc) #endif /* calling C functions */ #if defined(Z_ELF) #define C_JMP(proc) \ jmp SYMB(ml_z_##proc@PLT) #endif #if defined(Z_MACOS) #define C_JMP(proc) \ jmp SYMB(ml_z_##proc) #endif /* operation counter */ #ifndef Z_PERF_COUNTER #define OP #else #if defined(Z_ELF) || defined(Z_MACOS) #define OP \ mov SYMB(ml_z_ops_as@GOTPCREL(%rip)), %rcx; \ addq $1, (%rcx) #endif #endif /* unary arithmetics */ /* ***************** */ /* neg */ PROLOG(neg) L(negenter): test $1, %dil jz L(neg) mov %rdi, %rax not %rax add $3, %rax jo L(neg) OP ret L(neg): C_JMP(neg) EPILOG(neg) /* abs */ PROLOG(abs) test $1, %dil jz L(abs) mov %rdi, %rax test %rdi, %rdi jns L(abs2) not %rax add $3, %rax jo L(neg) L(abs2): OP ret L(abs): C_JMP(abs) EPILOG(abs) /* succ */ PROLOG(succ) test $1, %dil jz L(succ) mov %rdi, %rax add $2, %rax jo L(succ) OP ret L(succ): C_JMP(succ) EPILOG(succ) /* pred */ PROLOG(pred) test $1, %dil jz L(pred) mov %rdi, %rax sub $2, %rax jo L(pred) OP ret L(pred): C_JMP(pred) EPILOG(pred) /* binary arithmetics */ /* ****************** */ /* add */ PROLOG(add) test $1, %dil jz L(add) test $1, %sil jz L(add) lea -1(%rdi), %rax add %rsi, %rax jo L(add) OP ret L(add): C_JMP(add) EPILOG(add) /* sub */ PROLOG(sub) test $1, %dil jz L(sub) test $1, %sil jz L(sub) mov %rdi, %rax sub %rsi, %rax jo L(sub) inc %rax OP ret L(sub): C_JMP(sub) EPILOG(sub) /* mul */ PROLOG(mul) test $1, %dil jz L(mul) mov %rsi, %rcx sar %rcx jnc L(mul) lea -1(%rdi), %rax imul %rcx, %rax jo L(mul) inc %rax OP ret L(mul): C_JMP(mul) EPILOG(mul) /* div */ PROLOG(div) mov %rsi, %rcx cmp $-1, %rsi /* division by -1, the only one that can overflow */ je L(negenter) sar %rcx jnc L(div) jz L(div) /* division by zero */ mov %rdi, %rax sar %rax jnc L(div) cqo idiv %rcx lea 1(%rax, %rax), %rax OP ret L(div): C_JMP(div) EPILOG(div) /* rem */ PROLOG(rem) mov %rdi, %rax sar %rax jnc L(rem) mov %rsi, %rcx sar %rcx jnc L(rem) jz L(rem) /* division by zero */ cmp $-1, %rcx je L(remneg) cqo idiv %rcx lea 1(%rdx, %rdx), %rax OP ret L(remneg): /* division by -1 */ mov $1, %eax OP ret L(rem): C_JMP(rem) EPILOG(rem) /* bit operations */ /* ************** */ /* not */ PROLOG(lognot) test $1, %dil jz L(lognot) lea -1(%rdi), %rax not %rax OP ret L(lognot): C_JMP(lognot) EPILOG(lognot) /* and */ PROLOG(logand) mov %rdi, %rax and %rsi, %rax test $1, %al jz L(logand) OP ret L(logand): C_JMP(logand) EPILOG(logand) /* or */ PROLOG(logor) test $1, %dil jz L(logor) test $1, %sil jz L(logor) mov %rdi, %rax or %rsi, %rax OP ret L(logor): C_JMP(logor) EPILOG(logor) /* xor */ PROLOG(logxor) test $1, %dil jz L(logxor) test $1, %sil jz L(logxor) mov %rdi, %rax xor %rsi, %rax inc %rax OP ret L(logxor): C_JMP(logxor) EPILOG(logxor) /* shift_left */ PROLOG(shift_left) test $1, %dil jz L(shift_left) mov %esi, %ecx sar %ecx cmp $127, %rsi /* 63 unboxed */ jae L(shift_left) lea -1(%rdi), %rax mov %rax, %r8 sal %cl, %rax mov %rax, %rdx sar %cl, %rdx cmp %r8, %rdx jne L(shift_left) /* overflow */ inc %rax OP ret L(shift_left): C_JMP(shift_left) EPILOG(shift_left) /* shift_right */ PROLOG(shift_right) test $1, %dil jz L(shift_right) mov %rsi, %rcx mov $63, %eax sar %rcx js L(shift_right) cmp %rax, %rcx /* compare second argument to 63 */ cmovae %eax, %ecx /* if above or equal, then use 63 */ mov %rdi, %rax sar %cl, %rax or $1, %rax OP ret L(shift_right): C_JMP(shift_right) EPILOG(shift_right) zarith-1.2.1/Changes0000644000175000017540000000144312156017667012772 0ustar minemineRelease 1.2.1 (2013-06-12): - Install fixes Release 1.2 (2013-05-19): - Added fast asm path for ARMv7 processors. - PR#1192: incorrect behavior of div_2exp - Issue with aggressive C compiler optimization in the fast path for multiply - Better support for Windows/Mingw32 Release 1.1 (2012-03-24): - Various improvements in the asm fast path for i686 and x86_64 - PR#1034: support for static linking of GMP/MPIR - PR#1046: autodetection of ocamlopt and dynlink - PR#1048: autodetection of more platforms that we support - PR#1051: support architectures with strict alignment constraints for 64-bit integers (e.g. Sparc) - Fixed 1-bit precision loss when converting doubles to rationals - Improved support for the forthcoming release 4.00 of OCaml Release 1.0 (2011-08-18): - First public release zarith-1.2.1/z_pp.pl0000755000175000017540000000341612156017667013011 0ustar minemine#!/usr/bin/perl -W # Simple preprocessor to fix @ASM directives in z.mlp and z.mlip, and # generate z.ml and z.mli # This file is part of the Zarith library # http://forge.ocamlcore.org/projects/zarith . # It is distributed under LGPL 2 licensing, with static linking exception. # See the LICENSE file included in the distribution. # # Copyright (c) 2010-2011 Antoine Miné, Abstraction project. # Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), # a joint laboratory by: # CNRS (Centre national de la recherche scientifique, France), # ENS (École normale supérieure, Paris, France), # INRIA Rocquencourt (Institut national de recherche en informatique, France). die "Usage: './z_pp.pl architecture'" unless $#ARGV==0; # version, from META file $v = `grep version META`; ($ver) = $v =~ /version\s*=\s*(\S+)/; # scan assembly $ASM = "caml_z_${ARGV[0]}.S"; if (-e $ASM) { print "found assembly file $ASM\n"; open F, "<$ASM"; while (defined($l = )) { if ($l =~ /^\s*PROLOG\s*\(\s*([A-Za-z0-9_]+)/) { $ASM_FUNS{$1} = 1; } } close F; } for $i (sort (keys %ASM_FUNS)) { print " found $i\n"; } # specialize .ml & .mli files sub doml { $SUF = shift @_; open I, "z.${SUF}"; print O "(* This file was automatically generated by z_pp.pl from z.${SUF}p *) "; while (defined($l = )) { while ($l =~ /([A-Za-z0-9_]+)\@ASM/) { $f = $1; if (defined($ASM_FUNS{$f})) { $r = "\"ml_z_$f\" \"ml_as_z_$f\""; } else { $r = "\"ml_z_$f\""; } $l =~ s/$f\@ASM/$r/g; } $l =~ s/\@VERSION/$ver/; print O "$l"; } close F; } doml "ml"; doml "mli"; zarith-1.2.1/z_mlgmpidl.mli0000644000175000017540000000157012156017667014341 0ustar minemine(** Conversion between Zarith and MLGmpIDL integers and rationals. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) val z_of_mpz: Mpz.t -> Z.t val mpz_of_z: Z.t -> Mpz.t val z_of_mpzf: Mpzf.t -> Z.t val mpzf_of_z: Z.t -> Mpzf.t val q_of_mpq: Mpq.t -> Q.t val mpq_of_q: Q.t -> Mpq.t val q_of_mpqf: Mpqf.t -> Q.t val mpqf_of_q: Q.t -> Mpqf.t zarith-1.2.1/configure0000755000175000017540000002306212156017667013407 0ustar minemine#! /bin/sh # configuration script # This file is part of the Zarith library # http://forge.ocamlcore.org/projects/zarith . # It is distributed under LGPL 2 licensing, with static linking exception. # See the LICENSE file included in the distribution. # # Copyright (c) 2010-2011 Antoine Miné, Abstraction project. # Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), # a joint laboratory by: # CNRS (Centre national de la recherche scientifique, France), # ENS (École normale supérieure, Paris, France), # INRIA Rocquencourt (Institut national de recherche en informatique, France). # options installdir='auto' ocamllibdir='auto' host='auto' gmp='auto' perf='no' # should we make the following auto-detected or configurable? if test -n "$CC"; then cc="$CC" ccopt="$CFLAGS" else cc='gcc' ccopt="-O3 -Wall -Wextra $CFLAGS" fi ar='ar' ocaml='ocaml' ocamlc='ocamlc' ocamlopt='ocamlopt' ocamlmklib='ocamlmklib' ocamldep='ocamldep' ocamldoc='ocamldoc' ccinc="$CPPFLAGS" cclib="$LDFLAGS" asopt='' ccdef='' mlflags="$OCAMLFLAGS" mloptflags="$OCAMLOPTFLAGS" mlinc="$OCAMLINC" objsuffix="o" ocamlfind="auto" # sanitize LC_ALL=C export LC_ALL unset IFS # help help() { cat <" > tmp.c echo "int main() { return 1; }" >> tmp.c r=1 $cc $ccopt $ccinc -c tmp.c -o tmp.o >/dev/null 2>/dev/null || r=0 if test ! -f tmp.o; then r=0; fi rm -f tmp.c tmp.o if test $r -eq 0; then echo "not found"; else echo "found"; fi return $r } checklib() { echo_n "library $1: " rm -f tmp.c tmp.out echo "int main() { return 1; }" >> tmp.c r=1 $cc $ccopt $cclib tmp.c -l$1 -o tmp.out >/dev/null 2>/dev/null || r=0 if test ! -x tmp.out; then r=0; fi rm -f tmp.c tmp.o tmp.out if test $r -eq 0; then echo "not found"; else echo "found"; fi return $r } checkcc() { echo_n "checking compilation with $cc $ccopt: " rm -f tmp.c tmp.out echo "int main() { return 1; }" >> tmp.c r=1 $cc $ccopt tmp.c -o tmp.out >/dev/null 2>/dev/null || r=0 if test ! -x tmp.out; then r=0; fi rm -f tmp.c tmp.o tmp.out if test $r -eq 0; then echo "not working"; else echo "working"; fi return $r } checkcmxalib() { echo_n "library $1: " $ocamlopt $mloptflags $1 -o tmp.out >/dev/null 2>/dev/null || r=0 if test ! -x tmp.out; then r=0; fi rm -f tmp.out if test $r -eq 0; then echo "not found"; else echo "found"; fi return $r } # check required programs searchbinreq $ocaml searchbinreq $ocamlc searchbinreq $ocamldep searchbinreq $ocamlmklib searchbinreq $ocamldoc searchbinreq $cc searchbinreq $ar searchbinreq perl # optional native-code generation hasocamlopt='no' searchbin $ocamlopt if test $? -eq 1; then hasocamlopt='yes'; fi # check C compiler checkcc if test $? -eq 0; then # try again with (almost) no options ccopt='-O' checkcc if test $? -eq 0; then echo "cannot compile and link program"; exit 2; fi fi # directories if test "$ocamllibdir" = "auto"; then ocamllibdir=`ocamlc -where`; fi # fails on Cygwin: # if test ! -f "$ocamllibdir/caml/mlvalues.h" # then echo "cannot find OCaml libraries in $ocamllibdir"; exit 2; fi ccinc="-I$ocamllibdir $ccinc" checkinc "caml/mlvalues.h" if test $? -eq 0; then echo "cannot include caml/mlvalues.h"; exit 2; fi # optional dynamic linking hasdynlink='no' if test $hasocamlopt = yes then checkcmxalib dynlink.cmxa if test $? -eq 1; then hasdynlink='yes'; fi fi # installation method searchbin ocamlfind if test $? -eq 1 -a $ocamlfind != "no"; then instmeth='findlib' if test "$installdir" = "auto" then installdir=`ocamlfind printconf destdir`; fi else searchbin install if test $? -eq 1; then instmeth='install' else echo "no installation method found"; exit 2; fi if test "$installdir" = "auto"; then installdir="$ocamllibdir"; fi fi # detect OCaml's word-size echo "print_int (Sys.word_size);;" > tmp.ml wordsize=`ocaml tmp.ml` echo "OCaml's word size is $wordsize" rm -f tmp.ml # auto-detect host if test "x$host" = 'xauto'; then searchbin uname if test $? -eq 0; then host='none' else host=`. ./config.guess` fi fi # set arch from host arch='none' case $host in x86_64-*linux-gnu|x86_64-kfreebsd-gnu) ccdef="-DZ_ELF -DZ_DOT_LABEL_PREFIX $ccdef" arch='x86_64';; i486-*linux-gnu|i686-*linux-gnu|i486-kfreebsd-gnu) ccdef="-DZ_ELF -DZ_DOT_LABEL_PREFIX $ccdef" arch='i686';; i686-*cygwin) if test "x$wordsize" = "x64"; then ccdef="-DZ_COFF $ccdef" arch='x86_64_mingw64' else ccdef="-DZ_UNDERSCORE_PREFIX -DZ_COFF $ccdef" arch='i686' fi ;; i386-*darwin* | x86_64-*darwin*) ccdef="-DZ_UNDERSCORE_PREFIX -DZ_MACOS $ccdef" if test "x$wordsize" = "x64"; then ccopt="-arch x86_64 $ccopt" asopt="-arch x86_64 $asopt" arch='x86_64' checkcc else ccopt="-arch i386 $ccopt" asopt="-arch i386 $asopt" arch='i686' checkcc fi ;; armv7*-gnueabi) arch='arm' ;; none) ;; *) echo "unknown host $host";; esac if test "$arch" != 'none'; then if test ! -f "caml_z_${arch}.S"; then arch='none'; fi fi # check GMP, MPRI if test "$gmp" = 'gmp' -o "$gmp" = 'auto'; then checkinc gmp.h if test $? -eq 1; then checklib gmp if test $? -eq 1; then gmp='OK' cclib="$cclib -lgmp" ccdef="-DHAS_GMP $ccdef" fi fi fi if test "$gmp" = 'mpir' -o "$gmp" = 'auto'; then checkinc mpir.h if test $? -eq 1; then checklib mpir if test $? -eq 1; then gmp='OK' cclib="$cclib -lmpir" ccdef="-DHAS_MPIR $ccdef" fi fi fi if test "$gmp" != 'OK'; then echo "cannot find GMP nor MPIR"; exit 2; fi # OCaml version ocamlver=`ocamlc -version` # Extended comparisons available since 3.12.1 case "$ocamlver" in [12].* | 3.0* | 3.10* | 3.11* | 3.12.0*) ;; *) echo "OCaml extended comparison supported" ccdef="-DZ_OCAML_COMPARE_EXT $ccdef" ;; esac # New hash functions available since 4.00.0 case "$ocamlver" in [123].*) ;; *) echo "OCaml new hash functions available" ccdef="-DZ_OCAML_HASH $ccdef" ;; esac # dump Makefile cat > Makefile < depend include depend .PHONY: clean zarith-1.2.1/z_pp.ml0000644000175000017540000000337112156017667013003 0ustar mineminelet archname = ref "" let usage = "Usage: './z_pp architecture" let () = Arg.parse [] (* no options *) (fun name -> archname := name) usage; if !archname = "" then begin print_endline usage; exit 1 end let asmfilename = "caml_z_" ^ !archname ^ ".S" module StringSet = Set.Make(String) let funcnames = ref StringSet.empty let () = let rPROLOG = Str.regexp "[ ]*PROLOG(\\([^)]*\\))" in let input = open_in asmfilename in Printf.printf "found assembly file %s\n" asmfilename; try while true do let s = input_line input in if Str.string_match rPROLOG s 0 then let funcname = Str.matched_group 1 s in Printf.printf " found %s\n" funcname; funcnames := StringSet.add funcname !funcnames done with End_of_file -> close_in input let treat_file = let rASM = Str.regexp "\\(.*\\) \\([A-Za-z0-9_]+\\)@ASM\\(.*\\)" in let funcnames = !funcnames in function extension -> let outputname = "z." ^ extension in let inputname = outputname ^ "p" in let input = open_in inputname in let output = open_out outputname in Printf.fprintf output "(* This file was automatically generated by z_pp.ml from %s *)\n" inputname; try while true do let line_in = input_line input in let line_out = if Str.string_match rASM line_in 0 then let funcname = Str.matched_group 2 line_in in if StringSet.mem funcname funcnames then Str.replace_matched "\\1 \"ml_z_\\2\" \"ml_as_z_\\2\"\\3" line_in else Str.replace_matched "\\1 \"ml_z_\\2\"\\3" line_in else line_in in Printf.fprintf output "%s\n" line_out done with End_of_file -> close_in input ;; let _ = treat_file "ml" let _ = treat_file "mli" zarith-1.2.1/caml_z_arm.S0000644000175000017540000001261512156017667013732 0ustar minemine/* Assembly version for the fast path of some functions in Z: - ARM v5M and above target - System 5 ABI and assembly syntax - GNU as This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2013 Xavier Leroy, INRIA Paris-Rocquencourt, and Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). */ /* helper functions */ /* **************** */ /* dot prefix for local labels */ #define L(x) .L##x /* function prolog & epilog */ #define PROLOG(proc) \ .text; \ .global ml_as_z_##proc; \ .type ml_as_z_##proc, %function; \ ml_as_z_##proc: #define EPILOG(proc) \ .size ml_as_z_##proc, . - ml_as_z_##proc /* calling C functions */ #define C_JMP(proc) \ b ml_z_##proc(PLT) /* operation counter (not implemented) */ #define OP /* unary arithmetics */ /* ***************** */ /* neg */ PROLOG(neg) L(negenter): tst r0, #1 beq L(neg) rsbs r1, r0, #2 /* r1 = 2 - r0 */ bvs L(neg) mov r0, r1 OP bx lr L(neg): C_JMP(neg) EPILOG(neg) /* abs */ PROLOG(abs) tst r0, #1 beq L(abs) cmp r0, #0 bge L(abs2) rsbs r1, r0, #2 /* r1 = 2 - r0 */ bvs L(abs) mov r0, r1 L(abs2): OP bx lr L(abs): C_JMP(abs) EPILOG(abs) /* succ */ PROLOG(succ) tst r0, #1 beq L(succ) add r1, r0, #2 bvs L(succ) mov r0, r1 OP bx lr L(succ): C_JMP(succ) EPILOG(succ) /* pred */ PROLOG(pred) tst r0, #1 beq L(pred) sub r1, r0, #2 bvs L(pred) mov r0, r1 OP bx lr L(pred): C_JMP(pred) EPILOG(pred) /* binary arithmetics */ /* ****************** */ /* add */ PROLOG(add) and r2, r0, r1 tst r2, #1 beq L(add) sub r2, r0, #1 adds r2, r2, r1 bvs L(add) mov r0, r2 OP bx lr L(add): C_JMP(add) EPILOG(add) /* sub */ PROLOG(sub) and r2, r0, r1 tst r2, #1 beq L(sub) subs r2, r0, r1 bvs L(sub) add r0, r2, #1 OP bx lr L(sub): C_JMP(sub) EPILOG(sub) /* mul */ PROLOG(mul) and r2, r0, r1 tst r2, #1 beq L(mul) push {r0, r1} sub r2, r0, #1 mov r3, r1, asr #1 smull r0, r1, r2, r3 cmp r1, r0, asr #31 bne L(mul2) add sp, sp, #8 add r0, r0, #1 OP bx lr L(mul2): pop {r0, r1} L(mul): C_JMP(mul) EPILOG(mul) /* bit operations */ /* ************** */ /* not */ PROLOG(lognot) tst r0, #1 beq L(lognot) sub r0, r0, #1 mvn r0, r0 OP bx lr L(lognot): C_JMP(lognot) EPILOG(lognot) /* and */ PROLOG(logand) and r2, r0, r1 tst r2, #1 beq L(logand) mov r0, r2 OP bx lr L(logand): C_JMP(logand) EPILOG(logand) /* or */ PROLOG(logor) and r2, r0, r1 tst r2, #1 beq L(logor) orr r0, r0, r1 OP bx lr L(logor): C_JMP(logor) EPILOG(logor) /* xor */ PROLOG(logxor) and r2, r0, r1 tst r2, #1 beq L(logxor) eor r0, r0, r1 orr r0, r0, #1 OP bx lr L(logxor): C_JMP(logxor) EPILOG(logxor) /* shift_left */ PROLOG(shift_left) tst r0, #1 beq L(shift_left) cmp r1, #63 /* 32 in 2n+1 encoding */ bhs L(shift_left) mov r3, r1, asr #1 sub r2, r0, #1 mov r2, r2, lsl r3 mov r3, r2, asr r3 cmp r2, r3 bne L(shift_left) /* overflow occurred */ orr r0, r2, #1 OP bx lr L(shift_left): C_JMP(shift_left) EPILOG(shift_left) /* shift_right */ PROLOG(shift_right) tst r0, #1 beq L(shift_right) movs r2, r1, asr #1 bmi L(shift_right) /* if shift amount < 0, go to slow path */ cmp r2, #31 movlo r0, r0, asr r2 /* if shift amount < 31, shift by this amount */ movhs r0, r0, asr #31 /* if shift amount >= 31, shift by 31 */ orr r0, r0, #1 OP bx lr L(shift_right): C_JMP(shift_right) EPILOG(shift_right) zarith-1.2.1/config.guess0000644000175000017540000013055412156017667014022 0ustar minemine#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 # Free Software Foundation, Inc. timestamp='2010-09-24' # This file 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., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Originally written by Per Bothner. Please send patches (context # diff format) to and include a ChangeLog # entry. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # You can get the latest version of this script from: # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] Output the configuration name of the system \`$me' is run on. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" >&2 exit 1 ;; * ) break ;; esac done if test $# != 0; then echo "$me: too many arguments$help" >&2 exit 1 fi trap 'exit 1' HUP INT TERM # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a # headache to deal with in a portable fashion. # Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still # use `HOST_CC' if defined, but it is deprecated. # Portable tmp directory creation inspired by the Autoconf team. set_cc_for_build=' trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" HUP INT PIPE TERM ; : ${TMPDIR=/tmp} ; { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; dummy=$tmp/dummy ; tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; case $CC_FOR_BUILD,$HOST_CC,$CC in ,,) echo "int x;" > $dummy.c ; for c in cc gcc c89 c99 ; do if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then CC_FOR_BUILD="$c"; break ; fi ; done ; if test x"$CC_FOR_BUILD" = x ; then CC_FOR_BUILD=no_compiler_found ; fi ;; ,,*) CC_FOR_BUILD=$CC ;; ,*,*) CC_FOR_BUILD=$HOST_CC ;; esac ; set_cc_for_build= ;' # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_SYSTEM}" in Linux|GNU/*) eval $set_cc_for_build cat <<-EOF > $dummy.c #include #ifdef __UCLIBC__ # ifdef __UCLIBC_CONFIG_VERSION__ LIBC=uclibc __UCLIBC_CONFIG_VERSION__ # else LIBC=uclibc # endif #else # ifdef __dietlibc__ LIBC=dietlibc # else LIBC=gnu # endif #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` ;; esac # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward # compatibility and a consistent mechanism for selecting the # object file format. # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ /usr/sbin/$sysctl 2>/dev/null || echo unknown)` case "${UNAME_MACHINE_ARCH}" in armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; sh5el) machine=sh5le-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently, or will in the future. case "${UNAME_MACHINE_ARCH}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? os=netbsd else os=netbsdelf fi ;; *) os=netbsd ;; esac # The OS release # Debian GNU/NetBSD machines have a different userland, and # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. case "${UNAME_VERSION}" in Debian*) release='-gnu' ;; *) release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ;; esac # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} exit ;; *:ekkoBSD:*:*) echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} exit ;; *:SolidBSD:*:*) echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) echo powerpc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} exit ;; alpha:OSF1:*:*) case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on # OSF/1 and Tru64 systems produced since 1995. I hope that # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` case "$ALPHA_CPU_TYPE" in "EV4 (21064)") UNAME_MACHINE="alpha" ;; "EV4.5 (21064)") UNAME_MACHINE="alpha" ;; "LCA4 (21066/21068)") UNAME_MACHINE="alpha" ;; "EV5 (21164)") UNAME_MACHINE="alphaev5" ;; "EV5.6 (21164A)") UNAME_MACHINE="alphaev56" ;; "EV5.6 (21164PC)") UNAME_MACHINE="alphapca56" ;; "EV5.7 (21164PC)") UNAME_MACHINE="alphapca57" ;; "EV6 (21264)") UNAME_MACHINE="alphaev6" ;; "EV6.7 (21264A)") UNAME_MACHINE="alphaev67" ;; "EV6.8CB (21264C)") UNAME_MACHINE="alphaev68" ;; "EV6.8AL (21264B)") UNAME_MACHINE="alphaev68" ;; "EV6.8CX (21264D)") UNAME_MACHINE="alphaev68" ;; "EV6.9A (21264/EV69A)") UNAME_MACHINE="alphaev69" ;; "EV7 (21364)") UNAME_MACHINE="alphaev7" ;; "EV7.9 (21364A)") UNAME_MACHINE="alphaev79" ;; esac # A Pn.n version is a patched version. # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` exit ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead # of the specific Alpha model? echo alpha-pc-interix exit ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos exit ;; *:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-morphos exit ;; *:OS/390:*:*) echo i370-ibm-openedition exit ;; *:z/VM:*:*) echo s390-ibm-zvmoe exit ;; *:OS400:*:*) echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; arm:riscos:*:*|arm:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit ;; NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 exit ;; DRS?6000:unix:4.0:6*) echo sparc-icl-nx6 exit ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; s390x:SunOS:*:*) echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) echo i386-pc-auroraux${UNAME_RELEASE} exit ;; i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) eval $set_cc_for_build SUN_ARCH="i386" # If there is a compiler, see if it is configured for 64-bit objects. # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. # This test works for both compilers. if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null then SUN_ARCH="x86_64" fi fi echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 case "`/bin/arch`" in sun3) echo m68k-sun-sunos${UNAME_RELEASE} ;; sun4) echo sparc-sun-sunos${UNAME_RELEASE} ;; esac exit ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} exit ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor # > m68000). The system name ranges from "MiNT" over "FreeMiNT" # to the lowercase version "mint" (or "freemint"). Finally # the system name "TOS" denotes a system which is actually not # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) echo m68k-milan-mint${UNAME_RELEASE} exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) echo m68k-hades-mint${UNAME_RELEASE} exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) echo m68k-unknown-mint${UNAME_RELEASE} exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} exit ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 exit ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit ;; 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #ifdef __cplusplus #include /* for printf() prototype */ int main (int argc, char *argv[]) { #else int main (argc, argv) int argc; char *argv[]; { #endif #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_SVR4) printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); #endif #endif exit (-1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`$dummy $dummyarg` && { echo "$SYSTEM_NAME"; exit; } echo mips-mips-riscos${UNAME_RELEASE} exit ;; Motorola:PowerMAX_OS:*:*) echo powerpc-motorola-powermax exit ;; Motorola:*:4.3:PL8-*) echo powerpc-harris-powermax exit ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) echo powerpc-harris-powermax exit ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix exit ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ [ ${TARGET_BINARY_INTERFACE}x = x ] then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi else echo i586-dg-dgux${UNAME_RELEASE} fi exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) echo i386-ibm-aix exit ;; ia64:AIX:*:*) if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` then echo "$SYSTEM_NAME" else echo rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit ;; *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit ;; *:AIX:*:*) echo rs6000-ibm-aix exit ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit ;; 9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` case "${sc_cpu_version}" in 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 case "${sc_kernel_bits}" in 32) HP_ARCH="hppa2.0n" ;; 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 esac ;; esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #define _HPUX_SOURCE #include #include int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); #endif long cpu = sysconf (_SC_CPU_VERSION); switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; default: puts ("hppa2.0"); break; } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; #endif default: puts ("hppa1.0"); break; } exit (0); } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac if [ ${HP_ARCH} = "hppa2.0w" ] then eval $set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler # generating 64-bit code. GNU and HP use different nomenclature: # # $ CC_FOR_BUILD=cc ./config.guess # => hppa2.0w-hp-hpux11.23 # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | grep -q __LP64__ then HP_ARCH="hppa2.0w" else HP_ARCH="hppa64" fi fi echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit ;; ia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} exit ;; 3050*:HI-UX:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } echo unknown-hitachi-hiuxwe2 exit ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpeix exit ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit ;; i*86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi exit ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; *:UNICOS/mp:*:*) echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit ;; *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) case ${UNAME_MACHINE} in pc98) echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; i*:windows32*:*) # uname -m includes "-pc" on this system. echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; *:Interix*:*) case ${UNAME_MACHINE} in x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; IA64) echo ia64-unknown-interix${UNAME_RELEASE} exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; 8664:Windows_NT:*) echo x86_64-pc-mks exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we # UNAME_MACHINE based on the output of uname instead of i386? echo i586-pc-interix exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; *:GNU:*:*) # the GNU system echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; alpha:Linux:*:*) case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; PCA57) UNAME_MACHINE=alphapca56 ;; EV6) UNAME_MACHINE=alphaev6 ;; EV67) UNAME_MACHINE=alphaev67 ;; EV68*) UNAME_MACHINE=alphaev68 ;; esac objdump --private-headers /bin/sh | grep -q ld.so.1 if test "$?" = 0 ; then LIBC="gnulibc1" ; fi echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; arm*:Linux:*:*) eval $set_cc_for_build if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_EABI__ then echo ${UNAME_MACHINE}-unknown-linux-${LIBC} else echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi fi exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; cris:Linux:*:*) echo cris-axis-linux-${LIBC} exit ;; crisv32:Linux:*:*) echo crisv32-axis-linux-${LIBC} exit ;; frv:Linux:*:*) echo frv-unknown-linux-${LIBC} exit ;; i*86:Linux:*:*) echo ${UNAME_MACHINE}-pc-linux-${LIBC} exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; m32r*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef ${UNAME_MACHINE} #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } ;; or32:Linux:*:*) echo or32-unknown-linux-${LIBC} exit ;; padre:Linux:*:*) echo sparc-unknown-linux-${LIBC} exit ;; parisc64:Linux:*:* | hppa64:Linux:*:*) echo hppa64-unknown-linux-${LIBC} exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; *) echo hppa-unknown-linux-${LIBC} ;; esac exit ;; ppc64:Linux:*:*) echo powerpc64-unknown-linux-${LIBC} exit ;; ppc:Linux:*:*) echo powerpc-unknown-linux-${LIBC} exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; tile*:Linux:*:*) echo ${UNAME_MACHINE}-tilera-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-${LIBC} exit ;; x86_64:Linux:*:*) echo x86_64-unknown-linux-${LIBC} exit ;; xtensa*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-${LIBC} exit ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. echo ${UNAME_MACHINE}-pc-os2-emx exit ;; i*86:XTS-300:*:STOP) echo ${UNAME_MACHINE}-unknown-stop exit ;; i*86:atheos:*:*) echo ${UNAME_MACHINE}-unknown-atheos exit ;; i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) echo ${UNAME_MACHINE}-pc-msdosdjgpp exit ;; i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} else echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} fi exit ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} exit ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i586. # Note: whatever this is, it MUST be the same as what config.sub # prints for the "djgpp" host, or else GDB configury will decide that # this is a cross-build. echo i586-pc-msdosdjgpp exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; paragon:*:*:*) echo i860-intel-osf1 exit ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit ;; mc68k:UNIX:SYSTEM5:3.51m) echo m68k-convergent-sysv exit ;; M680?0:D-NIX:5.3:*) echo m68k-diab-dnix exit ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4; exit; } ;; NCR*:*:4.2:* | MPRAS*:*:4.2:*) OS_REL='.3' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} exit ;; rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit ;; RM*:ReliantUNIX-*:*:*) echo mips-sni-sysv4 exit ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says echo i586-unisys-sysv4 exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 exit ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 exit ;; i*86:VOS:*:*) # From Paul.Green@stratus.com. echo ${UNAME_MACHINE}-stratus-vos exit ;; *:VOS:*:*) # From Paul.Green@stratus.com. echo hppa1.1-stratus-vos exit ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} exit ;; news*:NEWS-OS:6*:*) echo mips-sony-newsos6 exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else echo mips-unknown-sysv${UNAME_RELEASE} fi exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos exit ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; BePC:Haiku:*:*) # Haiku running on Intel PC compatible. echo i586-pc-haiku exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; SX-5:SUPER-UX:*:*) echo sx5-nec-superux${UNAME_RELEASE} exit ;; SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; SX-7:SUPER-UX:*:*) echo sx7-nec-superux${UNAME_RELEASE} exit ;; SX-8:SUPER-UX:*:*) echo sx8-nec-superux${UNAME_RELEASE} exit ;; SX-8R:SUPER-UX:*:*) echo sx8r-nec-superux${UNAME_RELEASE} exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; *:Rhapsody:*:*) echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in i386) eval $set_cc_for_build if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null then UNAME_PROCESSOR="x86_64" fi fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = "x86"; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} exit ;; *:QNX:*:4*) echo i386-pc-qnx exit ;; NEO-?:NONSTOP_KERNEL:*:*) echo neo-tandem-nsk${UNAME_RELEASE} exit ;; NSE-?:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} exit ;; *:NonStop-UX:*:*) echo mips-compaq-nonstopux exit ;; BS2000:POSIX*:*:*) echo bs2000-siemens-sysv exit ;; DS/*:UNIX_System_V:*:*) echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} exit ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. if test "$cputype" = "386"; then UNAME_MACHINE=i386 else UNAME_MACHINE="$cputype" fi echo ${UNAME_MACHINE}-unknown-plan9 exit ;; *:TOPS-10:*:*) echo pdp10-unknown-tops10 exit ;; *:TENEX:*:*) echo pdp10-unknown-tenex exit ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) echo pdp10-dec-tops20 exit ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) echo pdp10-xkl-tops20 exit ;; *:TOPS-20:*:*) echo pdp10-unknown-tops20 exit ;; *:ITS:*:*) echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; V*) echo vax-dec-vms ; exit ;; esac ;; *:XENIX:*:SysV) echo i386-pc-xenix exit ;; i*86:skyos:*:*) echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' exit ;; i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; i*86:AROS:*:*) echo ${UNAME_MACHINE}-pc-aros exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 eval $set_cc_for_build cat >$dummy.c < # include #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix\n"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; if (version < 4) printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); else printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-pc-bsd\n"); exit (0); #endif #if defined (sequent) #if defined (i386) printf ("i386-sequent-dynix\n"); exit (0); #endif #if defined (ns32000) printf ("ns32k-sequent-dynix\n"); exit (0); #endif #endif #if defined (_SEQUENT_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) # if !defined (ultrix) # include # if defined (BSD) # if BSD == 43 printf ("vax-dec-bsd4.3\n"); exit (0); # else # if BSD == 199006 printf ("vax-dec-bsd4.3reno\n"); exit (0); # else printf ("vax-dec-bsd\n"); exit (0); # endif # endif # else printf ("vax-dec-bsd\n"); exit (0); # endif # else printf ("vax-dec-ultrix\n"); exit (0); # endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; c34*) echo c34-convex-bsd exit ;; c38*) echo c38-convex-bsd exit ;; c4*) echo c4-convex-bsd exit ;; esac fi cat >&2 < in order to provide the needed information to handle your system. config.guess timestamp = $timestamp uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` /bin/uname -X = `(/bin/uname -X) 2>/dev/null` hostinfo = `(hostinfo) 2>/dev/null` /bin/universe = `(/bin/universe) 2>/dev/null` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` /bin/arch = `(/bin/arch) 2>/dev/null` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` UNAME_MACHINE = ${UNAME_MACHINE} UNAME_RELEASE = ${UNAME_RELEASE} UNAME_SYSTEM = ${UNAME_SYSTEM} UNAME_VERSION = ${UNAME_VERSION} EOF exit 1 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: zarith-1.2.1/q.ml0000644000175000017540000001532212156017667012272 0ustar minemine(** Rationals. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) type t = { num: Z.t; (** Numerator. *) den: Z.t; (** Denominator, >= 0 *) } (* Type of rationals. Invariants: - den is always >= 0; - num and den have no common factor; - if den=0, then num is -1, 0 or 1. - if num=0, then den is -1, 0 or 1. *) (* creation *) (* -------- *) (* make *) let mk n d = { num = n; den = d; } (* make and normalize *) let make n d = if Z.sign d = 0 then mk (Z.of_int (Z.sign n)) Z.zero else if Z.sign n = 0 then mk Z.zero Z.one else let g = Z.gcd n d in let n,d = Z.div n g, Z.div d g in if Z.sign d > 0 then mk n d else mk (Z.neg n) (Z.neg d) let of_bigint n = mk n Z.one (* n/1 *) let of_int n = of_bigint (Z.of_int n) let of_int32 n = of_bigint (Z.of_int32 n) let of_int64 n = of_bigint (Z.of_int64 n) let of_nativeint n = of_bigint (Z.of_nativeint n) let of_ints n d = make (Z.of_int n) (Z.of_int d) let zero = of_bigint Z.zero (* 0/1 *) let one = of_bigint Z.one (* 1/1 *) let minus_one = of_bigint Z.minus_one (* -1/1 *) let inf = mk Z.one Z.zero (* 1/0 *) let minus_inf = mk Z.minus_one Z.zero (* -1/0 *) let undef = mk Z.zero Z.zero (* 0/0 *) let of_float d = if d = infinity then inf else if d = neg_infinity then minus_inf else if classify_float d = FP_nan then undef else let m,e = frexp d in (* put into the form m * 2^e, where m is an integer *) let m,e = Z.of_float (ldexp m 53), e-53 in if e >= 0 then of_bigint (Z.shift_left m e) else make m (Z.shift_left Z.one (-e)) let of_string s = try let i = String.index s '/' in make (Z.of_string (String.sub s 0 i)) (Z.of_string (String.sub s (i+1) (String.length s-i-1))) with Not_found -> if s = "inf" || s = "+inf" then inf else if s = "-inf" then minus_inf else if s = "undef" then undef else of_bigint (Z.of_string s) (* queries *) (* ------- *) type kind = | ZERO (* 0 *) | INF (* 1/0 *) | MINF (* -1/0 *) | UNDEF (* 0/0 *) | NZERO (* non-special, non-0 *) let classify n = match Z.sign n.num, Z.sign n.den with | 0,0 -> UNDEF | 0,_ -> ZERO | 1,0 -> INF | -1,0 -> MINF | _ -> NZERO let is_real n = match classify n with | ZERO | NZERO -> true | INF | MINF | UNDEF -> false let num x = x.num let den x = x.den let sign x = Z.sign x.num (* sign undef = 0 sign inf = 1 sign -inf = -1 *) let equal x y = (Z.equal x.num y.num) && (Z.equal x.den y.den) let compare x y = match classify x, classify y with | UNDEF,UNDEF | INF,INF | MINF,MINF -> 0 | UNDEF,_ -> -1 | _,UNDEF -> 1 | MINF,_ | _,INF -> -1 | INF,_ | _,MINF -> 1 | _ -> Z.compare (Z.mul x.num y.den) (Z.mul y.num x.den) let min a b = if compare a b <= 0 then a else b let max a b = if compare a b >= 0 then a else b let leq a b = compare a b <= 0 let geq a b = compare a b >= 0 let lt a b = compare a b < 0 let gt a b = compare a b > 0 let to_string n = match classify n with | UNDEF -> "undef" | INF -> "+inf" | MINF -> "-inf" | ZERO -> "0" | NZERO -> if Z.equal n.den Z.one then Z.to_string n.num else (Z.to_string n.num) ^ "/" ^ (Z.to_string n.den) let to_string_raw n = (Z.to_string n.num) ^ "/" ^ (Z.to_string n.den) let to_bigint x = Z.div x.num x.den (* raises a Division by zero in case x is undefined or infinity *) let to_int x = Z.to_int (to_bigint x) let to_int32 x = Z.to_int32 (to_bigint x) let to_int64 x = Z.to_int64 (to_bigint x) let to_nativeint x = Z.to_nativeint (to_bigint x) (* operations *) (* ---------- *) let neg x = mk (Z.neg x.num) x.den (* neg undef = undef neg inf = -inf neg -inf = inf *) let abs x = mk (Z.abs x.num) x.den (* abs undef = undef abs inf = abs -inf = inf *) let add x y = let d = Z.mul x.den y.den in if Z.sign d = 0 then match classify x, classify y with | ZERO,_ -> y | _,ZERO -> x | UNDEF,_ | _,UNDEF -> undef | INF,MINF | MINF,INF -> undef | INF,_ | _,INF -> inf | MINF,_ | _,MINF -> minus_inf | NZERO,NZERO -> failwith "impossible case" else make (Z.add (Z.mul x.num y.den) (Z.mul y.num x.den)) d (* undef + x = x + undef = undef inf + -inf = -inf + inf = undef inf + x = x + inf = inf -inf + x = x + -inf = -inf *) let sub x y = let d = Z.mul x.den y.den in if Z.sign d = 0 then match classify x, classify y with | ZERO,_ -> neg y | _,ZERO -> x | UNDEF,_ | _,UNDEF -> undef | INF,INF | MINF,MINF -> undef | INF,_ | _,MINF -> inf | MINF,_ | _,INF -> minus_inf | NZERO,NZERO -> failwith "impossible case" else make (Z.sub (Z.mul x.num y.den) (Z.mul y.num x.den)) d (* sub x y = add x (neg y) *) let mul x y = make (Z.mul x.num y.num) (Z.mul x.den y.den) (* undef * x = x * undef = undef 0 * inf = inf * 0 = 0 * -inf = -inf * 0 = undef inf * x = x * inf = sign x * inf -inf * x = x * -inf = - sign x * inf *) let inv x = match Z.sign x.num with | 1 -> mk x.den x.num | -1 -> mk (Z.neg x.den) (Z.neg x.num) | _ -> if Z.sign x.den = 0 then undef else inf (* 1 / undef = undef 1 / inf = 1 / -inf = 0 1 / 0 = inf note that: inv (inv -inf) = inf <> -inf *) let div x y = if Z.sign y.num >= 0 then make (Z.mul x.num y.den) (Z.mul x.den y.num) else make (Z.neg (Z.mul x.num y.den)) (Z.neg (Z.mul x.den y.num)) (* undef / x = x / undef = undef 0 / 0 = undef inf / inf = inf / -inf = -inf / inf = -inf / -inf = undef 0 / inf = 0 / -inf = x / inf = x / -inf = 0 inf / x = sign x * inf -inf / x = - sign x * inf inf / 0 = inf -inf / 0 = -inf x / 0 = sign x * inf we have div x y = mul x (inv y) *) let mul_2exp x n = if Z.sign x.den = 0 then x else make (Z.shift_left x.num n) x.den let div_2exp x n = if Z.sign x.num = 0 then x else make x.num (Z.shift_left x.den n) (* printing *) (* -------- *) let print x = print_string (to_string x) let output chan x = output_string chan (to_string x) let sprint () x = to_string x let bprint b x = Buffer.add_string b (to_string x) let pp_print f x = Format.pp_print_string f (to_string x) (* prefix and infix *) (* ---------------- *) let (~-) = neg let (~+) x = x let (+) = add let (-) = sub let ( * ) = mul let (/) = div let (lsl) = mul_2exp let (asr) = div_2exp let (~$) = of_int let (//) = of_ints let (~$$) = of_bigint let (///) = make zarith-1.2.1/caml_z_x86_64_mingw64.S0000644000175000017540000001547612156017667015474 0ustar minemine/* Assembly version for the fast path of some functions in Z: - x86_64 target - Win64 ABI - GNU as This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). */ /* helper functions */ /* **************** */ #define SYMB(x) x #define FUNCTION_ALIGN 16 #define PROLOG(proc) \ .text; \ .globl SYMB(ml_as_z_##proc); \ .align FUNCTION_ALIGN; \ SYMB(ml_as_z_##proc):\ #define EPILOG(proc) #define C_JMP(proc) \ jmp SYMB(ml_z_##proc) /* operation counter */ #ifndef Z_PERF_COUNTER #define OP #else #define OP \ mov SYMB(ml_z_ops_as(%rip)), %rcx; \ addq $1, (%rcx) #endif /* unary arithmetics */ /* ***************** */ /* neg */ PROLOG(neg) test $1, %rcx jz .Lneg mov %rcx, %rax not %rax add $3, %rax jo .Lneg OP ret .Lneg: C_JMP(neg) EPILOG(neg) /* abs */ PROLOG(abs) test $1, %rcx jz .Labs mov %rcx, %rax test %rcx, %rcx jns .Labs2 not %rax add $3, %rax jo .Lneg .Labs2: OP ret .Labs: C_JMP(abs) EPILOG(abs) /* succ */ PROLOG(succ) test $1, %rcx jz .Lsucc mov %rcx, %rax add $2, %rax jo .Lsucc OP ret .Lsucc: C_JMP(succ) EPILOG(succ) /* pred */ PROLOG(pred) test $1, %rcx jz .Lpred mov %rcx, %rax sub $2, %rax jo .Lpred OP ret .Lpred: C_JMP(pred) EPILOG(pred) /* binary arithmetics */ /* ****************** */ /* add */ PROLOG(add) test $1, %rcx jz .Ladd test $1, %rdx jz .Ladd lea -1(%rcx), %rax add %rdx, %rax jo .Ladd OP ret .Ladd: C_JMP(add) EPILOG(add) /* sub */ PROLOG(sub) test $1, %rcx jz .Lsub test $1, %rdx jz .Lsub mov %rcx, %rax sub %rdx, %rax jo .Lsub inc %rax OP ret .Lsub: C_JMP(sub) EPILOG(sub) /* mul */ PROLOG(mul) test $1, %rcx jz .Lmul test $1, %rdx jz .Lmul lea -1(%rdx), %rax mov %rcx, %r8 sar %r8 imul %r8, %rax jo .Lmul inc %rax OP ret .Lmul: C_JMP(mul) EPILOG(mul) /* div */ PROLOG(div) test $1, %rcx jz .Ldiv test $1, %rdx jz .Ldiv mov %rdx, %r8 mov %rcx, %rax sar %r8 jz .Ldiv /* division by zero */ cmp $-1, %r8 je .Ldivneg sar %rax cqo idiv %r8 sal %rax inc %rax OP ret .Ldivneg: /* division by -1, the only one that can overflow */ not %rax add $3, %rax jo .Ldiv OP ret .Ldiv: C_JMP(div) EPILOG(div) /* rem */ PROLOG(rem) test $1, %rcx jz .Lrem test $1, %rdx jz .Lrem mov %rdx, %r8 mov %rcx, %rax sar %r8 jz .Lrem /* division by zero */ cmp $-1, %r8 je .Lremneg sar %rax cqo idiv %r8 sal %rdx lea 1(%rdx), %rax OP ret .Lremneg: /* division by -1 */ mov $1, %rax OP ret .Lrem: C_JMP(rem) EPILOG(rem) /* bit operations */ /* ************** */ /* not */ PROLOG(lognot) test $1, %rcx jz .Llognot lea -1(%rcx), %rax not %rax OP ret .Llognot: C_JMP(lognot) EPILOG(lognot) /* and */ PROLOG(logand) mov %rcx, %rax and %rdx, %rax test $1, %rax jz .Llogand OP ret .Llogand: C_JMP(logand) EPILOG(logand) /* or */ PROLOG(logor) test $1, %rcx jz .Llogor test $1, %rdx jz .Llogor mov %rcx, %rax or %rdx, %rax OP ret .Llogor: C_JMP(logor) EPILOG(logor) /* xor */ PROLOG(logxor) test $1, %rcx jz .Llogxor test $1, %rdx jz .Llogxor mov %rcx, %rax xor %rdx, %rax inc %rax OP ret .Llogxor: C_JMP(logxor) EPILOG(logxor) /* shift_left */ PROLOG(shift_left) test $1, %rcx jz .Lshift_left2 lea -1(%rcx), %rax mov %rcx, %r9 mov %rdx, %r10 sar %rdx cmp $63, %rdx jae .Lshift_left mov %rdx, %rcx mov %rax, %r8 sal %cl, %rax mov %rax, %rdx sar %cl, %rdx cmp %r8, %rdx jne .Lshift_left /* overflow */ inc %rax OP ret .Lshift_left: mov %r9, %rcx mov %r10, %rdx .Lshift_left2: C_JMP(shift_left) EPILOG(shift_left) /* shift_right */ PROLOG(shift_right) test $1, %rcx jz .Lshift_right mov %rcx, %rax mov %rdx, %rcx sar %rcx js .Lshift_right cmp $63, %rcx jae .Lshift_right2 sar %cl, %rax or $1, %rax OP ret .Lshift_right2: /* shift by 63 or more */ test %rax, %rax js .Lshift_right3 mov $1, %rax OP ret .Lshift_right3: mov $-1, %rax OP ret .Lshift_right: C_JMP(shift_right) EPILOG(shift_right) zarith-1.2.1/z_mlgmpidl.ml0000644000175000017540000000241412156017667014166 0ustar minemine(** Conversion between Zarith and MLGmpIDL integers and rationals. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) external mlgmpidl_of_mpz: Mpz.t -> Z.t = "ml_z_mlgmpidl_of_mpz" external mlgmpidl_set_mpz: Mpz.t -> Z.t -> unit = "ml_z_mlgmpidl_set_mpz" let z_of_mpz x = mlgmpidl_of_mpz x let mpz_of_z x = let r = Mpz.init () in mlgmpidl_set_mpz r x; r let z_of_mpzf x = z_of_mpz (Mpzf.mpz x) let mpzf_of_z x = Mpzf.mpzf (mpz_of_z x) let q_of_mpq x = let n,d = Mpz.init (), Mpz.init () in Mpq.get_num n x; Mpq.get_den d x; Q.make (z_of_mpz n) (z_of_mpz d) let mpq_of_q x = Mpq.of_mpz2 (mpz_of_z x.Q.num) (mpz_of_z x.Q.den) let q_of_mpqf x = q_of_mpq (Mpqf.mpq x) let mpqf_of_q x = Mpqf.mpqf (mpq_of_q x) zarith-1.2.1/test.ml0000644000175000017540000011751712156017667013022 0ustar minemine(* Simple tests for the Z and Q modules. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) (* testing Z *) module I = Z let pr ch x = output_string ch (I.to_string x); flush ch let pr2 ch (x,y) = Printf.fprintf ch "%s, %s" (I.to_string x) (I.to_string y); flush ch let pr3 ch (x,y,z) = Printf.fprintf ch "%s, %s, %s" (I.to_string x) (I.to_string y) (I.to_string z); flush ch let pow2 n = let rec doit acc n = if n<=0 then acc else doit (I.add acc acc) (n-1) in doit I.one n let fact n = let rec doit acc n = if n<=1 then acc else doit (I.mul acc (I.of_int n)) (n-1) in doit I.one n let pow a b = let rec doit b = if b <= 0 then I.one else let acc = doit (b lsr 1) in if b land 1 = 1 then I.mul (I.mul acc acc) (I.of_int a) else I.mul acc acc in doit b let cvt_int x = try string_of_int (I.to_int x) with I.Overflow -> "ovf" let cvt_int32 x = try Int32.to_string (I.to_int32 x) with I.Overflow -> "ovf" let cvt_int64 x = try Int64.to_string (I.to_int64 x) with I.Overflow -> "ovf" let cvt_nativeint x = try Nativeint.to_string (I.to_nativeint x) with I.Overflow -> "ovf" let p2 = I.of_int 2 let p30 = pow2 30 let p62 = pow2 62 let p300 = pow2 300 let p120 = pow2 120 let p121 = pow2 121 let maxi = I.of_int max_int let mini = I.of_int min_int let maxi32 = I.of_int32 Int32.max_int let mini32 = I.of_int32 Int32.min_int let maxi64 = I.of_int64 Int64.max_int let mini64 = I.of_int64 Int64.min_int let maxni = I.of_nativeint Nativeint.max_int let minni = I.of_nativeint Nativeint.min_int let chk_bits x = Printf.printf "to_bits %a\n =" pr x; String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x); Printf.printf "\n"; assert(I.equal (I.abs x) (I.of_bits (I.to_bits x))); assert((I.to_bits x) = (I.to_bits (I.neg x))); Printf.printf "marshal %a\n =" pr x; String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (Marshal.to_string x []); Printf.printf "\n"; assert (x = Marshal.from_string (Marshal.to_string x []) 0) let chk_extract (x, o, l) = let expected = I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l)) and actual = I.extract x o l in Printf.printf "extract %a %d %d = %a " pr x o l pr actual; if I.equal actual expected then Printf.printf "(passed)\n" else Printf.printf "(FAILED, expected %a)\n" pr expected let chk_signed_extract (x, o, l) = let uns_res = I.extract x o l in let expected = if I.compare uns_res (I.shift_left (I.of_int 1) (l-1)) >= 0 then I.sub uns_res (I.shift_left (I.of_int 1) l) else uns_res in let actual = I.signed_extract x o l in Printf.printf "signed_extract %a %d %d = %a " pr x o l pr actual; if I.equal actual expected then Printf.printf "(passed)\n" else Printf.printf "(FAILED, expected %a)\n" pr expected let test_Z() = Printf.printf "0\n = %a\n" pr I.zero; Printf.printf "1\n = %a\n" pr I.one; Printf.printf "-1\n = %a\n" pr I.minus_one; Printf.printf "42\n = %a\n" pr (I.of_int 42); Printf.printf "1+1\n = %a\n" pr (I.add I.one I.one); Printf.printf "1-1\n = %a\n" pr (I.sub I.one I.one); Printf.printf "- 1\n = %a\n" pr (I.neg I.one); Printf.printf "0-1\n = %a\n" pr (I.sub I.zero I.one); Printf.printf "max_int\n = %a\n" pr maxi; Printf.printf "min_int\n = %a\n" pr mini; Printf.printf "-max_int\n = %a\n" pr (I.neg maxi); Printf.printf "-min_int\n = %a\n" pr (I.neg mini); Printf.printf "2^300\n = %a\n" pr p300; Printf.printf "2^120\n = %a\n" pr p120; Printf.printf "2^300+2^120\n = %a\n" pr (I.add p300 p120); Printf.printf "2^300-2^120\n = %a\n" pr (I.sub p300 p120); Printf.printf "2^300+(-(2^120))\n = %a\n" pr (I.add p300 (I.neg p120)); Printf.printf "2^120-2^300\n = %a\n" pr (I.sub p120 p300); Printf.printf "2^120+(-(2^300))\n = %a\n" pr (I.add p120 (I.neg p300)); Printf.printf "-(2^120)+(-(2^300))\n = %a\n" pr (I.add (I.neg p120) (I.neg p300)); Printf.printf "-(2^120)-2^300\n = %a\n" pr (I.sub (I.neg p120) p300); Printf.printf "2^300-2^300\n = %a\n" pr (I.sub p300 p300); Printf.printf "2^121\n = %a\n" pr p121; Printf.printf "2^121+2^120\n = %a\n" pr (I.add p121 p120); Printf.printf "2^121-2^120\n = %a\n" pr (I.sub p121 p120); Printf.printf "2^121+(-(2^120))\n = %a\n" pr (I.add p121 (I.neg p120)); Printf.printf "2^120-2^121\n = %a\n" pr (I.sub p120 p121); Printf.printf "2^120+(-(2^121))\n = %a\n" pr (I.add p120 (I.neg p121)); Printf.printf "-(2^120)+(-(2^121))\n = %a\n" pr (I.add (I.neg p120) (I.neg p121)); Printf.printf "-(2^120)-2^121\n = %a\n" pr (I.sub (I.neg p120) p121); Printf.printf "2^121+0\n = %a\n" pr (I.add p121 I.zero); Printf.printf "2^121-0\n = %a\n" pr (I.sub p121 I.zero); Printf.printf "0+2^121\n = %a\n" pr (I.add I.zero p121); Printf.printf "0-2^121\n = %a\n" pr (I.sub I.zero p121); Printf.printf "2^300+1\n = %a\n" pr (I.add p300 I.one); Printf.printf "2^300-1\n = %a\n" pr (I.sub p300 I.one); Printf.printf "1+2^300\n = %a\n" pr (I.add I.one p300); Printf.printf "1-2^300\n = %a\n" pr (I.sub I.one p300); Printf.printf "2^300+(-1)\n = %a\n" pr (I.add p300 I.minus_one); Printf.printf "2^300-(-1)\n = %a\n" pr (I.sub p300 I.minus_one); Printf.printf "(-1)+2^300\n = %a\n" pr (I.add I.minus_one p300); Printf.printf "(-1)-2^300\n = %a\n" pr (I.sub I.minus_one p300); Printf.printf "-(2^300)+1\n = %a\n" pr (I.add (I.neg p300) I.one); Printf.printf "-(2^300)-1\n = %a\n" pr (I.sub (I.neg p300) I.one); Printf.printf "1+(-(2^300))\n = %a\n" pr (I.add I.one (I.neg p300)); Printf.printf "1-(-(2^300))\n = %a\n" pr (I.sub I.one (I.neg p300)); Printf.printf "-(2^300)+(-1)\n = %a\n" pr (I.add (I.neg p300) I.minus_one); Printf.printf "-(2^300)-(-1)\n = %a\n" pr (I.sub (I.neg p300) I.minus_one); Printf.printf "(-1)+(-(2^300))\n = %a\n" pr (I.add I.minus_one (I.neg p300)); Printf.printf "(-1)-(-(2^300))\n = %a\n" pr (I.sub I.minus_one (I.neg p300)); Printf.printf "max_int+1\n = %a\n" pr (I.add maxi I.one); Printf.printf "min_int-1\n = %a\n" pr (I.sub mini I.one); Printf.printf "-max_int-1\n = %a\n" pr (I.sub (I.neg maxi) I.one); Printf.printf "-min_int-1\n = %a\n" pr (I.sub (I.neg mini) I.one); Printf.printf "5! = %a\n" pr (fact 5); Printf.printf "12! = %a\n" pr (fact 12); Printf.printf "15! = %a\n" pr (fact 15); Printf.printf "20! = %a\n" pr (fact 20); Printf.printf "25! = %a\n" pr (fact 25); Printf.printf "50! = %a\n" pr (fact 50); Printf.printf "2^300*2^120\n = %a\n" pr (I.mul p300 p120); Printf.printf "2^120*2^300\n = %a\n" pr (I.mul p120 p300); Printf.printf "2^300*(-(2^120))\n = %a\n" pr (I.mul p300 (I.neg p120)); Printf.printf "2^120*(-(2^300))\n = %a\n" pr (I.mul p120 (I.neg p300)); Printf.printf "-(2^120)*(-(2^300))\n = %a\n" pr (I.mul (I.neg p120) (I.neg p300)); Printf.printf "2^121*2^120\n = %a\n" pr (I.mul p121 p120); Printf.printf "2^120*2^121\n = %a\n" pr (I.mul p120 p121); Printf.printf "2^121*0\n = %a\n" pr (I.mul p121 I.zero); Printf.printf "0*2^121\n = %a\n" pr (I.mul I.zero p121); Printf.printf "2^300*1\n = %a\n" pr (I.mul p300 I.one); Printf.printf "1*2^300\n = %a\n" pr (I.mul I.one p300); Printf.printf "2^300*(-1)\n = %a\n" pr (I.mul p300 I.minus_one); Printf.printf "(-1)*2^300\n = %a\n" pr (I.mul I.minus_one p300); Printf.printf "-(2^300)*1\n = %a\n" pr (I.mul (I.neg p300) I.one); Printf.printf "1*(-(2^300))\n = %a\n" pr (I.mul I.one (I.neg p300)); Printf.printf "-(2^300)*(-1)\n = %a\n" pr (I.mul (I.neg p300) I.minus_one); Printf.printf "(-1)*(-(2^300))\n = %a\n" pr (I.mul I.minus_one (I.neg p300)); Printf.printf "1*(2^30)\n = %a\n" pr (I.mul I.one p30); Printf.printf "1*(2^62)\n = %a\n" pr (I.mul I.one p62); Printf.printf "(2^30)*(2^30)\n = %a\n" pr (I.mul p30 p30); Printf.printf "(2^62)*(2^62)\n = %a\n" pr (I.mul p62 p62); Printf.printf "0+1\n = %a\n" pr (I.succ I.zero); Printf.printf "1+1\n = %a\n" pr (I.succ I.one); Printf.printf "-1+1\n = %a\n" pr (I.succ I.minus_one); Printf.printf "2+1\n = %a\n" pr (I.succ p2); Printf.printf "-2+1\n = %a\n" pr (I.succ (I.neg p2)); Printf.printf "(2^300)+1\n = %a\n" pr (I.succ p300); Printf.printf "-(2^300)+1\n = %a\n" pr (I.succ (I.neg p300)); Printf.printf "0-1\n = %a\n" pr (I.pred I.zero); Printf.printf "1-1\n = %a\n" pr (I.pred I.one); Printf.printf "-1-1\n = %a\n" pr (I.pred I.minus_one); Printf.printf "2-1\n = %a\n" pr (I.pred p2); Printf.printf "-2-1\n = %a\n" pr (I.pred (I.neg p2)); Printf.printf "(2^300)-1\n = %a\n" pr (I.pred p300); Printf.printf "-(2^300)-1\n = %a\n" pr (I.pred (I.neg p300)); Printf.printf "max_int+1\n = %a\n" pr (I.succ maxi); Printf.printf "min_int-1\n = %a\n" pr (I.pred mini); Printf.printf "-max_int-1\n = %a\n" pr (I.pred (I.neg maxi)); Printf.printf "-min_int-1\n = %a\n" pr (I.pred (I.neg mini)); Printf.printf "abs(0)\n = %a\n" pr (I.abs I.zero); Printf.printf "abs(1)\n = %a\n" pr (I.abs I.one); Printf.printf "abs(-1)\n = %a\n" pr (I.abs I.minus_one); Printf.printf "abs(min_int)\n = %a\n" pr (I.abs mini); Printf.printf "abs(2^300)\n = %a\n" pr (I.abs p300); Printf.printf "abs(-(2^300))\n = %a\n" pr (I.abs (I.neg p300)); Printf.printf "max_natint\n = %a\n" pr maxni; Printf.printf "max_int32\n = %a\n" pr maxi32; Printf.printf "max_int64\n = %a\n" pr maxi64; Printf.printf "to_int 1\n = %s\n" (cvt_int I.one); Printf.printf "to_int max_int\n = %s\n" (cvt_int maxi); Printf.printf "to_int max_natint\n = %s\n" (cvt_int maxni); Printf.printf "to_int max_int32\n = %s\n" (cvt_int maxi32); Printf.printf "to_int max_int64\n = %s\n" (cvt_int maxi64); Printf.printf "to_int32 1\n = %s\n" (cvt_int32 I.one); Printf.printf "to_int32 max_int\n = %s\n" (cvt_int32 maxi); Printf.printf "to_int32 max_natint\n = %s\n" (cvt_int32 maxni); Printf.printf "to_int32 max_int32\n = %s\n" (cvt_int32 maxi32); Printf.printf "to_int32 max_int64\n = %s\n" (cvt_int32 maxi64); Printf.printf "to_int64 1\n = %s\n" (cvt_int64 I.one); Printf.printf "to_int64 max_int\n = %s\n" (cvt_int64 maxi); Printf.printf "to_int64 max_natint\n = %s\n" (cvt_int64 maxni); Printf.printf "to_int64 max_int32\n = %s\n" (cvt_int64 maxi32); Printf.printf "to_int64 max_int64\n = %s\n" (cvt_int64 maxi64); Printf.printf "to_natint 1\n = %s\n" (cvt_nativeint I.one); Printf.printf "to_natint max_int\n = %s\n" (cvt_nativeint maxi); Printf.printf "to_natint max_natint\n = %s\n" (cvt_nativeint maxni); Printf.printf "to_natint max_int32\n = %s\n" (cvt_nativeint maxi32); Printf.printf "to_natint max_int64\n = %s\n" (cvt_nativeint maxi64); Printf.printf "to_int -min_int\n = %s\n" (cvt_int (I.neg mini)); Printf.printf "to_int -min_natint\n = %s\n" (cvt_int (I.neg minni)); Printf.printf "to_int -min_int32\n = %s\n" (cvt_int (I.neg mini32)); Printf.printf "to_int -min_int64\n = %s\n" (cvt_int (I.neg mini64)); Printf.printf "to_int32 -min_int\n = %s\n" (cvt_int32 (I.neg mini)); Printf.printf "to_int32 -min_natint\n = %s\n" (cvt_int32 (I.neg minni)); Printf.printf "to_int32 -min_int32\n = %s\n" (cvt_int32 (I.neg mini32)); Printf.printf "to_int32 -min_int64\n = %s\n" (cvt_int32(I.neg mini64)); Printf.printf "to_int64 -min_int\n = %s\n" (cvt_int64 (I.neg mini)); Printf.printf "to_int64 -min_natint\n = %s\n" (cvt_int64 (I.neg minni)); Printf.printf "to_int64 -min_int32\n = %s\n" (cvt_int64 (I.neg mini32)); Printf.printf "to_int64 -min_int64\n = %s\n" (cvt_int64 (I.neg mini64)); Printf.printf "to_natint -min_int\n = %s\n" (cvt_nativeint (I.neg mini)); Printf.printf "to_natint -min_natint\n = %s\n" (cvt_nativeint (I.neg minni)); Printf.printf "to_natint -min_int32\n = %s\n" (cvt_nativeint (I.neg mini32)); Printf.printf "to_natint -min_int64\n = %s\n" (cvt_nativeint (I.neg mini64)); Printf.printf "of_float 1.\n = %a\n" pr (I.of_float 1.); Printf.printf "of_float -1.\n = %a\n" pr (I.of_float (-. 1.)); Printf.printf "of_float pi\n = %a\n" pr (I.of_float (2. *. acos 0.)); Printf.printf "of_float 2^30\n = %a\n" pr (I.of_float (ldexp 1. 30)); Printf.printf "of_float 2^31\n = %a\n" pr (I.of_float (ldexp 1. 31)); Printf.printf "of_float 2^32\n = %a\n" pr (I.of_float (ldexp 1. 32)); Printf.printf "of_float 2^33\n = %a\n" pr (I.of_float (ldexp 1. 33)); Printf.printf "of_float -2^30\n = %a\n" pr (I.of_float (-.(ldexp 1. 30))); Printf.printf "of_float -2^31\n = %a\n" pr (I.of_float (-.(ldexp 1. 31))); Printf.printf "of_float -2^32\n = %a\n" pr (I.of_float (-.(ldexp 1. 32))); Printf.printf "of_float -2^33\n = %a\n" pr (I.of_float (-.(ldexp 1. 33))); Printf.printf "of_float 2^61\n = %a\n" pr (I.of_float (ldexp 1. 61)); Printf.printf "of_float 2^62\n = %a\n" pr (I.of_float (ldexp 1. 62)); Printf.printf "of_float 2^63\n = %a\n" pr (I.of_float (ldexp 1. 63)); Printf.printf "of_float 2^64\n = %a\n" pr (I.of_float (ldexp 1. 64)); Printf.printf "of_float 2^65\n = %a\n" pr (I.of_float (ldexp 1. 65)); Printf.printf "of_float -2^61\n = %a\n" pr (I.of_float (-.(ldexp 1. 61))); Printf.printf "of_float -2^62\n = %a\n" pr (I.of_float (-.(ldexp 1. 62))); Printf.printf "of_float -2^63\n = %a\n" pr (I.of_float (-.(ldexp 1. 63))); Printf.printf "of_float -2^64\n = %a\n" pr (I.of_float (-.(ldexp 1. 64))); Printf.printf "of_float -2^65\n = %a\n" pr (I.of_float (-.(ldexp 1. 65))); Printf.printf "of_float 2^120\n = %a\n" pr (I.of_float (ldexp 1. 120)); Printf.printf "of_float 2^300\n = %a\n" pr (I.of_float (ldexp 1. 300)); Printf.printf "of_float -2^120\n = %a\n" pr (I.of_float (-.(ldexp 1. 120))); Printf.printf "of_float -2^300\n = %a\n" pr (I.of_float (-.(ldexp 1. 300))); Printf.printf "of_float 0.5\n = %a\n" pr (I.of_float 0.5); Printf.printf "of_float -0.5\n = %a\n" pr (I.of_float (-. 0.5)); Printf.printf "of_float 200.5\n = %a\n" pr (I.of_float 200.5); Printf.printf "of_float -200.5\n = %a\n" pr (I.of_float (-. 200.5)); Printf.printf "to_float 0\n = %f\n" (I.to_float I.zero); Printf.printf "to_float 1\n = %f\n" (I.to_float I.one); Printf.printf "to_float -1\n = %f\n" (I.to_float I.minus_one); Printf.printf "to_float 2^120\n = %f\n" (I.to_float p120); Printf.printf "to_float -2^120\n = %f\n" (I.to_float (I.neg p120)); Printf.printf "to_float (2^120-1)\n = %f\n" (I.to_float (I.pred p120)); Printf.printf "to_float (-2^120+1)\n = %f\n" (I.to_float (I.succ (I.neg p120))); Printf.printf "to_float 2^63\n = %f\n" (I.to_float (pow2 63)); Printf.printf "to_float -2^63\n = %f\n" (I.to_float (I.neg (pow2 63))); Printf.printf "to_float (2^63-1)\n = %f\n" (I.to_float (I.pred (pow2 63))); Printf.printf "to_float (-2^63-1)\n = %f\n" (I.to_float (I.pred (I.neg (pow2 63)))); Printf.printf "to_float (-2^63+1)\n = %f\n" (I.to_float (I.succ (I.neg (pow2 63)))); Printf.printf "to_float 2^300\n = %f\n" (I.to_float p300); Printf.printf "to_float -2^300\n = %f\n" (I.to_float (I.neg p300)); Printf.printf "to_float (2^300-1)\n = %f\n" (I.to_float (I.pred p300)); Printf.printf "to_float (-2^300+1)\n = %f\n" (I.to_float (I.succ (I.neg p300))); Printf.printf "of_string 12\n = %a\n" pr (I.of_string "12"); Printf.printf "of_string 0x12\n = %a\n" pr (I.of_string "0x12"); Printf.printf "of_string 0b10\n = %a\n" pr (I.of_string "0b10"); Printf.printf "of_string 0o12\n = %a\n" pr (I.of_string "0o12"); Printf.printf "of_string -12\n = %a\n" pr (I.of_string "-12"); Printf.printf "of_string -0x12\n = %a\n" pr (I.of_string "-0x12"); Printf.printf "of_string -0b10\n = %a\n" pr (I.of_string "-0b10"); Printf.printf "of_string -0o12\n = %a\n" pr (I.of_string "-0o12"); Printf.printf "of_string 000123456789012345678901234567890\n = %a\n" pr (I.of_string "000123456789012345678901234567890"); Printf.printf "2^120 / 2^300 (trunc)\n = %a\n" pr (I.div p120 p300); Printf.printf "max_int / 2 (trunc)\n = %a\n" pr (I.div maxi p2); Printf.printf "(2^300+1) / 2^120 (trunc)\n = %a\n" pr (I.div (I.succ p300) p120); Printf.printf "(-(2^300+1)) / 2^120 (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) p120); Printf.printf "(2^300+1) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.succ p300) (I.neg p120)); Printf.printf "(-(2^300+1)) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) (I.neg p120)); Printf.printf "2^120 / 2^300 (ceil)\n = %a\n" pr (I.cdiv p120 p300); Printf.printf "max_int / 2 (ceil)\n = %a\n" pr (I.cdiv maxi p2); Printf.printf "(2^300+1) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) p120); Printf.printf "(-(2^300+1)) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) p120); Printf.printf "(2^300+1) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) (I.neg p120)); Printf.printf "(-(2^300+1)) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) (I.neg p120)); Printf.printf "2^120 / 2^300 (floor)\n = %a\n" pr (I.fdiv p120 p300); Printf.printf "max_int / 2 (floor)\n = %a\n" pr (I.fdiv maxi p2); Printf.printf "(2^300+1) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.succ p300) p120); Printf.printf "(-(2^300+1)) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) p120); Printf.printf "(2^300+1) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.succ p300) (I.neg p120)); Printf.printf "(-(2^300+1)) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) (I.neg p120)); Printf.printf "2^120 %% 2^300\n = %a\n" pr (I.rem p120 p300); Printf.printf "max_int %% 2\n = %a\n" pr (I.rem maxi p2); Printf.printf "(2^300+1) %% 2^120\n = %a\n" pr (I.rem (I.succ p300) p120); Printf.printf "(-(2^300+1)) %% 2^120\n = %a\n" pr (I.rem (I.neg (I.succ p300)) p120); Printf.printf "(2^300+1) %% (-(2^120))\n = %a\n" pr (I.rem (I.succ p300) (I.neg p120)); Printf.printf "(-(2^300+1)) %% (-(2^120))\n = %a\n" pr (I.rem (I.neg (I.succ p300)) (I.neg p120)); Printf.printf "2^120 /,%% 2^300\n = %a\n" pr2 (I.div_rem p120 p300); Printf.printf "max_int /,%% 2\n = %a\n" pr2 (I.div_rem maxi p2); Printf.printf "(2^300+1) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.succ p300) p120); Printf.printf "(-(2^300+1)) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) p120); Printf.printf "(2^300+1) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.succ p300) (I.neg p120)); Printf.printf "(-(2^300+1)) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) (I.neg p120)); Printf.printf "1 & 2\n = %a\n" pr (I.logand I.one p2); Printf.printf "1 & 2^300\n = %a\n" pr (I.logand I.one p300); Printf.printf "2^120 & 2^300\n = %a\n" pr (I.logand p120 p300); Printf.printf "2^300 & 2^120\n = %a\n" pr (I.logand p300 p120); Printf.printf "2^300 & 2^300\n = %a\n" pr (I.logand p300 p300); Printf.printf "2^300 & 0\n = %a\n" pr (I.logand p300 I.zero); Printf.printf "-2^120 & 2^300\n = %a\n" pr (I.logand (I.neg p120) p300); Printf.printf " 2^120 & -2^300\n = %a\n" pr (I.logand p120 (I.neg p300)); Printf.printf "-2^120 & -2^300\n = %a\n" pr (I.logand (I.neg p120) (I.neg p300)); Printf.printf "-2^300 & 2^120\n = %a\n" pr (I.logand (I.neg p300) p120); Printf.printf " 2^300 & -2^120\n = %a\n" pr (I.logand p300 (I.neg p120)); Printf.printf "-2^300 & -2^120\n = %a\n" pr (I.logand (I.neg p300) (I.neg p120)); Printf.printf "1 | 2\n = %a\n" pr (I.logor I.one p2); Printf.printf "1 | 2^300\n = %a\n" pr (I.logor I.one p300); Printf.printf "2^120 | 2^300\n = %a\n" pr (I.logor p120 p300); Printf.printf "2^300 | 2^120\n = %a\n" pr (I.logor p300 p120); Printf.printf "2^300 | 2^300\n = %a\n" pr (I.logor p300 p300); Printf.printf "2^300 | 0\n = %a\n" pr (I.logor p300 I.zero); Printf.printf "-2^120 | 2^300\n = %a\n" pr (I.logor (I.neg p120) p300); Printf.printf " 2^120 | -2^300\n = %a\n" pr (I.logor p120 (I.neg p300)); Printf.printf "-2^120 | -2^300\n = %a\n" pr (I.logor (I.neg p120) (I.neg p300)); Printf.printf "-2^300 | 2^120\n = %a\n" pr (I.logor (I.neg p300) p120); Printf.printf " 2^300 | -2^120\n = %a\n" pr (I.logor p300 (I.neg p120)); Printf.printf "-2^300 | -2^120\n = %a\n" pr (I.logor (I.neg p300) (I.neg p120)); Printf.printf "1 ^ 2\n = %a\n" pr (I.logxor I.one p2); Printf.printf "1 ^ 2^300\n = %a\n" pr (I.logxor I.one p300); Printf.printf "2^120 ^ 2^300\n = %a\n" pr (I.logxor p120 p300); Printf.printf "2^300 ^ 2^120\n = %a\n" pr (I.logxor p300 p120); Printf.printf "2^300 ^ 2^300\n = %a\n" pr (I.logxor p300 p300); Printf.printf "2^300 ^ 0\n = %a\n" pr (I.logxor p300 I.zero); Printf.printf "-2^120 ^ 2^300\n = %a\n" pr (I.logxor (I.neg p120) p300); Printf.printf " 2^120 ^ -2^300\n = %a\n" pr (I.logxor p120 (I.neg p300)); Printf.printf "-2^120 ^ -2^300\n = %a\n" pr (I.logxor (I.neg p120) (I.neg p300)); Printf.printf "-2^300 ^ 2^120\n = %a\n" pr (I.logxor (I.neg p300) p120); Printf.printf " 2^300 ^ -2^120\n = %a\n" pr (I.logxor p300 (I.neg p120)); Printf.printf "-2^300 ^ -2^120\n = %a\n" pr (I.logxor (I.neg p300) (I.neg p120)); Printf.printf "~0\n = %a\n" pr (I.lognot I.zero); Printf.printf "~1\n = %a\n" pr (I.lognot I.one); Printf.printf "~2\n = %a\n" pr (I.lognot p2); Printf.printf "~2^300\n = %a\n" pr (I.lognot p300); Printf.printf "~(-1)\n = %a\n" pr (I.lognot I.minus_one); Printf.printf "~(-2)\n = %a\n" pr (I.lognot (I.neg p2)); Printf.printf "~(-(2^300))\n = %a\n" pr (I.lognot (I.neg p300)); Printf.printf "0 >> 1\n = %a\n" pr (I.shift_right I.zero 1); Printf.printf "0 >> 100\n = %a\n" pr (I.shift_right I.zero 100); Printf.printf "2 >> 1\n = %a\n" pr (I.shift_right p2 1); Printf.printf "2 >> 2\n = %a\n" pr (I.shift_right p2 2); Printf.printf "2 >> 100\n = %a\n" pr (I.shift_right p2 100); Printf.printf "2^300 >> 1\n = %a\n" pr (I.shift_right p300 1); Printf.printf "2^300 >> 2\n = %a\n" pr (I.shift_right p300 2); Printf.printf "2^300 >> 100\n = %a\n" pr (I.shift_right p300 100); Printf.printf "2^300 >> 200\n = %a\n" pr (I.shift_right p300 200); Printf.printf "2^300 >> 300\n = %a\n" pr (I.shift_right p300 300); Printf.printf "2^300 >> 400\n = %a\n" pr (I.shift_right p300 400); Printf.printf "-1 >> 1\n = %a\n" pr (I.shift_right I.minus_one 1); Printf.printf "-2 >> 1\n = %a\n" pr (I.shift_right (I.neg p2) 1); Printf.printf "-2 >> 2\n = %a\n" pr (I.shift_right (I.neg p2) 2); Printf.printf "-2 >> 100\n = %a\n" pr (I.shift_right (I.neg p2) 100); Printf.printf "-2^300 >> 1\n = %a\n" pr (I.shift_right (I.neg p300) 1); Printf.printf "-2^300 >> 2\n = %a\n" pr (I.shift_right (I.neg p300) 2); Printf.printf "-2^300 >> 100\n = %a\n" pr (I.shift_right (I.neg p300) 100); Printf.printf "-2^300 >> 200\n = %a\n" pr (I.shift_right (I.neg p300) 200); Printf.printf "-2^300 >> 300\n = %a\n" pr (I.shift_right (I.neg p300) 300); Printf.printf "-2^300 >> 400\n = %a\n" pr (I.shift_right (I.neg p300) 400); Printf.printf "0 >>0 1\n = %a\n" pr (I.shift_right_trunc I.zero 1); Printf.printf "0 >>0 100\n = %a\n" pr (I.shift_right_trunc I.zero 100); Printf.printf "2 >>0 1\n = %a\n" pr (I.shift_right_trunc p2 1); Printf.printf "2 >>0 2\n = %a\n" pr (I.shift_right_trunc p2 2); Printf.printf "2 >>0 100\n = %a\n" pr (I.shift_right_trunc p2 100); Printf.printf "2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc p300 1); Printf.printf "2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc p300 2); Printf.printf "2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc p300 100); Printf.printf "2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc p300 200); Printf.printf "2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc p300 300); Printf.printf "2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc p300 400); Printf.printf "-1 >>0 1\n = %a\n" pr (I.shift_right_trunc I.minus_one 1); Printf.printf "-2 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 1); Printf.printf "-2 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 2); Printf.printf "-2 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 100); Printf.printf "-2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 1); Printf.printf "-2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 2); Printf.printf "-2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 100); Printf.printf "-2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 200); Printf.printf "-2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 300); Printf.printf "-2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 400); Printf.printf "0 << 1\n = %a\n" pr (I.shift_left I.zero 1); Printf.printf "0 << 100\n = %a\n" pr (I.shift_left I.zero 100); Printf.printf "2 << 1\n = %a\n" pr (I.shift_left p2 1); Printf.printf "2 << 32\n = %a\n" pr (I.shift_left p2 32); Printf.printf "2 << 64\n = %a\n" pr (I.shift_left p2 64); Printf.printf "2 << 299\n = %a\n" pr (I.shift_left p2 299); Printf.printf "2^120 << 1\n = %a\n" pr (I.shift_left p120 1); Printf.printf "2^120 << 180\n = %a\n" pr (I.shift_left p120 180); Printf.printf "compare 1 2\n = %i\n" (I.compare I.one p2); Printf.printf "compare 1 1\n = %i\n" (I.compare I.one I.one); Printf.printf "compare 2 1\n = %i\n" (I.compare p2 I.one); Printf.printf "compare 2^300 2^120\n = %i\n" (I.compare p300 p120); Printf.printf "compare 2^120 2^120\n = %i\n" (I.compare p120 p120); Printf.printf "compare 2^120 2^300\n = %i\n" (I.compare p120 p300); Printf.printf "compare 2^121 2^120\n = %i\n" (I.compare p121 p120); Printf.printf "compare 2^120 2^121\n = %i\n" (I.compare p120 p121); Printf.printf "compare 2^300 -2^120\n = %i\n" (I.compare p300 (I.neg p120)); Printf.printf "compare 2^120 -2^120\n = %i\n" (I.compare p120 (I.neg p120)); Printf.printf "compare 2^120 -2^300\n = %i\n" (I.compare p120 (I.neg p300)); Printf.printf "compare -2^300 2^120\n = %i\n" (I.compare (I.neg p300) p120); Printf.printf "compare -2^120 2^120\n = %i\n" (I.compare (I.neg p120) p120); Printf.printf "compare -2^120 2^300\n = %i\n" (I.compare (I.neg p120) p300); Printf.printf "compare -2^300 -2^120\n = %i\n" (I.compare (I.neg p300) (I.neg p120)); Printf.printf "compare -2^120 -2^120\n = %i\n" (I.compare (I.neg p120) (I.neg p120)); Printf.printf "compare -2^120 -2^300\n = %i\n" (I.compare (I.neg p120) (I.neg p300)); Printf.printf "equal 1 2\n = %B\n" (I.equal I.one p2); Printf.printf "equal 1 1\n = %B\n" (I.equal I.one I.one); Printf.printf "equal 2 1\n = %B\n" (I.equal p2 I.one); Printf.printf "equal 2^300 2^120\n = %B\n" (I.equal p300 p120); Printf.printf "equal 2^120 2^120\n = %B\n" (I.equal p120 p120); Printf.printf "equal 2^120 2^300\n = %B\n" (I.equal p120 p300); Printf.printf "equal 2^121 2^120\n = %B\n" (I.equal p121 p120); Printf.printf "equal 2^120 2^121\n = %B\n" (I.equal p120 p121); Printf.printf "equal 2^120 -2^120\n = %B\n" (I.equal p120 (I.neg p120)); Printf.printf "equal -2^120 2^120\n = %B\n" (I.equal (I.neg p120) p120); Printf.printf "equal -2^120 -2^120\n = %B\n" (I.equal (I.neg p120) (I.neg p120)); Printf.printf "sign 0\n = %i\n" (I.sign I.zero); Printf.printf "sign 1\n = %i\n" (I.sign I.one); Printf.printf "sign -1\n = %i\n" (I.sign I.minus_one); Printf.printf "sign 2^300\n = %i\n" (I.sign p300); Printf.printf "sign -2^300\n = %i\n" (I.sign (I.neg p300)); Printf.printf "gcd 12 27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int 27)); Printf.printf "gcd 27 12\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 12)); Printf.printf "gcd 27 27\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 27)); Printf.printf "gcd -12 27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int 27)); Printf.printf "gcd 12 -27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int (-27))); Printf.printf "gcd -12 -27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int (-27))); Printf.printf "gcd 2^120 2^300\n = %a\n" pr (I.gcd p120 p300); Printf.printf "gcd 2^300 2^120\n = %a\n" pr (I.gcd p300 p120); Printf.printf "gcdext 12 27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int 27)); Printf.printf "gcdext 27 12\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 12)); Printf.printf "gcdext 27 27\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 27)); Printf.printf "gcdext -12 27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int 27)); Printf.printf "gcdext 12 -27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int (-27))); Printf.printf "gcdext -12 -27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int (-27))); Printf.printf "gcdext 2^120 2^300\n = %a\n" pr3 (I.gcdext p120 p300); Printf.printf "gcdext 2^300 2^120\n = %a\n" pr3 (I.gcdext p300 p120); Printf.printf "sqrt 0\n = %a\n" pr (I.sqrt I.zero); Printf.printf "sqrt 1\n = %a\n" pr (I.sqrt I.one); Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2); Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120); Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121); Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero); Printf.printf "popcount 1\n = %i\n" (I.popcount I.one); Printf.printf "popcount 2\n = %i\n" (I.popcount p2); Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32); Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120); Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120)); Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120); Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); (* always 0 when not using custom blocks *) Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120); Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121); Printf.printf "hash(2^300)\n = %i\n" (Hashtbl.hash p300); (* fails if not using custom blocks *) Printf.printf "2^120 = 2^300\n = %B\n" (p120 = p300); Printf.printf "2^120 = 2^120\n = %B\n" (p120 = p120); Printf.printf "2^120 = 2^120\n = %B\n" (p120 = (pow2 120)); Printf.printf "2^120 > 2^300\n = %B\n" (p120 > p300); Printf.printf "2^120 < 2^300\n = %B\n" (p120 < p300); Printf.printf "2^120 = 1\n = %B\n" (p120 = I.one); (* In OCaml < 3.12.1, the order is not consistent with integers when comparing mpn_ and ints with OCaml's polymorphic compare operator. In OCaml >= 3.12.1, the results are consistent. *) Printf.printf "2^120 > 1\n = %B\n" (p120 > I.one); Printf.printf "2^120 < 1\n = %B\n" (p120 < I.one); Printf.printf "-2^120 > 1\n = %B\n" ((I.neg p120) > I.one); Printf.printf "-2^120 < 1\n = %B\n" ((I.neg p120) < I.one); Printf.printf "demarshal 2^120, 2^300, 1\n = %a\n" pr3 (Marshal.from_string (Marshal.to_string (p120,p300,I.one) []) 0); Printf.printf "demarshal -2^120, -2^300, -1\n = %a\n" pr3 (Marshal.from_string (Marshal.to_string (I.neg p120,I.neg p300,I.minus_one) []) 0); Printf.printf "format %%i 0 = /%s/\n" (I.format "%i" I.zero); Printf.printf "format %%i 1 = /%s/\n" (I.format "%i" I.one); Printf.printf "format %%i -1 = /%s/\n" (I.format "%i" I.minus_one); Printf.printf "format %%i 2^30 = /%s/\n" (I.format "%i" p30); Printf.printf "format %%i -2^30 = /%s/\n" (I.format "%i" (I.neg p30)); Printf.printf "format %% i 1 = /%s/\n" (I.format "% i" I.one); Printf.printf "format %%+i 1 = /%s/\n" (I.format "%+i" I.one); Printf.printf "format %%x 0 = /%s/\n" (I.format "%x" I.zero); Printf.printf "format %%x 1 = /%s/\n" (I.format "%x" I.one); Printf.printf "format %%x -1 = /%s/\n" (I.format "%x" I.minus_one); Printf.printf "format %%x 2^30 = /%s/\n" (I.format "%x" p30); Printf.printf "format %%x -2^30 = /%s/\n" (I.format "%x" (I.neg p30)); Printf.printf "format %%X 0 = /%s/\n" (I.format "%X" I.zero); Printf.printf "format %%X 1 = /%s/\n" (I.format "%X" I.one); Printf.printf "format %%X -1 = /%s/\n" (I.format "%X" I.minus_one); Printf.printf "format %%X 2^30 = /%s/\n" (I.format "%X" p30); Printf.printf "format %%X -2^30 = /%s/\n" (I.format "%X" (I.neg p30)); Printf.printf "format %%o 0 = /%s/\n" (I.format "%o" I.zero); Printf.printf "format %%o 1 = /%s/\n" (I.format "%o" I.one); Printf.printf "format %%o -1 = /%s/\n" (I.format "%o" I.minus_one); Printf.printf "format %%o 2^30 = /%s/\n" (I.format "%o" p30); Printf.printf "format %%o -2^30 = /%s/\n" (I.format "%o" (I.neg p30)); Printf.printf "format %%10i 0 = /%s/\n" (I.format "%10i" I.zero); Printf.printf "format %%10i 1 = /%s/\n" (I.format "%10i" I.one); Printf.printf "format %%10i -1 = /%s/\n" (I.format "%10i" I.minus_one); Printf.printf "format %%10i 2^30 = /%s/\n" (I.format "%10i" p30); Printf.printf "format %%10i -2^30 = /%s/\n" (I.format "%10i" (I.neg p30)); Printf.printf "format %%-10i 0 = /%s/\n" (I.format "%-10i" I.zero); Printf.printf "format %%-10i 1 = /%s/\n" (I.format "%-10i" I.one); Printf.printf "format %%-10i -1 = /%s/\n" (I.format "%-10i" I.minus_one); Printf.printf "format %%-10i 2^30 = /%s/\n" (I.format "%-10i" p30); Printf.printf "format %%-10i -2^30 = /%s/\n" (I.format "%-10i" (I.neg p30)); Printf.printf "format %%+10i 0 = /%s/\n" (I.format "%+10i" I.zero); Printf.printf "format %%+10i 1 = /%s/\n" (I.format "%+10i" I.one); Printf.printf "format %%+10i -1 = /%s/\n" (I.format "%+10i" I.minus_one); Printf.printf "format %%+10i 2^30 = /%s/\n" (I.format "%+10i" p30); Printf.printf "format %%+10i -2^30 = /%s/\n" (I.format "%+10i" (I.neg p30)); Printf.printf "format %% 10i 0 = /%s/\n" (I.format "% 10i" I.zero); Printf.printf "format %% 10i 1 = /%s/\n" (I.format "% 10i" I.one); Printf.printf "format %% 10i -1 = /%s/\n" (I.format "% 10i" I.minus_one); Printf.printf "format %% 10i 2^30 = /%s/\n" (I.format "% 10i" p30); Printf.printf "format %% 10i -2^30 = /%s/\n" (I.format "% 10i" (I.neg p30)); Printf.printf "format %%010i 0 = /%s/\n" (I.format "%010i" I.zero); Printf.printf "format %%010i 1 = /%s/\n" (I.format "%010i" I.one); Printf.printf "format %%010i -1 = /%s/\n" (I.format "%010i" I.minus_one); Printf.printf "format %%010i 2^30 = /%s/\n" (I.format "%010i" p30); Printf.printf "format %%010i -2^30 = /%s/\n" (I.format "%010i" (I.neg p30)); Printf.printf "format %%#x 0 = /%s/\n" (I.format "%#x" I.zero); Printf.printf "format %%#x 1 = /%s/\n" (I.format "%#x" I.one); Printf.printf "format %%#x -1 = /%s/\n" (I.format "%#x" I.minus_one); Printf.printf "format %%#x 2^30 = /%s/\n" (I.format "%#x" p30); Printf.printf "format %%#x -2^30 = /%s/\n" (I.format "%#x" (I.neg p30)); Printf.printf "format %%#X 0 = /%s/\n" (I.format "%#X" I.zero); Printf.printf "format %%#X 1 = /%s/\n" (I.format "%#X" I.one); Printf.printf "format %%#X -1 = /%s/\n" (I.format "%#X" I.minus_one); Printf.printf "format %%#X 2^30 = /%s/\n" (I.format "%#X" p30); Printf.printf "format %%#X -2^30 = /%s/\n" (I.format "%#X" (I.neg p30)); Printf.printf "format %%#o 0 = /%s/\n" (I.format "%#o" I.zero); Printf.printf "format %%#o 1 = /%s/\n" (I.format "%#o" I.one); Printf.printf "format %%#o -1 = /%s/\n" (I.format "%#o" I.minus_one); Printf.printf "format %%#o 2^30 = /%s/\n" (I.format "%#o" p30); Printf.printf "format %%#o -2^30 = /%s/\n" (I.format "%#o" (I.neg p30)); Printf.printf "format %%#10x 0 = /%s/\n" (I.format "%#10x" I.zero); Printf.printf "format %%#10x 1 = /%s/\n" (I.format "%#10x" I.one); Printf.printf "format %%#10x -1 = /%s/\n" (I.format "%#10x" I.minus_one); Printf.printf "format %%#10x 2^30 = /%s/\n" (I.format "%#10x" p30); Printf.printf "format %%#10x -2^30 = /%s/\n" (I.format "%#10x" (I.neg p30)); Printf.printf "format %%#10X 0 = /%s/\n" (I.format "%#10X" I.zero); Printf.printf "format %%#10X 1 = /%s/\n" (I.format "%#10X" I.one); Printf.printf "format %%#10X -1 = /%s/\n" (I.format "%#10X" I.minus_one); Printf.printf "format %%#10X 2^30 = /%s/\n" (I.format "%#10X" p30); Printf.printf "format %%#10X -2^30 = /%s/\n" (I.format "%#10X" (I.neg p30)); Printf.printf "format %%#10o 0 = /%s/\n" (I.format "%#10o" I.zero); Printf.printf "format %%#10o 1 = /%s/\n" (I.format "%#10o" I.one); Printf.printf "format %%#10o -1 = /%s/\n" (I.format "%#10o" I.minus_one); Printf.printf "format %%#10o 2^30 = /%s/\n" (I.format "%#10o" p30); Printf.printf "format %%#10o -2^30 = /%s/\n" (I.format "%#10o" (I.neg p30)); Printf.printf "format %%#-10x 0 = /%s/\n" (I.format "%#-10x" I.zero); Printf.printf "format %%#-10x 1 = /%s/\n" (I.format "%#-10x" I.one); Printf.printf "format %%#-10x -1 = /%s/\n" (I.format "%#-10x" I.minus_one); Printf.printf "format %%#-10x 2^30 = /%s/\n" (I.format "%#-10x" p30); Printf.printf "format %%#-10x -2^30 = /%s/\n" (I.format "%#-10x" (I.neg p30)); Printf.printf "format %%#-10X 0 = /%s/\n" (I.format "%#-10X" I.zero); Printf.printf "format %%#-10X 1 = /%s/\n" (I.format "%#-10X" I.one); Printf.printf "format %%#-10X -1 = /%s/\n" (I.format "%#-10X" I.minus_one); Printf.printf "format %%#-10X 2^30 = /%s/\n" (I.format "%#-10X" p30); Printf.printf "format %%#-10X -2^30 = /%s/\n" (I.format "%#-10X" (I.neg p30)); Printf.printf "format %%#-10o 0 = /%s/\n" (I.format "%#-10o" I.zero); Printf.printf "format %%#-10o 1 = /%s/\n" (I.format "%#-10o" I.one); Printf.printf "format %%#-10o -1 = /%s/\n" (I.format "%#-10o" I.minus_one); Printf.printf "format %%#-10o 2^30 = /%s/\n" (I.format "%#-10o" p30); Printf.printf "format %%#-10o -2^30 = /%s/\n" (I.format "%#-10o" (I.neg p30)); let extract_testdata = let a = I.of_int 42 and b = I.of_int (-42) and c = I.of_string "3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701" in [a,0,1; a,0,5; a,0,32; a,0,64; a,1,1; a,1,5; a,1,32; a,1,63; a,1,64; a,1,127; a,1,128; a,69,12; b,0,1; b,0,5; b,0,32; b,0,64; b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128; b,69,12; c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in List.iter chk_extract extract_testdata; List.iter chk_signed_extract extract_testdata; chk_bits I.zero; chk_bits p2; chk_bits (I.neg p2); chk_bits p30; chk_bits (I.neg p30); chk_bits p62; chk_bits (I.neg p62); chk_bits p300; chk_bits p120; chk_bits p121; chk_bits maxi; chk_bits mini; chk_bits maxi32; chk_bits mini32; chk_bits maxi64; chk_bits mini64; chk_bits maxni; chk_bits minni; () (* testing Q *) (* gcd extended to: gcd x 0 = gcd 0 x = 0 *) let gcd2 a b = if Z.sign a = 0 then b else if Z.sign b = 0 then a else Z.gcd a b (* check invariant *) let check x = assert (Z.sign x.Q.den >= 0); assert (Z.compare (gcd2 x.Q.num x.Q.den) Z.one <= 0) let t_list = [Q.zero;Q.one;Q.minus_one;Q.inf;Q.minus_inf;Q.undef] let test1 msg op = List.iter (fun x -> let r = op x in check r; Printf.printf "%s %s = %s\n" msg (Q.to_string x) (Q.to_string r) ) t_list let test2 msg op = List.iter (fun x -> List.iter (fun y -> let r = op x y in check r; Printf.printf "%s %s %s = %s\n" (Q.to_string x) msg (Q.to_string y) (Q.to_string r) ) t_list ) t_list let test_Q () = let _ = List.iter check t_list in let _ = test1 "-" Q.neg in let _ = test1 "1/" Q.inv in let _ = test1 "abs" Q.abs in let _ = test2 "+" Q.add in let _ = test2 "-" Q.sub in let _ = test2 "*" Q.mul in let _ = test2 "/" Q.div in let _ = test2 "* 1/" (fun a b -> Q.mul a (Q.inv b)) in (* check simple identitites *) List.iter (fun x -> List.iter (fun y -> Printf.printf "identity checking %s %s\n" (Q.to_string x) (Q.to_string y); assert (Q.equal (Q.add x y) (Q.add y x)); assert (Q.equal (Q.sub x y) (Q.neg (Q.sub y x))); assert (Q.equal (Q.sub x y) (Q.add x (Q.neg y))); assert (Q.equal (Q.mul x y) (Q.mul y x)); assert (Q.equal (Q.div x y) (Q.mul x (Q.inv y))); ) t_list ) t_list (* main *) let _ = test_Z() let _ = test_Q() zarith-1.2.1/big_int_Z.ml0000644000175000017540000000605012156017667013734 0ustar minemine(** [Big_int] interface for Z module. This modules provides an interface compatible with [Big_int], but using [Z] functions internally. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) type big_int = Z.t let zero_big_int = Z.zero let unit_big_int = Z.one let minus_big_int = Z.neg let abs_big_int = Z.abs let add_big_int = Z.add let succ_big_int = Z.succ let add_int_big_int x y = Z.add (Z.of_int x) y let sub_big_int = Z.sub let pred_big_int = Z.pred let mult_big_int = Z.mul let mult_int_big_int x y = Z.mul (Z.of_int x) y let square_big_int x = Z.mul x x let sqrt_big_int = Z.sqrt let quomod_big_int = Z.ediv_rem let div_big_int = Z.ediv let mod_big_int = Z.erem let gcd_big_int = Z.gcd let power = Z.pow let power_big a b = Z.pow a (Z.to_int b) let power_int_positive_int a b = if b < 0 then raise (Invalid_argument "power_int_positive_int"); power (Z.of_int a) b let power_big_int_positive_int a b = if b < 0 then raise (Invalid_argument "power_big_int_positive_int"); power a b let power_int_positive_big_int a b = if Z.sign b < 0 then raise (Invalid_argument "power_int_positive_big_int"); power_big (Z.of_int a) b let power_big_int_positive_big_int a b = if Z.sign b < 0 then raise (Invalid_argument "power_big_int_positive_big_int"); power_big a b let sign_big_int = Z.sign let compare_big_int = Z.compare let eq_big_int = Z.equal let le_big_int a b = Z.compare a b <= 0 let ge_big_int a b = Z.compare a b >= 0 let lt_big_int a b = Z.compare a b < 0 let gt_big_int a b = Z.compare a b > 0 let max_big_int = Z.max let min_big_int = Z.min let num_digits_big_int = Z.size let string_of_big_int = Z.to_string let big_int_of_string = Z.of_string let big_int_of_int = Z.of_int let is_int_big_int = Z.fits_int let int_of_big_int x = try Z.to_int x with Z.Overflow -> failwith "int_of_big_int" let big_int_of_int32 = Z.of_int32 let big_int_of_nativeint = Z.of_nativeint let big_int_of_int64 = Z.of_int64 let int32_of_big_int x = try Z.to_int32 x with Z.Overflow -> failwith "int32_of_big_int" let nativeint_of_big_int x = try Z.to_nativeint x with Z.Overflow -> failwith "nativeint_of_big_int" let int64_of_big_int x = try Z.to_int64 x with Z.Overflow -> failwith "int64_of_big_int" let float_of_big_int = Z.to_float let and_big_int = Z.logand let or_big_int = Z.logor let xor_big_int = Z.logxor let shift_left_big_int = Z.shift_left let shift_right_big_int = Z.shift_right let shift_right_towards_zero_big_int = Z.shift_right_trunc let extract_big_int = Z.extract zarith-1.2.1/zarith.h0000644000175000017540000000222212156017667013145 0ustar minemine/** Public C interface for Zarith. This is intended for C libraries that wish to convert between mpz_t and Z.t objects. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). */ /* gmp.h or mpir.h must be included manually before zarith.h */ #ifdef __cplusplus extern "C" { #endif #include /* sets rop to the value in op (limbs are copied) */ void ml_z_mpz_set_z(mpz_t rop, value op); /* inits and sets rop to the value in op (limbs are copied) */ void ml_z_mpz_init_set_z(mpz_t rop, value op); /* returns a new z objects equal to op (limbs are copied) */ value ml_z_from_mpz(mpz_t op); #ifdef __cplusplus } #endif zarith-1.2.1/caml_z.c0000644000175000017540000021474612156017667013124 0ustar minemine/** Implementation of Z module. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). */ /*--------------------------------------------------- INCLUDES ---------------------------------------------------*/ #include #include #include #include #ifdef HAS_GMP #include #endif #ifdef HAS_MPIR #include #endif #ifdef __cplusplus extern "C" { #endif #include #include #include #include #include #include #include #include #ifdef Z_OCAML_HASH #include #endif #define inline __inline #ifdef _MSC_VER #include #define isnan _isnan static const double inf_helper = 1.0; #define isinf(x) ((x == (1.0 / (inf_helper - 1.0))) || (x == -(1.0 / (inf_helper - 1.0)))) #endif /*--------------------------------------------------- CONFIGURATION ---------------------------------------------------*/ /* Whether to enable native (i.e. non-mpn_) operations and output ocaml integers when possible. Highly recommended. */ #define Z_FAST_PATH 1 #define Z_USE_NATINT 1 /* Sanity checks. */ #define Z_PERFORM_CHECK 0 /* Enable performance counters. Prints some info on stdout at exit. */ /* #define Z_PERF_COUNTER 0 now set by configure */ /* whether to use custom blocks (supporting serialization, comparison & hashing) instead of abstract tags */ #define Z_CUSTOM_BLOCK 1 /* whether the "compare_ext" operation over custom blocks is supported. This operation is required for OCaml's generic comparisons to operate properly over values of type Z.t. The compare_ext operation is supported in OCaml since version 3.12.1. */ /* #define Z_OCAML_COMPARE_EXT 0 now set by configure */ /*--------------------------------------------------- DATA STRUCTURES ---------------------------------------------------*/ /* we assume that: - intnat is a signed integer type - mp_limb_t is an unsigned integer type - sizeof(intnat) == sizeof(mp_limb_t) == either 4 or 8 */ #ifdef _WIN64 #define PRINTF_LIMB "I64" #else #define PRINTF_LIMB "l" #endif /* A z object x can be: - either an ocaml int - or a block with abstract or custom tag and containing: . a 1 value header containing the sign Z_SIGN(x) and the size Z_SIZE(x) . Z_SIZE(x) mp_limb_t Invariant: - if the number fits in an int, it is stored in an int, not a block - if the number is stored in a block, then Z_SIZE(x) >= 1 and the most significant limb Z_LIMB(x)[Z_SIZE(x)] is not 0 */ /* a sign is always denoted as 0 (+) or Z_SIGN_MASK (-) */ #ifdef ARCH_SIXTYFOUR #define Z_SIGN_MASK 0x8000000000000000 #define Z_SIZE_MASK 0x7fffffffffffffff #else #define Z_SIGN_MASK 0x80000000 #define Z_SIZE_MASK 0x7fffffff #endif #if Z_CUSTOM_BLOCK #define Z_HEAD(x) (*((value*)Data_custom_val((x)))) #define Z_LIMB(x) ((mp_limb_t*)Data_custom_val((x)) + 1) #else #define Z_HEAD(x) (Field((x),0)) #define Z_LIMB(x) ((mp_limb_t*)&(Field((x),1))) #endif #define Z_SIGN(x) (Z_HEAD((x)) & Z_SIGN_MASK) #define Z_SIZE(x) (Z_HEAD((x)) & Z_SIZE_MASK) /* bounds of an Ocaml int */ #ifdef ARCH_SIXTYFOUR #define Z_MAX_INT 0x3fffffffffffffff #define Z_MIN_INT (-0x4000000000000000) #else #define Z_MAX_INT 0x3fffffff #define Z_MIN_INT (-0x40000000) #endif #define Z_FITS_INT(v) ((v) >= Z_MIN_INT && (v) <= Z_MAX_INT) /* Z_MAX_INT may not be representable exactly as a double => we use a lower approximation to be safe */ #ifdef ARCH_SIXTYFOUR #define Z_MAX_INT_FL 0x3ffffffffffff000 #define Z_MIN_INT_FL (-Z_MAX_INT_FL) #else #define Z_MAX_INT_FL Z_MAX_INT #define Z_MIN_INT_FL Z_MIN_INT #endif /* safe bounds to avoid overflow in multiplication */ #ifdef ARCH_SIXTYFOUR #define Z_MAX_HINT 0x3fffffff #else #define Z_MAX_HINT 0x3fff #endif #define Z_MIN_HINT (-Z_MAX_HINT) #define Z_FITS_HINT(v) ((v) >= Z_MIN_HINT && (v) <= Z_MAX_HINT) /* hi bit of OCaml int32, int64 & nativeint */ #define Z_HI_INT32 0x80000000 #define Z_HI_INT64 0x8000000000000000LL #ifdef ARCH_SIXTYFOUR #define Z_HI_INTNAT Z_HI_INT64 #define Z_HI_INT 0x4000000000000000 #else #define Z_HI_INTNAT Z_HI_INT32 #define Z_HI_INT 0x40000000 #endif #define Z_LIMB_BITS (8 * sizeof(mp_limb_t)) /* performance counters */ unsigned long ml_z_ops = 0; unsigned long ml_z_slow = 0; unsigned long ml_z_ops_as = 0; #if Z_PERF_COUNTER #define Z_MARK_OP ml_z_ops++ #define Z_MARK_SLOW ml_z_slow++ #else #define Z_MARK_OP #define Z_MARK_SLOW #endif /*--------------------------------------------------- UTILITIES ---------------------------------------------------*/ extern struct custom_operations ml_z_custom_ops; static double ml_z_2p32; /* 2 ^ 32 in double */ /* for debugging: dump a mp_limb_t array */ static void ml_z_dump(const char* msg, mp_limb_t* p, mp_size_t sz) { mp_size_t i; printf("%s %i: ",msg,(int)sz); for (i = 0; i < sz; i++) #ifdef ARCH_SIXTYFOUR printf("%08" PRINTF_LIMB "x ",p[i]); #else printf("%04" PRINTF_LIMB "x ",p[i]); #endif printf("\n"); fflush(stdout); } /* for debugging: check invariant */ void ml_z_check(const char* fn, int line, const char* arg, value v) { mp_size_t sz; if (Is_block(v)) { #if Z_CUSTOM_BLOCK if (Custom_ops_val(v) != &ml_z_custom_ops) { printf("ml_z_check: wrong custom block for %s at %s:%i.\n", arg, fn, line); exit(1); } sz = Wosize_val(v) - 1; #else sz = Wosize_val(v); #endif if (Z_SIZE(v) + 2 > sz) { printf("ml_z_check: invalid block size (%i / %i) for %s at %s:%i.\n", (int)Z_SIZE(v), (int)sz, arg, fn, line); exit(1); } if ((mp_size_t) Z_LIMB(v)[sz - 2] != (0xDEADBEEF ^ (sz - 2))) { printf("ml_z_check: corrupted block for %s at %s:%i.\n", arg, fn, line); exit(1); } if (Z_SIZE(v) && Z_LIMB(v)[Z_SIZE(v)-1]) return; #if !Z_USE_NATINT if (!Z_SIZE(v)) { if (Z_SIGN(v)) { printf("ml_z_check: invalid sign of 0 for %s at %s:%i.\n", arg, fn, line); exit(1); } return; } if (Z_SIZE(v) <= 1 && Z_LIMB(v)[0] <= Z_MAX_INT) { printf("ml_z_check: unreduced argument for %s at %s:%i.\n", arg, fn, line); ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v)); exit(1); } #endif printf("ml_z_check failed for %s at %s:%i.\n", arg, fn, line); ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v)); exit(1); } } /* for debugging */ #if Z_PERFORM_CHECK #define Z_CHECK(v) ml_z_check(__FUNCTION__, __LINE__, #v, v) #else #define Z_CHECK(v) #endif /* allocates z object block with space for sz mp_limb_t; does not set the header */ #if !Z_PERFORM_CHECK /* inlined allocation */ #if Z_CUSTOM_BLOCK #define ml_z_alloc(sz) \ caml_alloc_custom(&ml_z_custom_ops, (1 + (sz)) * sizeof(value), 0, 1) #else #define ml_z_alloc(sz) \ caml_alloc(1 + (sz), Abstract_tag); #endif #else /* out-of-line allocation, inserting a canary after the last limb */ static value ml_z_alloc(mp_size_t sz) { value v; #if Z_CUSTOM_BLOCK v = caml_alloc_custom(&ml_z_custom_ops, (1 + sz + 1) * sizeof(value), 0, 1); #else v = caml_alloc(1 + sz + 1, Abstract_tag); #endif Z_LIMB(v)[sz] = 0xDEADBEEF ^ sz; return v; } #endif /* duplicates the caml block src */ static inline void ml_z_cpy_limb(mp_limb_t* dst, mp_limb_t* src, mp_size_t sz) { memcpy(dst, src, sz * sizeof(mp_limb_t)); } /* duplicates the mp_limb_t array src */ static inline mp_limb_t* ml_z_dup_limb(mp_limb_t* src, mp_size_t sz) { mp_limb_t* r = (mp_limb_t*) malloc(sz * sizeof(mp_limb_t)); memcpy(r, src, sz * sizeof(mp_limb_t)); return r; } /* given a z object, define: - ptr_arg: a pointer to the first mp_limb_t - size_arg: the number of mp-limb_t - sign_arg: the sign of the number if arg is an int, it is converted to a 1-limb number */ #define Z_DECL(arg) \ mp_limb_t loc_##arg, *ptr_##arg; \ mp_size_t size_##arg; \ intnat sign_##arg #define Z_ARG(arg) \ if (Is_long(arg)) { \ intnat n = Long_val(arg); \ if (n < 0) { loc_##arg = -n; sign_##arg = Z_SIGN_MASK; size_##arg = 1; } \ else if (n > 0) { loc_##arg = n; sign_##arg = 0; size_##arg = 1; } \ else { loc_##arg = 0; sign_##arg = 0; size_##arg = 0; } \ ptr_##arg = &loc_##arg; \ } \ else { \ size_##arg = Z_SIZE(arg); \ sign_##arg = Z_SIGN(arg); \ ptr_##arg = Z_LIMB(arg); \ } /* After an allocation, a heap-allocated Z argument may have moved and its ptr_arg pointer can be invalid. Reset the ptr_arg pointer to its correct value. */ #define Z_REFRESH(arg) \ if (! Is_long(arg)) ptr_##arg = Z_LIMB(arg); /* computes the actual size of the z object r and updates its header, either returns r or, if the number is small enough, an int */ static value ml_z_reduce(value r, mp_size_t sz, intnat sign) { while (sz > 0 && !Z_LIMB(r)[sz-1]) sz--; #if Z_USE_NATINT if (!sz) return Val_long(0); if (sz <= 1 && Z_LIMB(r)[0] <= Z_MAX_INT) { if (sign) return Val_long(-Z_LIMB(r)[0]); else return Val_long(Z_LIMB(r)[0]); } #else if (!sz) sign = 0; #endif Z_HEAD(r) = sz | sign; return r; } static void ml_z_raise_overflow() { caml_raise_constant(*caml_named_value("ml_z_overflow")); } #define ml_z_raise_divide_by_zero() \ caml_raise_zero_divide() /*--------------------------------------------------- CONVERSION FUNCTIONS ---------------------------------------------------*/ CAMLprim value ml_z_of_int(value v) { #if Z_USE_NATINT Z_MARK_OP; return v; #else intnat x; value r; Z_MARK_OP; Z_MARK_SLOW; x = Long_val(v); r = ml_z_alloc(1); if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; } else Z_HEAD(r) = 0; Z_CHECK(r); return r; #endif } CAMLprim value ml_z_of_nativeint(value v) { intnat x; value r; Z_MARK_OP; x = Nativeint_val(v); #if Z_USE_NATINT if (Z_FITS_INT(x)) return Val_long(x); #endif Z_MARK_SLOW; r = ml_z_alloc(1); if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; } else Z_HEAD(r) = 0; Z_CHECK(r); return r; } CAMLprim value ml_z_of_int32(value v) { int32 x; value r; Z_MARK_OP; x = Int32_val(v); #if Z_USE_NATINT #ifdef ARCH_SIXTYFOUR return Val_long(x); #else if (Z_FITS_INT(x)) return Val_long(x); #endif #endif Z_MARK_SLOW; r = ml_z_alloc(1); if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -(mp_limb_t)x; } else Z_HEAD(r) = 0; Z_CHECK(r); return r; } CAMLprim value ml_z_of_int64(value v) { int64 x; value r; Z_MARK_OP; x = Int64_val(v); #if Z_USE_NATINT if (Z_FITS_INT(x)) return Val_long(x); #endif Z_MARK_SLOW; #ifdef ARCH_SIXTYFOUR r = ml_z_alloc(1); if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; } else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; } else Z_HEAD(r) = 0; #else { mp_limb_t sign; r = ml_z_alloc(2); if (x >= 0) { sign = 0; } else { sign = Z_SIGN_MASK; x = -x; } Z_LIMB(r)[0] = x; Z_LIMB(r)[1] = x >> 32; r = ml_z_reduce(r, 2, sign); } #endif Z_CHECK(r); return r; } CAMLprim value ml_z_of_float(value v) { double x; int exp; int64 y, m; value r; Z_MARK_OP; x = Double_val(v); #if Z_USE_NATINT if (x >= Z_MIN_INT_FL && x <= Z_MAX_INT_FL) return Val_long(x); #endif Z_MARK_SLOW; if (isinf(x) || isnan(x)) ml_z_raise_overflow(); #ifdef ARCH_ALIGN_INT64 memcpy(&y, v, 8); #else y = *((int64*)v); #endif exp = ((y >> 52) & 0x7ff) - 1023; /* exponent */ if (exp < 0) return(Val_long(0)); m = (y & 0x000fffffffffffffLL) | 0x0010000000000000LL; /* mantissa */ if (exp <= 52) { m >>= 52-exp; #ifdef ARCH_SIXTYFOUR r = Val_long((x >= 0.) ? m : -m); #else r = ml_z_alloc(2); Z_LIMB(r)[0] = m; Z_LIMB(r)[1] = m >> 32; r = ml_z_reduce(r, 2, (x >= 0.) ? 0 : Z_SIGN_MASK); #endif } else { int c1 = (exp-52) / Z_LIMB_BITS; int c2 = (exp-52) % Z_LIMB_BITS; mp_size_t i; #ifdef ARCH_SIXTYFOUR r = ml_z_alloc(c1 + 2); for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0; Z_LIMB(r)[c1] = m << c2; Z_LIMB(r)[c1+1] = c2 ? (m >> (64-c2)) : 0; r = ml_z_reduce(r, c1 + 2, (x >= 0.) ? 0 : Z_SIGN_MASK); #else r = ml_z_alloc(c1 + 3); for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0; Z_LIMB(r)[c1] = m << c2; Z_LIMB(r)[c1+1] = m >> (32-c2); Z_LIMB(r)[c1+2] = c2 ? (m >> (64-c2)) : 0; r = ml_z_reduce(r, c1 + 3, (x >= 0.) ? 0 : Z_SIGN_MASK); #endif } Z_CHECK(r); return r; } CAMLprim value ml_z_of_string_base(value b, value v) { CAMLparam1(v); CAMLlocal1(r); char *d = String_val(v); mp_size_t i, sz, sz2; mp_limb_t sign = 0; intnat base = Long_val(b); /* get optional sign */ if (*d == '-') { sign ^= Z_SIGN_MASK; d++; } if (*d == '+') d++; /* get optional base */ if (!base) { base = 10; if (*d == '0') { d++; if (*d == 'o' || *d == 'O') { base = 8; d++; } else if (*d == 'x' || *d == 'X') { base = 16; d++; } else if (*d == 'b' || *d == 'B') { base = 2; d++; } } } if (base < 2 || base > 16) caml_invalid_argument("Z.of_string_base: base must be between 2 and 16"); while (*d == '0') d++; sz = strlen(d); if (!sz) r = Val_long(0); else { /* converts to sequence of digits */ char* dd = (char*)malloc(strlen(d)+1); strcpy(dd,d); for (i = 0; i < sz; i++) { if (dd[i] >= '0' && dd[i] <= '9') dd[i] -= '0'; else if (dd[i] >= 'a' && dd[i] <= 'f') dd[i] -= 'a' - 10; else if (dd[i] >= 'A' && dd[i] <= 'F') dd[i] -= 'A' - 10; else caml_invalid_argument("Z.of_string_base: invalid number"); if (dd[i] > base) caml_invalid_argument("Z.of_string_base: invalid number"); } r = ml_z_alloc(1 + sz / (2 * sizeof(mp_limb_t))); sz2 = mpn_set_str(Z_LIMB(r), (unsigned char*)dd, sz, base); r = ml_z_reduce(r, sz2, sign); free(dd); } Z_CHECK(r); CAMLreturn(r); } CAMLprim value ml_z_to_int(value v) { intnat x; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return v; Z_MARK_SLOW; Z_ARG(v); if (size_v > 1) ml_z_raise_overflow(); if (!size_v) return Val_long(0); x = *ptr_v; if (sign_v) { if ((uintnat)x > Z_HI_INT) ml_z_raise_overflow(); x = -x; } else { if ((uintnat)x >= Z_HI_INT) ml_z_raise_overflow(); } return Val_long(x); } CAMLprim value ml_z_to_nativeint(value v) { intnat x; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return caml_copy_nativeint(Long_val(v)); Z_MARK_SLOW; Z_ARG(v); if (size_v > 1) ml_z_raise_overflow(); if (!size_v) x = 0; else { x = *ptr_v; if (sign_v) { if ((uintnat)x > Z_HI_INTNAT) ml_z_raise_overflow(); x = -x; } else { if ((uintnat)x >= Z_HI_INTNAT) ml_z_raise_overflow(); } } return caml_copy_nativeint(x); } CAMLprim value ml_z_to_int32(value v) { intnat x; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) { x = Long_val(v); #ifdef ARCH_SIXTYFOUR if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32) ml_z_raise_overflow(); #endif return caml_copy_int32(x); } else { Z_ARG(v); Z_MARK_SLOW; if (size_v > 1) ml_z_raise_overflow(); if (!size_v) x = 0; else { x = *ptr_v; if (sign_v) { if ((uintnat)x > Z_HI_INT32) ml_z_raise_overflow(); x = -x; } else { if ((uintnat)x >= Z_HI_INT32) ml_z_raise_overflow(); } } return caml_copy_int32(x); } } CAMLprim value ml_z_to_int64(value v) { int64 x = 0; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return caml_copy_int64(Long_val(v)); Z_MARK_SLOW; Z_ARG(v); switch (size_v) { case 0: x = 0; break; case 1: x = ptr_v[0]; break; #ifndef ARCH_SIXTYFOUR case 2: x = ptr_v[0] | ((uint64)ptr_v[1] << 32); break; #endif default: ml_z_raise_overflow(); break; } if (sign_v) { if ((uint64)x > Z_HI_INT64) ml_z_raise_overflow(); x = -x; } else { if ((uint64)x >= Z_HI_INT64) ml_z_raise_overflow(); } return caml_copy_int64(x); } CAMLprim value ml_z_to_float(value v) { double x, m; mp_size_t i; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return caml_copy_double(Long_val(v)); Z_MARK_SLOW; Z_ARG(v); m = sign_v ? -1. : 1.; x = 0.; for (i = 0; i < size_v; i++) { #ifdef ARCH_SIXTYFOUR /* split into two 32-bit numbers, as 64-bit integers may not fit exactly in a double the cast to long is a work-around for gcc's bug 37544 */ x += m * (intnat)(ptr_v[i] & 0xffffffff); m *= ml_z_2p32; x += m * (intnat)((ptr_v[i] >> 32) & 0xffffffff); m *= ml_z_2p32; #else x += m * ptr_v[i]; m *= ml_z_2p32; #endif } return caml_copy_double(x); } /* XXX: characters that do not belong to the format are ignored, this departs from the classic printf behavior (it copies them in the output) */ CAMLprim value ml_z_format(value f, value v) { CAMLparam2(f,v); Z_DECL(v); const char tab[2][16] = { { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' }, { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' } }; char* buf, *dst; mp_size_t i, size_dst, max_size; value r; char* fmt = String_val(f); int base = 10; /* base */ int cas = 0; /* uppercase X / lowercase x */ int width = 0; int alt = 0; /* alternate # */ int dir = 0; /* right / left adjusted */ char sign = 0; /* sign char */ char pad = ' '; /* padding char */ char *prefix = ""; Z_MARK_OP; Z_CHECK(v); Z_ARG(v); Z_MARK_SLOW; /* parse format */ while (*fmt == '%') fmt++; for (; ; fmt++) { if (*fmt == '#') alt = 1; else if (*fmt == '0') pad = '0'; else if (*fmt == '-') dir = 1; else if (*fmt == ' ' || *fmt == '+') sign = *fmt; else break; } if (sign_v) sign = '-'; for (;*fmt>='0' && *fmt<='9';fmt++) width = 10*width + *fmt-'0'; switch (*fmt) { case 'i': case 'd': case 'u': break; case 'b': base = 2; if (alt) prefix = "0b"; break; case 'o': base = 8; if (alt) prefix = "0o"; break; case 'x': base = 16; if (alt) prefix = "0x"; cas = 1; break; case 'X': base = 16; if (alt) prefix = "0X"; break; default: caml_invalid_argument("Z.format: invalid format"); } if (dir) pad = ' '; /* get digits */ /* we need space for sign + prefix + digits + 1 + padding + terminal 0 */ max_size = 1 + 2 + Z_LIMB_BITS * size_v + 1 + 2 * width + 1; buf = (char*) malloc(max_size); dst = buf + 1 + 2 + width; if (!size_v) { size_dst = 1; *dst = '0'; } else { mp_limb_t* copy_v = ml_z_dup_limb(ptr_v, size_v); size_dst = mpn_get_str((unsigned char*)dst, base, copy_v, size_v); if (dst + size_dst >= buf + max_size) caml_failwith("Z.format: internal error"); free(copy_v); while (size_dst && !*dst) { dst++; size_dst--; } for (i = 0; i < size_dst; i++) dst[i] = tab[cas][ (int) dst[i] ]; } /* add prefix, sign & padding */ if (pad == ' ') { if (dir) { /* left alignment */ for (i = strlen(prefix); i > 0; i--, size_dst++) *(--dst) = prefix[i-1]; if (sign) { *(--dst) = sign; size_dst++; } for (; size_dst < width; size_dst++) dst[size_dst] = pad; } else { /* right alignment, space padding */ for (i = strlen(prefix); i > 0; i--, size_dst++) *(--dst) = prefix[i-1]; if (sign) { *(--dst) = sign; size_dst++; } for (; size_dst < width; size_dst++) *(--dst) = pad; } } else { /* right alignment, non-space padding */ width -= strlen(prefix) + (sign ? 1 : 0); for (; size_dst < width; size_dst++) *(--dst) = pad; for (i = strlen(prefix); i > 0; i--, size_dst++) *(--dst) = prefix[i-1]; if (sign) { *(--dst) = sign; size_dst++; } } dst[size_dst] = 0; if (dst < buf || dst + size_dst >= buf + max_size) caml_failwith("Z.format: internal error"); r = caml_copy_string(dst); free(buf); CAMLreturn(r); } #ifdef ARCH_SIXTYFOUR #define BITS_PER_WORD 64 #else #define BITS_PER_WORD 32 #endif CAMLprim value ml_z_extract(value arg, value off, value len) { intnat o, l, x; mp_size_t sz, c1, c2, csz, i; mp_limb_t cr; value r; Z_DECL(arg); Z_MARK_OP; o = Long_val(off); l = Long_val(len); if (o < 0) caml_invalid_argument("Z.extract: negative bit offset"); if (l <= 0) caml_invalid_argument("Z.extract: non-positive bit length"); #if Z_USE_NATINT /* Fast path */ if (Is_long(arg)) { x = Long_val(arg); /* Shift away low "o" bits. If "o" too big, just replicate sign bit. */ if (o >= BITS_PER_WORD) o = BITS_PER_WORD - 1; x = x >> o; /* Extract "l" low bits, if "l" is small enough */ if (l < BITS_PER_WORD - 1) { x = x & (((intnat)1 << l) - 1); return Val_long(x); } else { /* If x >= 0, the extraction of "l" low bits keeps x unchanged. */ if (x >= 0) return Val_long(x); /* If x < 0, fall through slow path */ } } #endif Z_MARK_SLOW; { CAMLparam1(arg); Z_ARG(arg); sz = (l + Z_LIMB_BITS - 1) / Z_LIMB_BITS; r = ml_z_alloc(sz + 1); Z_REFRESH(arg); c1 = o / Z_LIMB_BITS; c2 = o % Z_LIMB_BITS; /* shift or copy */ csz = size_arg - c1; if (csz > sz + 1) csz = sz + 1; cr = 0; if (csz > 0) { if (c2) cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, csz, c2); else ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, csz); } else csz = 0; /* 0-pad */ for (i = csz; i < sz; i++) Z_LIMB(r)[i] = 0; /* 2's complement */ if (sign_arg) { for (i = 0; i < sz; i++) Z_LIMB(r)[i] = ~Z_LIMB(r)[i]; /* carry (cr=0 if all shifted-out bits are 0) */ for (i = 0; !cr && i < c1 && i < size_arg; i++) cr = ptr_arg[i]; if (!cr) mpn_add_1(Z_LIMB(r), Z_LIMB(r), sz, 1); } /* mask out high bits */ l %= Z_LIMB_BITS; if (l) Z_LIMB(r)[sz-1] &= ((uintnat)(intnat)-1) >> (Z_LIMB_BITS - l); r = ml_z_reduce(r, sz, 0); CAMLreturn(r); } } /* NOTE: the sign is not stored */ CAMLprim value ml_z_to_bits(value arg) { CAMLparam1(arg); CAMLlocal1(r); Z_DECL(arg); mp_size_t i; unsigned char* p; Z_MARK_OP; Z_MARK_SLOW; Z_ARG(arg); r = caml_alloc_string(size_arg * sizeof(mp_limb_t)); Z_REFRESH(arg); p = (unsigned char*) String_val(r); memset(p, 0, size_arg * sizeof(mp_limb_t)); for (i = 0; i < size_arg; i++) { mp_limb_t x = ptr_arg[i]; *(p++) = x; *(p++) = x >> 8; *(p++) = x >> 16; *(p++) = x >> 24; #ifdef ARCH_SIXTYFOUR *(p++) = x >> 32; *(p++) = x >> 40; *(p++) = x >> 48; *(p++) = x >> 56; #endif } CAMLreturn(r); } CAMLprim value ml_z_of_bits(value arg) { CAMLparam1(arg); CAMLlocal1(r); mp_size_t sz, szw; mp_size_t i = 0; mp_limb_t x; unsigned char* p; Z_MARK_OP; Z_MARK_SLOW; sz = caml_string_length(arg); szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t); r = ml_z_alloc(szw); p = (unsigned char*) String_val(arg); /* all limbs but last */ if (szw > 1) { for (; i < szw - 1; i++) { x = *(p++); x |= ((mp_limb_t) *(p++)) << 8; x |= ((mp_limb_t) *(p++)) << 16; x |= ((mp_limb_t) *(p++)) << 24; #ifdef ARCH_SIXTYFOUR x |= ((mp_limb_t) *(p++)) << 32; x |= ((mp_limb_t) *(p++)) << 40; x |= ((mp_limb_t) *(p++)) << 48; x |= ((mp_limb_t) *(p++)) << 56; #endif Z_LIMB(r)[i] = x; } sz -= i * sizeof(mp_limb_t); } /* last limb */ if (sz > 0) { x = *(p++); if (sz > 1) x |= ((mp_limb_t) *(p++)) << 8; if (sz > 2) x |= ((mp_limb_t) *(p++)) << 16; if (sz > 3) x |= ((mp_limb_t) *(p++)) << 24; #ifdef ARCH_SIXTYFOUR if (sz > 4) x |= ((mp_limb_t) *(p++)) << 32; if (sz > 5) x |= ((mp_limb_t) *(p++)) << 40; if (sz > 6) x |= ((mp_limb_t) *(p++)) << 48; if (sz > 7) x |= ((mp_limb_t) *(p++)) << 56; #endif Z_LIMB(r)[i] = x; } r = ml_z_reduce(r, szw, 0); Z_CHECK(r); CAMLreturn(r); } /*--------------------------------------------------- TESTS AND COMPARISONS ---------------------------------------------------*/ CAMLprim value ml_z_compare(value arg1, value arg2) { int r; Z_DECL(arg1); Z_DECL(arg2); Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ if (arg1 > arg2) return Val_long(1); else if (arg1 < arg2) return Val_long(-1); else return Val_long(0); } #endif /* mpn_ version */ Z_MARK_SLOW; Z_ARG(arg1); Z_ARG(arg2); r = 0; if (sign_arg1 != sign_arg2) r = 1; else if (size_arg1 > size_arg2) r = 1; else if (size_arg1 < size_arg2) r = -1; else { mp_size_t i; for (i = size_arg1 - 1; i >= 0; i--) { if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; } if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; } } } if (sign_arg1) r = -r; return Val_long(r); } CAMLprim value ml_z_equal(value arg1, value arg2) { mp_size_t i; Z_DECL(arg1); Z_DECL(arg2); Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ return (arg1 == arg2) ? Val_true : Val_false; } #endif /* mpn_ version */ Z_MARK_SLOW; Z_ARG(arg1); Z_ARG(arg2); if (sign_arg1 != sign_arg2 || size_arg1 != size_arg2) return Val_false; for (i = 0; i < size_arg1; i++) if (ptr_arg1[i] != ptr_arg2[i]) return Val_false; return Val_true; } int ml_z_sgn(value arg) { if (Is_long(arg)) { if (arg > Val_long(0)) return 1; else if (arg < Val_long(0)) return -1; else return 0; } else { Z_MARK_SLOW; if (!Z_SIZE(arg)) return 0; else if (Z_SIGN(arg)) return -1; else return 1; } } CAMLprim value ml_z_sign(value arg) { Z_MARK_OP; Z_CHECK(arg); return Val_long(ml_z_sgn(arg)); } CAMLprim value ml_z_fits_int(value v) { intnat x; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return Val_true; Z_MARK_SLOW; Z_ARG(v); if (size_v > 1) return Val_false; if (!size_v) return Val_true; x = *ptr_v; if (sign_v) { if ((uintnat)x > Z_HI_INT) return Val_false; } else { if ((uintnat)x >= Z_HI_INT) return Val_false; } return Val_true; } CAMLprim value ml_z_fits_nativeint(value v) { intnat x; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return Val_true; Z_MARK_SLOW; Z_ARG(v); if (size_v > 1) return Val_false; if (!size_v) return Val_true; x = *ptr_v; if (sign_v) { if ((uintnat)x > Z_HI_INTNAT) return Val_false; } else { if ((uintnat)x >= Z_HI_INTNAT) return Val_false; } return Val_true; } CAMLprim value ml_z_fits_int32(value v) { intnat x; Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) { #ifdef ARCH_SIXTYFOUR x = Long_val(v); if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32) return Val_false; #endif return Val_true; } else { Z_DECL(v); Z_MARK_SLOW; Z_ARG(v); if (size_v > 1) return Val_false; if (!size_v) return Val_true; x = *ptr_v; if (sign_v) { if ((uintnat)x > Z_HI_INT32) return Val_false; } else { if ((uintnat)x >= Z_HI_INT32) return Val_false; } return Val_true; } } CAMLprim value ml_z_fits_int64(value v) { int64 x; Z_DECL(v); Z_MARK_OP; Z_CHECK(v); if (Is_long(v)) return Val_true; Z_MARK_SLOW; Z_ARG(v); switch (size_v) { case 0: return Val_true; case 1: x = ptr_v[0]; break; #ifndef ARCH_SIXTYFOUR case 2: x = ptr_v[0] | ((uint64)ptr_v[1] << 32); break; #endif default: return Val_false; } if (sign_v) { if ((uint64)x > Z_HI_INT64) return Val_false; } else { if ((uint64)x >= Z_HI_INT64) return Val_false; } return Val_true; } CAMLprim value ml_z_size(value v) { Z_MARK_OP; if (Is_long(v)) return Val_long(1); else return Val_long(Z_SIZE(v)); } /*--------------------------------------------------- ARITHMETIC OPERATORS ---------------------------------------------------*/ CAMLprim value ml_z_neg(value arg) { Z_MARK_OP; Z_CHECK(arg); #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ if (arg > Val_long(Z_MIN_INT)) return 2 - arg; } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam1(arg); value r; Z_DECL(arg); Z_ARG(arg); r = ml_z_alloc(size_arg); Z_REFRESH(arg); ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg); r = ml_z_reduce(r, size_arg, sign_arg ^ Z_SIGN_MASK); Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_abs(value arg) { Z_MARK_OP; Z_CHECK(arg); #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ if (arg >= Val_long(0)) return arg; if (arg > Val_long(Z_MIN_INT)) return 2 - arg; } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam1(arg); Z_DECL(arg); value r; Z_ARG(arg); r = ml_z_alloc(size_arg); Z_REFRESH(arg); ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg); r = ml_z_reduce(r, size_arg, 0); Z_CHECK(r); CAMLreturn(r); } } /* helper function for add/sub */ static value ml_z_addsub(value arg1, value arg2, intnat sign) { CAMLparam2(arg1,arg2); Z_DECL(arg1); Z_DECL(arg2); value r; mp_limb_t c; Z_ARG(arg1); Z_ARG(arg2); sign_arg2 ^= sign; if (!size_arg2) r = arg1; else if (!size_arg1) { if (sign) { /* negation */ r = ml_z_alloc(size_arg2); Z_REFRESH(arg2); ml_z_cpy_limb(Z_LIMB(r), ptr_arg2, size_arg2); r = ml_z_reduce(r, size_arg2, sign_arg2); } else r = arg2; } else if (sign_arg1 == sign_arg2) { /* addition */ if (size_arg1 >= size_arg2) { r = ml_z_alloc(size_arg1 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); c = mpn_add(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2); Z_LIMB(r)[size_arg1] = c; r = ml_z_reduce(r, size_arg1+1, sign_arg1); } else { r = ml_z_alloc(size_arg2 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); c = mpn_add(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1); Z_LIMB(r)[size_arg2] = c; r = ml_z_reduce(r, size_arg2+1, sign_arg1); } } else { /* subtraction */ if (size_arg1 > size_arg2) { r = ml_z_alloc(size_arg1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2); r = ml_z_reduce(r, size_arg1, sign_arg1); } else if (size_arg1 < size_arg2) { r = ml_z_alloc(size_arg2); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1); r = ml_z_reduce(r, size_arg2, sign_arg2); } else { int cmp = mpn_cmp(ptr_arg1, ptr_arg2, size_arg1); if (cmp > 0) { r = ml_z_alloc(size_arg1+1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1); r = ml_z_reduce(r, size_arg1, sign_arg1); } else if (cmp < 0) { r = ml_z_alloc(size_arg1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_n(Z_LIMB(r), ptr_arg2, ptr_arg1, size_arg1); r = ml_z_reduce(r, size_arg1, sign_arg2); } else r = Val_long(0); } } Z_CHECK(r); CAMLreturn(r); } CAMLprim value ml_z_add(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat v = a1 + a2; if (Z_FITS_INT(v)) return Val_long(v); } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_addsub(arg1, arg2, 0); } CAMLprim value ml_z_sub(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat v = a1 - a2; if (Z_FITS_INT(v)) return Val_long(v); } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_addsub(arg1, arg2, Z_SIGN_MASK); } CAMLprim value ml_z_mul(value arg1, value arg2) { Z_DECL(arg1); Z_DECL(arg2); Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); if (!a1 || !a2) return Val_long(0); /* small argument case */ if (Z_FITS_HINT(arg1) && Z_FITS_HINT(arg2)) return Val_long(a1 * a2); } #endif /* mpn_ version */ Z_MARK_SLOW; Z_ARG(arg1); Z_ARG(arg2); if (!size_arg1 || !size_arg2) return Val_long(0); { CAMLparam2(arg1,arg2); value r = ml_z_alloc(size_arg1 + size_arg2); mp_limb_t c; Z_REFRESH(arg1); Z_REFRESH(arg2); if (size_arg2 == 1) { c = mpn_mul_1(Z_LIMB(r), ptr_arg1, size_arg1, *ptr_arg2); Z_LIMB(r)[size_arg1] = c; } else if (size_arg1 == 1) { c = mpn_mul_1(Z_LIMB(r), ptr_arg2, size_arg2, *ptr_arg1); Z_LIMB(r)[size_arg2] = c; } #if HAVE_NATIVE_mpn_mul_2 /* untested */ else if (size_arg2 == 2) { c = mpn_mul_2(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2); Z_LIMB(r)[size_arg1 + 1] = c; } else if (size_arg1 == 2) { c = mpn_mul_2(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1); Z_LIMB(r)[size_arg2 + 1] = c; } #endif else if (size_arg1 > size_arg2) mpn_mul(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2); else if (size_arg1 < size_arg2) mpn_mul(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1); /* older GMP don't have mpn_sqr, so we make the optimisation optional */ #ifdef mpn_sqr else if (ptr_arg1 == ptr_arg2) mpn_sqr(Z_LIMB(r), ptr_arg1, size_arg1); #endif else mpn_mul_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1); r = ml_z_reduce(r, size_arg1 + size_arg2, sign_arg1^sign_arg2); Z_CHECK(r); CAMLreturn(r); } } /* helper function for division: returns truncated quotient and remainder */ static value ml_z_tdiv_qr(value arg1, value arg2) { CAMLparam2(arg1, arg2); CAMLlocal3(q, r, p); Z_DECL(arg1); Z_DECL(arg2); Z_ARG(arg1); Z_ARG(arg2); if (!size_arg2) ml_z_raise_divide_by_zero(); if (size_arg1 >= size_arg2) { q = ml_z_alloc(size_arg1 - size_arg2 + 1); r = ml_z_alloc(size_arg2); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0, ptr_arg1, size_arg1, ptr_arg2, size_arg2); q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2); r = ml_z_reduce(r, size_arg2, sign_arg1); } else { q = Val_long(0); r = arg1; } Z_CHECK(q); Z_CHECK(r); p = caml_alloc_small(2, 0); Field(p,0) = q; Field(p,1) = r; CAMLreturn(p); } CAMLprim value ml_z_div_rem(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat q, r; if (!a2) ml_z_raise_divide_by_zero(); q = a1 / a2; r = a1 % a2; if (Z_FITS_INT(q) && Z_FITS_INT(r)) { value p = caml_alloc_small(2, 0); Field(p,0) = Val_long(q); Field(p,1) = Val_long(r); return p; } } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_tdiv_qr(arg1, arg2); } CAMLprim value ml_z_div(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat q; if (!a2) ml_z_raise_divide_by_zero(); q = a1 / a2; if (Z_FITS_INT(q)) return Val_long(q); } #endif /* mpn_ version */ Z_MARK_SLOW; return Field(ml_z_tdiv_qr(arg1, arg2), 0); } CAMLprim value ml_z_rem(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat r; if (!a2) ml_z_raise_divide_by_zero(); r = a1 % a2; if (Z_FITS_INT(r)) return Val_long(r); } #endif /* mpn_ version */ Z_MARK_SLOW; return Field(ml_z_tdiv_qr(arg1, arg2), 1); } /* helper function for division with rounding towards +oo / -oo */ static value ml_z_rdiv(value arg1, value arg2, intnat dir) { CAMLparam2(arg1, arg2); CAMLlocal2(q, r); Z_DECL(arg1); Z_DECL(arg2); Z_ARG(arg1); Z_ARG(arg2); if (!size_arg2) ml_z_raise_divide_by_zero(); if (size_arg1 >= size_arg2) { mp_limb_t c = 0; q = ml_z_alloc(size_arg1 - size_arg2 + 2); r = ml_z_alloc(size_arg2); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0, ptr_arg1, size_arg1, ptr_arg2, size_arg2); if ((sign_arg1 ^ sign_arg2) == dir) { /* outward rounding */ mp_size_t sz; for (sz = size_arg2; sz > 0 && !Z_LIMB(r)[sz-1]; sz--); if (sz) { /* r != 0: needs adjustment */ c = mpn_add_1(Z_LIMB(q), Z_LIMB(q), size_arg1 - size_arg2 + 1, 1); } } Z_LIMB(q)[size_arg1 - size_arg2 + 1] = c; q = ml_z_reduce(q, size_arg1 - size_arg2 + 2, sign_arg1 ^ sign_arg2); } else { if (size_arg1 && (sign_arg1 ^ sign_arg2) == dir) { if (dir) q = Val_long(-1); else q = Val_long(1); } else q = Val_long(0); } Z_CHECK(q); CAMLreturn(q); } CAMLprim value ml_z_cdiv(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat q; if (!a2) ml_z_raise_divide_by_zero(); /* adjust to round towards +oo */ if (a1 > 0 && a2 > 0) a1 += a2-1; else if (a1 < 0 && a2 < 0) a1 += a2+1; q = a1 / a2; if (Z_FITS_INT(q)) return Val_long(q); } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_rdiv(arg1, arg2, 0); } CAMLprim value ml_z_fdiv(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat q; if (!a2) ml_z_raise_divide_by_zero(); /* adjust to round towards -oo */ if (a1 < 0 && a2 > 0) a1 -= a2-1; else if (a1 > 0 && a2 < 0) a1 -= a2+1; q = a1 / a2; if (Z_FITS_INT(q)) return Val_long(q); } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_rdiv(arg1, arg2, Z_SIGN_MASK); } /* helper function for succ / pred */ static value ml_z_succpred(value arg, intnat sign) { CAMLparam1(arg); Z_DECL(arg); value r; Z_ARG(arg); r = ml_z_alloc(size_arg + 1); Z_REFRESH(arg); if (!size_arg) { Z_LIMB(r)[0] = 1; r = ml_z_reduce(r, 1, sign); } else if (sign_arg == sign) { /* add 1 */ mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1); Z_LIMB(r)[size_arg] = c; r = ml_z_reduce(r, size_arg + 1, sign_arg); } else { /* subtract 1 */ mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1); r = ml_z_reduce(r, size_arg, sign_arg); } Z_CHECK(r); CAMLreturn(r); } CAMLprim value ml_z_succ(value arg) { Z_MARK_OP; Z_CHECK(arg); #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ if (arg < Val_long(Z_MAX_INT)) return arg + 2; } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_succpred(arg, 0); } CAMLprim value ml_z_pred(value arg) { Z_MARK_OP; Z_CHECK(arg); #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ if (arg > Val_long(Z_MIN_INT)) return arg - 2; } #endif /* mpn_ version */ Z_MARK_SLOW; return ml_z_succpred(arg, Z_SIGN_MASK); } CAMLprim value ml_z_sqrt(value arg) { /* XXX TODO: fast path */ CAMLparam1(arg); Z_DECL(arg); value r; Z_MARK_OP; Z_MARK_SLOW; Z_CHECK(arg); Z_ARG(arg); if (sign_arg) caml_invalid_argument("Z.sqrt: square root of a negative number"); if (size_arg) { mp_size_t sz = (size_arg + 1) / 2; r = ml_z_alloc(sz); Z_REFRESH(arg); mpn_sqrtrem(Z_LIMB(r), NULL, ptr_arg, size_arg); r = ml_z_reduce(r, sz, 0); } else r = Val_long(0); Z_CHECK(r); CAMLreturn(r); } CAMLprim value ml_z_sqrt_rem(value arg) { CAMLparam1(arg); CAMLlocal3(r, s, p); Z_DECL(arg); /* XXX TODO: fast path */ Z_MARK_OP; Z_MARK_SLOW; Z_CHECK(arg); Z_ARG(arg); if (sign_arg) caml_invalid_argument("Z.sqrt_rem: square root of a negative number"); if (size_arg) { mp_size_t sz = (size_arg + 1) / 2, sz2; r = ml_z_alloc(sz); s = ml_z_alloc(size_arg); Z_REFRESH(arg); sz2 = mpn_sqrtrem(Z_LIMB(r), Z_LIMB(s), ptr_arg, size_arg); r = ml_z_reduce(r, sz, 0); s = ml_z_reduce(s, sz2, 0); } else r = s = Val_long(0); Z_CHECK(r); Z_CHECK(s); p = caml_alloc_small(2, 0); Field(p,0) = r; Field(p,1) = s; CAMLreturn(p); } CAMLprim value ml_z_gcd(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); if (!a1 || !a2) ml_z_raise_divide_by_zero(); if (a1 < 0) a1 = -a1; if (a2 < 0) a2 = -a2; while (a2) { intnat r = a1 % a2; a1 = a2; a2 = r; } if (Z_FITS_INT(a1)) return Val_long(a1); } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam2(arg1, arg2); CAMLlocal3(r, tmp1, tmp2); mp_size_t sz, pos1, pos2, limb1, limb2, bit1, bit2, pos, limb, bit, i; Z_DECL(arg1); Z_DECL(arg2); Z_ARG(arg1); Z_ARG(arg2); if (!size_arg1 || !size_arg2) ml_z_raise_divide_by_zero(); /* copy args to tmp storage & remove lower 0 bits */ pos1 = mpn_scan1(ptr_arg1, 0); pos2 = mpn_scan1(ptr_arg2, 0); limb1 = pos1 / Z_LIMB_BITS; limb2 = pos2 / Z_LIMB_BITS; bit1 = pos1 % Z_LIMB_BITS; bit2 = pos2 % Z_LIMB_BITS; size_arg1 -= limb1; size_arg2 -= limb2; tmp1 = ml_z_alloc(size_arg1 + 1); tmp2 = ml_z_alloc(size_arg2 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); if (bit1) { mpn_rshift(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1, bit1); if (!Z_LIMB(tmp1)[size_arg1-1]) size_arg1--; } else ml_z_cpy_limb(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1); if (bit2) { mpn_rshift(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2, bit2); if (!Z_LIMB(tmp2)[size_arg2-1]) size_arg2--; } else ml_z_cpy_limb(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2); /* compute gcd of 2^pos1 & 2^pos2 */ pos = (pos1 <= pos2) ? pos1 : pos2; limb = pos / Z_LIMB_BITS; bit = pos % Z_LIMB_BITS; /* compute gcd of arg1 & arg2 without lower 0 bits */ /* second argument must have less bits than first */ if ((size_arg1 > size_arg2) || ((size_arg1 == size_arg2) && (Z_LIMB(tmp1)[size_arg1 - 1] >= Z_LIMB(tmp2)[size_arg1 - 1]))) { r = ml_z_alloc(size_arg2 + limb + 1); sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp1), size_arg1, Z_LIMB(tmp2), size_arg2); } else { r = ml_z_alloc(size_arg1 + limb + 1); sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp2), size_arg2, Z_LIMB(tmp1), size_arg1); } /* glue the two results */ for (i = 0; i < limb; i++) Z_LIMB(r)[i] = 0; Z_LIMB(r)[sz + limb] = 0; if (bit) mpn_lshift(Z_LIMB(r) + limb, Z_LIMB(r) + limb, sz + 1, bit); r = ml_z_reduce(r, limb + sz + 1, 0); Z_CHECK(r); CAMLreturn(r); } } /* only computes one cofactor */ CAMLprim value ml_z_gcdext_intern(value arg1, value arg2) { /* XXX TODO: fast path */ CAMLparam2(arg1, arg2); CAMLlocal5(r, res_arg1, res_arg2, s, p); Z_DECL(arg1); Z_DECL(arg2); mp_size_t sz, sn; Z_MARK_OP; Z_MARK_SLOW; Z_CHECK(arg1); Z_CHECK(arg2); Z_ARG(arg1); Z_ARG(arg2); if (!size_arg1 || !size_arg2) ml_z_raise_divide_by_zero(); /* copy args to tmp storage */ res_arg1 = ml_z_alloc(size_arg1 + 1); res_arg2 = ml_z_alloc(size_arg2 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); ml_z_cpy_limb(Z_LIMB(res_arg1), ptr_arg1, size_arg1); ml_z_cpy_limb(Z_LIMB(res_arg2), ptr_arg2, size_arg2); /* must have arg1 >= arg2 */ if ((size_arg1 > size_arg2) || ((size_arg1 == size_arg2) && (mpn_cmp(Z_LIMB(res_arg1), Z_LIMB(res_arg2), size_arg1) >= 0))) { r = ml_z_alloc(size_arg1 + 1); s = ml_z_alloc(size_arg1 + 1); sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn, Z_LIMB(res_arg1), size_arg1, Z_LIMB(res_arg2), size_arg2); p = caml_alloc_small(3, 0); Field(p,2) = Val_true; } else { r = ml_z_alloc(size_arg2 + 1); s = ml_z_alloc(size_arg2 + 1); sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn, Z_LIMB(res_arg2), size_arg2, Z_LIMB(res_arg1), size_arg1); p = caml_alloc_small(3, 0); Field(p,2) = Val_false; sign_arg1 = sign_arg2; } /* pack result */ r = ml_z_reduce(r, sz, 0); if ((int)sn >= 0) s = ml_z_reduce(s, sn, sign_arg1); else s = ml_z_reduce(s, -sn, sign_arg1 ^ Z_SIGN_MASK); Z_CHECK(r); Z_CHECK(s); Field(p,0) = r; Field(p,1) = s; CAMLreturn(p); } /*--------------------------------------------------- BITWISE OPERATORS ---------------------------------------------------*/ CAMLprim value ml_z_logand(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ return arg1 & arg2; } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam2(arg1,arg2); value r; mp_size_t i; mp_limb_t c; Z_DECL(arg1); Z_DECL(arg2); Z_ARG(arg1); Z_ARG(arg2); /* ensure size_arg1 >= size_arg2 */ if (size_arg1 < size_arg2) { mp_size_t sz; mp_limb_t *p, s; value a; sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz; p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p; s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s; a = arg1; arg1 = arg2; arg2 = a; } if (!size_arg2) r = arg2; else if (sign_arg1 && sign_arg2) { /* arg1 < 0, arg2 < 0 => r < 0 */ r = ml_z_alloc(size_arg1 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); c = 1; /* carry when decrementing arg2 */ for (i = 0; i < size_arg2; i++) { mp_limb_t v = ptr_arg2[i]; Z_LIMB(r)[i] = Z_LIMB(r)[i] | (v - c); c = c && !v; } c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); Z_LIMB(r)[size_arg1] = c; r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); } else if (sign_arg1) { /* arg1 < 0, arg2 > 0 => r >= 0 */ r = ml_z_alloc(size_arg2); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = (~Z_LIMB(r)[i]) & ptr_arg2[i]; r = ml_z_reduce(r, size_arg2, 0); } else if (sign_arg2) { /* arg1 > 0, arg2 < 0 => r >= 0 */ r = ml_z_alloc(size_arg1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = ptr_arg1[i] & (~Z_LIMB(r)[i]); for (; i < size_arg1; i++) Z_LIMB(r)[i] = ptr_arg1[i]; r = ml_z_reduce(r, size_arg1, 0); } else { /* arg1, arg2 > 0 => r >= 0 */ r = ml_z_alloc(size_arg2); Z_REFRESH(arg1); Z_REFRESH(arg2); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = ptr_arg1[i] & ptr_arg2[i]; r = ml_z_reduce(r, size_arg2, 0); } Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_logor(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ return arg1 | arg2; } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam2(arg1,arg2); Z_DECL(arg1); Z_DECL(arg2); mp_size_t i; mp_limb_t c; value r; Z_ARG(arg1); Z_ARG(arg2); /* ensure size_arg1 >= size_arg2 */ if (size_arg1 < size_arg2) { mp_size_t sz; mp_limb_t *p, s; value a; sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz; p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p; s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s; a = arg1; arg1 = arg2; arg2 = a; } if (!size_arg2) r = arg1; else if (sign_arg1 && sign_arg2) { /* arg1 < 0, arg2 < 0 => r < 0 */ r = ml_z_alloc(size_arg2 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1); c = 1; /* carry when decrementing arg2 */ for (i = 0; i < size_arg2; i++) { mp_limb_t v = ptr_arg2[i]; Z_LIMB(r)[i] = Z_LIMB(r)[i] & (v - c); c = c && !v; } c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1); Z_LIMB(r)[size_arg2] = c; r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK); } else if (sign_arg1) { /* arg1 < 0, arg2 > 0 => r < 0 */ r = ml_z_alloc(size_arg1 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = Z_LIMB(r)[i] & (~ptr_arg2[i]); c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); Z_LIMB(r)[size_arg1] = c; r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); } else if (sign_arg2) { /* arg1 > 0, arg2 < 0 => r < 0*/ r = ml_z_alloc(size_arg2 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = (~ptr_arg1[i]) & Z_LIMB(r)[i]; c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1); Z_LIMB(r)[size_arg2] = c; r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK); } else { /* arg1, arg2 > 0 => r > 0 */ r = ml_z_alloc(size_arg1); Z_REFRESH(arg1); Z_REFRESH(arg2); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = ptr_arg1[i] | ptr_arg2[i]; for (; i < size_arg1; i++) Z_LIMB(r)[i] = ptr_arg1[i]; r = ml_z_reduce(r, size_arg1, 0); } Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_logxor(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ return (arg1 ^ arg2) | 1; } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam2(arg1,arg2); Z_DECL(arg1); Z_DECL(arg2); value r; mp_size_t i; mp_limb_t c; Z_ARG(arg1); Z_ARG(arg2); /* ensure size_arg1 >= size_arg2 */ if (size_arg1 < size_arg2) { mp_size_t sz; mp_limb_t *p, s; value a; sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz; p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p; s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s; a = arg1; arg1 = arg2; arg2 = a; } if (!size_arg2) r = arg1; else if (sign_arg1 && sign_arg2) { /* arg1 < 0, arg2 < 0 => r >=0 */ r = ml_z_alloc(size_arg1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); c = 1; /* carry when decrementing arg2 */ for (i = 0; i < size_arg2; i++) { mp_limb_t v = ptr_arg2[i]; Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ (v - c); c = c && !v; } r = ml_z_reduce(r, size_arg1, 0); } else if (sign_arg1) { /* arg1 < 0, arg2 > 0 => r < 0 */ r = ml_z_alloc(size_arg1 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ ptr_arg2[i]; c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); Z_LIMB(r)[size_arg1] = c; r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); } else if (sign_arg2) { /* arg1 > 0, arg2 < 0 => r < 0 */ r = ml_z_alloc(size_arg1 + 1); Z_REFRESH(arg1); Z_REFRESH(arg2); mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = ptr_arg1[i] ^ Z_LIMB(r)[i]; for (; i < size_arg1; i++) Z_LIMB(r)[i] = ptr_arg1[i]; c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1); Z_LIMB(r)[size_arg1] = c; r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK); } else { /* arg1, arg2 > 0 => r >= 0 */ r = ml_z_alloc(size_arg1); Z_REFRESH(arg1); Z_REFRESH(arg2); for (i = 0; i < size_arg2; i++) Z_LIMB(r)[i] = ptr_arg1[i] ^ ptr_arg2[i]; for (; i < size_arg1; i++) Z_LIMB(r)[i] = ptr_arg1[i]; r = ml_z_reduce(r, size_arg1, 0); } Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_lognot(value arg) { Z_MARK_OP; Z_CHECK(arg); #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ return (~arg) | 1; } #endif /* mpn_ version */ Z_MARK_SLOW; { CAMLparam1(arg); Z_DECL(arg); value r; Z_ARG(arg); r = ml_z_alloc(size_arg + 1); Z_REFRESH(arg); /* compute r = -arg - 1 */ if (!size_arg) { /* arg = 0 => r = -1 */ Z_LIMB(r)[0] = 1; r = ml_z_reduce(r, 1, Z_SIGN_MASK); } else if (sign_arg) { /* arg < 0, r > 0, |r| = |arg| - 1 */ mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1); r = ml_z_reduce(r, size_arg, 0); } else { /* arg > 0, r < 0, |r| = |arg| + 1 */ mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1); Z_LIMB(r)[size_arg] = c; r = ml_z_reduce(r, size_arg + 1, Z_SIGN_MASK); } Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_shift_left(value arg, value count) { Z_DECL(arg); intnat c = Long_val(count); intnat c1, c2; Z_MARK_OP; Z_CHECK(arg); if (c < 0) caml_invalid_argument("Z.shift_left: count argument must be positive"); if (!c) return arg; c1 = c / Z_LIMB_BITS; c2 = c % Z_LIMB_BITS; #if Z_FAST_PATH if (Is_long(arg) && !c1) { /* fast path */ value a = arg - 1; value r = arg << c2; if (a == (r >> c2)) return r | 1; } #endif Z_ARG(arg); if (!size_arg) return Val_long(0); /* mpn_ version */ Z_MARK_SLOW; { CAMLparam1(arg); value r; mp_size_t i; r = ml_z_alloc(size_arg + c1 + 1); Z_REFRESH(arg); /* 0-filled limbs */ for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0; if (c2) { /* shifted bits */ mp_limb_t x = mpn_lshift(Z_LIMB(r) + c1, ptr_arg, size_arg, c2); Z_LIMB(r)[size_arg + c1] = x; } else { /* unshifted copy */ ml_z_cpy_limb(Z_LIMB(r) + c1, ptr_arg, size_arg); Z_LIMB(r)[size_arg + c1] = 0; } r = ml_z_reduce(r, size_arg + c1 + 1, sign_arg); Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_shift_right(value arg, value count) { Z_DECL(arg); intnat c = Long_val(count); intnat c1, c2; value r; Z_MARK_OP; Z_CHECK(arg); if (c < 0) caml_invalid_argument("Z.shift_right: count argument must be positive"); if (!c) return arg; c1 = c / Z_LIMB_BITS; c2 = c % Z_LIMB_BITS; #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ if (c1) { if (arg < 0) return Val_long(-1); else return Val_long(0); } return (arg >> c2) | 1; } #endif Z_ARG(arg); if (c1 >= size_arg) { if (sign_arg) return Val_long(-1); else return Val_long(0); } /* mpn_ version */ Z_MARK_SLOW; { CAMLparam1(arg); mp_limb_t cr; r = ml_z_alloc(size_arg - c1 + 1); Z_REFRESH(arg); if (c2) /* shifted bits */ cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2); else { /* unshifted copy */ ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1); cr = 0; } if (sign_arg) { /* round |arg| to +oo */ mp_size_t i; if (!cr) { for (i = 0; i < c1; i++) if (ptr_arg[i]) { cr = 1; break; } } if (cr) cr = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg - c1, 1); } else cr = 0; Z_LIMB(r)[size_arg - c1] = cr; r = ml_z_reduce(r, size_arg - c1 + 1, sign_arg); Z_CHECK(r); CAMLreturn(r); } } CAMLprim value ml_z_shift_right_trunc(value arg, value count) { Z_DECL(arg); intnat c = Long_val(count); intnat c1, c2; value r; Z_MARK_OP; Z_CHECK(arg); if (c < 0) caml_invalid_argument("Z.shift_right_trunc: count argument must be positive"); if (!c) return arg; c1 = c / Z_LIMB_BITS; c2 = c % Z_LIMB_BITS; #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ if (c1) return Val_long(0); if (arg >= 1) return (arg >> c2) | 1; else return 2 - (((2 - arg) >> c2) | 1); } #endif Z_ARG(arg); if (c1 >= size_arg) return Val_long(0); /* mpn_ version */ Z_MARK_SLOW; { CAMLparam1(arg); r = ml_z_alloc(size_arg - c1); Z_REFRESH(arg); if (c2) /* shifted bits */ mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2); else /* unshifted copy */ ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1); r = ml_z_reduce(r, size_arg - c1, sign_arg); Z_CHECK(r); CAMLreturn(r); } } /* helper function for popcount & hamdist: number of bits at 1 in x */ /* maybe we should use the mpn_ function even for small arguments, in case the CPU has a fast popcount opcode? */ uintnat ml_z_count(uintnat x) { #ifdef ARCH_SIXTYFOUR x = (x & 0x5555555555555555UL) + ((x >> 1) & 0x5555555555555555UL); x = (x & 0x3333333333333333UL) + ((x >> 2) & 0x3333333333333333UL); x = (x & 0x0f0f0f0f0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0f0f0f0f0fUL); x = (x & 0x00ff00ff00ff00ffUL) + ((x >> 8) & 0x00ff00ff00ff00ffUL); x = (x & 0x0000ffff0000ffffUL) + ((x >> 16) & 0x0000ffff0000ffffUL); x = (x & 0x00000000ffffffffUL) + ((x >> 32) & 0x00000000ffffffffUL); #else x = (x & 0x55555555UL) + ((x >> 1) & 0x55555555UL); x = (x & 0x33333333UL) + ((x >> 2) & 0x33333333UL); x = (x & 0x0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0fUL); x = (x & 0x00ff00ffUL) + ((x >> 8) & 0x00ff00ffUL); x = (x & 0x0000ffffUL) + ((x >> 16) & 0x0000ffffUL); #endif return x; } CAMLprim value ml_z_popcount(value arg) { Z_DECL(arg); intnat r; Z_MARK_OP; Z_CHECK(arg); #if Z_FAST_PATH if (Is_long(arg)) { /* fast path */ r = Long_val(arg); if (r < 0) ml_z_raise_overflow(); return Val_long(ml_z_count(r)); } #endif /* mpn_ version */ Z_MARK_SLOW; Z_ARG(arg); if (sign_arg) ml_z_raise_overflow(); if (!size_arg) return Val_long(0); r = mpn_popcount(ptr_arg, size_arg); if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); return Val_long(r); } CAMLprim value ml_z_hamdist(value arg1, value arg2) { Z_DECL(arg1); Z_DECL(arg2); intnat r; mp_size_t sz; Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ r = Long_val(arg1) ^ Long_val(arg2); if (r < 0) ml_z_raise_overflow(); return Val_long(ml_z_count(r)); } #endif /* mpn_ version */ Z_MARK_SLOW; Z_ARG(arg1); Z_ARG(arg2); if (sign_arg1 != sign_arg2) ml_z_raise_overflow(); /* XXX TODO: case where arg1 & arg2 are both negative */ if (sign_arg1 || sign_arg2) caml_invalid_argument("Z.hamdist: negative arguments"); /* distance on common size */ sz = (size_arg1 <= size_arg2) ? size_arg1 : size_arg2; if (sz) { r = mpn_hamdist(ptr_arg1, ptr_arg2, sz); if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); } else r = 0; /* add stray bits */ if (size_arg1 > size_arg2) { r += mpn_popcount(ptr_arg1 + size_arg2, size_arg1 - size_arg2); if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); } else if (size_arg2 > size_arg1) { r += mpn_popcount(ptr_arg2 + size_arg1, size_arg2 - size_arg1); if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); } return Val_long(r); } /*--------------------------------------------------- FUNCTIONS BASED ON mpz_t ---------------------------------------------------*/ /* sets rop to the value in op (limbs are copied) */ void ml_z_mpz_set_z(mpz_t rop, value op) { Z_DECL(op); Z_CHECK(op); Z_ARG(op); mpz_realloc2(rop, size_op * Z_LIMB_BITS); rop->_mp_size = (sign_op >= 0) ? size_op : -size_op; ml_z_cpy_limb(rop->_mp_d, ptr_op, size_op); } /* inits and sets rop to the value in op (limbs are copied) */ void ml_z_mpz_init_set_z(mpz_t rop, value op) { mpz_init(rop); ml_z_mpz_set_z(rop,op); } /* returns a new z objects equal to op (limbs are copied) */ value ml_z_from_mpz(mpz_t op) { value r; size_t sz = mpz_size(op); r = ml_z_alloc(sz); ml_z_cpy_limb(Z_LIMB(r), op->_mp_d, sz); return ml_z_reduce(r, sz, (mpz_sgn(op) >= 0) ? 0 : Z_SIGN_MASK); } CAMLprim value ml_z_divexact(value arg1, value arg2) { Z_MARK_OP; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ intnat a1 = Long_val(arg1); intnat a2 = Long_val(arg2); intnat q; if (!a2) ml_z_raise_divide_by_zero(); q = a1 / a2; if (Z_FITS_INT(q)) return Val_long(q); } #endif /* mpz_ version */ Z_MARK_SLOW; { CAMLparam2(arg1,arg2); CAMLlocal1(r); mpz_t a,b; if (!ml_z_sgn(arg2)) ml_z_raise_divide_by_zero(); ml_z_mpz_init_set_z(a, arg1); ml_z_mpz_init_set_z(b, arg2); mpz_divexact(a, a, b); r = ml_z_from_mpz(a); mpz_clear(a); mpz_clear(b); CAMLreturn(r); } } CAMLprim value ml_z_powm(value base, value exp, value mod) { CAMLparam3(base,exp,mod); CAMLlocal1(r); mpz_t mbase, mexp, mmod; ml_z_mpz_init_set_z(mbase, base); ml_z_mpz_init_set_z(mexp, exp); ml_z_mpz_init_set_z(mmod, mod); if (mpz_sgn(mexp) < 0) { /* we need to check whether base is invertible to avoid a division by zero in mpz_powm, so we can as well use the computed inverse */ if (!mpz_invert(mbase, mbase, mmod)) ml_z_raise_divide_by_zero(); mpz_neg(mexp, mexp); } mpz_powm(mbase, mbase, mexp, mmod); r = ml_z_from_mpz(mbase); mpz_clear(mbase); mpz_clear(mexp); mpz_clear(mmod); CAMLreturn(r); } CAMLprim value ml_z_pow(value base, value exp) { CAMLparam2(base,exp); CAMLlocal1(r); mpz_t mbase; int e = Long_val(exp); if (e < 0) caml_invalid_argument("Z.pow: exponent must be non-negative"); ml_z_mpz_init_set_z(mbase, base); mpz_pow_ui(mbase, mbase, e); r = ml_z_from_mpz(mbase); mpz_clear(mbase); CAMLreturn(r); } CAMLprim value ml_z_root(value a, value b) { CAMLparam2(a,b); CAMLlocal1(r); mpz_t ma; int mb = Long_val(b); if (mb < 0) caml_invalid_argument("Z.root: exponent must be non-negative"); ml_z_mpz_init_set_z(ma, a); mpz_root(ma, ma, mb); r = ml_z_from_mpz(ma); mpz_clear(ma); CAMLreturn(r); } CAMLprim value ml_z_perfect_power(value a) { CAMLparam1(a); int r; mpz_t ma; ml_z_mpz_init_set_z(ma, a); r = mpz_perfect_power_p(ma); mpz_clear(ma); CAMLreturn(r ? Val_true : Val_false); } CAMLprim value ml_z_perfect_square(value a) { CAMLparam1(a); int r; mpz_t ma; ml_z_mpz_init_set_z(ma, a); r = mpz_perfect_square_p(ma); mpz_clear(ma); CAMLreturn(r ? Val_true : Val_false); } CAMLprim value ml_z_probab_prime(value a, int b) { CAMLparam1(a); int r; mpz_t ma; ml_z_mpz_init_set_z(ma, a); r = mpz_probab_prime_p(ma, Int_val(b)); mpz_clear(ma); CAMLreturn(Val_int(r)); } CAMLprim value ml_z_nextprime(value a) { CAMLparam1(a); CAMLlocal1(r); mpz_t ma; ml_z_mpz_init_set_z(ma, a); mpz_nextprime(ma, ma); r = ml_z_from_mpz(ma); mpz_clear(ma); CAMLreturn(r); } CAMLprim value ml_z_invert(value base, value mod) { CAMLparam2(base,mod); CAMLlocal1(r); mpz_t mbase, mmod; ml_z_mpz_init_set_z(mbase, base); ml_z_mpz_init_set_z(mmod, mod); if (!mpz_invert(mbase, mbase, mmod)) ml_z_raise_divide_by_zero(); r = ml_z_from_mpz(mbase); mpz_clear(mbase); mpz_clear(mmod); CAMLreturn(r); } /* XXX should we support the following? mpz_divisible_p mpz_congruent_p mpz_powm_sec mpz_rootrem mpz_jacobi mpz_legendre mpz_kronecker mpz_remove mpz_fac_ui mpz_bin_ui mpz_fib_ui mpz_lucnum_ui mpz_scan0, mpz_scan1 mpz_setbit, mpz_clrbit, mpz_combit, mpz_tstbit mpz_odd_p, mpz_even_p random numbers */ /*--------------------------------------------------- CUSTOMS BLOCKS ---------------------------------------------------*/ /* With OCaml < 3.12.1, comparing a block an int with OCaml's polymorphic compare will give erroneous results (int always strictly smaller than block). OCaml 3.12.1 and above give the correct result. */ int ml_z_custom_compare(value arg1, value arg2) { Z_DECL(arg1); Z_DECL(arg2); int r; Z_CHECK(arg1); Z_CHECK(arg2); #if Z_FAST_PATH if (Is_long(arg1) && Is_long(arg2)) { /* fast path */ if (arg1 > arg2) return 1; else if (arg1 < arg2) return -1; else return 0; } #endif r = 0; Z_ARG(arg1); Z_ARG(arg2); if (sign_arg1 != sign_arg2) r = 1; else if (size_arg1 > size_arg2) r = 1; else if (size_arg1 < size_arg2) r = -1; else { mp_size_t i; for (i = size_arg1 - 1; i >= 0; i--) { if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; } if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; } } } if (sign_arg1) r = -r; return r; } #ifndef Z_OCAML_HASH #define caml_hash_mix_uint32(h,n) ((h) * 65599 + (n)) #endif static intnat ml_z_custom_hash(value v) { Z_DECL(v); mp_size_t i; uint32 acc = 0; Z_CHECK(v); Z_ARG(v); for (i = 0; i < size_v; i++) { acc = caml_hash_mix_uint32(acc, (uint32)(ptr_v[i])); #ifdef ARCH_SIXTYFOUR acc = caml_hash_mix_uint32(acc, ptr_v[i] >> 32); #endif } #ifndef ARCH_SIXTYFOUR /* To obtain the same hash value on 32- and 64-bit platforms */ if (size_v % 2 != 0) acc = caml_hash_mix_uint32(acc, 0); #endif if (sign_v) acc++; return acc; } CAMLprim value ml_z_hash(value v) { return Val_long(ml_z_custom_hash(v)); } /* serialized format: - 1-byte sign (1 for negative, 0 for positive) - 4-byte size in bytes - size-byte unsigned integer, in little endian order */ static void ml_z_custom_serialize(value v, uintnat * wsize_32, uintnat * wsize_64) { mp_size_t i,nb; Z_DECL(v); Z_CHECK(v); Z_ARG(v); if ((mp_size_t)(uint32) size_v != size_v) caml_failwith("Z.serialize: number is too large"); nb = size_v * sizeof(mp_limb_t); caml_serialize_int_1(sign_v ? 1 : 0); caml_serialize_int_4(nb); for (i = 0; i < size_v; i++) { mp_limb_t x = ptr_v[i]; caml_serialize_int_1(x); caml_serialize_int_1(x >> 8); caml_serialize_int_1(x >> 16); caml_serialize_int_1(x >> 24); #ifdef ARCH_SIXTYFOUR caml_serialize_int_1(x >> 32); caml_serialize_int_1(x >> 40); caml_serialize_int_1(x >> 48); caml_serialize_int_1(x >> 56); #endif } *wsize_32 = 4 * (1 + (nb + 3) / 4); *wsize_64 = 8 * (1 + (nb + 7) / 8); #if Z_PERFORM_CHECK /* Add space for canary */ *wsize_32 += 4; *wsize_64 += 8; #endif } /* XXX: serializing a large (i.e., > 2^31) int on a 64-bit machine and deserializing on a 32-bit machine will fail (instead of returning a block). */ static uintnat ml_z_custom_deserialize(void * dst) { mp_limb_t* d = ((mp_limb_t*)dst) + 1; int sign = caml_deserialize_uint_1(); uint32 sz = caml_deserialize_uint_4(); uint32 szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t); uint32 i = 0; mp_limb_t x; /* all limbs but last */ if (szw > 1) { for (; i < szw - 1; i++) { x = caml_deserialize_uint_1(); x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8; x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16; x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24; #ifdef ARCH_SIXTYFOUR x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32; x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40; x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48; x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56; #endif d[i] = x; } sz -= i * sizeof(mp_limb_t); } /* last limb */ if (sz > 0) { x = caml_deserialize_uint_1(); if (sz > 1) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8; if (sz > 2) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16; if (sz > 3) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24; #ifdef ARCH_SIXTYFOUR if (sz > 4) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32; if (sz > 5) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40; if (sz > 6) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48; if (sz > 7) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56; #endif d[i] = x; i++; } while (i > 0 && !d[i-1]) i--; d[-1] = i | (sign ? Z_SIGN_MASK : 0); #if Z_PERFORM_CHECK d[szw] = 0xDEADBEEF ^ szw; szw++; #endif return (szw+1) * sizeof(mp_limb_t); } struct custom_operations ml_z_custom_ops = { /* Identifiers starting with _ are normally reserved for the OCaml runtime system, but we got authorization form Gallium to use "_z". It is very compact and stays in the spirit of identifiers used for int32 & co ("_i" & co.). */ "_z", custom_finalize_default, ml_z_custom_compare, ml_z_custom_hash, ml_z_custom_serialize, ml_z_custom_deserialize, #if Z_OCAML_COMPARE_EXT ml_z_custom_compare, #endif }; /*--------------------------------------------------- CONVERSION WITH MLGMPIDL ---------------------------------------------------*/ CAMLprim value ml_z_mlgmpidl_of_mpz(value a) { CAMLparam1(a); mpz_ptr mpz = (mpz_ptr)(Data_custom_val(a)); CAMLreturn(ml_z_from_mpz(mpz)); } /* stores the Z.t object into an existing Mpz.t one; as we never allocate Mpz.t objects, we don't need any pointer to mlgmpidl's custom block ops, and so, can link the function even if mlgmpidl is not installed */ CAMLprim value ml_z_mlgmpidl_set_mpz(value r, value a) { CAMLparam2(r,a); mpz_ptr mpz = (mpz_ptr)(Data_custom_val(r)); ml_z_mpz_set_z(mpz,a); CAMLreturn(Val_unit); } /*--------------------------------------------------- INIT / EXIT ---------------------------------------------------*/ /* called at program exit to display performance information */ #if Z_PERF_COUNTER static void ml_z_dump_count() { printf("Z: %lu asm operations, %lu C operations, %lu slow (%lu%%)\n", ml_z_ops_as, ml_z_ops, ml_z_slow, ml_z_ops ? (ml_z_slow*100/(ml_z_ops+ml_z_ops_as)) : 0); } #endif CAMLprim value ml_z_install_frametable() { /* nothing to do for bytecode version */ return Val_unit; } CAMLprim value ml_z_init() { ml_z_2p32 = ldexp(1., 32); /* run-time checks */ #ifdef ARCH_SIXTYFOUR if (sizeof(intnat) != 8 || sizeof(mp_limb_t) != 8) caml_failwith("Z.init: invalid size of types, 8 expected"); #else if (sizeof(intnat) != 4 || sizeof(mp_limb_t) != 4) caml_failwith("Z.init: invalid size of types, 4 expected"); #endif /* install functions */ #if Z_PERF_COUNTER atexit(ml_z_dump_count); #endif #if Z_CUSTOM_BLOCK caml_register_custom_operations(&ml_z_custom_ops); #endif return Val_unit; } #ifdef __cplusplus } #endif zarith-1.2.1/bitest.ml0000644000175000017540000001512312156017667013323 0ustar minemine(* stress test, using random and corner cases compares Big_int_Z, a Big_int compatible interface for Z, to OCaml's reference Big_int library some functions in 3.12 but missing in 3.11 are not tested This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) module B = (* reference library *) struct include Big_int (* missing in OCaml 3.11 *) let shift_left_big_int a b = mult_big_int a (power_int_positive_int 2 b) end module T = Big_int_Z (* tested library *) (* randomness *) let _ = Random.init 42 let random_int64 () = let a,b,c = Random.bits(), Random.bits(), Random.bits () in let a,b,c = Int64.of_int a, Int64.of_int b, Int64.of_int c in let a,b,c = Int64.shift_left a 60, Int64.shift_left b 30, c in Int64.logor a (Int64.logor b c) let random_int () = Int64.to_int (random_int64 ()) let random_string () = let s = String.create (1 + Random.int 200) in for i = 0 to String.length s - 1 do s.[i] <- Char.chr (48 + Random.int 10) done; if String.length s > 1 && Random.bool () then s.[0] <- '-'; s (* list utility *) let list_make n f = let rec doit i acc = if i < 0 then acc else doit (i-1) ((f i)::acc) in doit (n-1) [] (* interesting numbers, as big_int *) let p = (list_make 128 (B.shift_left_big_int B.unit_big_int)) let pn = p @ (List.map B.minus_big_int p) let g_list = [B.zero_big_int] @ pn @ (List.map B.succ_big_int pn) @ (List.map B.pred_big_int pn) @ (list_make 128 (fun _ -> B.big_int_of_int (random_int ()))) @ (list_make 128 (fun _ -> B.big_int_of_string (random_string()))) let sh_list = list_make 256 (fun x -> x) (* conversion to Z *) let g_t_list = Printf.printf "converting %i numbers\n%!" (List.length g_list); List.map (fun g -> let t = T.big_int_of_string (B.string_of_big_int g) in let g' = B.big_int_of_string (T.string_of_big_int t) in if B.compare_big_int g g' <> 0 then failwith (Printf.sprintf "string_of_big_int failure: %s" (B.string_of_big_int g)); g, t ) g_list (* operator tests *) let test_un msg filt gf tf = Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list); List.iter (fun (g,t) -> try if filt g then ( let g' = gf g and t' = tf t in if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g) (B.string_of_big_int g') (T.string_of_big_int t')) ) with Failure _ -> () ) g_t_list let test_bin msg filt gf tf = Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length g_t_list) (List.length g_t_list); List.iter (fun (g1,t1) -> List.iter (fun (g2,t2) -> if filt (g1,g2) then ( let g' = gf g1 g2 and t' = tf t1 t2 in if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2) (B.string_of_big_int g') (T.string_of_big_int t')) ) ) g_t_list ) g_t_list let test_shift msg gf tf = Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list); List.iter (fun s -> List.iter (fun (g,t) -> let g' = gf g s and t' = tf t s in if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t')) ) g_t_list ) sh_list let filt_none _ = true let filt_pos x = B.sign_big_int x >= 0 let filt_nonzero2 (_,d) = B.sign_big_int d <> 0 let filt_pos2 (x,y) = B.sign_big_int x >= 0 && B.sign_big_int y >= 0 let filt_nonzero22 (x,y) = B.sign_big_int x <> 0 && B.sign_big_int y <> 0 let ffst f x = fst (f x) let fsnd f x = snd (f x) let ffst2 f x y = fst (f x y) let fsnd2 f x y = snd (f x y) let _ = test_un "int_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int (T.int_of_big_int x)) let _ = test_un "int32_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int32 (T.int32_of_big_int x)) let _ = test_un "int64_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int64 (T.int64_of_big_int x)) let _ = test_un "nativeint_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_nativeint (T.nativeint_of_big_int x)) let _ = test_un "string_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_string (T.string_of_big_int x)) let _ = test_un "minus_big_int" filt_none B.minus_big_int T.minus_big_int let _ = test_un "abs_big_int" filt_none B.abs_big_int T.abs_big_int let _ = test_un "succ_big_int"filt_none B.succ_big_int T.succ_big_int let _ = test_un "pred_big_int" filt_none B.pred_big_int T.pred_big_int let _ = test_un "sqrt_big_int" filt_pos B.sqrt_big_int T.sqrt_big_int let _ = test_bin "add_big_int" filt_none B.add_big_int T.add_big_int let _ = test_bin "sub_big_int" filt_none B.sub_big_int T.sub_big_int let _ = test_bin "mult_big_int" filt_none B.mult_big_int T.mult_big_int let _ = test_bin "div_big_int" filt_nonzero2 B.div_big_int T.div_big_int let _ = test_bin "quomod_big_int #1" filt_nonzero2 (ffst2 B.quomod_big_int) (ffst2 T.quomod_big_int) let _ = test_bin "quomod_big_int #2" filt_nonzero2 (fsnd2 B.quomod_big_int) (fsnd2 T.quomod_big_int) let _ = test_bin "mod_big_int" filt_nonzero2 B.mod_big_int T.mod_big_int let _ = test_bin "gcd_big_int" filt_nonzero22 B.gcd_big_int T.gcd_big_int (* missing in OCaml 3.11 let _ = test_bin "and_big_int" filt_pos2 B.and_big_int T.and_big_int let _ = test_bin "or_big_int" filt_pos2 B.or_big_int T.or_big_int let _ = test_bin "xor_big_int" filt_pos2 B.xor_big_int T.xor_big_int *) let _ = test_shift "shift_left_big_int" B.shift_left_big_int T.shift_left_big_int (* missing in OCaml 3.11 let _ = test_shift "shift_right_big_int" B.shift_right_big_int T.shift_right_big_int let _ = test_shift "shift_right_towards_zero_big_int" B.shift_right_towards_zero_big_int T.shift_right_towards_zero_big_int *) let _ = test_shift "power_big_int_positive_int" B.power_big_int_positive_int T.power_big_int_positive_int let _ = Printf.printf "All tests passed!\n" zarith-1.2.1/z.mlp0000644000175000017540000001344212156017667012464 0ustar minemine(** Integers. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) type t exception Overflow external init: unit -> unit = "ml_z_init" let _ = init () external install_frametable: unit -> unit = install_frametable@ASM let _ = install_frametable () let _ = Callback.register_exception "ml_z_overflow" Overflow external neg: t -> t = neg@ASM external add: t -> t -> t = add@ASM external sub: t -> t -> t = sub@ASM external mul: t -> t -> t = mul@ASM external div: t -> t -> t = div@ASM external cdiv: t -> t -> t = "ml_z_cdiv" external fdiv: t -> t -> t = "ml_z_fdiv" external rem: t -> t -> t = rem@ASM external div_rem: t -> t -> (t * t) = "ml_z_div_rem" external succ: t -> t = succ@ASM external pred: t -> t = pred@ASM external abs: t -> t = abs@ASM external logand: t -> t -> t = logand@ASM external logor: t -> t -> t = logor@ASM external logxor: t -> t -> t = logxor@ASM external lognot: t -> t = lognot@ASM external shift_left: t -> int -> t = shift_left@ASM external shift_right: t -> int -> t = shift_right@ASM external shift_right_trunc: t -> int -> t = shift_right_trunc@ASM external of_int32: int32 -> t = "ml_z_of_int32" external of_int64: int64 -> t = "ml_z_of_int64" external of_nativeint: nativeint -> t = "ml_z_of_nativeint" external of_float: float -> t = "ml_z_of_float" external to_int: t -> int = "ml_z_to_int" external to_int32: t -> int32 = "ml_z_to_int32" external to_int64: t -> int64 = "ml_z_to_int64" external to_nativeint: t -> nativeint = "ml_z_to_nativeint" external to_float: t -> float = "ml_z_to_float" external format: string -> t -> string = "ml_z_format" external of_string_base: int -> string -> t = "ml_z_of_string_base" external compare: t -> t -> int = "ml_z_compare" "noalloc" external equal: t -> t -> bool = "ml_z_equal" "noalloc" external sign: t -> int = "ml_z_sign" "noalloc" external gcd: t -> t -> t = "ml_z_gcd" external gcdext_intern: t -> t -> (t * t * bool) = "ml_z_gcdext_intern" external sqrt: t -> t = "ml_z_sqrt" external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem" external popcount: t -> int = "ml_z_popcount" external hamdist: t -> t -> int = "ml_z_hamdist" external size: t -> int = "ml_z_size" "noalloc" external fits_int: t -> bool = "ml_z_fits_int" "noalloc" external fits_int32: t -> bool = "ml_z_fits_int32" "noalloc" external fits_int64: t -> bool = "ml_z_fits_int64" "noalloc" external fits_nativeint: t -> bool = "ml_z_fits_nativeint" "noalloc" external extract: t -> int -> int -> t = "ml_z_extract" external powm: t -> t -> t -> t = "ml_z_powm" external pow: t -> int -> t = "ml_z_pow" external divexact: t -> t -> t = "ml_z_divexact" external root: t -> int -> t = "ml_z_root" external invert: t -> t -> t = "ml_z_invert" external perfect_power: t -> bool = "ml_z_perfect_power" external perfect_square: t -> bool = "ml_z_perfect_square" external probab_prime: t -> int -> int = "ml_z_probab_prime" external nextprime: t -> t = "ml_z_nextprime" external hash: t -> int = "ml_z_hash" external to_bits: t -> string = "ml_z_to_bits" external of_bits: string -> t = "ml_z_of_bits" external of_int: int -> t = "%identity" (* it's magic... *) let zero = of_int 0 let one = of_int 1 let minus_one = of_int (-1) let min a b = if compare a b <= 0 then a else b let max a b = if compare a b >= 0 then a else b let leq a b = compare a b <= 0 let geq a b = compare a b >= 0 let lt a b = compare a b < 0 let gt a b = compare a b > 0 let to_string = format "%d" let of_string = of_string_base 0 let ediv_rem a b = (* we have a = a * b + r, but [Big_int]'s remainder satisfies 0 <= r < |b|, while [Z]'s remainder satisfies -|b| < r < |b| and sign(r) = sign(a) *) let q,r = div_rem a b in if sign r >= 0 then (q,r) else if sign b >= 0 then (pred q, add r b) else (succ q, sub r b) let ediv a b = if sign b >= 0 then fdiv a b else cdiv a b let erem a b = let r = rem a b in if sign r >= 0 then r else add r (abs b) let gcdext u v = let g,s,z = gcdext_intern u v in if z then g, s, div (sub g (mul u s)) v else g, div (sub g (mul v s)) u, s let lcm u v = let g = gcd u v in abs (mul (divexact u g) v) let signed_extract x o l = if o < 0 then invalid_arg "Z.signed_extract: negative bit offset"; if l < 1 then invalid_arg "Z.signed_extract: non-positive bit length"; let sgn = extract x (o + l - 1) 1 in if equal sgn (of_int 0) then extract x o l else lognot (extract (lognot x) o l) let print x = print_string (to_string x) let output chan x = output_string chan (to_string x) let sprint () x = to_string x let bprint b x = Buffer.add_string b (to_string x) let pp_print f x = Format.pp_print_string f (to_string x) external (~-): t -> t = neg@ASM external (~+): t -> t = "%identity" external (+): t -> t -> t = add@ASM external (-): t -> t -> t = sub@ASM external ( * ): t -> t -> t = mul@ASM external (/): t -> t -> t = div@ASM external (/>): t -> t -> t = "ml_z_cdiv" external (/<): t -> t -> t = "ml_z_fdiv" external (/|): t -> t -> t = "ml_z_divexact" external (mod): t -> t -> t = rem@ASM external (land): t -> t -> t = logand@ASM external (lor): t -> t -> t = logor@ASM external (lxor): t -> t -> t = logxor@ASM external (~!): t -> t = lognot@ASM external (lsl): t -> int -> t = shift_left@ASM external (asr): t -> int -> t = shift_right@ASM external (~$): int -> t = "%identity" external ( ** ): t -> int -> t = "ml_z_pow" let version = @VERSION zarith-1.2.1/z.mlip0000644000175000017540000004077312156017667012644 0ustar minemine(** Integers. This modules provides arbitrary-precision integers. Small integers internally use a regular OCaml [int]. When numbers grow too large, we switch transparently to GMP numbers ([mpn] numbers fully allocated on the OCaml heap). This interface is rather similar to that of [Int32] and [Int64], with some additional functions provided natively by GMP (GCD, square root, pop-count, etc.). This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) (** {1 Toplevel} *) (** For an optimal experience with the [ocaml] interactive toplevel, the magic commands are: {[ #load "zarith.cma";; #install_printer Z.pp_print;; ]} *) (** {1 Types} *) type t (** Type of integers of arbitrary length. *) exception Overflow (** Raised by conversion functions when the value cannot be represented in the destination type. *) (** {1 Construction} *) val zero: t (** The number 0. *) val one: t (** The number 1. *) val minus_one: t (** The number -1. *) val of_int: int -> t (** Converts from a base integer. *) external of_int32: int32 -> t = "ml_z_of_int32" (** Converts from a 32-bit integer. *) external of_int64: int64 -> t = "ml_z_of_int64" (** Converts from a 64-bit integer. *) external of_nativeint: nativeint -> t = "ml_z_of_nativeint" (** Converts from a native integer. *) external of_float: float -> t = "ml_z_of_float" (** Converts from a floating-point value. The value is truncated. Raises [Overflow] on infinity and NaN arguments. *) val of_string: string -> t (** Converts a string to an integer. An optional [-] prefix indicates a negative number, while a [+] prefix is ignored. An optional prefix [0x], [0o], or [0b] (following the optional [-] or [+] prefix) indicates that the number is, represented, in hexadecimal, octal, or binary, respectively. Otherwise, base 10 is assumed. (Unlike C, a lone [0] prefix does not denote octal.) *) external of_string_base: int -> string -> t = "ml_z_of_string_base" (** Parses a number represented as a string in the specified base, with optional [-] or [+] prefix. The base must be between 2 and 16. *) (** {1 Basic arithmetic operations} *) external succ: t -> t = succ@ASM (** Returns its argument plus one. *) external pred: t -> t = pred@ASM (** Returns its argument minus one. *) external abs: t -> t = abs@ASM (** Absolute value. *) external neg: t -> t = neg@ASM (** Unary negation. *) external add: t -> t -> t = add@ASM (** Addition. *) external sub: t -> t -> t = sub@ASM (** Subtraction. *) external mul: t -> t -> t = mul@ASM (** Multiplication. *) external div: t -> t -> t = div@ASM (** Integer division. The result is truncated towards zero and obeys the rule of signs. Raises [Division_by_zero] if the divisor (second argument) is 0. *) external rem: t -> t -> t = rem@ASM (** Integer remainder. Can raise a [Division_by_zero]. The result of [rem a b] has the sign of [a], and its absolute value is strictly smaller than the absolute value of [b]. The result satisfies the equality [a = b * div a b + rem a b]. *) external div_rem: t -> t -> (t * t) = "ml_z_div_rem" (** Computes both the integer quotient and the remainder. [div_rem a b] is equal to [(div a b, rem a b)]. Raises [Division_by_zero] if [b = 0]. *) external cdiv: t -> t -> t = "ml_z_cdiv" (** Integer division with rounding towards +oo (ceiling). Can raise a [Division_by_zero]. *) external fdiv: t -> t -> t = "ml_z_fdiv" (** Integer division with rounding towards -oo (floor). Can raise a [Division_by_zero]. *) val ediv_rem: t -> t -> (t * t) (** Euclidean division and remainder. [ediv_rem a b] returns a pair [(q, r)] such that [a = b * q + r] and [0 <= r < |b|]. Raises [Division_by_zero] if [b = 0]. *) val ediv: t -> t -> t (** Euclidean division. [ediv a b] is equal to [fst (ediv_rem a b)]. The result satisfies [0 <= a - b * ediv a b < |b|]. Raises [Division_by_zero] if [b = 0]. *) val erem: t -> t -> t (** Euclidean remainder. [erem a b] is equal to [snd (ediv_rem a b)]. The result satisfies [0 <= erem a b < |b|] and [a = b * ediv a b + erem a b]. Raises [Division_by_zero] if [b = 0]. *) external divexact: t -> t -> t = "ml_z_divexact" (** [divexact a b] divides [a] by [b], only producing correct result when the division is exact, i.e., when [b] evenly divides [a]. It should be faster than general division. Can raise a [Division_by_zero]. *) (** {1 Bit-level operations} *) (** For all bit-level operations, negative numbers are considered in 2's complement representation, starting with a virtual infinite number of 1s. *) external logand: t -> t -> t = logand@ASM (** Bitwise logical and. *) external logor: t -> t -> t = logor@ASM (** Bitwise logical or. *) external logxor: t -> t -> t = logxor@ASM (** Bitwise logical exclusive or. *) external lognot: t -> t = lognot@ASM (** Bitwise logical negation. The identity [lognot a]=[-a-1] always hold. *) external shift_left: t -> int -> t = shift_left@ASM (** Shifts to the left. Equivalent to a multiplication by a power of 2. The second argument must be non-negative. *) external shift_right: t -> int -> t = shift_right@ASM (** Shifts to the right. This is an arithmetic shift, equivalent to a division by a power of 2 with rounding towards -oo. The second argument must be non-negative. *) external shift_right_trunc: t -> int -> t = shift_right_trunc@ASM (** Shifts to the right, rounding towards 0. This is equivalent to a division by a power of 2, with truncation. The second argument must be non-negative. *) external popcount: t -> int = "ml_z_popcount" (** Counts the number of bits set. Raises [Overflow] for negative arguments, as those have an infinite number of bits set. *) external hamdist: t -> t -> int = "ml_z_hamdist" (** Counts the number of different bits. Raises [Overflow] if the arguments have different signs (in which case the distance is infinite). *) (** {1 Conversions} *) (** Note that, when converting to an integer type that cannot represent the converted value, an [Overflow] exception is raised. *) external to_int: t -> int = "ml_z_to_int" (** Converts to a base integer. May raise an [Overflow]. *) external to_int32: t -> int32 = "ml_z_to_int32" (** Converts to a 32-bit integer. May raise an [Overflow]. *) external to_int64: t -> int64 = "ml_z_to_int64" (** Converts to a 64-bit integer. May raise [Overflow]. *) external to_nativeint: t -> nativeint = "ml_z_to_nativeint" (** Converts to a native integer. May raise an [Overflow]. *) external to_float: t -> float = "ml_z_to_float" (** Converts to a floating-point value. This function is designed explicitly for the case where the FPU rounds towards +oo, in which case the resulting float always over-approximates the argument. It is not guaranteed to be the least over-approximation though. In the (default) case where the FPU does not round towards +oo, it is only guaranteed that the result approximates the argument (but it may not be the nearest float). *) val to_string: t -> string (** Gives a human-readable, decimal string representation of the argument. *) external format: string -> t -> string = "ml_z_format" (** Gives a string representation of the argument in the specified printf-like format. The general specification has the following form: [% \[flags\] \[width\] type] Where the type actually indicates the base: - [i], [d], [u]: decimal - [b]: binary - [o]: octal - [x]: lowercase hexadecimal - [X]: uppercase hexadecimal Supported flags are: - [+]: prefix positive numbers with a [+] sign - space: prefix positive numbers with a space - [-]: left-justify (default is right justification) - [0]: pad with zeroes (instead of spaces) - [#]: alternate formatting (actually, simply output a literal-like prefix: [0x], [0b], [0o]) Unlike the classic [printf], all numbers are signed (even hexadecimal ones), there is no precision field, and characters that are not part of the format are simply ignored (and not copied in the output). *) external fits_int: t -> bool = "ml_z_fits_int" "noalloc" (** Whether the argument fits in a regular [int]. *) external fits_int32: t -> bool = "ml_z_fits_int32" "noalloc" (** Whether the argument fits in an [int32]. *) external fits_int64: t -> bool = "ml_z_fits_int64" "noalloc" (** Whether the argument fits in an [int64]. *) external fits_nativeint: t -> bool = "ml_z_fits_nativeint" "noalloc" (** Whether the argument fits in a [nativeint]. *) (** {1 Printing} *) val print: t -> unit (** Prints the argument on the standard output. *) val output: out_channel -> t -> unit (** Prints the argument on the specified channel. Also intended to be used as [%a] format printer in [Printf.printf]. *) val sprint: unit -> t -> string (** To be used as [%a] format printer in [Printf.sprintf]. *) val bprint: Buffer.t -> t -> unit (** To be used as [%a] format printer in [Printf.bprintf]. *) val pp_print: Format.formatter -> t -> unit (** Prints the argument on the specified formatter. Can be used as [%a] format printer in [Format.printf] and as argument to [#install_printer] in the top-level. *) (** {1 Ordering} *) external compare: t -> t -> int = "ml_z_compare" "noalloc" (** Comparison. [compare x y] returns 0 if [x] equals [y], -1 if [x] is smaller than [y], and 1 if [x] is greater than [y]. Note that Pervasive.compare can be used to compare reliably two integers only on OCaml 3.12.1 and later versions. *) external equal: t -> t -> bool = "ml_z_equal" "noalloc" (** Equality test. *) val leq: t -> t -> bool (** Less than or equal. *) val geq: t -> t -> bool (** Greater than or equal. *) val lt: t -> t -> bool (** Less than (and not equal). *) val gt: t -> t -> bool (** Greater than (and not equal). *) external sign: t -> int = "ml_z_sign" "noalloc" (** Returns -1, 0, or 1 when the argument is respectively negative, null, or positive. *) val min: t -> t -> t (** Returns the minimum of its arguments. *) val max: t -> t -> t (** Returns the maximum of its arguments. *) val hash: t -> int (** Hashes a number. This functions gives the same result as OCaml's polymorphic hashing function. The result is consistent with equality: if [a] = [b], then [hash a] = [hash b]. *) (** {1 Elementary number theory} *) external gcd: t -> t -> t = "ml_z_gcd" (** Greatest common divisor. The result is always positive. Raises a [Division_by_zero] is either argument is null. *) val gcdext: t -> t -> (t * t * t) (** [gcd_ext u v] returns [(g,s,t)] where [g] is the greatest common divisor and [g=us+vt]. [g] is always positive. Raises a [Division_by_zero] is either argument is null. *) val lcm: t -> t -> t (** Least common multiple. The result is always positive. Raises a [Division_by_zero] is either argument is null. *) external powm: t -> t -> t -> t = "ml_z_powm" (** [powm base exp mod] computes [base]^[exp] modulo [mod]. Negative [exp] are supported, in which case ([base]^-1)^(-[exp]) modulo [mod] is computed. However, if [exp] is negative but [base] has no inverse modulo [mod], then a [Division_by_zero] is raised. *) external invert: t -> t -> t = "ml_z_invert" (** [invert base mod] returns the inverse of [base] modulo [mod]. Raises a [Division_by_zero] if [base] is not invertible modulo [mod]. *) external probab_prime: t -> int -> int = "ml_z_probab_prime" (** [probab_prime x r] returns 0 if [x] is definitely composite, 1 if [x] is probably prime, and 2 if [x] is definitely prime. The [r] argument controls how many Miller-Rabin probabilistic primality tests are performed (5 to 10 is a reasonable value). *) external nextprime: t -> t = "ml_z_nextprime" (** Returns the next prime greater than the argument. The result is only prime with very high probability. *) (** {1 Powers} *) external pow: t -> int -> t = "ml_z_pow" (** [pow base exp] raises [base] to the [exp] power. [exp] must be non-negative. Note that only exponents fitting in a machine integer are supported, as larger exponents would surely make the result's size overflow the address space. *) external sqrt: t -> t = "ml_z_sqrt" (** Returns the square root. The result is truncated. Raises an [Invalid_argument] on negative arguments. *) external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem" (** Returns the square root truncated, and the remainder. Raises an [Invalid_argument] on negative arguments. *) external root: t -> int -> t = "ml_z_root" (** [root base n] computes the [n]-th root of [exp]. [n] must be non-negative. *) external perfect_power: t -> bool = "ml_z_perfect_power" (** True if the argument has the form [a^b], with [b>1] *) external perfect_square: t -> bool = "ml_z_perfect_square" (** True if the argument has the form [a^2]. *) (** {1 Representation} *) external size: t -> int = "ml_z_size" "noalloc" (** Returns the number of machine words used to represent the number. *) external extract: t -> int -> int -> t = "ml_z_extract" (** [extract a off len] returns a non-negative number corresponding to bits [off] to [off]+[len]-1 of [b]. Negative [a] are considered in infinite-length 2's complement representation. *) val signed_extract: t -> int -> int -> t (** [signed_extract a off len] extracts bits [off] to [off]+[len]-1 of [b], as [extract] does, then sign-extends bit [len-1] of the result (that is, bit [off + len - 1] of [a]). The result is between [- 2{^[len]-1}] (included) and [2{^[len]-1}] excluded, and equal to [extract a off len] modulo [2{^len}]. *) external to_bits: t -> string = "ml_z_to_bits" (** Returns a binary representation of the argument. The string result should be interpreted as a sequence of bytes, corresponding to the binary representation of the absolute value of the argument in little endian ordering. The sign is not stored in the string. *) external of_bits: string -> t = "ml_z_of_bits" (** Constructs a number from a binary string representation. The string is interpreted as a sequence of bytes in little endian order, and the result is always positive. We have the identity: [of_bits (to_bits x) = abs x]. However, we can have [to_bits (of_bits s) <> s] due to the presence of trailing zeros in s. *) (** {1 Prefix and infix operators} *) (** Classic (and less classic) prefix and infix [int] operators are redefined on [t]. This makes it easy to typeset expressions. Using OCaml 3.12's local open, you can simply write [Z.(~$2 + ~$5 * ~$10)]. *) external (~-): t -> t = neg@ASM (** Negation [neg]. *) external (~+): t -> t = "%identity" (** Identity. *) external (+): t -> t -> t = add@ASM (** Addition [add]. *) external (-): t -> t -> t = sub@ASM (** Subtraction [sub]. *) external ( * ): t -> t -> t = mul@ASM (** Multiplication [mul]. *) external (/): t -> t -> t = div@ASM (** Truncated division [div]. *) external (/>): t -> t -> t = "ml_z_cdiv" (** Ceiling division [cdiv]. *) external (/<): t -> t -> t = "ml_z_fdiv" (** Flooring division [fdiv]. *) external (/|): t -> t -> t = "ml_z_divexact" (** Exact division [div_exact]. *) external (mod): t -> t -> t = rem@ASM (** Remainder [rem]. *) external (land): t -> t -> t = logand@ASM (** Bit-wise logical and [logand]. *) external (lor): t -> t -> t = logor@ASM (** Bit-wise logical inclusive or [logor]. *) external (lxor): t -> t -> t = logxor@ASM (** Bit-wise logical exclusive or [logxor]. *) external (~!): t -> t = lognot@ASM (** Bit-wise logical negation [lognot]. *) external (lsl): t -> int -> t = shift_left@ASM (** Bit-wise shift to the left [shift_left]. *) external (asr): t -> int -> t = shift_right@ASM (** Bit-wise shift to the right [shift_right]. *) external (~$): int -> t = "%identity" (** Conversion from [int] [of_int]. *) external ( ** ): t -> int -> t = "ml_z_pow" (** Power [pow]. *) (** {1 Miscellaneous} *) val version: string (** Library version (this file refers to version [@VERSION]). *) zarith-1.2.1/README0000644000175000017540000001003612156017667012355 0ustar minemineOVERVIEW: This library implements arithmetic and logical operations over arbitrary-precision integers. The module is simply named "Z". Its interface is similar to that of the Int32, Int64 and Nativeint modules from the OCaml standard library, with some additional functions. See the file z.mlip for documentation. The implementation uses GMP (the GNU Multiple Precision arithmetic library) to compute over big integers. However, small integers are represented as unboxed Caml integers, to save space and improve performance. Big integers are allocated in the Caml heap, bypassing GMP's memory management and achieving better GC behavior than e.g. the MLGMP library. Computations on small integers use a special, faster path (coded in assembly for some platforms and functions) eschewing calls to GMP, while computations on large intergers use the low-level MPN functions from GMP. Arbitrary-precision integers can be compared correctly using OCaml's polymorphic comparison operators (=, <, >, etc.). This requires OCaml version 3.12.1 or later, though. Additional features include: - a module Q for rationals, built on top of Z (see q.mli) - a compatibility layer Big_int_Z that implements the same API as Big_int, but uses Z internally REQUIREMENTS: - OCaml, preferably version 3.12.1 or later. (Earlier versions are usable but generic comparisons will misbehave.) - Either the GMP library or the MPIR library, including development files. - The GNU C compiler (gcc) and assembler. - The Perl programming language. - (optional) The Findlib package manager. INSTALLATION: 1) First, run the "configure" script by typing: ./configure 2) It creates a Makefile, which can be invoked by: make This builds native and bytecode versions of the library. 3) The libraries are installed by typing: make install or, if you install to a system location but are not an administrator sudo make install If Findlib is detected, it is used to install files. Otherwise, the files are copied to a zarith subdirectory of the directory given by `ocamlc -where`. The libraries are named "zarith.cmxa" and "zarith.cma", and the Findlib module is named "zarith". Compiling and linking with the library requires passing the "-I +zarith" option to ocamlc / ocamlopt. The "configure" script has a few options. Use the "-help" option to get a list and short description of each option. 4) (optional) HTML API documentation is built (using ocamldoc) by the additional command make doc Test programs are built by the additional command make tests (but these are not installed). LICENSE: This Library is distributed under the terms of the GNU Library General Public License version 2, with a special exception allowing unconstrained static linking. See LICENSE file for details. AUTHORS: Antoine Miné, ENS Paris. Xavier Leroy, INRIA Paris-Rocquencourt. Pascal Cuoq, CEA LIST. COPYRIGHT: Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). CONTENTS: The source files are: * configure - configuration script * caml_z.c - C implementation of all functions * caml_z_*.S - asm implementation for a few functions * z_pp.pl - script to generate z.ml[i] from z.ml[i]p * z.ml[i]p - templates used to generate z.ml[i]p * big_int_z.ml[i] - wrapper to provide a Big_int compatible API to Z * q.ml[i] - rational library, pure OCaml on top of Z * test.ml - simple test * bitest.ml - consistency test between Z and Big_int * projet.mak - builds Z, Q and the tests Note: z_pp.pl simply scans the asm file (if any) to see which functions have an asm implementation. It then fixes the external statements in .mlp and .mlip accordingly. The argument to z_pp.pl is the suffix * of the caml_z_*.S to use (guessed by configure). zarith-1.2.1/META0000644000175000017540000000021212156017667012141 0ustar mineminedescription = "Arbitrary precision integers" requires = "" version = "1.2.1" archive(byte) = "zarith.cma" archive(native) = "zarith.cmxa" zarith-1.2.1/q.mli0000644000175000017540000001475412156017667012453 0ustar minemine(** Rationals. This modules builds arbitrary precision rationals on top of arbitrary integers from module Z. This file is part of the Zarith library http://forge.ocamlcore.org/projects/zarith . It is distributed under LGPL 2 licensing, with static linking exception. See the LICENSE file included in the distribution. Copyright (c) 2010-2011 Antoine Miné, Abstraction project. Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), a joint laboratory by: CNRS (Centre national de la recherche scientifique, France), ENS (École normale supérieure, Paris, France), INRIA Rocquencourt (Institut national de recherche en informatique, France). *) (** {1 Types} *) type t = { num: Z.t; (** Numerator. *) den: Z.t; (** Denominator, >= 0 *) } (** A rational is represented as a pair numerator/denominator, reduced to have a non-negative denominator and no common factor. This form is canonical (enabling polymorphic equality and hashing). The representation allows three special numbers: [inf] (1/0), [-inf] (-1/0) and [undef] (0/0). *) (** {1 Construction} *) val make: Z.t -> Z.t -> t (** [make num den] constructs a new rational equal to [num]/[den]. It takes care of putting the rational in canonical form. *) val zero: t val one: t val minus_one:t (** 0, 1, -1. *) val inf: t (** 1/0. *) val minus_inf: t (** -1/0. *) val undef: t (** 0/0. *) val of_bigint: Z.t -> t val of_int: int -> t val of_int32: int32 -> t val of_int64: int64 -> t val of_nativeint: nativeint -> t (** Conversions from various integer types. *) val of_ints: int -> int -> t (** Conversion from an [int] numerator and an [int] denominator. *) val of_float: float -> t (** Conversion from a [float]. The conversion is exact, and maps NaN to [undef]. *) val of_string: string -> t (** Converts a string to a rational. Plain decimals, and [/] separated decimal ratios (with optional sign) are understood. Additionally, the special [inf], [-inf], and [undef] are recognized (they can also be typeset respectively as [1/0], [-1/0], [0/0]). *) (** {1 Inspection} *) val num: t -> Z.t (** Get the numerator. *) val den: t -> Z.t (** Get the denominator. *) (** {1 Testing} *) type kind = | ZERO (** 0 *) | INF (** infinity, i.e. 1/0 *) | MINF (** minus infinity, i.e. -1/0 *) | UNDEF (** undefined, i.e., 0/0 *) | NZERO (** well-defined, non-infinity, non-zero number *) (** Rationals can be categorized into different kinds, depending mainly on whether the numerator and/or denominator is null. *) val classify: t -> kind (** Determines the kind of a rational. *) val is_real: t -> bool (** Whether the argument is non-infinity and non-undefined. *) val sign: t -> int (** Returns 1 if the argument is positive (including inf), -1 if it is negative (including -inf), and 0 if it is null or undefined. *) val compare: t -> t -> int (** [compare x y] compares [x] to [y] and returns 1 if [x] is strictly greater that [y], -1 if it is strictly smaller, and 0 if they are equal. This is a total ordering. Infinities are ordered in the natural way, while undefined is considered the smallest of all: undef = undef < -inf <= -inf < x < inf <= inf. This is consistent with OCaml's handling of floating-point infinities and NaN. OCaml's polymorphic comparison will NOT return a result consistent with the ordering of rationals. *) val equal: t -> t -> bool (** Equality testing. This is consistent with [compare]; in particular, [undef]=[undef]. *) val min: t -> t -> t (** Returns the smallest of its arguments. *) val max: t -> t -> t (** Returns the largest of its arguments. *) val leq: t -> t -> bool (** Less than or equal. *) val geq: t -> t -> bool (** Greater than or equal. *) val lt: t -> t -> bool (** Less than (not equal). *) val gt: t -> t -> bool (** Greater than (not equal). *) (** {1 Conversions} *) val to_bigint: t -> Z.t val to_int: t -> int val to_int32: t -> int32 val to_int64: t -> int64 val to_nativeint: t -> nativeint (** Convert to integer by truncation. Raises a [Divide_by_zero] if the argument is an infinity or undefined. Raises a [Z.Overflow] if the result does not fit in the destination type. *) val to_string: t -> string (** Converts to human-readable, decimal, [/]-separated rational. *) (** {1 Arithmetic operations} *) (** In all operations, the result is [undef] if one argument is [undef]. Other operations can return [undef]: such as [inf]-[inf], [inf]*0, 0/0. *) val neg: t -> t (** Negation. *) val abs: t -> t (** Absolute value. *) val add: t -> t -> t (** Addition. *) val sub: t -> t -> t (** Subtraction. We have [sub x y] = [add x (neg y)]. *) val mul: t -> t -> t (** Multiplication. *) val inv: t -> t (** Inverse. Note that [inv 0] is defined, and equals [inf]. *) val div: t -> t -> t (** Division. We have [div x y] = [mul x (inv y)], and [inv x] = [div one x]. *) val mul_2exp: t -> int -> t (** [mul_2exp x n] multiplies [x] by 2 to the power of [n]. *) val div_2exp: t -> int -> t (** [div_2exp x n] divides [x] by 2 to the power of [n]. *) (** {1 Printing} *) val print: t -> unit (** Prints the argument on the standard output. *) val output: out_channel -> t -> unit (** Prints the argument on the specified channel. Also intended to be used as [%a] format printer in [Printf.printf]. *) val sprint: unit -> t -> string (** To be used as [%a] format printer in [Printf.sprintf]. *) val bprint: Buffer.t -> t -> unit (** To be used as [%a] format printer in [Printf.bprintf]. *) val pp_print: Format.formatter -> t -> unit (** Prints the argument on the specified formatter. Also intended to be used as [%a] format printer in [Format.printf]. *) (** {1 Prefix and infix operators} *) (** Classic prefix and infix [int] operators are redefined on [t]. *) val (~-): t -> t (** Negation [neg]. *) val (~+): t -> t (** Identity. *) val (+): t -> t -> t (** Addition [add]. *) val (-): t -> t -> t (** Subtraction [sub]. *) val ( * ): t -> t -> t (** Multiplication [mul]. *) val (/): t -> t -> t (** Division [div]. *) val (lsl): t -> int -> t (** Multiplication by a power of two [mul_2exp]. *) val (asr): t -> int -> t (** Division by a power of two [shift_right]. *) val (~$): int -> t (** Conversion from [int]. *) val (//): int -> int -> t (** Creates a rational from two [int]s. *) val (~$$): Z.t -> t (** Conversion from [Z.t]. *) val (///): Z.t -> Z.t -> t (** Creates a rational from two [Z.t]. *) zarith-1.2.1/LICENSE0000644000175000017540000006343212156017667012512 0ustar minemineThis Library is distributed under the terms of the GNU Library General Public License version 2 (included below). As a special exception to the GNU Library General Public License, you may link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by INRIA, or a modified version of the Library that is distributed under the conditions defined in clause 3 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. ---------------------------------------------------------------------- GNU LIBRARY GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the library GPL. It is numbered 2 because it goes with version 2 of the ordinary GPL.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Library General Public License, applies to some specially designated Free Software Foundation software, and to any other libraries whose authors decide to use it. You can use it for your libraries, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library, or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link a program with the library, you must provide complete object files to the recipients so that they can relink them with the library, after making changes to the library and recompiling it. And you must show them these terms so they know their rights. Our method of protecting your rights has two steps: (1) copyright the library, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the library. Also, for each distributor's protection, we want to make certain that everyone understands that there is no warranty for this free library. If the library is modified by someone else and passed on, we want its recipients to know that what they have is not the original version, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that companies distributing free software will individually obtain patent licenses, thus in effect transforming the program into proprietary software. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License, which was designed for utility programs. This license, the GNU Library General Public License, applies to certain designated libraries. This license is quite different from the ordinary one; be sure to read it in full, and don't assume that anything in it is the same as in the ordinary license. The reason we have a separate public license for some libraries is that they blur the distinction we usually make between modifying or adding to a program and simply using it. Linking a program with a library, without changing the library, is in some sense simply using the library, and is analogous to running a utility program or application program. However, in a textual and legal sense, the linked executable is a combined work, a derivative of the original library, and the ordinary General Public License treats it as such. Because of this blurred distinction, using the ordinary General Public License for libraries did not effectively promote software sharing, because most developers did not use the libraries. We concluded that weaker conditions might promote sharing better. However, unrestricted linking of non-free programs would deprive the users of those programs of all benefit from the free status of the libraries themselves. This Library General Public License is intended to permit developers of non-free programs to use free libraries, while preserving your freedom as a user of such programs to change the free libraries that are incorporated in them. (We have not seen how to achieve this as regards changes in header files, but we have achieved it as regards changes in the actual functions of the Library.) The hope is that this will lead to faster development of free libraries. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, while the latter only works together with the library. Note that it is possible for a library to be covered by the ordinary General Public License rather than by this special one. GNU LIBRARY GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Library General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also compile or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. c) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. d) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Library General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. 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 Library General Public License for more details. You should have received a copy of the GNU Library 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 Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it!