diff options
55 files changed, 20340 insertions, 0 deletions
diff --git a/otherlibs/num/Makefile b/otherlibs/num/Makefile new file mode 100644 index 000000000..eaa3270cc --- /dev/null +++ b/otherlibs/num/Makefile @@ -0,0 +1,75 @@ +# Makefile for the "num" (exact rational arithmetic) library + +include ../../Makefile.config + +# Compilation options +CC=$(BYTECC) +CFLAGS=-O -I./bignum/h -I../../byterun $(BYTECCCOMPOPTS) +CAMLC=../../boot/cslrun ../../boot/cslc -I ../../boot +CAMLOPT=../../boot/cslrun ../../cslopt -I ../../stdlib + +CAMLOBJS=int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo \ + ratio.cmo num.cmo arith_status.cmo + +CAMLINTF=big_int.cmi nat.cmi num.cmi ratio.cmi arith_status.cmi + +COBJS=nat_stubs.o + +all: libnums.a nums.cma $(CMIFILES) + +allopt: libnums.a nums.cmxa $(CMIFILES) + +nums.cma: $(CAMLOBJS) + $(CAMLC) -a -o nums.cma $(CAMLOBJS) + +nums.cmxa: $(CAMLOBJS:.cmo=.cmx) + $(CAMLOPT) -a -o nums.cmxa $(CAMLOBJS:.cmo=.cmx) + +libnums.a: bignum/libbignum.a $(COBJS) + cp bignum/libbignum.a libnums.a + ar r libnums.a $(COBJS) + $(RANLIB) libnums.a + +bignum/libbignum.a: + cd bignum; make $(BIGNUM_ARCH) CC="$(CC)" + +install: + cp libnums.a $(LIBDIR)/libnums.a + cd $(LIBDIR); $(RANLIB) libnums.a + cp nums.cma $(CMIFILES) $(LIBDIR) + +installopt: + cp nums.cmxa nums.a $(LIBDIR) + cd $(LIBDIR); $(RANLIB) nums.a + +clean: + rm -f *.a *.o *.cm* + rm -f nat.ml int_misc.ml + cd bignum; make scratch + cd test; make clean + +.SUFFIXES: .ml .mli .mlp .cmi .cmo .cmx + +.mli.cmi: + $(CAMLC) -c $(COMPFLAGS) $< + +.ml.cmo: + $(CAMLC) -c $(COMPFLAGS) $< + +.ml.cmx: + $(CAMLOPT) -c $(COMPFLAGS) $< + +.mlp.ml: + @rm -f $@ + $(CPP) $< > $@ + @chmod a-w $@ + +int_misc.ml: int_misc.mlp +nat.ml: nat.mlp +nat_stubs.o: nat.h + +depend: nat.ml int_misc.ml + gcc -MM $(CFLAGS) *.c > .depend + ../../tools/csldep *.mli *.ml >> .depend + +include .depend diff --git a/otherlibs/num/README b/otherlibs/num/README new file mode 100644 index 000000000..e7f432591 --- /dev/null +++ b/otherlibs/num/README @@ -0,0 +1,64 @@ +The "libnum" library implements exact-precision rational arithmetic. +It is built upon the state-of-the-art BigNum arbitrary-precision +integer arithmetic package, and therefore achieves very high +performance (it's faster than Maple, for instance). + +This library is derived from Valerie Menissie-Morain's implementation +of rational arithmetic for Caml V3.1 (INRIA), and builds on the BigNum +package developed by Bernard Serpette, Jean Vuillemin and Jean-Claude +Herve (INRIA and Digital PRL). Xavier Leroy (INRIA) did the Caml Light +port. Victor Manuel Gulias Fernandez did the Caml Special Light port. + +This library is documented in "The CAML Numbers Reference Manual" by +Valerie Menissier-Morain, technical report 141, INRIA, july 1992, +available by anonymous FTP from ftp.inria.fr, directory +INRIA/publications/RT, file RT-0141.ps.Z. + +USAGE: + +To use the bignum library from your programs, just do + + cslc -custom <other options> nums.cma <other .cmo and .ml files> -lnums + +for the linking phase. + +If you'd like to have the bignum functions available at toplevel, do + + cslmktop -o csltopnum -custom <other options> nums.cma <other .cmo and .ml files> -lnums + ./csltopnum + +As an example, try: + + open Num;; + let rec fact n = + if n = 0 then Int 1 else mult_num (num_of_int n) (fact(n-1));; + string_of_num(fact 1000);; + +KNOWN TARGET ARCHITECTURES: + + C portable C version (default) + sparc Sparc V8 assembly code, SunOS 4.1 + sparc-solaris Sparc V8 assembly code, Solaris 2 + supersparc Sparc V9 assembly code, SunOS 4.1 + supersparc-solaris Sparc V9 assembly code, Solaris 2 + mips MIPS R2000, R3000, R4000 assembly code + alpha DEC Alpha (21064) assembly code + 68K Motorola 68020 assembly code + vax DEC VAX assembly code + i960 Intel 80960A assembly code + ns National Semiconductors 32032 assembly code + pyramid Pyramid minicomputers assembly code + +LEGAL NOTICE: + +This work uses the BigNum package developed jointly by INRIA and Digital PRL. + +The code in the bignum/ subdirectory is copyright INRIA and Digital, +and may be reproduced and distributed freely to non commercial usage +according to the conditions stated in the documentation of this package +(directory bignum/doc). + +KNOWN PROBLEMS: + +64-bit architectures are not yet fully supported. The test suite passes on +a Dec Alpha, but some bugs remain. diff --git a/otherlibs/num/arith_flags.ml b/otherlibs/num/arith_flags.ml new file mode 100644 index 000000000..e9d9fb035 --- /dev/null +++ b/otherlibs/num/arith_flags.ml @@ -0,0 +1,23 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +let error_when_null_denominator_flag = ref true;; + +let normalize_ratio_flag = ref false;; + +let normalize_ratio_when_printing_flag = ref true;; + +let floating_precision = ref 12;; + +let approx_printing_flag = ref false;; + diff --git a/otherlibs/num/arith_flags.mli b/otherlibs/num/arith_flags.mli new file mode 100644 index 000000000..948a8438e --- /dev/null +++ b/otherlibs/num/arith_flags.mli @@ -0,0 +1,18 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +val error_when_null_denominator_flag : bool ref +val normalize_ratio_flag : bool ref +val normalize_ratio_when_printing_flag : bool ref +val floating_precision : int ref +val approx_printing_flag : bool ref;; diff --git a/otherlibs/num/arith_status.ml b/otherlibs/num/arith_status.ml new file mode 100644 index 000000000..e98e3f82c --- /dev/null +++ b/otherlibs/num/arith_status.ml @@ -0,0 +1,98 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +open Arith_flags;; + +let get_error_when_null_denominator () = + !error_when_null_denominator_flag +and set_error_when_null_denominator choice = + error_when_null_denominator_flag := choice;; + +let get_normalize_ratio () = !normalize_ratio_flag +and set_normalize_ratio choice = normalize_ratio_flag := choice;; + +let get_normalize_ratio_when_printing () = + !normalize_ratio_when_printing_flag +and set_normalize_ratio_when_printing choice = + normalize_ratio_when_printing_flag := choice;; + +let get_floating_precision () = !floating_precision +and set_floating_precision i = floating_precision := i;; + +let get_approx_printing () = !approx_printing_flag +and set_approx_printing b = approx_printing_flag := b;; + +let arith_print_string s = print_string s; print_string " --> ";; + +let arith_print_bool = function + true -> print_string "ON" +| _ -> print_string "OFF" +;; + +let arith_status () = + print_newline (); + + arith_print_string + "Normalization during computation"; + arith_print_bool (get_normalize_ratio ()); + print_newline (); + print_string " (returned by get_normalize_ratio ())"; + print_newline (); + print_string " (modifiable with set_normalize_ratio <your choice>)"; + print_newline (); + print_newline (); + + arith_print_string + "Normalization when printing"; + arith_print_bool (get_normalize_ratio_when_printing ()); + print_newline (); + print_string + " (returned by get_normalize_ratio_when_printing ())"; + print_newline (); + print_string + " (modifiable with set_normalize_ratio_when_printing <your choice>)"; + print_newline (); + print_newline (); + + arith_print_string + "Floating point approximation when printing rational numbers"; + arith_print_bool (get_approx_printing ()); + print_newline (); + print_string + " (returned by get_approx_printing ())"; + print_newline (); + print_string + " (modifiable with set_approx_printing <your choice>)"; + print_newline (); + (if (get_approx_printing ()) + then (print_string " Default precision = "; + print_int (get_floating_precision ()); + print_newline (); + print_string " (returned by get_floating_precision ())"; + print_newline (); + print_string + " (modifiable with set_floating_precision <your choice>)"; + print_newline (); + print_newline ()) + else print_newline()); + + arith_print_string + "Error when a rational denominator is null"; + arith_print_bool (get_error_when_null_denominator ()); + print_newline (); + print_string " (returned by get_error_when_null_denominator ())"; + print_newline (); + print_string + " (modifiable with set_error_when_null_denominator <your choice>)"; + print_newline () +;; diff --git a/otherlibs/num/arith_status.mli b/otherlibs/num/arith_status.mli new file mode 100644 index 000000000..c0b7f878f --- /dev/null +++ b/otherlibs/num/arith_status.mli @@ -0,0 +1,49 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Arith_status]: flags that control rational arithmetic *) + +val arith_status: unit -> unit;; + (* Print the current status of the arithmetic flags. *) + +val get_error_when_null_denominator : unit -> bool +val set_error_when_null_denominator : bool -> unit + (* Get or set the flag [null_denominator]. When on, attempting to + create a rational with a null denominator raises an exception. + When off, rationals with null denominators are accepted. + Initially: on. *) +val get_normalize_ratio : unit -> bool +val set_normalize_ratio : bool -> unit + (* Get or set the flag [normalize_ratio]. When on, rational + numbers are normalized after each operation. When off, + rational numbers are not normalized until printed. + Initially: off. *) +val get_normalize_ratio_when_printing : unit -> bool +val set_normalize_ratio_when_printing : bool -> unit + (* Get or set the flag [normalize_ratio_when_printing]. + When on, rational numbers are normalized before being printed. + When off, rational numbers are printed as is, without normalization. + Initially: on. *) +val get_approx_printing : unit -> bool +val set_approx_printing : bool -> unit + (* Get or set the flag [approx_printing]. + When on, rational numbers are printed as a decimal approximation. + When off, rational numbers are printed as a fraction. + Initially: off. *) +val get_floating_precision : unit -> int +val set_floating_precision : int -> unit + (* Get or set the parameter [floating_precision]. + This parameter is the number of digits displayed when + [approx_printing] is on. + Initially: 12. *) +;; diff --git a/otherlibs/num/big_int.ml b/otherlibs/num/big_int.ml new file mode 100644 index 000000000..81ff44278 --- /dev/null +++ b/otherlibs/num/big_int.ml @@ -0,0 +1,594 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +open Int_misc +open Nat + +type big_int = + { sign : int; + abs_value : nat } + +let create_big_int sign nat = + if sign = 1 or sign = -1 or + (sign = 0 & + is_zero_nat nat 0 (num_digits_nat nat 0 (length_nat nat))) + then { sign = sign; + abs_value = nat } + else invalid_arg "create_big_int" + +(* Sign of a big_int *) +let sign_big_int bi = bi.sign + +let zero_big_int = + { sign = 0; + abs_value = make_nat 1 } + +let unit_big_int = + { sign = 1; + abs_value = nat_of_int 1 } + +(* Number of digits in a big_int *) +let num_digits_big_int bi = + num_digits_nat (bi.abs_value) 0 (length_nat bi.abs_value) + +(* Opposite of a big_int *) +let minus_big_int bi = + { sign = - bi.sign; + abs_value = copy_nat (bi.abs_value) 0 (num_digits_big_int bi)} + +(* Absolute value of a big_int *) +let abs_big_int bi = + { sign = if bi.sign = 0 then 0 else 1; + abs_value = copy_nat (bi.abs_value) 0 (num_digits_big_int bi)} + +(* Comparison operators on big_int *) + +(* + compare_big_int (bi, bi2) = sign of (bi-bi2) + i.e. 1 if bi > bi2 + 0 if bi = bi2 + -1 if bi < bi2 +*) +let compare_big_int bi1 bi2 = + if bi1.sign = 0 & bi2.sign = 0 then 0 + else if bi1.sign < bi2.sign then -1 + else if bi1.sign > bi2.sign then 1 + else if bi1.sign = 1 then + compare_nat (bi1.abs_value) 0 (num_digits_big_int bi1) + (bi2.abs_value) 0 (num_digits_big_int bi2) + else + compare_nat (bi2.abs_value) 0 (num_digits_big_int bi2) + (bi1.abs_value) 0 (num_digits_big_int bi1) + +let eq_big_int bi1 bi2 = compare_big_int bi1 bi2 = 0 +and le_big_int bi1 bi2 = compare_big_int bi1 bi2 <= 0 +and ge_big_int bi1 bi2 = compare_big_int bi1 bi2 >= 0 +and lt_big_int bi1 bi2 = compare_big_int bi1 bi2 < 0 +and gt_big_int bi1 bi2 = compare_big_int bi1 bi2 > 0 + +let max_big_int bi1 bi2 = if lt_big_int bi1 bi2 then bi2 else bi1 +and min_big_int bi1 bi2 = if gt_big_int bi1 bi2 then bi2 else bi1 + +(* Operations on big_int *) + +let pred_big_int bi = + match bi.sign with + 0 -> { sign = -1; abs_value = nat_of_int 1} + | 1 -> let size_bi = num_digits_big_int bi in + let copy_bi = copy_nat (bi.abs_value) 0 size_bi in + decr_nat copy_bi 0 size_bi 0; + { sign = if is_zero_nat copy_bi 0 size_bi then 0 else 1; + abs_value = copy_bi } + | _ -> let size_bi = num_digits_big_int bi in + let size_res = succ (size_bi) in + let copy_bi = create_nat (size_res) in + blit_nat copy_bi 0 (bi.abs_value) 0 size_bi; + set_digit_nat copy_bi size_bi 0; + incr_nat copy_bi 0 size_res 1; + { sign = -1; + abs_value = copy_bi } + +let succ_big_int bi = + match bi.sign with + 0 -> {sign = 1; abs_value = nat_of_int 1} + | -1 -> let size_bi = num_digits_big_int bi in + let copy_bi = copy_nat (bi.abs_value) 0 size_bi in + decr_nat copy_bi 0 size_bi 0; + { sign = if is_zero_nat copy_bi 0 size_bi then 0 else -1; + abs_value = copy_bi } + | _ -> let size_bi = num_digits_big_int bi in + let size_res = succ (size_bi) in + let copy_bi = create_nat (size_res) in + blit_nat copy_bi 0 (bi.abs_value) 0 size_bi; + set_digit_nat copy_bi size_bi 0; + incr_nat copy_bi 0 size_res 1; + { sign = 1; + abs_value = copy_bi } + +let add_big_int bi1 bi2 = + let size_bi1 = num_digits_big_int bi1 + and size_bi2 = num_digits_big_int bi2 in + if bi1.sign = bi2.sign + then (* Add absolute values if signs are the same *) + { sign = bi1.sign; + abs_value = + match compare_nat (bi1.abs_value) 0 size_bi1 + (bi2.abs_value) 0 size_bi2 with + -1 -> let res = create_nat (succ size_bi2) in + (blit_nat res 0 (bi2.abs_value) 0 size_bi2; + set_digit_nat res size_bi2 0; + add_nat res 0 (succ size_bi2) + (bi1.abs_value) 0 size_bi1 0; + res) + |_ -> let res = create_nat (succ size_bi1) in + (blit_nat res 0 (bi1.abs_value) 0 size_bi1; + set_digit_nat res size_bi1 0; + add_nat res 0 (succ size_bi1) + (bi2.abs_value) 0 size_bi2 0; + res)} + + else (* Subtract absolute values if signs are different *) + match compare_nat (bi1.abs_value) 0 size_bi1 + (bi2.abs_value) 0 size_bi2 with + 0 -> zero_big_int + | 1 -> { sign = bi1.sign; + abs_value = + let res = copy_nat (bi1.abs_value) 0 size_bi1 in + (sub_nat res 0 size_bi1 + (bi2.abs_value) 0 size_bi2 1; + res) } + | _ -> { sign = bi2.sign; + abs_value = + let res = copy_nat (bi2.abs_value) 0 size_bi2 in + (sub_nat res 0 size_bi2 + (bi1.abs_value) 0 size_bi1 1; + res) } + +(* Coercion with int type *) +let big_int_of_int i = + { sign = sign_int i; + abs_value = + let res = (create_nat 1) + in (if i = monster_int + then (set_digit_nat res 0 biggest_int; + incr_nat res 0 1 1; ()) + else set_digit_nat res 0 (abs i)); + res } + +let add_int_big_int i bi = add_big_int (big_int_of_int i) bi + +let sub_big_int bi1 bi2 = add_big_int bi1 (minus_big_int bi2) + +(* Returns i * bi *) +let mult_int_big_int i bi = + let size_bi = num_digits_big_int bi in + let size_res = succ size_bi in + if i = monster_int + then let res = create_nat size_res in + blit_nat res 0 (bi.abs_value) 0 size_bi; + mult_digit_nat res 0 size_res (bi.abs_value) 0 size_bi + (nat_of_int biggest_int) 0; + { sign = - (sign_big_int bi); + abs_value = res } + else let res = make_nat (size_res) in + mult_digit_nat res 0 size_res (bi.abs_value) 0 size_bi + (nat_of_int (abs i)) 0; + { sign = (sign_int i) * (sign_big_int bi); + abs_value = res } + +let mult_big_int bi1 bi2 = + let size_bi1 = num_digits_big_int bi1 + and size_bi2 = num_digits_big_int bi2 in + let size_res = size_bi1 + size_bi2 in + let res = make_nat (size_res) in + { sign = bi1.sign * bi2.sign; + abs_value = + if size_bi2 > size_bi1 + then (mult_nat res 0 size_res (bi2.abs_value) 0 size_bi2 + (bi1.abs_value) 0 size_bi1;res) + else (mult_nat res 0 size_res (bi1.abs_value) 0 size_bi1 + (bi2.abs_value) 0 size_bi2;res) } + +(* (quotient, rest) of the euclidian division of 2 big_int *) +let quomod_big_int bi1 bi2 = + if bi2.sign = 0 then raise Division_by_zero + else + let size_bi1 = num_digits_big_int bi1 + and size_bi2 = num_digits_big_int bi2 in + match compare_nat (bi1.abs_value) 0 size_bi1 + (bi2.abs_value) 0 size_bi2 with + -1 -> (* 1/2 -> 0, reste 1, -1/2 -> -1, reste 1 *) + if bi1.sign = -1 + then (big_int_of_int(-1), add_big_int bi2 bi1) + else (big_int_of_int 0, bi1) + | 0 -> (big_int_of_int (bi1.sign * bi2.sign), zero_big_int) + | _ -> let bi1_negatif = bi1.sign = -1 in + let size_q = + if bi1_negatif + then succ (max (succ (size_bi1 - size_bi2)) 1) + else max (succ (size_bi1 - size_bi2)) 1 + and size_r = succ (max size_bi1 size_bi2) + (* r is long enough to contain both quotient and remainder *) + (* of the euclidian division *) + in + (* set up quotient, remainder *) + let q = create_nat size_q + and r = create_nat size_r in + blit_nat r 0 (bi1.abs_value) 0 size_bi1; + set_to_zero_nat r size_bi1 (size_r - size_bi1); + + (* do the division of |bi1| by |bi2| + - at the beginning, r contains |bi1| + - at the end, r contains + * in the size_bi2 least significant digits, the remainder + * in the size_r-size_bi2 most significant digits, the quotient + note the conditions for application of div_nat are verified here + *) + div_nat r 0 size_r (bi2.abs_value) 0 size_bi2; + + (* separate quotient and remainder *) + blit_nat q 0 r size_bi2 (size_r - size_bi2); + let not_null_mod = not (is_zero_nat r 0 size_bi2) in + + (* correct the signs, adjusting the quotient and remainder *) + if bi1_negatif & not_null_mod + then + (* bi1<0, r>0, noting r for (r, size_bi2) the remainder, *) + (* we have |bi1|=q * |bi2| + r with 0 < r < |bi2|, *) + (* thus -bi1 = q * |bi2| + r *) + (* and bi1 = (-q) * |bi2| + (-r) with -|bi2| < (-r) < 0 *) + (* thus bi1 = -(q+1) * |bi2| + (|bi2|-r) *) + (* with 0 < (|bi2|-r) < |bi2| *) + (* so the quotient has for sign the opposite of the bi2'one *) + (* and for value q+1 *) + (* and the remainder is strictly positive *) + (* has for value |bi2|-r *) + (let new_r = copy_nat (bi2.abs_value) 0 size_bi2 in + (* new_r contains (r, size_bi2) the remainder *) + { sign = - bi2.sign; + abs_value = (set_digit_nat q (pred size_q) 0; + incr_nat q 0 size_q 1; q) }, + { sign = 1; + abs_value = + (sub_nat new_r 0 size_bi2 r 0 size_bi2 1; + new_r) }) + else + (if bi1_negatif then set_digit_nat q (pred size_q) 0; + { sign = if is_zero_nat q 0 size_q + then 0 + else bi1.sign * bi2.sign; + abs_value = q }, + { sign = if not_null_mod then 1 else 0; + abs_value = copy_nat r 0 size_bi2 }) + +let div_big_int bi1 bi2 = fst (quomod_big_int bi1 bi2) +and mod_big_int bi1 bi2 = snd (quomod_big_int bi1 bi2) + +let gcd_big_int bi1 bi2 = + let size_bi1 = num_digits_big_int bi1 + and size_bi2 = num_digits_big_int bi2 in + if is_zero_nat (bi1.abs_value) 0 size_bi1 then abs_big_int bi2 + else if is_zero_nat (bi2.abs_value) 0 size_bi2 then + { sign = 1; + abs_value = bi1.abs_value } + else + { sign = 1; + abs_value = + match compare_nat (bi1.abs_value) 0 size_bi1 + (bi2.abs_value) 0 size_bi2 with + 0 -> bi1.abs_value + | 1 -> + let res = copy_nat (bi1.abs_value) 0 size_bi1 in + let len = + gcd_nat res 0 size_bi1 (bi2.abs_value) 0 size_bi2 in + copy_nat res 0 len + | _ -> + let res = copy_nat (bi2.abs_value) 0 size_bi2 in + let len = + gcd_nat res 0 size_bi2 (bi1.abs_value) 0 size_bi1 in + copy_nat res 0 len + } + +(* Coercion operators *) + +let int_of_big_int bi = + try bi.sign * int_of_nat bi.abs_value + with Failure _ -> + if eq_big_int bi (big_int_of_int monster_int) + then monster_int + else failwith "int_of_big_int" + +let is_int_big_int bi = + is_nat_int (bi.abs_value) 0 (num_digits_big_int bi) +or (bi.sign = -1 & num_digits_big_int bi = 1 & + num_leading_zero_bits_in_digit (bi.abs_value) 0 >= 1) + +(* XL: le "1" provient de "pred (length_of_digit - length_of_int))" *) + +(* Coercion with nat type *) +let nat_of_big_int bi = + if bi.sign = -1 + then failwith "nat_of_big_int" + else copy_nat (bi.abs_value) 0 (num_digits_big_int bi) + +let sys_big_int_of_nat nat off len = + let length = num_digits_nat nat off len in + { sign = if is_zero_nat nat off length then 0 else 1; + abs_value = copy_nat nat off length } + +let big_int_of_nat nat = + sys_big_int_of_nat nat 0 (length_nat nat) + +(* Coercion with string type *) + +let string_of_big_int bi = + if bi.sign = -1 + then "-" ^ string_of_nat bi.abs_value + else string_of_nat bi.abs_value + +(* XL: j'ai puissamment simplifie "big_int_of_string", en virant + la notation scientifique (123e6 ou 123.456e12). *) + +let sys_big_int_of_string s ofs len = + let (sign, nat) = + if String.get s ofs = '-' + then (-1, sys_nat_of_string 10 s (ofs+1) (len-1)) + else ( 1, sys_nat_of_string 10 s ofs len) in + { sign = if is_zero_nat nat 0 (length_nat nat) then 0 else sign; + abs_value = nat } + +let big_int_of_string s = + sys_big_int_of_string s 0 (String.length s) + +let power_base_nat base nat off len = + if is_zero_nat nat off len then nat_of_int 1 else + let power_base = make_nat (succ length_of_digit) in + let (pmax, pint) = make_power_base base power_base in + let (n, rem) = + let (x, y) = quomod_big_int (sys_big_int_of_nat nat off len) + (big_int_of_int (succ pmax)) in + (int_of_big_int x, int_of_big_int y) in + if n = 0 then copy_nat power_base (pred rem) 1 else + begin + let res = make_nat n + and res2 = make_nat n + and l = num_bits_int n - 2 in + let p = ref (1 lsl l) in + blit_nat res 0 power_base pmax 1; + for i = l downto 0 do + let len = num_digits_nat res 0 n in + let len2 = min n (2 * len) in + let succ_len2 = succ len2 in + square_nat res2 0 len2 res 0 len; + begin + if n land !p > 0 + then (set_to_zero_nat res 0 len; + mult_digit_nat res 0 succ_len2 + res2 0 len2 + power_base pmax; ()) + else blit_nat res 0 res2 0 len2 + end; + set_to_zero_nat res2 0 len2; + p := !p lsr 1 + done; + if rem > 0 + then (mult_digit_nat res2 0 n + res 0 n power_base (pred rem); + res2) + else res + end + +let power_int_positive_int i n = + match sign_int n with + 0 -> unit_big_int + | -1 -> invalid_arg "power_int_positive_int" + | _ -> let nat = power_base_int (abs i) n in + { sign = if i >= 0 + then sign_int i + else if n land 1 = 0 + then 1 + else -1; + abs_value = nat} + +let power_big_int_positive_int bi n = + match sign_int n with + 0 -> unit_big_int + | -1 -> invalid_arg "power_big_int_positive_int" + | _ -> let bi_len = num_digits_big_int bi in + let res_len = bi_len * n in + let res = make_nat res_len + and res2 = make_nat res_len + and l = num_bits_int n - 2 in + let p = ref (1 lsl l) in + blit_nat res 0 (bi.abs_value) 0 bi_len; + for i = l downto 0 do + let len = num_digits_nat res 0 res_len in + let len2 = min res_len (2 * len) in + let succ_len2 = succ len2 in + square_nat res2 0 len2 res 0 len; + (if n land !p > 0 + then (set_to_zero_nat res 0 len; + mult_nat res 0 succ_len2 + res2 0 len2 (bi.abs_value) 0 bi_len; + set_to_zero_nat res2 0 len2) + else blit_nat res 0 res2 0 len2; + set_to_zero_nat res2 0 len2); + p := !p lsr 1 + done; + {sign = if bi.sign >= 0 + then bi.sign + else if n land 1 = 0 + then 1 + else -1; + abs_value = res} + +let power_int_positive_big_int i bi = + match sign_big_int bi with + 0 -> unit_big_int + | -1 -> invalid_arg "power_int_positive_big_int" + | _ -> let nat = power_base_nat + (abs i) (bi.abs_value) 0 (num_digits_big_int bi) in + { sign = if i >= 0 + then sign_int i + else if is_digit_odd (bi.abs_value) 0 + then -1 + else 1; + abs_value = nat } + +let power_big_int_positive_big_int bi1 bi2 = + match sign_big_int bi2 with + 0 -> unit_big_int + | -1 -> invalid_arg "power_big_int_positive_big_int" + | _ -> let nat = bi2.abs_value + and off = 0 + and len_bi2 = num_digits_big_int bi2 in + let bi1_len = num_digits_big_int bi1 in + let res_len = int_of_big_int (mult_int_big_int bi1_len bi2) in + let res = make_nat res_len + and res2 = make_nat res_len + and l = (len_bi2 * length_of_digit + - num_leading_zero_bits_in_digit nat (pred len_bi2)) - 2 in + let p = ref (1 lsl l) in + blit_nat res 0 (bi1.abs_value) 0 bi1_len; + for i = l downto 0 do + let nat = bi2.abs_value in + let len = num_digits_nat res 0 res_len in + let len2 = min res_len (2 * len) in + let succ_len2 = succ len2 in + square_nat res2 0 len2 res 0 len; + land_digit_nat nat 0 (nat_of_int !p) 0; + if is_zero_nat nat 0 len_bi2 + then (blit_nat res 0 res2 0 len2; + set_to_zero_nat res2 0 len2) + else (set_to_zero_nat res 0 len; + mult_nat res 0 succ_len2 + res2 0 len2 (bi1.abs_value) 0 bi1_len; + set_to_zero_nat res2 0 len2); + p := !p lsr 1 + done; + {sign = if bi1.sign >= 0 + then bi1.sign + else if is_digit_odd (bi2.abs_value) 0 + then -1 + else 1; + abs_value = res} + +(* base_power_big_int compute bi*base^n *) +let base_power_big_int base n bi = + match sign_int n with + 0 -> bi + | -1 -> let nat = power_base_int base (-n) in + let len_nat = num_digits_nat nat 0 (length_nat nat) + and len_bi = num_digits_big_int bi in + if len_bi < len_nat then + invalid_arg "base_power_big_int" + else if len_bi = len_nat & + compare_digits_nat (bi.abs_value) len_bi nat len_nat = -1 + then invalid_arg "base_power_big_int" + else + let copy = create_nat (succ len_bi) in + blit_nat copy 0 (bi.abs_value) 0 len_bi; + set_digit_nat copy len_bi 0; + div_nat copy 0 (succ len_bi) + nat 0 len_nat; + if not (is_zero_nat copy 0 len_nat) + then invalid_arg "base_power_big_int" + else { sign = bi.sign; + abs_value = copy_nat copy len_nat 1 } + | _ -> let nat = power_base_int base n in + let len_nat = num_digits_nat nat 0 (length_nat nat) + and len_bi = num_digits_big_int bi in + let new_len = len_bi + len_nat in + let res = make_nat new_len in + (if len_bi > len_nat + then mult_nat res 0 new_len + (bi.abs_value) 0 len_bi + nat 0 len_nat + else mult_nat res 0 new_len + nat 0 len_nat + (bi.abs_value) 0 len_bi) + ; if is_zero_nat res 0 new_len + then zero_big_int + else create_big_int (bi.sign) res + +(* Coercion with float type *) + +let float_of_big_int bi = + float_of_string (string_of_big_int bi) + +(* XL: suppression de big_int_of_float et nat_of_float. *) + +(* Other functions needed *) + +(* Integer part of the square root of a big_int *) +let sqrt_big_int bi = + match bi.sign with + -1 -> invalid_arg "sqrt_big_int" + | 0 -> {sign = 0; + abs_value = make_nat (1)} + | _ -> {sign = 1; + abs_value = sqrt_nat (bi.abs_value) 0 (num_digits_big_int bi)} + +let square_big_int bi = + let len_bi = num_digits_big_int bi in + let len_res = 2 * len_bi in + let res = make_nat len_res in + square_nat res 0 len_res (bi.abs_value) 0 len_bi; + { sign = bi.sign; + abs_value = res } + +(* round off of the futur last digit (of the integer represented by the string + argument of the function) that is now the previous one. + if s contains an integer of the form (10^n)-1 + then s <- only 0 digits and the result_int is true + else s <- the round number and the result_int is false *) +let round_futur_last_digit s off_set length = + let l = pred (length + off_set) in + if Char.code(String.get s l) >= Char.code '5' + then + let rec round_rec l = + let current_char = String.get s l in + if current_char = '9' + then + (String.set s l '0'; + if l = off_set then true else round_rec (pred l)) + else + (String.set s l (Char.chr (succ (Char.code current_char))); + false) + in round_rec (pred l) + else false + + +(* Approximation with floating decimal point a` la approx_ratio_exp *) +let approx_big_int prec bi = + let len_bi = num_digits_big_int bi in + let n = + max 0 + (int_of_big_int ( + add_int_big_int + (-prec) + (div_big_int (mult_big_int (big_int_of_int (pred len_bi)) + (big_int_of_string "963295986")) + (big_int_of_string "100000000")))) in + let s = + string_of_big_int (div_big_int bi (power_int_positive_int 10 n)) in + let (sign, off, len) = + if String.get s 0 = '-' + then ("-", 1, succ prec) + else ("", 0, prec) in + if (round_futur_last_digit s off (succ prec)) + then (sign^"1."^(String.make prec '0')^"e"^ + (string_of_int (n + 1 - off + String.length s))) + else (sign^(String.sub s off 1)^"."^ + (String.sub s (succ off) (pred prec)) + ^"e"^(string_of_int (n - succ off + String.length s))) diff --git a/otherlibs/num/big_int.mli b/otherlibs/num/big_int.mli new file mode 100644 index 000000000..42c26f1b3 --- /dev/null +++ b/otherlibs/num/big_int.mli @@ -0,0 +1,64 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Big_int]: operations on big integers *) + +(* Big integers (type [big_int]) are signed integers of arbitrary size. *) + +open Nat + +type big_int + +val sign_big_int : big_int -> int +val zero_big_int : big_int +val unit_big_int : big_int +val num_digits_big_int : big_int -> int +val minus_big_int : big_int -> big_int +val abs_big_int : big_int -> big_int +val compare_big_int : big_int -> big_int -> int +val eq_big_int : big_int -> big_int -> bool +val le_big_int : big_int -> big_int -> bool +val ge_big_int : big_int -> big_int -> bool +val lt_big_int : big_int -> big_int -> bool +val gt_big_int : big_int -> big_int -> bool +val max_big_int : big_int -> big_int -> big_int +val min_big_int : big_int -> big_int -> big_int +val pred_big_int : big_int -> big_int +val succ_big_int : big_int -> big_int +val add_big_int : big_int -> big_int -> big_int +val big_int_of_int : int -> big_int +val add_int_big_int : int -> big_int -> big_int +val sub_big_int : big_int -> big_int -> big_int +val mult_int_big_int : int -> big_int -> big_int +val mult_big_int : big_int -> big_int -> big_int +val quomod_big_int : big_int -> big_int -> big_int * big_int +val div_big_int : big_int -> big_int -> big_int +val mod_big_int : big_int -> big_int -> big_int +val gcd_big_int : big_int -> big_int -> big_int +val int_of_big_int : big_int -> int +val is_int_big_int : big_int -> bool +val nat_of_big_int : big_int -> nat +val big_int_of_nat : nat -> big_int +val string_of_big_int : big_int -> string +val big_int_of_string : string -> big_int +val float_of_big_int : big_int -> float +val square_big_int: big_int -> big_int +val sqrt_big_int: big_int -> big_int +val base_power_big_int: int -> int -> big_int -> big_int +val sys_big_int_of_string: string -> int -> int -> big_int +val power_int_positive_int: int -> int -> big_int +val power_big_int_positive_int: big_int -> int -> big_int +val power_int_positive_big_int: int -> big_int -> big_int +val power_big_int_positive_big_int: big_int -> big_int -> big_int +val round_futur_last_digit : string -> int -> int -> bool +val approx_big_int: int -> big_int -> string diff --git a/otherlibs/num/bignum/Makefile b/otherlibs/num/bignum/Makefile new file mode 100644 index 000000000..89be3bda7 --- /dev/null +++ b/otherlibs/num/bignum/Makefile @@ -0,0 +1,335 @@ +# Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1992 +# Last modified_on Tue Nov 3 13:44:57 1992 by shand +# modified_on Fri May 31 18:26:52 GMT+2:00 1991 by herve +# modified_on Thu Nov 2 14:23:14 GMT+1:00 1989 by gangnet +# modified_on Wed Jul 5 10:23:54 GMT+2:00 1989 by bertin + +CC = cc +AR = ar +RANLIB = ranlib +RANLIBTEST=test -f /usr/bin/ranlib -o -f /bin/ranlib +LIB = libbignum.a +OBJECT = o/KerN.o o/bnInit.o o/bnMult.o o/bnDivide.o o/bnCmp.o o/bzf.o o/bz.o +KERNH = h/BigNum.h +CFLAGS = -c -I./h -O -DCAML_LIGHT +LDFLAGS = + +# extra entries: +# all - make all the stuff +# tidy - cleanup directories +# scratch - start from scratch + +default: + @echo "Usage: make <version>" + @echo "see README for valid versions." + @sh -c 'exit 1' + +#all: testKerN bztest +# @echo All is done + +all: $(LIB) + @echo All is done + +tidy: + -rm -f ,* .,* *~ #*# .emacs_[0-9]* *.BAK *.CKP core a.out + -rm -f */,* */.,* */*~ */#*# */.emacs_[0-9]* */*.BAK */*.CKP + +scratch:tidy + rm -f o/*.o libbignum.a bztest testKerN + +# build the BigNum library +$(LIB): $(OBJECT) + -rm -f $(LIB) + $(AR) cr $(LIB) $(OBJECT) + if $(RANLIBTEST); then $(RANLIB) $(LIB); else true; fi + +# How to choose the machine dependent version. All produce KerN.o +o/KerN.o: c/KerN.c + @echo "The Default is KerN written in C with digits on long" + make C CC="$(CC)" CFLAGS="$(CFLAGS)" + +C: scratch + $(CC) $(CFLAGS) c/KerN.c + mv KerN.o o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +68K: scratch + as s/68KerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +vax: scratch + as s/vaxKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" all + +ns: scratch + as s/nsKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +mips: scratch + as -w s/mipsKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" all + +alpha: scratch + as -O s/alphaKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" all + +pyramid: scratch + as s/pyramidKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +i960: scratch + as s/i960KerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +sparc: scratch + as s/sparcKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +sparcfpu: scratch + as s/sparcfpuKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +supersparc: scratch + as s/supersparcKerN.s -o o/KerN.o + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +sparc-solaris: scratch + sed -e 's/_Bnn/Bnn/g' s/sparcKerN.s > s/KerN.s + as s/KerN.s -o o/KerN.o + rm -f s/KerN.s + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +sparcfpu-solaris: scratch + sed -e 's/_Bnn/Bnn/g' s/sparcfpuKerN.s > s/KerN.s + as s/KerN.s -o o/KerN.o + rm -f s/KerN.s + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +supersparc-solaris: scratch + sed -e 's/_Bnn/Bnn/g' s/supersparcKerN.s > s/KerN.s + as s/KerN.s -o o/KerN.o + rm -f s/KerN.s + make CC="$(CC)" CFLAGS="$(CFLAGS)" \ + OBJECT="$(OBJECT)" all + +# Construct VMS assembler from UNIX version + +s/vaxKerN.mar: s/vaxKerN.s + sed -f s/unix2vms.sed < s/vaxKerN.s > $@ + +# Level N +o/bnInit.o: c/bn/bnInit.c $(KERNH) + $(CC) $(CFLAGS) c/bn/bnInit.c + mv bnInit.o o + +o/bnMult.o: c/bn/bnMult.c $(KERNH) + $(CC) $(CFLAGS) c/bn/bnMult.c + mv bnMult.o o + +o/bnDivide.o: c/bn/bnDivide.c $(KERNH) + $(CC) $(CFLAGS) c/bn/bnDivide.c + mv bnDivide.o o + +o/bnCmp.o: c/bn/bnCmp.c $(KERNH) + $(CC) $(CFLAGS) c/bn/bnCmp.c + mv bnCmp.o o + +# Level Z +o/bz.o: c/bz.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) c/bz.c + mv bz.o o + +# level R +o/br.o: c/br.c h/BigR.h h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) c/br.c + mv br.o o + +# Some functions build with BigZ +o/bzf.o: c/bzf.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) c/bzf.c + mv bzf.o o + +# Tests Of KerN +testKerN: o/testKerN.o $(LIB) + $(CC) o/testKerN.o $(LIB) $(LDFLAGS) -o testKerN + +o/testKerN.o: c/testKerN.c $(KERNH) + $(CC) $(CFLAGS) c/testKerN.c + mv testKerN.o o + +# Tests Of BigZ +bztest: o/bztest.o $(LIB) + $(CC) o/bztest.o $(LIB) $(LDFLAGS) -o bztest + +o/bztest.o: c/bztest.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) c/bztest.c + mv bztest.o o + +# Tests Of BigR +brtest: o/brtest.o $(LIB) + $(CC) o/brtest.o $(LIB) $(LDFLAGS) -o brtest + +o/brtest.o: c/brtest.c h/BigR.h h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) c/brtest.c + mv brtest.o o + +# documentation +doc: doc/bn.ps doc/bnf.ps +docprl: doc/bnprl.ps + +doc/bn.dvi: doc/bn.tex doc/bnbody.tex + cd doc;\ + latex bn;\ + makeindex bn;\ + sed -e "s/\\item Bz/\\newpage \\Bz/g" < bn.ind > bn.index;\ + mv bn.index bn.ind;\ + latex bn;\ + cd .. + +doc/bn.ps: doc/bn.dvi + cd doc;\ + dvips -o bn.ps bn;\ + cd .. + +doc/bnf.dvi: doc/bnf.tex + cd doc;\ + latex bnf;\ + cd .. + +doc/bnf.ps: doc/bnf.dvi + cd doc;\ + dvips -o bnf.ps bnf;\ + cd .. + +doc/bnprl.dvi: doc/bnprl.tex doc/bnbody.tex + cd doc;\ + latex bnprl;\ + makeindex bnprl;\ + sed -e "s/\\item Bz/\\newpage \\Bz/g" < bnprl.ind > bnprl.index;\ + mv bnprl.index bnprl.ind;\ + latex bnprl;\ + cd .. + +doc/bnprl.ps: doc/bnprl.dvi + cd doc;\ + dvips -o bnprl.ps bnprl;\ + cd .. + + +# build shell archives +PACKET_SIZE = 90 +PREFIX = bignum. +DIRS = c c/bn h s o doc + +# If you modify the list of files in the package kit, don't forget +# to update README. + +KIT= README Makefile VMSmakefile MSDOSmakefile\ + doc/bn.tex doc/bnbody.tex doc/bnf.tex doc/intro\ + c/KerN.c c/bn/bnInit.c c/bn/bnMult.c c/bn/bnDivide.c\ + c/bn/bnCmp.c c/bz.c c/bzf.c \ + c/bztest.c c/testKerN.c \ + h/BigNum.h h/BigZ.h \ + s/vaxKerN.s s/68KerN.s s/nsKerN.s s/68KerN_mot.s \ + s/mipsKerN.s s/pyramidKerN.s s/vaxKerN.mar s/unix2vms.sed \ + s/i960KerN.s s/sparcKerN.s s/sparcfpuKerN.s \ + s/alphaKerN.s \ + o/EMPTY + +bignum.01.shar: $(KIT) + makekit -s$(PACKET_SIZE)k -n$(PREFIX) -t"Now do 'make'" $(DIRS) $(KIT) + for f in `ls bignum.[0-9][0-9]`; \ + do mv $$f $$f.shar; \ + done + +bignum.00.shar: README doc/intro bignum.01.shar + ls bignum.[0-9][0-9].shar | sed -e "s/^bignum0*/ BigNum - Part /" > _flist1 + ls bignum.[0-9][0-9].shar | sed -e "s/^/ /" > _flist2 + ls bignum.[0-9][0-9].shar | sed -e "s/^/ \/bin\/sh /" > _flist3 + ls bignum.[0-9][0-9].shar | sed -e "s/^/ shar -u /" > _flist4 + cc -E -Uvax -I. doc/intro >introtobn + sed \ + -e "s/modified_on/modified_on/g" \ + -e "/doc\/$(VERSION)intro/d" \ + -e "/.\/$(VERSION)README/d" \ + -e "s/NN/"`ls bignum.??.shar | wc -l | sed -e "s/ //g"`"/g" \ + -e "/^INCLUDE1/r _flist1" \ + -e "/^INCLUDE2/r _flist2" \ + -e "/^INCLUDE3/r _flist3" \ + -e "/^INCLUDE4/r _flist4" \ + -e "/^INCLUDE./d" \ + <introtobn > bignum.00.shar + rm -f introtobn _flist[1-9] + +# build shell archives of the beta version + +# If you modify the list of files in the package betakit, don't forget +# to update betaREADME. + +BETAKIT= $(KIT) c/br.c c/brtest.c h/BigR.h + +# note we replace README by betaREADME and doc/intro by doc/betaintro +# such that the filename will be README and doc/intro in the archive, +betabignum01: $(BETAKIT) betaREADME doc/betaintro + mv README README.cur + cp betaREADME README + mv doc/intro doc/intro.cur + cp doc/betaintro doc/intro + makekit -s$(PACKET_SIZE)k -n$(PREFIX) -t"Now do 'make'" $(DIRS) $(BETAKIT) + mv README.cur README + mv doc/intro.cur doc/intro + + +# send shell archives +SENDMAIL=/usr/lib/sendmail +SENDMAILFLAGS= +USER=nil +FULLNAME=nil +COPY=librarian@prl.dec.com +VERSION= # the version you want to mail, could be empty (current release) or "beta" + + +mail: $(VERSION)bignum.01.shar bignum.00.shar # do bignum00 AFTER !! + @sh -c "if [ x$(USER) = xnil -o 'x$(FULLNAME)' = xnil ]; \ + then echo must specify USER and FULLNAME; \ + echo EG make USER=herve@prl FULLNAME="'\"'"J-C Herve, Digital PRL"'\"'" mail; exit 1; \ + else :; fi" + @touch Recipients + @echo '' >> Recipients + @date >> Recipients + @echo "$(FULLNAME)" >> Recipients + @echo '<'"$(USER)"'>' >> Recipients + @echo "To: $(COPY)" >tosend + @echo "Subject: BIGNUM DAEMON" >>tosend + @echo "Jean-Christophe, I have sent the package bignum to:" >>tosend + @echo >>tosend + @echo " $(FULLNAME)" >>tosend + @echo " $(USER)" >>tosend + @echo >>tosend + @echo "Thanks to register this address in your distribution list." >>tosend + @$(SENDMAIL) $(SENDMAILFLAGS) $(COPY) <tosend + echo To: $(USER) > sendmail_header + cp sendmail_header tosend + echo "Subject: BigNum package from Digital PRL" >>tosend + cat bignum.00.shar >>tosend + rm -f bignum.00.shar + $(SENDMAIL) $(SENDMAILFLAGS) $(USER) <tosend + for i in `ls bignum.[0-9][0-9].shar`; \ + do cp sendmail_header tosend; \ + echo $$i | sed -e "s/^bignum0*/Subject: BigNum - Part /" >>tosend; \ + echo "# Remove all text above and including this line." >>tosend; \ + sed -e "s/modified_on/modified_on/g" <$$i >>tosend; \ + $(SENDMAIL) $(SENDMAILFLAGS) $(USER) <tosend; \ + done + rm -f sendmail_header tosend bignum.[0-9][0-9].shar + diff --git a/otherlibs/num/bignum/README b/otherlibs/num/bignum/README new file mode 100644 index 000000000..a2fb5ef54 --- /dev/null +++ b/otherlibs/num/bignum/README @@ -0,0 +1,97 @@ + +This directory contains the C and assembler source code for BigNum. + + The subdirectory doc contains the documentation files: + bn.tex - Document BigNum in LaTeX format + bnf.tex - Document BigNum in French and LaTeX format + makeidx.sty - macro used in BigNum document + + The subdirectory h contains the C include files: + BigZ.h - Types and structures for clients of BigZ + BigNum.h - Types and structures for clients of BigNum + + The subdirectory c contains the C source files: + KerN.c - BigNum implementation ("kernel" routines) + bn/bn*.c - BigNum implementation ("non-kernel" routines), + that is bnInit.c, bnMult.c, bnDivide.c and bnCmp.c + bz.c - BigZ implementation + bzf.c - Miscellaneous functions built on top of BigZ + bztest.c - Test program for verifying a BigNum implementation + testKerN.c - Test program for verifying KerN implementation + + The subdirectory s contains the assembler source files: + vaxKerN.s - Vax/U*ix implementation of KerN + vaxKerN.mar - Vax/VMS implementation of KerN + 68KerN.s - 68020 implementation of KerN (MIT syntax) + 68KerN_mot.s - 68020 implementation of KerN (Motorola syntax) + nsKerN.s - NS implementation of KerN + mipsKerN.s - MIPS implementation of KerN + pyramidKerN.s - Pyramid implementation of KerN + i960KerN.s - Intel 80960 implementation of KerN + sparcKerN.s - SPARC implementation of KerN + sparcfpuKerN.s - SPARC implementation of KerN using FPU, may + give faster multiplication on SPARC + implementations with fast floating point + supersparcKerN.s - SPARC V8 implementation of KerN + (with hardware integer multiplication) + + Other Files: + Makefile - U*ix makefile + VMSmakefile - VMS makefile + MSDOSmakefile - MSDOS makefile + + +Now, to build or modify the current version of the package, type one of: + + on U*ix system: + make vax - to use vax assembly code + make 68K - to use 68020 assembly code + make ns - to use NS assembly code + make mips - to use mips assembly code + make pyramid - to use pyramid assembly code + make i960 - to use intel 80960 assembly code + make sparc - to use sparc assembly code (SunOS 4) + make sparcfpu - to use sparc assembly code (with multiply in FPU) + make supersparc - to use sparc V8 assembly code (Sun OS 4) + make sparc-solaris + make sparcfpu-solaris same as above, for Solaris 2 instead of SunOS 4 + make supersparc-solaris + make C16 - to use C code with 16 bits digits + make C32 - to use C code with 32 bits digits (default version) + + on VMS system: (copy VMSmakefile to Makefile, before) + mms vax - to use vax assembly code (default version) + mms C32 - to use C code with 32 bits digits + we suppose you have defined the standard libraries of C-VMS with: + define lnk$library sys$library:vaxccurse + define lnk$library_1 sys$library:vaxcrtlg + define lnk$library_2 sys$library:vaxcrtl + + on MSDOS system: (copy MSDOSmakefile to Makefile, before) + make makefile - to use C code (16 bits digits) + +Each of these commands products the following files: + + on U*ix system: + BigNum.a - BigNum library + testKerN - Test program executable for KerN + bztest - Test program executable for BigZ + + on VMS system: + BigNum.olb - BigNum library + testKerN.exe - Test program executable for KerN + bztest.exe - Test program executable for BigZ + + on MSDOS system: + BigNum.lib - BigNum library + testKerN.exe - Test program executable for KerN + bztest.exe - Test program executable for BigZ + + +On U*ix system, if you have the tools LaTeX (L. Lamport's special version of Knuth's +famous TeX, as described in the Addison-Wesley book), makeindex and +dvips, type: + make doc - to build the Postscript files of the documents, + +If you do not have dvips, use your local equivalent tool to print +the dvi file produced by the LaTeX command. diff --git a/otherlibs/num/bignum/c/KerN.c b/otherlibs/num/bignum/c/KerN.c new file mode 100644 index 000000000..7b9ef1ce1 --- /dev/null +++ b/otherlibs/num/bignum/c/KerN.c @@ -0,0 +1,932 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Thu Feb 20 18:18:12 GMT+1:00 1992 by shand */ +/* modified_on Tue Jan 15 19:32:53 GMT+1:00 1991 by herve */ + + +/* KerN.c: the kernel written in C */ + +/* + * Description of types and constants. + * + * Several conventions are used in the commentary: + * A "BigNum" is the name for an infinite-precision number. + * Capital letters (e.g., "N") are used to refer to the value of BigNums. + * The word "digit" refers to a single BigNum digit. + * The notation "Size(N)" refers to the number of digits in N, + * which is typically passed to the subroutine as "nl". + * The notation "Length(N)" refers to the number of digits in N, + * not including any leading zeros. + * The word "Base" is used for the number 2 ** BN_DIGIT_SIZE, where + * BN_DIGIT_SIZE is the number of bits in a single BigNum digit. + * The expression "BBase(N)" is used for Base ** NumDigits(N). + * The term "leading zeros" refers to any zeros before the most + * significant digit of a number. + * + * + * In the code, we have: + * + * "nn" is a pointer to a big number, + * "nl" is the number of digits from nn, + * "d" is a digit. + * + */ + + +/* */ + +#define BNNMACROS_OFF +#include "BigNum.h" +#define NOMEM + + /*** copyright ***/ + +static char copyright[]="@(#)KerN.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\n"; + + + /******* non arithmetic access to digits ********/ + + +#ifndef _NO_PROTO +void BnnSetToZero (BigNum nn, BigNumLength nl) +#else +void BnnSetToZero (nn, nl) +BigNum nn; BigNumLength nl; +#endif + +/* + * Sets all the specified digits of the BigNum to 0 + */ + +{ + BigNum nnlim; + if (nl <= 0) + return; + nnlim = nn+nl-1; + do *nn = 0; while(nn++ < nnlim); +} + + /***************************************/ + + +#ifndef _NO_PROTO +void BnnAssign (BigNum mm, BigNum nn, BigNumLength nl) +#else /* _NO_PROTO */ +void BnnAssign ( mm, nn, nl) +BigNum mm; BigNum nn; BigNumLength nl; +#endif /* _NO_PROTO */ + +/* + * Copies N => M + */ + +{ + BigNum nnlim; + if (nl <= 0) + return; + nnlim = nn+nl; +#ifdef MSDOS + if (realaddr(mm) < realaddr(nn) || realaddr(mm) > realaddr(nnlim)) +#else + if ((mm < nn) || ( mm > nnlim)) +#endif + do *mm++ = *nn++; while(nn < nnlim); + else +#ifdef MSDOS + if (realaddr(mm) > realaddr(nn)) +#else + if (mm > nn) +#endif + { + mm += nl; + do *--mm = *--nnlim; while(nn < nnlim); + } +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +void BnnSetDigit (BigNum nn, BigNumDigit d) +#else /* _NO_PROTO */ +void BnnSetDigit ( nn, d) +BigNum nn; BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Sets a single digit of N to the passed value + */ + +{ + *nn = d; +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigNumDigit BnnGetDigit (BigNum nn) +#else /* _NO_PROTO */ +BigNumDigit BnnGetDigit ( nn) +BigNum nn; +#endif /* _NO_PROTO */ + +/* + * Returns the single digit pointed by N + */ + +{ + return (*nn); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigNumLength BnnNumDigits (BigNum nn, BigNumLength nl) +#else /* _NO_PROTO */ +BigNumLength BnnNumDigits ( nn, nl) +BigNum nn; BigNumLength nl; +#endif /* _NO_PROTO */ + +/* + * Returns the number of digits of N, not counting leading zeros + */ + +{ + nn += nl; + + while (nl != 0 && *--nn == 0) + nl--; + + return (nl == 0 ? 1 : nl); +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigNumDigit BnnNumLeadingZeroBitsInDigit (BigNumDigit d) +#else /* _NO_PROTO */ +BigNumDigit BnnNumLeadingZeroBitsInDigit ( d) +BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns the number of leading zero bits in a digit + */ + +{ + register int p = 0; + if (BN_DIGIT_SIZE == 16 || BN_DIGIT_SIZE == 32 || BN_DIGIT_SIZE == 64) + { + register BigNumDigit mask = (~(BigNumDigit)0) << (BN_DIGIT_SIZE/2); + register BigNumLength maskl = BN_DIGIT_SIZE/2; + + if (d == 0) + return (BN_DIGIT_SIZE); + while (maskl) + { + if ((d & mask) == 0) + { + p += maskl; + d <<= maskl; + } + maskl >>= 1; + mask <<= maskl; + } + } + else + { + register BigNumDigit mask = ((BigNumDigit)1) << (BN_DIGIT_SIZE-1); + + while ((d & mask) == 0) + { + p++; + mask >>= 1; + } + } + + return (p); +} + + /***************************************/ +/* */ + + /************** Predicates on one digit ***************/ + + +#ifndef _NO_PROTO +Boolean BnnDoesDigitFitInWord (BigNumDigit d) +#else /* _NO_PROTO */ +Boolean BnnDoesDigitFitInWord ( d) +BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns TRUE iff the digit can be represented in just BN_WORD_SIZE bits + */ +{ + /* The C compiler must evaluate the predicate at compile time */ + if (BN_DIGIT_SIZE > BN_WORD_SIZE) + return (d >= ((BigNumDigit)1) << BN_WORD_SIZE ? FALSE : TRUE); + else + return (TRUE); +} + + /***************************************/ + + +#ifndef _NO_PROTO +Boolean BnnIsDigitZero (BigNumDigit d) +#else /* _NO_PROTO */ +Boolean BnnIsDigitZero ( d) +BigNumDigit d; +#endif /* _NO_PROTO */ + +/* Returns TRUE iff digit = 0 */ + +{ + return (d == 0); +} + + /***************************************/ + + +#ifndef _NO_PROTO +Boolean BnnIsDigitNormalized (BigNumDigit d) +#else /* _NO_PROTO */ +Boolean BnnIsDigitNormalized ( d) +BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns TRUE iff Base/2 <= digit < Base + * i.e., if digit's leading bit is 1 + */ + +{ + return (d & (((BigNumDigit)1) << (BN_DIGIT_SIZE - 1)) ? TRUE : FALSE); +} + + /***************************************/ + + +#ifndef _NO_PROTO +Boolean BnnIsDigitOdd (BigNumDigit d) +#else /* _NO_PROTO */ +Boolean BnnIsDigitOdd ( d) +BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns TRUE iff digit is odd + */ + +{ + return (d & 1 ? TRUE : FALSE); +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigNumCmp BnnCompareDigits (BigNumDigit d1, BigNumDigit d2) +#else /* _NO_PROTO */ +BigNumCmp BnnCompareDigits ( d1, d2) +BigNumDigit d1; BigNumDigit d2; +#endif /* _NO_PROTO */ + +/* + * Returns BN_GREATER if digit1 > digit2 + * BN_EQUAL if digit1 = digit2 + * BN_LESS if digit1 < digit2 + */ + +{ + return (d1 > d2 ? BN_GT : (d1 == d2 ? BN_EQ : BN_LT)); +} + + /***************** Logical operations ********************/ + + +#ifndef _NO_PROTO +void BnnComplement (BigNum nn, BigNumLength nl) +#else /* _NO_PROTO */ +void BnnComplement ( nn, nl) +BigNum nn; BigNumLength nl; +#endif /* _NO_PROTO */ + +/* + * Performs the computation BBase(N) - N - 1 => N + */ + +{ + BigNum nnlim; + + if (nl <= 0) + return; + nnlim = nn+nl; + do + { + nn++; + nn[-1] = ~nn[-1]; + } + while (nn < nnlim); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +void BnnAndDigits (BigNum n, BigNumDigit d) +#else /* _NO_PROTO */ +void BnnAndDigits ( n, d) +BigNum n; BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns the logical computation n[0] AND d in n[0] + */ + +{ + *n &= d; +} + + /***************************************/ + + +#ifndef _NO_PROTO +void BnnOrDigits (BigNum n, BigNumDigit d) +#else /* _NO_PROTO */ +void BnnOrDigits ( n, d) +BigNum n; BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns the logical computation n[0] OR d2 in n[0]. + */ + +{ + *n |= d; +} + + /***************************************/ + + +#ifndef _NO_PROTO +void BnnXorDigits (BigNum n, BigNumDigit d) +#else /* _NO_PROTO */ +void BnnXorDigits ( n, d) +BigNum n; BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Returns the logical computation n[0] XOR d in n[0]. + */ + +{ + *n ^= d; +} + + /***************************************/ +/* */ + + /****************** Shift operations *******************/ + + +#ifndef _NO_PROTO +BigNumDigit BnnShiftLeft (BigNum mm, BigNumLength ml, int nbits) +#else /* _NO_PROTO */ +BigNumDigit BnnShiftLeft ( mm, ml, nbits) +BigNum mm; BigNumLength ml; int nbits; +#endif /* _NO_PROTO */ + +/* + * Shifts M left by "nbits", filling with 0s. + * Returns the leftmost "nbits" of M in a digit. + * Assumes 0 <= nbits < BN_DIGIT_SIZE. + */ + +{ + register BigNumDigit res = 0, save; + int rnbits; + + + if (nbits != 0) + { + rnbits = BN_DIGIT_SIZE - nbits; + + while (ml-- > 0) + { + save = *mm; + *mm++ = (save << nbits) | res; + res = save >> rnbits; + } + } + + return (res); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigNumDigit BnnShiftRight (BigNum mm, BigNumLength ml, int nbits) +#else /* _NO_PROTO */ +BigNumDigit BnnShiftRight ( mm, ml, nbits) +BigNum mm; BigNumLength ml; int nbits; +#endif /* _NO_PROTO */ + +/* + * Shifts M right by "nbits", filling with 0s. + * Returns the rightmost "nbits" of M in a digit. + * Assumes 0 <= nbits < BN_DIGIT_SIZE. + */ + +{ + register BigNumDigit res = 0, save; + int lnbits; + + + if (nbits != 0) + { + mm += ml; + lnbits = BN_DIGIT_SIZE - nbits; + + while (ml-- > 0) + { + save = *(--mm); + *mm = (save >> nbits) | res; + res = save << lnbits; + } + } + + return (res); +} + + /***************************************/ +/* */ + + + /******************* Additions **************************/ + + +#ifndef _NO_PROTO +BigNumCarry BnnAddCarry (BigNum nn, BigNumLength nl, BigNumCarry carryin) +#else /* _NO_PROTO */ +BigNumCarry BnnAddCarry ( nn, nl, carryin) +BigNum nn; BigNumLength nl; BigNumCarry carryin; +#endif /* _NO_PROTO */ + +/* + * Performs the sum N + CarryIn => N. + * Returns the CarryOut. + */ + +{ + if (carryin == 0) + return (0); + + if (nl == 0) + return (1); + + while (nl > 0 && !(++(*nn++))) + nl--; + + return (nl > 0 ? 0 : 1); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigNumCarry BnnAdd (BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl, BigNumCarry carryin) +#else /* _NO_PROTO */ +BigNumCarry BnnAdd ( mm, ml, nn, nl, carryin) +BigNum mm; BigNumLength ml; BigNum nn; BigNumLength nl; BigNumCarry carryin; +#endif /* _NO_PROTO */ + +/* + * Performs the sum M + N + CarryIn => M. + * Returns the CarryOut. + * Assumes Size(M) >= Size(N). + */ + +{ + register BigNumProduct c = carryin; + + + ml -= nl; + /* test computed at compile time */ + if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + { + while (nl > 0) + { + c += ((BigNumProduct)*mm) + *(nn++); + *(mm++) = c; + c >>= BN_DIGIT_SIZE; + nl--; + } + } + else + { + register BigNumProduct save; + + while (nl > 0) + { + save = *mm; + c += save; + if (c < save) + { + *(mm++) = *(nn++); + c = 1; + } + else + { + save = *(nn++); + c += save; + *(mm++) = c; + c = (c < save) ? 1 : 0; + } + nl--; + } + } + + return (BnnAddCarry (mm, ml, (BigNumCarry) c)); +} + + /***************************************/ +/* */ + + /****************** Subtraction *************************/ + + + +#ifndef _NO_PROTO +BigNumCarry BnnSubtractBorrow (BigNum nn, BigNumLength nl, BigNumCarry carryin) +#else /* _NO_PROTO */ +BigNumCarry BnnSubtractBorrow ( nn, nl, carryin) +BigNum nn; BigNumLength nl; BigNumCarry carryin; +#endif /* _NO_PROTO */ + +/* + * Performs the difference N + CarryIn - 1 => N. + * Returns the CarryOut. + */ + +{ + if (carryin == 1) + return (1); + if (nl == 0) + return (0); + + while (nl > 0 && !((*nn++)--)) + nl--; + + return (nl > 0 ? 1 : 0); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigNumCarry BnnSubtract (BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl, BigNumCarry carryin) +#else /* _NO_PROTO */ +BigNumCarry BnnSubtract ( mm, ml, nn, nl, carryin) +BigNum mm; BigNumLength ml; BigNum nn; BigNumLength nl; BigNumCarry carryin; +#endif /* _NO_PROTO */ + +/* + * Performs the difference M - N + CarryIn - 1 => M. + * Returns the CarryOut. + * Assumes Size(M) >= Size(N). + */ + +{ + register BigNumProduct c = carryin; + register BigNumDigit invn; + + + ml -= nl; + /* test computed at compile time */ + if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + { + while (nl > 0) + { + invn = *(nn++) ^ -1; + c += ((BigNumProduct)*mm) + invn; + *(mm++) = c; + c >>= BN_DIGIT_SIZE; + nl--; + } + } + else + { + register BigNumProduct save; + + while (nl > 0) + { + save = *mm; + invn = *(nn++) ^ -1; + c += save; + + if (c < save) + { + *(mm++) = invn; + c = 1; + } + else + { + c += invn; + *(mm++) = c; + c = (c < invn) ? 1 : 0; + } + nl--; + } + } + + return (BnnSubtractBorrow (mm, ml, (BigNumCarry) c)); } + + + /***************************************/ +/* */ + + /***************** Multiplication ************************/ + +#ifndef _NO_PROTO +BigNumCarry BnnMultiplyDigit (BigNum pp, BigNumLength pl, BigNum mm, BigNumLength ml, BigNumDigit d) +#else /* _NO_PROTO */ +BigNumCarry BnnMultiplyDigit ( pp, pl, mm, ml, d) +BigNum pp; BigNumLength pl; BigNum mm; BigNumLength ml; BigNumDigit d; +#endif /* _NO_PROTO */ + +/* + * Performs the product: + * Q = P + M * d + * BB = BBase(P) + * Q mod BB => P + * Q div BB => CarryOut + * Returns the CarryOut. + * Assumes Size(P) >= Size(M) + 1. + */ + +{ + register BigNumProduct c = 0; + + + if (d == 0) + return (0); + + if (d == 1) + return (BnnAdd (pp, pl, mm, ml, (BigNumCarry) 0)); + + pl -= ml; + /* test computed at compile time */ + if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + { + while (ml != 0) + { + ml--; + c += *pp + (((BigNumProduct)d) * (*(mm++))); + *(pp++) = c; + c >>= BN_DIGIT_SIZE; + } + + while (pl != 0) + { + pl--; + c += *pp; + *(pp++) = c; + c >>= BN_DIGIT_SIZE; + } + + return (c); + } + else + { +/* help for stupid compilers--may actually be counter + productive on pipelined machines with decent register allocation!! */ +#define m_digit X0 +#define X3 Lm +#define X1 Hm + register BigNumDigit Lm, Hm, Ld, Hd, X0, X2 /*, X1, X3 */; + + Ld = d & ((((BigNumDigit)1) << (BN_DIGIT_SIZE / 2)) -1); + Hd = d >> (BN_DIGIT_SIZE / 2); + while (ml != 0) + { + ml--; + m_digit = *mm++; + Lm = m_digit & ((((BigNumDigit)1) << (BN_DIGIT_SIZE / 2)) -1); + Hm = m_digit >> (BN_DIGIT_SIZE / 2); + X0 = Ld * Lm; + X2 = Hd * Lm; + X3 = Hd * Hm; + X1 = Ld * Hm; + + if ((c += X0) < X0) X3++; + if ((X1 += X2) < X2) X3 += (((BigNumDigit)1)<<(BN_DIGIT_SIZE / 2)); + X3 += (X1 >> (BN_DIGIT_SIZE / 2)); + X1 <<= (BN_DIGIT_SIZE / 2); + if ((c += X1) < X1) X3++; + if ((*pp += c) < c) X3++; + pp++; + + c = X3; +#undef m_digit +#undef X1 +#undef X3 + } + + X0 = *pp; + c += X0; + *(pp++) = c; + + if (c >= X0) + return (0); + + pl--; + while (pl != 0 && !(++(*pp++))) + pl--; + + return (pl != 0 ? 0 : 1); + } +} + +#ifdef mips +#ifndef _NO_PROTO +BigNumCarry BnnMultiply2Digit (BigNum pp, BigNumLength pl, BigNum mm, BigNumLength ml, BigNumDigit d0, BigNumDigit d1) +#else /* _NO_PROTO */ +BigNumCarry BnnMultiply2Digit ( pp, pl, mm, ml, d0, d1) +BigNum pp; BigNumLength pl; BigNum mm; BigNumLength ml; BigNumDigit d0; BigNumDigit d1; +#endif /* _NO_PROTO */ + +/* + * Provided for compatibility with mips assembler implementation. + * Performs the product: + * Q = P + M * d0_d1 + * BB = BBase(P) + * Q mod BB => P + * Q div BB => CarryOut + * Returns the CarryOut. + * Assumes Size(P) >= Size(M) + 1. + */ + +{ + return + BnnMultiplyDigit (pp, pl, mm, ml, d0) + + BnnMultiplyDigit (pp+1, pl-1, mm, ml, d1); +} +#endif /* mips */ + + + /***************************************/ +/* */ + + /********************** Division *************************/ + + + /* xh:xl -= yh:yl */ +#define SUB(xh,xl,yh,yl) if (yl > xl) {xl -= yl; xh -= yh + 1;}\ + else {xl -= yl; xh -= yh;} + +#define LOW(x) (x & ((((BigNumDigit)1) << (BN_DIGIT_SIZE / 2)) -1)) +#define HIGH(x) (x >> (BN_DIGIT_SIZE / 2)) +#define L2H(x) (x << (BN_DIGIT_SIZE / 2)) + + +#ifndef _NO_PROTO +BigNumDigit BnnDivideDigit (BigNum qq, BigNum nn, BigNumLength nl, BigNumDigit d) +#else /* _NO_PROTO */ +BigNumDigit BnnDivideDigit ( qq, nn, nl, d) +BigNum qq; BigNum nn; BigNumLength nl; BigNumDigit d; +#endif /* _NO_PROTO */ + +/* Performs the quotient: N div d => Q + * Returns R = N mod d + * Assumes leading digit of N < d, and d > 0. + */ + +{ + /* test computed at compile time */ + if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + { + register BigNumProduct quad; + + + nn += nl; + nl--; + qq += nl; + quad = *(--nn); + + while (nl != 0) + { + nl--; + quad = (quad << BN_DIGIT_SIZE) | *(--nn); + *(--qq) = quad / d; + quad = quad % d; + } + + return (quad); + } + else + { + int k; + BigNumLength orig_nl; + BigNumDigit rh; /* Two halves of current remainder */ + BigNumDigit rl; /* Correspond to quad above */ + register BigNumDigit qa; /* Current appr. to quotient */ + register BigNumDigit ph, pl; /* product of c and qa */ + BigNumDigit ch, cl, prev_qq; + + + /* Normalize divisor */ + k = BnnNumLeadingZeroBitsInDigit (d); + if (k != 0) + { + prev_qq = qq[-1]; + orig_nl = nl; + d <<= k; + BnnShiftLeft (nn, nl, k); + } + + nn += nl; + nl--; + qq += nl; + + ch = HIGH (d); + cl = LOW (d); + + rl = *(--nn); + + while (nl != 0) + { + nl--; + rh = rl; + rl = *(--nn); + qa = rh / ch; /* appr. quotient */ + + /* Compute ph, pl */ + pl = cl * qa; + ph = ch * qa; + ph += HIGH (pl); + pl = L2H (pl); + + /* While ph:pl > rh:rl, decrement qa, adjust qh:ql */ + while (ph > rh || ph == rh && pl > rl) + { + qa--; + SUB (ph, pl, ch, L2H (cl)); + } + + SUB (rh, rl, ph, pl); + + /* Top half of quotient is correct; save it */ + *(--qq) = L2H (qa); + qa = (L2H (rh) | HIGH (rl)) / ch; + + /* Approx low half of q */ + /* Compute ph, pl, again */ + pl = cl * qa; + ph = ch * qa; + ph += HIGH (pl); + pl = LOW (pl) | L2H (LOW (ph)); + ph = HIGH (ph); + + /* While ph:pl > rh:rl, decrement qa, adjust qh:ql */ + while (ph > rh || ph == rh && pl > rl) + { + qa--; + SUB (ph, pl, 0, d); + } + + /* Subtract ph:pl from rh:rl; we know rh will be 0 */ + rl -= pl; + *qq |= qa; + } + + /* Denormalize dividend */ + if (k != 0) { + if((qq > nn) && (qq < &nn[orig_nl])) { + /* Overlap between qq and nn. Care of *qq! */ + orig_nl = (qq - nn); + BnnShiftRight (nn, orig_nl, k); + nn[orig_nl - 1] = prev_qq; + } else if(qq == nn) { + BnnShiftRight(&nn[orig_nl - 1], 1, k); + } else { + BnnShiftRight (nn, orig_nl, k); + } } + return (rl >> k); + } +} + + /***************************************/ + + diff --git a/otherlibs/num/bignum/c/bn/bnCmp.c b/otherlibs/num/bignum/c/bn/bnCmp.c new file mode 100644 index 000000000..b678124d1 --- /dev/null +++ b/otherlibs/num/bignum/c/bn/bnCmp.c @@ -0,0 +1,77 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Fri Oct 5 16:13:31 GMT+1:00 1990 by herve */ +/* modified_on Fri Aug 10 17:21:47 GMT+2:00 1990 by shand */ + + +/* bnCmp.c: a piece of the bignum kernel written in C */ + + + /***************************************/ + +#define BNNMACROS_OFF +#include "BigNum.h" + + /*** copyright ***/ + +static char copyright[]="@(#)bnCmp.c: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\n"; + + +#ifndef _NO_PROTO +Boolean BnnIsZero (BigNum nn, BigNumLength nl) +#else /* _NO_PROTO */ +Boolean BnnIsZero (nn, nl) +BigNum nn; BigNumLength nl; +#endif /* _NO_PROTO */ + +/* + * Returns TRUE iff N = 0 + */ + +{ + return (BnnNumDigits (nn, nl) == 1 && (nl == 0 || BnnIsDigitZero (*nn))); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigNumCmp BnnCompare (BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl) +#else /* _NO_PROTO */ +BigNumCmp BnnCompare (mm, ml, nn, nl) +BigNum mm; BigNumLength ml; BigNum nn; BigNumLength nl; +#endif /* _NO_PROTO */ + +/* + * return + * BN_GT iff M > N + * BN_EQ iff N = N + * BN_LT iff N < N +*/ + +{ + register BigNumCmp result = BN_EQ; + + + ml = BnnNumDigits (mm, ml); + nl = BnnNumDigits (nn, nl); + + if (ml != nl) + return (ml > nl ? BN_GT : BN_LT); + + while (result == BN_EQ && ml-- > 0) + result = BnnCompareDigits (*(mm+ml), *(nn+ml)); + + return (result); + +/**** USE memcmp() instead: extern int memcmp (); + + if (ml == nl) + { + lex = memcmp (mm, nn, nl*BN_DIGIT_SIZE/BN_BYTE_SIZE); + return (lex > 0 ? BN_GT: (lex == 0 ? BN_EQ: BN_LT)); + } + else + return (ml > nl ? BN_GT : BN_LT); +******/ +} diff --git a/otherlibs/num/bignum/c/bn/bnDivide.c b/otherlibs/num/bignum/c/bn/bnDivide.c new file mode 100644 index 000000000..e25938bb8 --- /dev/null +++ b/otherlibs/num/bignum/c/bn/bnDivide.c @@ -0,0 +1,156 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Mon Apr 15 18:51:35 GMT+2:00 1991 by herve */ +/* modified_on Fri Mar 30 3:29:17 GMT+2:00 1990 by shand */ + + +/* bnDivide.c: a piece of the bignum kernel written in C */ + + + /***************************************/ + +#define BNNMACROS_OFF +#include "BigNum.h" + + /*** copyright ***/ + +static char copyright[]="@(#)bnDivide.c: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\n"; + + +static divide (nn, nl, dd, dl) + + BigNum nn, dd; +register BigNumLength nl, dl; + +/* + * In-place division. + * + * Input (N has been EXTENDED by 1 PLACE; D is normalized): + * +-----------------------------------------------+----+ + * | N EXT| + * +-----------------------------------------------+----+ + * + * +-------------------------------+ + * | D 1| + * +-------------------------------+ + * + * Output (in place of N): + * +-------------------------------+---------------+----+ + * | R | Q | + * +-------------------------------+---------------+----+ + * + * Assumes: + * N > D + * Size(N) > Size(D) + * last digit of N < last digit of D + * D is normalized (Base/2 <= last digit of D < Base) + */ + +{ + register int ni; + BigNumDigit DDigit, BaseMinus1, QApp, RApp; + + + /* Initialize constants */ + BnnSetDigit (&BaseMinus1, 0); + BnnComplement(&BaseMinus1, 1); + + /* Save the most significant digit of D */ + BnnAssign (&DDigit, dd+dl-1, 1); + + /* Replace D by Base - D */ + BnnComplement (dd, dl); + BnnAddCarry (dd, dl, 1); + + /* For each digit of the divisor, from most significant to least: */ + nl += 1; + ni = nl-dl; + while (--ni >= 0) + { + /* Compute the approximate quotient */ + nl--; + + /* If first digits of numerator and denominator are the same, */ + if (BnnCompareDigits (*(nn+nl), DDigit) == BN_EQ) + /* Use "Base - 1" for the approximate quotient */ + BnnAssign (&QApp, &BaseMinus1, 1); + else + /* Divide the first 2 digits of N by the first digit of D */ + RApp = BnnDivideDigit (&QApp, nn+nl-1, 2, DDigit); + + /* Compute the remainder */ + BnnMultiplyDigit (nn+ni, dl+1, dd, dl, QApp); + + /* Correct the approximate quotient, in case it was too large */ + while (BnnCompareDigits (*(nn+nl), QApp) != BN_EQ) + { + BnnSubtract (nn+ni, dl+1, dd, dl, 1); /* Subtract D from N */ + BnnSubtractBorrow (&QApp, 1, 0); /* Q -= 1 */ + } + } + + /* Restore original D */ + BnnComplement (dd, dl); + BnnAddCarry (dd, dl, 1); +} + + + /***************************************/ +/* */ + + +void BnnDivide (nn, nl, dd, dl) + + BigNum nn, dd; +register BigNumLength nl, dl; + +/* + * Performs the quotient: + * N div D => high-order bits of N, starting at N[dl] + * N mod D => low-order dl bits of N + * + * Assumes + * Size(N) > Size(D), + * last digit of N < last digit of D (if N > D). + */ + +{ + BigNumDigit nshift; + + + /* Take care of easy cases first */ + switch (BnnCompare (nn, nl, dd, dl)) + { + case BN_LT: /* n < d */ + ; /* N => R */ + BnnSetToZero (nn+dl, nl-dl); /* 0 => Q */ + return; + case BN_EQ: /* n == d */ + BnnSetToZero (nn, nl); /* 0 => R */ + BnnSetDigit (nn+dl, 1); /* 1 => Q */ + /* bug fixed Mon Apr 15 18:36:50 GMT+2:00 1991 by jch, + was BnnSetDigit (nn+nl-1, 1); */ + return; + } + + /* here: n > d */ + + /* If divisor is just 1 digit, use a special divide */ + if (dl == 1) + *nn = BnnDivideDigit (nn+1, nn, nl, *dd); /* note: nn+1 = nn+dl */ + /* Otherwise, divide one digit at a time */ + else + { + /* Normalize */ + nshift = BnnNumLeadingZeroBitsInDigit (*(dd+dl-1)); + BnnShiftLeft (dd, dl, nshift); + BnnShiftLeft (nn, nl, nshift); + + /* Divide */ + divide (nn, nl-1, dd, dl); + + /* Unnormalize */ + BnnShiftRight (dd, dl, nshift); + BnnShiftRight (nn, dl, nshift); + /* note: unnormalize N <=> unnormalize R (with R < D) */ + } +} diff --git a/otherlibs/num/bignum/c/bn/bnInit.c b/otherlibs/num/bignum/c/bn/bnInit.c new file mode 100644 index 000000000..d02301508 --- /dev/null +++ b/otherlibs/num/bignum/c/bn/bnInit.c @@ -0,0 +1,74 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Fri Oct 5 16:28:39 GMT+1:00 1990 by herve */ +/* modified_on Fri Mar 30 3:28:56 GMT+2:00 1990 by shand */ + + +/* bnInit.c: a piece of the bignum kernel written in C */ + + + /***************************************/ + +#define BNNMACROS_OFF +#include "BigNum.h" + +static int Initialized = FALSE; + + /*** copyright ***/ + +static char copyright[]="@(#)bnInit.c: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\n"; + + + /***************************************/ + +void BnnInit () +{ + if (!Initialized) + { + + + Initialized = TRUE; + } +} + + /***************************************/ + +void BnnClose () +{ + if (Initialized) + { + + + Initialized = FALSE; + } +} + + /***************************************/ + + /* some U*ix standard functions do not exist on VMS */ + /* neither on MSDOS */ + +#ifdef NOMEM + +/* Copies LENGTH bytes from string SRC to string DST */ +void bcopy(src, dst, length) +char *src, *dst; +register int length; +{ + for (; length > 0; length--) + *dst++ = *src++; +} + +/* Places LENGTH 0 bytes in the string B */ +void bzero(buffer, length) +char *buffer; +register int length; +{ + for (; length>0; length--) + *buffer++ = 0; +} + +#endif + + + + /***************************************/ diff --git a/otherlibs/num/bignum/c/bn/bnMult.c b/otherlibs/num/bignum/c/bn/bnMult.c new file mode 100644 index 000000000..f4ecf8337 --- /dev/null +++ b/otherlibs/num/bignum/c/bn/bnMult.c @@ -0,0 +1,84 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Tue Oct 9 10:43:48 GMT+1:00 1990 by herve */ +/* modified_on Fri Mar 30 4:13:47 GMT+2:00 1990 by shand */ + + +/* bnMult.c: a piece of the bignum kernel written in C */ + + + /***************************************/ + +#define BNNMACROS_OFF +#include "BigNum.h" + + /*** copyright ***/ + +static char copyright[]="@(#)bnMult.c: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\n"; + + +BigNumCarry BnnMultiply (pp, pl, mm, ml, nn, nl) + +register BigNum pp, nn; + BigNum mm; +register BigNumLength pl, nl; + BigNumLength ml; + +/* + * Performs the product: + * Q = P + M * N + * BB = BBase(P) + * Q mod BB => P + * Q div BB => CarryOut + * + * Returns the CarryOut. + * + * Assumes: + * Size(P) >= Size(M) + Size(N), + * Size(M) >= Size(N). + */ + +{ + BigNumCarry c; + + /* Multiply one digit at a time */ + + /* the following code give higher performance squaring. + ** Unfortunately for small nl, procedure call overheads kills it + */ +#ifndef mips_v131 +#ifndef MSDOS + /* Squaring code provoke a mips optimizer bug in V1.31 */ + /* It also doesn't work using MSDOS */ + if (mm == nn && ml == nl && nl > 6) + { + register BigNumDigit n_prev = 0; + /* special case of squaring */ + for (c = 0; nl > 0; ) + { + register BigNumDigit n = *nn; + c += BnnMultiplyDigit(pp, pl, nn, 1, n); + if (n_prev) + c += BnnAdd(pp, pl, nn, 1, (BigNumCarry) 0); + nl--, nn++; + pp += 2, pl -= 2; + c += BnnMultiplyDigit(pp-1, pl+1, nn, nl, n+n+n_prev); + /* note following if statements are resolved at compile time */ + if (sizeof(BigNumDigit) == sizeof(short)) + n_prev = ((short) n) < 0; + else if (sizeof(BigNumDigit) == sizeof(int)) + n_prev = ((int) n) < 0; + else if (sizeof(BigNumDigit) == sizeof(long)) + n_prev = ((long) n) < 0; + else + n_prev = ((n<<1)>>1) == n; + } + } + else +#endif +#endif + for (c = 0; nl-- > 0; pp++, nn++, pl--) + c += BnnMultiplyDigit (pp, pl, mm, ml, *nn); + + return c; +} + diff --git a/otherlibs/num/bignum/c/bz.c b/otherlibs/num/bignum/c/bz.c new file mode 100644 index 000000000..10d0c224f --- /dev/null +++ b/otherlibs/num/bignum/c/bz.c @@ -0,0 +1,833 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Thu Apr 4 20:01:18 GMT+2:00 1991 by herve */ +/* modified_on Thu Mar 22 20:45:38 GMT+1:00 1990 by shand */ + + +/* bz.c: provides an implementation of "unlimited-precision" + * arithmetic for signed integers. + * + * Several conventions are used in the commentary: + * A "BigZ" is the name for an arbitrary-precision signed integer. + * Capital letters (e.g., "Z") are used to refer to the value of BigZs. + */ + + +#include "BigZ.h" + + + /***************************************/ +/* +#include <stdio.h> +#include <macros.h> +#include <math.h> +#include <malloc.h> +#include <values.h> +*/ + +#define NULL 0 +#define max(a,b) (a<b ? b : a) +#define abs(x) (x>=0 ? x : -(x)) +#define M_LN2 0.69314718055994530942 +#define M_LN10 2.30258509299404568402 +#define BITSPERBYTE 8 +#define BITS(type) (BITSPERBYTE * (int)sizeof(type)) +#define HIBITI (1 << BITS(int) - 1) +#define MAXINT (~HIBITI) + + /***************************************/ + +#define BzToBn(z) ((z)->Digits) +#define CTOI(c) (c >= '0' && c <= '9' ? c - '0' :\ + c >= 'a' && c <= 'f' ? c - 'a' + 10:\ + c >= 'A' && c <= 'F' ? c - 'A' + 10:\ + 0) + +extern char *malloc(); + + /*** copyright ***/ + +static char copyright[]="@(#)bz.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\n"; + + + /***************************************/ + +static int Initialized = FALSE; + +/* constants used by BzToString() and BzFromString() */ +static double BzLog [] = +{ + 0, + 0, /* log (1) */ + M_LN2, /* log (2) */ + 1.098612, /* log (3) */ + 1.386294, /* log (4) */ + 1.609438, /* log (5) */ + 1.791759, /* log (6) */ + 1.945910, /* log (7) */ + 2.079442, /* log (8) */ + 2.197225, /* log (9) */ + M_LN10, /* log (10) */ + 2.397895, /* log (11) */ + 2.484907, /* log (12) */ + 2.564949, /* log (13) */ + 2.639057, /* log (14) */ + 2.708050, /* log (15) */ + 2.772588, /* log (16) */ +}; + +/* */ + + +#ifndef _NO_PROTO +void BzInit (void) +#else /* _NO_PROTO */ +void BzInit () +#endif /* _NO_PROTO */ +{ + if (!Initialized) + { + BnnInit (); + Initialized = TRUE; + } +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigZ BzCreate (BigNumLength Size) +#else /* _NO_PROTO */ +BigZ BzCreate (Size) +BigNumLength Size; +#endif /* _NO_PROTO */ + +/* + * Allocates a BigZ of the desired size. + * Sets it to 0. + */ + +{ + BigZ z; + + + if ((z = (BigZ) (malloc (sizeof (struct BigZHeader) + Size * sizeof (BigNumDigit)))) != NULL) + { + /* reset digits */ + BnnSetToZero (BzToBn (z), Size); + + /* init header */ + BzSetSize (z, Size); + BzSetSign (z, BZ_ZERO); + } + + return (z); +} + + + +#ifndef _NO_PROTO +void BzFree (BigZ z) +#else /* _NO_PROTO */ +void BzFree (z) +BigZ z; +#endif /* _NO_PROTO */ + +/* + * Frees an existing BigZ. + */ + +{ + free (z); +} + + /***************************************/ + /***************************************/ + + +#ifndef _NO_PROTO +void BzFreeString (char *s) +#else /* _NO_PROTO */ +void BzFreeString (s) +char *s; +#endif /* _NO_PROTO */ + +/* + * Frees an existing BigZ allocated string. + */ + +{ + free (s); +} + + /***************************************/ +/* */ + +#ifndef _NO_PROTO +BigNumLength BzNumDigits (BigZ z) +#else /* _NO_PROTO */ +BigNumLength BzNumDigits (z) +BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns the number of digits used by z. + */ + +{ + return (BnnNumDigits (BzToBn (z), BzGetSize (z))); +} + + + /***************************************/ + + +#ifndef _NO_PROTO +BigZ BzCopy (BigZ z) +#else /* _NO_PROTO */ +BigZ BzCopy (z) +BigZ z; +#endif /* _NO_PROTO */ + +/* + * Creates a copy of the passed BigZ. + */ + +{ + BigZ y; + int zl; + + + zl = BzNumDigits (z); + if ((y = BzCreate (zl)) != NULL) + { + /* copy the digits */ + BnnAssign (BzToBn (y), BzToBn (z), zl); + + /* copy the header WITHOUT the size !! */ + BzSetSign (y, BzGetSign (z)); + } + + return (y); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzNegate (BigZ z) +#else /* _NO_PROTO */ +BigZ BzNegate (z) +BigZ z; +#endif /* _NO_PROTO */ + +/* + * Negates the passed BigZ. + */ + +{ + BigZ y; + + y = BzCopy (z); + BzSetSign (y, BzGetOppositeSign (z)); + + return (y); +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigZ BzAbs (BigZ z) +#else /* _NO_PROTO */ +BigZ BzAbs (z) +BigZ z; +#endif /* _NO_PROTO */ + +/* + * Takes the absolute value of the passed BigZ. + */ + +{ + BigZ y; + + y = BzCopy (z); + BzSetSign (y, abs (BzGetSign (z))); + + return (y); +} + + /***************************************/ + + +#ifndef _NO_PROTO +BzCmp BzCompare (BigZ y, BigZ z) +#else /* _NO_PROTO */ +BzCmp BzCompare (y, z) +BigZ y; BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns BZ_GT if Y > Z, + * BZ_LT if Y < Z, + * BZ_EQ otherwise. + */ + +{ + return (BzGetSign (y) > BzGetSign (z) ? BZ_GT : + BzGetSign (y) < BzGetSign (z) ? BZ_LT : + BzGetSign (y) > 0 ? BnnCompare (BzToBn (y), BzGetSize (y), + BzToBn (z), BzGetSize (z)) : + BzGetSign (y) < 0 ? BnnCompare (BzToBn (z), BzGetSize (z), + BzToBn (y), BzGetSize (y)) : + BZ_EQ); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzAdd (BigZ y, BigZ z) +#else /* _NO_PROTO */ +BigZ BzAdd (y, z) +BigZ y; BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns Y + Z. + */ + +{ + BigZ n; + int yl; + int zl; + + + yl = BzNumDigits (y); + zl = BzNumDigits (z); + + if (BzGetSign (y) == BzGetSign (z)) + { + /* Add magnitudes if signs are the same */ + switch (BnnCompare (BzToBn (y), yl, BzToBn (z), zl)) + { + case BZ_EQ: + case BZ_GT: /* |Y| >= |Z| */ + + if ((n = BzCreate (yl+1)) != NULL) + { + BnnAssign (BzToBn (n), BzToBn (y), yl); + BnnAdd (BzToBn (n), yl+1, BzToBn (z), zl, (BigNumCarry) 0); + BzSetSign (n, BzGetSign (y)); + } + break; + + default: /* BZ_LT: |Y| < |Z| */ + + if ((n = BzCreate (zl+1)) != NULL) + { + BnnAssign (BzToBn (n), BzToBn (z), zl); + BnnAdd (BzToBn (n), zl+1, BzToBn (y), yl, (BigNumCarry) 0); + BzSetSign (n, BzGetSign (z)); + } + break; + } + } +/* */ + + + else + { + /* Subtract magnitudes if signs are different */ + switch (BnnCompare (BzToBn (y), yl, BzToBn (z), zl)) + { + case BZ_EQ: /* Y = -Z */ + + n = BzCreate (1); + break; + + case BZ_GT: /* |Y| > |Z| */ + + if ((n = BzCreate (yl)) != NULL) + { + BnnAssign (BzToBn (n), BzToBn (y), yl); + BnnSubtract (BzToBn (n), yl, BzToBn (z), zl, (BigNumCarry) 1); + BzSetSign (n, BzGetSign (y)); + } + break; + + default: /* BZ_LT: |Y| < |Z| */ + + if ((n = BzCreate (zl)) != NULL) + { + BnnAssign (BzToBn (n), BzToBn (z), zl); + BnnSubtract (BzToBn (n), zl, BzToBn (y), yl, (BigNumCarry) 1); + BzSetSign (n, BzGetSign (z)); + } + break; + } + } + + return (n); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzSubtract (BigZ y, BigZ z) +#else /* _NO_PROTO */ +BigZ BzSubtract (y, z) +BigZ y; BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns Y - Z. + */ + +{ + if (y == z) + return (BzCreate (1)); + else + { + BigZ diff; + + BzSetSign (z, BzGetOppositeSign (z)); + diff = BzAdd (y, z); + BzSetSign (z, BzGetOppositeSign (z)); + + return diff; + } +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzMultiply (BigZ y, BigZ z) +#else /* _NO_PROTO */ +BigZ BzMultiply (y, z) +BigZ y; BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns Y * Z. + */ + +{ + BigZ n; + int yl, zl; + + + yl = BzNumDigits (y); + zl = BzNumDigits (z); + + if ((n = BzCreate (yl+zl)) != NULL) + { + BnnMultiply (BzToBn (n), yl+zl, BzToBn (y), yl, BzToBn (z), zl); + BzSetSign (n, BzGetSign (y) * BzGetSign (z)); + } + + return (n); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzDivide (BigZ y, BigZ z, BigZ *r) +#else /* _NO_PROTO */ +BigZ BzDivide (y, z, r) +BigZ y; BigZ z; BigZ *r; +#endif /* _NO_PROTO */ + +/* + * Sets Y mod Z => R, + * Returns Y div Z => Q + * + * such that Y = ZQ + R + * and 0 <= R < |Z|. + * + * Return NULL if Z = 0 + * + * Return floor(Y/Z) if Z > 0 + * otherwise return ceil(Y/Z) + * where / is the real numbers division. + */ + +{ + BigZ q; + int yl, zl, ql, rl; + Boolean rnotnul; + + + if (BzGetSign (z) == BZ_ZERO) + return (NULL); + + yl = BzNumDigits (y); + zl = BzNumDigits (z); + + /* max +1 since BnnAddCarry can overflow */ + ql = max (yl-zl+1, 1) +1; + rl = max (zl,yl) + 1; + + /* Set up quotient, remainder */ + q = BzCreate (ql); + *r = BzCreate (rl); + + if (!*r || !q) + return (NULL); + + BnnAssign (BzToBn (*r), BzToBn (y), yl); + + /* Do the division */ + BnnDivide (BzToBn (*r), rl, BzToBn (z), zl); + BnnAssign (BzToBn (q), BzToBn (*r) + zl, rl-zl); + BnnSetToZero (BzToBn (*r) + zl, rl-zl); + rl = zl; + + /* Correct the signs, adjusting the quotient and remainder */ + rnotnul = !BnnIsZero (BzToBn (*r), rl); + if (BzGetSign (y) == BZ_MINUS && rnotnul) + { + /* Y < 0, R > 0: (Q+1)=>Q, Z-R=>R */ + BnnAddCarry (BzToBn (q), ql, (BigNumCarry) 1); + + BzSetSign (q, BzGetOppositeSign (z)); + BnnComplement (BzToBn (*r), rl); + BnnAdd (BzToBn (*r), rl, BzToBn (z), zl, (BigNumCarry) 1); + } + else + BzSetSign (q, BzGetSign (y) * BzGetSign (z)); + + if (BnnIsZero (BzToBn(q),ql)) + BzSetSign (q,BZ_ZERO); + + /* Correct the sign of the remainder */ + if (rnotnul) + BzSetSign (*r, BZ_PLUS); + + return (q); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzDiv (BigZ y, BigZ z) +#else /* _NO_PROTO */ +BigZ BzDiv (y, z) +BigZ y; BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns Y div Z. + * + * Return NULL if Z = 0 + * + * Return floor(Y/Z) if Z > 0 + * otherwise return ceil(Y/Z) + * where / is the real numbers division + */ + +{ + BigZ q, r; + + + q = BzDivide (y, z, &r); + BzFree (r); + + return (q); +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigZ BzMod (BigZ y, BigZ z) +#else /* _NO_PROTO */ +BigZ BzMod (y, z) +BigZ y; BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns Y mod Z. + */ + +{ + BigZ r; + + + BzFree (BzDivide (y, z, &r)); + + return (r); +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +char * BzToString (BigZ z, BigNumDigit base) +#else /* _NO_PROTO */ +char * BzToString (z, base) +BigZ z; BigNumDigit base; +#endif /* _NO_PROTO */ + +/* + * Returns a pointer to a string that represents Z in the specified base. + * Assumes 2 <= base <= 16. + */ + +{ + char * string; + BigZ y, q, t; + BigNumDigit r; + + static char Digit[] = "0123456789ABCDEF"; + char * s; + int sd; + int zl, sl; + + + if (base < 2 || base > 16) + return (NULL); + + /* Allocate BigNums and set up string */ + zl = BzNumDigits (z) + 1; + sl = BzLog[2] * BN_DIGIT_SIZE * zl / BzLog[base] + 3; + + y = BzCreate (zl); + q = BzCreate (zl); + + string = malloc (sl * sizeof (char)); + + if (!y || !q || !string) + return (NULL); + + BnnAssign (BzToBn (y), BzToBn (z), zl-1); + s = string + sl; + + /* Divide Z by base repeatedly; successive digits given by remainders */ + *--s = '\0'; + if (BzGetSign (z) == BZ_ZERO) + *--s = '0'; + else + do + { + r = BnnDivideDigit (BzToBn (q), BzToBn (y), zl, base); + *--s = Digit[r]; + + /* exchange y and q (to avoid BzMove (y, q) */ + t = q, q = y, y = t; + } while (!BnnIsZero (BzToBn (y), zl)); + + /* Set sign if negative */ + if (BzGetSign (z) < 0) + *--s = '-'; + + /* and move string into position */ + if ((sd = s-string) > 0) + while (s < string + sl) + { + *(s-sd) = *s; + s++; + } + + /* Free temporary BigNums and return the string */ + BzFree(y); + BzFree(q); + + return string; +} + + /***************************************/ +/* */ + + +#ifndef _NO_PROTO +BigZ BzFromString (char *s, BigNumDigit base) +#else /* _NO_PROTO */ +BigZ BzFromString (s, base) +char *s; BigNumDigit base; +#endif /* _NO_PROTO */ + +/* + * Creates a BigZ whose value is represented by "string" in the + * specified base. The "string" may contain leading spaces, + * followed by an optional sign, followed by a series of digits. + * Assumes 2 <= base <= 16. + * When called from C, only the first 2 arguments are passed. + */ + +{ + BigZ z, p, t; + BzSign sign; + int zl; + + + /* Throw away any initial space */ + while (*s == ' ') + s++; + + /* Allocate BigNums */ + zl = strlen (s) * BzLog[base] / (BzLog[2] * BN_DIGIT_SIZE) + 1; + + z = BzCreate (zl); + p = BzCreate (zl); + + if (!z || !p) + return (NULL); + + /* Set up sign, base, initialize result */ + sign = (*s == '-' ? (s++, BZ_MINUS) : *s == '+' ? (s++, BZ_PLUS) : BZ_PLUS); + + /* Multiply in the digits of the string, one at a time */ + for (; *s != '\0'; s++) + { + BnnSetToZero (BzToBn (p), zl); + BnnSetDigit (BzToBn (p), CTOI (*s)); + BnnMultiplyDigit (BzToBn (p), zl, BzToBn (z), zl, base); + + /* exchange z and p (to avoid BzMove (z, p) */ + t = p, p = z, z = t; + } + + /* Set sign of result */ + BzSetSign (z, BnnIsZero (BzToBn (z), zl) ? BZ_ZERO : sign); + + /* Free temporary BigNums */ + BzFree (p); + + return (z); +} + + /***************************************/ + +#ifndef _NO_PROTO +BigZ BzFromInteger (int i) +#else /* _NO_PROTO */ +BigZ BzFromInteger (i) +int i; +#endif /* _NO_PROTO */ + +{ + BigZ z; + + + z = BzCreate (1); + + z->Digits[0] = abs (i); + + if (i > 0) + BzSetSign (z, BZ_PLUS); + else + if (i < 0) + BzSetSign (z, BZ_MINUS); + else + BzSetSign (z, BZ_ZERO); + + return z; +} + + /***************************************/ + + +#ifndef _NO_PROTO +int BzToInteger (BigZ z) +#else /* _NO_PROTO */ +int BzToInteger (z) +BigZ z; +#endif /* _NO_PROTO */ + +{ + if (BzNumDigits (z) > 1) + return (MAXINT); + + if (BzGetSign (z) == BZ_MINUS) + return (- z->Digits[0]); + else + return (z->Digits[0]); +} + + /***************************************/ + + +#ifndef _NO_PROTO +BigZ BzFromBigNum (BigNum n, BigNumLength nl) +#else /* _NO_PROTO */ +BigZ BzFromBigNum (n, nl) +BigNum n; BigNumLength nl; +#endif /* _NO_PROTO */ + +{ + BigZ z; + int i; + + + z = BzCreate (nl); + + /* set the sign of z such that the pointer n is unchanged yet */ + if (BnnIsZero (n, nl)) + BzSetSign (z, BZ_ZERO); + else + BzSetSign (z, BZ_PLUS); + + for (i = 0; i < nl; i++, n++) + z->Digits[i] = *n; + + return z; +} + + /***************************************/ + +#ifndef _NO_PROTO +BigNum BzToBigNum (BigZ z, BigNumLength *nl) +#else /* _NO_PROTO */ +BigNum BzToBigNum (z, nl) +BigZ z; BigNumLength *nl; +#endif /* _NO_PROTO */ + +{ + BigNum n, m; + int i; + + + if (BzGetSign (z) == BZ_MINUS) + return NULL; + + *nl = BzNumDigits (z); + + if ((n = (BigNum) (malloc (((*nl+1) * sizeof (BigNumDigit))))) != NULL) + { + *n = *nl; /* set size */ + + for (i = 0, m = ++n; i < *nl; i++, m++) + *m = z->Digits[i]; + } + + return n; +} + + /***************************************/ + + +#ifndef _NO_PROTO +void BzClose (void) +#else /* _NO_PROTO */ +void BzClose () +#endif /* _NO_PROTO */ +{ + if (Initialized) + { + BnnClose (); + Initialized = FALSE; + } +} + + /***************************************/ diff --git a/otherlibs/num/bignum/c/bzf.c b/otherlibs/num/bignum/c/bzf.c new file mode 100644 index 000000000..7186452aa --- /dev/null +++ b/otherlibs/num/bignum/c/bzf.c @@ -0,0 +1,50 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Mon Jan 23 16:05:27 GMT+1:00 1989 by herve */ + +/* + * bzf.c: Miscellaneous functions built on top of BigZ. + * + */ + + +#include "BigZ.h" + + /***************************************/ + +#define BzToBn(z) ((z)->Digits) + + /***************************************/ + + +#ifndef _NO_PROTO +BigZ BzFactorial (BigZ z) +#else /* _NO_PROTO */ +BigZ BzFactorial (z) +BigZ z; +#endif /* _NO_PROTO */ + +/* + * Returns Z! + * Assumes Z < Base. + */ + +{ + BigZ f; + BigNumDigit zval; + int fl = 1; + + + zval = BnnGetDigit (BzToBn (z)); + f = BzCreate (zval+1); + BnnSetDigit (BzToBn (f), 1); + BzSetSign (f, BzGetSign (z)); + + while (zval-- > 1) + { + BnnMultiplyDigit (BzToBn (f), fl+1, BzToBn (f), fl, zval); + fl = BnnNumDigits (BzToBn (f), fl+1); + } + + return (f); +} + diff --git a/otherlibs/num/bignum/c/bztest.c b/otherlibs/num/bignum/c/bztest.c new file mode 100644 index 000000000..2d06b184e --- /dev/null +++ b/otherlibs/num/bignum/c/bztest.c @@ -0,0 +1,167 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Tue Feb 25 1:27:57 GMT+1:00 1992 by shand */ +/* modified_on Mon Apr 15 18:44:14 GMT+2:00 1991 by herve */ + +#include <stdio.h> +#include "BigZ.h" + +#ifndef MSDOS +#define S(A,B) strcmp(A,B) +#define P(A) fprintf(stderr,"%d...",A) +#define E(A,B,C) fprintf(stderr,"\nError in test #%d:\nComputed: %s\nCorrect: %s\n",A,C,B) +#define T(A,B,C) S(B,C)?E(A,B,C):P(A) +#else +void T(A,B,C) +int A; +char *B, *C; +{ + if (strcmp (B, C)) + fprintf (stderr, "\nError in test #%d:\nComputed: %s\nCorrect: %s\n",A,C,B); + else + fprintf (stderr,"%2d...",A); +} +#endif +#define NEWLINE fprintf(stderr,"\n") +#define To(A) BzToString(A,10) +#define From(A) BzFromString(A,10) +#define Abs(A) BzAbs(A) +#define Neg(A) BzNegate(A) +#define Add(A,B) BzAdd(A,B) +#define Sub(A,B) BzSubtract(A,B) +#define Mul(A,B) BzMultiply(A,B) +#define Div(A,B) BzDiv(A,B) +#define Mod(A,B) BzMod(A,B) +#define Fac(A) BzFactorial(A) +#define FromI(I) BzFromInteger(I) +#define Cmp(A,B) BzCompare(A,B) +#define Sqa(A) Mul(A,A) + +#define zero FromI(0) +#define one FromI(1) +#define two FromI(2) +#define minusone FromI(-1) + +#ifdef DIGITonUSHORT +#define two31m1 Sub(Mul(From("65536"),From("32768")),one) +#else +#define two31m1 FromI(0x7FFFFFFF) +#endif + +main() +{ + BigZ a,b; + + T(1,"12", To(From("12"))) ; + T(2,"12345678910", To(From("12345678910"))) ; + T(3,"123", To(From("00000123"))) ; + T(4,"-123", To(From("-123"))) ; + T(5,"-32768", To(From("-32768"))) ; + T(6,"-32768", To(Neg(From("32768")))) ; + T(7,"-32768", To(Add(From("-16384"),From("-16384")))) ; + T(8,"-32768", To(Add(From("-16383"),From("-16385")))) ; + T(9,"-32768", To(Mul(From("2"),From("-16384")))) ; + T(10,"-16384", To(Div(From("-32768"),From("2")))) ; + NEWLINE; + T(11,"100000", To(Add(From("1"),From("99999")))) ; + T(12,"12343994",To(Add(From("-1684"),From("12345678")))); + T(13,"-12329294",To(Sub(From("16384"),From("12345678")))); + T(14,"135801",To(Add(From("12345"),From("123456")))); + T(15,"123456135801",To(Add(From("12345"),From("123456123456")))); + T(16,"135801",To(Add(From("123456"),From("12345")))); + T(17,"123456135801",To(Add(From("123456123456"),From("12345")))); + T(18,"135801",To(Sub(From("12345"),From("-123456")))); + T(19,"123456135801",To(Sub(From("12345"),From("-123456123456")))); + T(20,"135801",To(Sub(From("123456"),From("-12345")))); + NEWLINE; + T(21,"123456135801",To(Sub(From("123456123456"),From("-12345")))); + T(22,"-111111",To(Sub(From("12345"),From("123456")))); + T(23,"111111",To(Sub(From("123456"),From("12345")))); + T(24,"-123456111111",To(Sub(From("12345"),From("123456123456")))); + T(25,"123456111111",To(Sub(From("123456123456"),From("12345")))); + T(26,"-111111",To(Add(From("12345"),From("-123456")))); + T(27,"111111",To(Add(From("123456"),From("-12345")))); + T(28,"-123456111111",To(Add(From("12345"),From("-123456123456")))); + T(29,"123456111111",To(Add(From("123456123456"),From("-12345")))); + T(30,"2", To(Div(From("264195"),From("97200")))) ; + NEWLINE; + T(31,"27405", To(Mod(From("97200"),From("69795")))) ; + T(32,"4294967295", To(Div(From("22685491128062564230891640495451214097"),From("5281877500950955845296219748")))) ; + T(33,"99997",To(Add(From("-3"),From("100000")))); + T(34,"-100003",To(Add(From("-3"),From("-100000")))); + T(35,"999999",To(Sub(From("1000000"),From("1")))); + T(36,"999999999",To(Mul(From("12345679"),From("81")))); + a = From("1234567"); + b = From("123456"); + T(37,"1234567",To(Add(Mul(Div(a,b),b),Mod(a,b)))); + T(38,"-1234567",To(Add(Mul(Div(Neg(a),Neg(b)),Neg(b)),Mod(Neg(a),Neg(b))))); + T(39,"1234567",To(Add(Mul(Div(a,Neg(b)),Neg(b)),Mod(a,Neg(b))))); + T(40,"10000000000000000000000",To(Mul(From("-100000000000"),From("-100000000000")))); + NEWLINE; + T(41,"-10000000000000000000000",To(Mul(From("-100000000000"),From("100000000000")))); + T(42,"-10000000000000000000000",To(Mul(From("100000000000"),From("-100000000000")))); + T(43,"10000000000000000000000",To(Mul(From("100000000000"),From("100000000000")))); + a = Sub(From("10000000000000"),From("10000000000000")); + T(44,"0",To(Mod(a,From("1000000000000")))); + T(45,"0",To(Div(a,From("1000000000000")))); + T(46,"0",To(Mod(Neg(a),From("10000000000000")))); + T(47,"0",To(Div(Neg(a),From("10000000000000")))); + T(48,"2",To(Div(From("3000"),Sub(From("1234567891234"),From("1234567890000"))))); + T(49,"532",To(Mod(From("3000"),Sub(From("1234567891234"),From("1234567890000"))))); + T(50,"9",To(Mod(From("-1234567890"),From("1234567899")))); + NEWLINE; + T(51,"2",To(Mod(Sub(From("12345678900000"),From("12345678926887")),From("3")))); + T(52,"40830949904677684825316369628906250000000000000",To(Mul(From("48270948888581289062500000000"),From("845870049062500000")))); + T(53,"22666179639240748063923391983020279316955515",To(Mul(From("6956883693"),From("3258093801689886619170103176686855")))); + T(54,"1405006117752879898543142606244511569936384000000000",To(Fac(From("42")))); + T(55,"0",To(Mod(Fac(From("13")),Fac(From("9"))))); + T(56,"0",To(Mod(Fac(From("34")),Fac(From("13"))))); + T(57,"0",To(Mod(Fac(From("57")),Fac(From("21"))))); + T(58,"0",To(Mod(Fac(From("40")),Fac(From("39"))))); + T(59,"59",To(Div(Fac(From("59")),Fac(From("58"))))); + T(60,"2",To(Div(From("5"),From("2")))); + NEWLINE; + T(61,"1",To(Mod(From("5"),From("2")))); + T(62,"-3",To(Div(From("-5"),From("2")))); + T(63,"1",To(Mod(From("-5"),From("2")))); + T(64,"3",To(Div(From("-5"),From("-2")))); + T(65,"1",To(Mod(From("-5"),From("-2")))); + T(66,"-2",To(Div(From("5"),From("-2")))); + T(67,"1",To(Mod(From("5"),From("-2")))); + T(68,"3",To(Div(From("6"),From("2")))); + T(69,"0",To(Mod(From("6"),From("2")))); + T(70,"-3",To(Div(From("-6"),From("2")))); + NEWLINE; + T(71,"0",To(Mod(From("-6"),From("2")))); + T(72,"3",To(Div(From("-6"),From("-2")))); + T(73,"0",To(Mod(From("-6"),From("-2")))); + T(74,"-3",To(Div(From("6"),From("-2")))); + T(75,"0",To(Mod(From("6"),From("-2")))); + T(76,"0",To(Abs(From("0")))); + T(77,"1234567890",To(Abs(From("1234567890")))); + T(78,"1234567890",To(Abs(From("-1234567890")))); + T(79,"1",BzCompare(From("-1234567890"),From("12345"))<0?"1":"0"); + T(80,"1",BzGetSign(From("-1234567890"))<0?"1":"0"); + NEWLINE; + T(81,"0", To(Add(From("-1"),Mul(From("-1"),From("-1"))))); + T(82,"-1",To(Add(From("-1"),Mul(From("0"), From("-1"))))); + T(83,"-3",To(Add(From("-1"),Mul(From("-2"),From("1" ))))); + T(84,"1", To(Add(From("-1"),Mul(From("-2"),From("-1"))))); + T(85,"-1",To(Add(From("1"), Mul(From("-2"),From("1" ))))); + T(86,"18446744065119617025",To(Mul(From("4294967295"),From("4294967295")))); + /* (-2^64 + 2^32 - 1) / 2^32 */ + T(87,"-4294967296",To(Div( + Sub(Mul(Mul(Add(Mul(two31m1,two),one),Mul(Add(two31m1,one), two)),minusone),one), + Mul(Add (two31m1,one),two)))); + T(88,"Equal",(Cmp(Mod(FromI(10),FromI(5)),zero) == BZ_EQ)?"Equal":"Not equal"); + T(89,"Equal",(Cmp(Div(FromI(4),FromI(5)),zero) == BZ_EQ)?"Equal":"Not equal"); + a = From ("100000000000000000000000000000000000000"); + T(90,To (a),To(Div (Sqa (a),a))); + /* 90: tests the MIPS & turbo C optimizer bugs. If the special */ + /* purpose squaring code is enabled and the optimizer */ + /* messes up, this test will fail */ + NEWLINE; + b = Sqa (a); + T(91,To (b),To(Div (Sqa (b),b))); + T(92,"-1",To(Div(From("13"),From("-13")))); + NEWLINE; +} diff --git a/otherlibs/num/bignum/c/testKerN.c b/otherlibs/num/bignum/c/testKerN.c new file mode 100644 index 000000000..22faa3224 --- /dev/null +++ b/otherlibs/num/bignum/c/testKerN.c @@ -0,0 +1,1085 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* testKerN.c: tests des primitives de KerN */ +/* Last modified_on Thu Feb 20 17:26:13 GMT+1:00 1992 by shand */ +/* modified_on Wed Feb 14 16:14:04 GMT+1:00 1990 by herve */ +/* modified_on 17-OCT-1989 20:35:55.91 by Jim Lawton */ + +/* You can comment the line below if you want to test the C macro Package + instead of C or Assembly functions. */ + +#define BNNMACROS_OFF 1 + + +#include "BigNum.h" + /* old types of Bn */ + +typedef BigNumDigit BigNumType; /* A BigNum's type */ + +struct BigNumHeader /* The header of a BigNum */ +{ + BigNumType type; + BigNumLength length; +}; + + /* old functions of Bn */ + +/* + * Creation and access to type and length fields. + */ +extern char *malloc(); +/* Allocates a BigNum structure and returns a pointer to it */ +BigNum BnAlloc(size) int size; { + register BigNum n; + + n = (BigNum) (malloc(sizeof(struct BigNumHeader) + + size * sizeof(BigNumDigit)) + + sizeof(struct BigNumHeader)); + (((struct BigNumHeader *) n) - 1)->length = size; + return(n); +} + +/* Allocates a BigNum, inserts its Type, and returns a pointer to it */ +BigNum BnCreate(type, size) BigNumType type; int size; { + register BigNum n; + + n = BnAlloc(size); + (((struct BigNumHeader *) n) - 1)->type = type; + BnnSetToZero ((n+ 0), size); + return(n); +} + +/* Frees a BigNum structure */ +BnFree(n) BigNum n; { + free(((struct BigNumHeader *) n) - 1); + return 1; +} + +/* Returns the BigNum's Type */ +BigNumType BnGetType(n) BigNum n; { + return((((struct BigNumHeader *) n) - 1)->type); +} + +/* Sets the BigNum's Type */ +BnSetType(n, type) BigNum n; BigNumType type; { + (((struct BigNumHeader *) n) - 1)->type = type; +} + +/* Returns the number of digits allocated for the BigNum */ +BnGetSize(n) BigNum n; { + return((((struct BigNumHeader *) n) - 1)->length); +} + + + + /* structure d'un test */ + +struct testenv { + char *name; /* Le nom de la fonction teste'e. */ + int flag; /* Pour savoir si l'on continue le Test. */ + char hist[2048]; /* L'expression qui provoque l'erreur. */ + char *depend; /* De quoi depend le Test. */ +}; + + + /* Les nombres pre'de'finies. */ + +static BigNum NumbVect[5][2]; +static BigNum NumbProto, Ntmp2, NtmpBig; + +#define RN(n) NumbVect[n][0] +#define SN(n) NumbVect[n][1] + + /* Taille des nombres utilise's. */ + /* de la forme 4(n + 1) */ +#define TESTLENGTH 16 +#define DTL TESTLENGTH/2 +#define QTL TESTLENGTH/4 + +/* Nombre de test. */ +int TestCount, CallDummy = 0; + +int dummy() +{ + /* a simple way to get control after <n> steps in the debugger */ + printf("TestCount = %d\n", TestCount); +} + +int TestCountInc() +{ + TestCount++; + if (TestCount == CallDummy) + dummy(); +} + +ResetTest(n) int n; { + /* Remet le nieme nombre a` la valeur prototype. */ + BnnAssign ((RN(n)+ 0), ( NumbProto+ 0), TESTLENGTH); + BnnAssign ((SN(n)+ 0), ( NumbProto+ 0), TESTLENGTH); +} + +Check(n) int n; { + int i; + /* Verifie que les n nombres calcules correspondent aux simule's. */ + for(i = 0; i < n; i++) + if(CheckSubRange(i, 0, TESTLENGTH)) return(1); + return(FALSE); +} + +CheckSubRange(x, nd, nl) int x, nd, nl; { + /* Verifie l'e'galite' des sous-nombres + (RN(x), nd, nl) et (SN(x), nd, nl) */ + while(nl) { + nl--; + if(BnnCompareDigits (*(RN(x)+ nd), *( SN(x)+ nd))) return(nd + 1); + nd++; + } + return(FALSE); +} + +ShowDiff0(e, r1, r2) struct testenv *e; int r1,r2; { + ErrorPrint(e); + if(r1 != r2) + printf("---- Result is %d and should be %d----\n", r1, r2); + return(e->flag); +} + +ShowDiff1(e, r1, r2, n, nd, nl) + struct testenv *e; char *n; int r1, r2, nd, nl; { + ErrorPrint(e); + if(r1 != r2) + printf("---- Result is %d and should be %d----\n", r1, r2); + ShowOutRange(0, n, nd, nl); + ShowSubNumber(0, n, nd, nl); + return(e->flag); +} + +ShowDiff2(e, r1, r2, n, nd, nl, m, md, ml) + struct testenv *e; char *n, *m; int r1, r2, nd, nl, md, ml; { + ErrorPrint(e); + if(r1 != r2) + printf("---- Result is %d and should be %d----\n", r1, r2); + ShowOutRange(0, n, nd, nl); + ShowOutRange(1, m, md, ml); + ShowSubNumber(0, n, nd, nl); + ShowSubNumber(1, m, md, ml); + return(e->flag); +} + +ShowDiff3(e, r1, r2, n, nd, nl, m, md, ml, o, od, ol) + struct testenv *e; char *n, *m, *o; + int r1, r2, nd, nl, md, ml, od, ol; { + ErrorPrint(e); + if(r1 != r2) + printf("---- Result is %d and should be %d----\n", r1, r2); + ShowOutRange(0, n, nd, nl); + ShowOutRange(1, m, md, ml); + ShowOutRange(2, o, od, ol); + ShowSubNumber(0, n, nd, nl); + ShowSubNumber(1, m, md, ml); + ShowSubNumber(2, o, od, ol); + return(e->flag); +} + +ShowDiff4(e, r1, r2, n, nd, nl, m, md, ml, o, od, ol, p, pd, pl) + struct testenv *e; char *n, *m, *o, *p; + int r1, r2, nd, nl, md, ml, od, ol, pd, pl; { + ErrorPrint(e); + if(r1 != r2) + printf("---- Result is %d and should be %d----\n", r1, r2); + ShowOutRange(0, n, nd, nl); + ShowOutRange(1, m, md, ml); + ShowOutRange(2, o, od, ol); + ShowOutRange(3, p, pd, pl); + ShowSubNumber(0, n, nd, nl); + ShowSubNumber(1, m, md, ml); + ShowSubNumber(2, o, od, ol); + ShowSubNumber(3, p, pd, pl); + return(e->flag); +} + +ShowSubNumber(x, n, nd, nl) char *n; int x, nd, nl; { + printf("[%s, %d, %d] = ", n, nd, nl); + RangeNumberPrint("", RN(x), nd, nl); + if(CheckSubRange(x, nd, nl)) { + RangeNumberPrint(" Before: ", NumbProto, nd, nl); + RangeNumberPrint(" Simulated: ", SN(x), nd, nl); +} } + +RangeNumberPrint(s, n, nd, nl) char *s; BigNum n; int nd, nl; { + int first = 1; + + /* Ne marche que si BnGetDigit est garanti!!! */ + printf("%s {", s); + while(nl) { + nl--; + if(!first) printf(", "); else first = 0; + if(BN_DIGIT_SIZE <= 16) + printf("%.4X", BnnGetDigit ((n+ nd + nl))); + else if(BN_DIGIT_SIZE <= 32) + printf("%.8X", BnnGetDigit ((n+ nd + nl))); + else printf("%.16lX", BnnGetDigit ((n+ nd + nl))); + } + printf("}\n"); +} + +char *msg = "---- Modification Out of Range of number "; +ShowOutRange(x, n, nd, nl) char *n; int x, nd, nl; { + int i = 0, bol = 0; + + while(i = CheckSubRange(x, i, TESTLENGTH - i)) { + if((i <= nd) || (i > nd + nl)) { + if(!bol) { + bol = 1; + printf("%s %s at index: (%d", msg, n, i - 1); + } else { + printf(" %d", i - 1); + } } } + if(bol) printf(").\n"); +} + +ErrorPrint(e) struct testenv *e; { + printf("*** Error in compute : %s\n", e->hist); + printf(" Depends on %s\n", e->depend); +} + +/* + * Tests des fonctions non redefinisables + */ + +int genlengthvec[] = {9, 8, 1, 0, 2000, 32000,}; +BigNumType gentypevec[] = {0, 1, 2, 3, 4, 5,}; + +Generique(e) struct testenv *e; { + int i; + int length, length2; + BigNumType type, type2; + int fix; + BigNum n; + + + for(i=0; i < 6; i++) { + type = gentypevec[i]; + length = genlengthvec[i]; + n = BnCreate(type, length); + if((type2 = BnGetType(n)) != type) { + sprintf(e->hist,"BnGetType(BnCreate(%d, %d));", type, length); + if(ShowDiff0(e, type, type2)) return(TRUE); + } + if((length2 = BnGetSize(n)) != length) { + sprintf(e->hist,"BnGetSize(BnCreate(%d, %d));", type, length); + if(ShowDiff0(e, length, length2)) return(TRUE); + } + if(BnFree(n) == 0) { + sprintf(e->hist, "BnFree(BnCreate(%d, %d));", type, length); + if(ShowDiff0(e, 1, 0)) return(TRUE); + } + BnSetType((n = BnAlloc(length)), type); + if((type2 = BnGetType(n)) != type) { + sprintf(e->hist,"BnGetType(BnAlloc(%d, %d));", type, length); + if(ShowDiff0(e, type, type2)) return(TRUE); + } + if((length2 = BnGetSize(n)) != length) { + sprintf(e->hist,"BnGetSize(BnAlloc(%d, %d));", type, length); + if(ShowDiff0(e, length, length2)) return(TRUE); + } + if(BnFree(n) == 0) { + sprintf(e->hist, "BnFree(BnAlloc(%d, %d));", type, length); + if(ShowDiff0(e, 1, 0)) return(TRUE); + } + } + return(FALSE); +} + +/* + * BnSetToZero + */ +___BnSetToZero___(n, nd, nl) register BigNum n; register int nd, nl; { + register int i; + for(i=0; i<nl; i++) + BnnSetDigit ((n+ nd + i), 0); +} + +TestBnSetToZero(e) struct testenv *e; { + int nd, nl; + + e->depend = "(BnSetDigit)"; + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) { + TestCountInc(); + ResetTest(0); + BnnSetToZero ((RN(0)+ nd), nl); + ___BnSetToZero___(SN(0), nd, nl); + if(Check(1)) { + sprintf(e->hist, "%s(n, %d, %d)", e->name, nd, nl); + if(ShowDiff1(e, 0, 0, "n", nd, nl)) return(1); + } } + return(FALSE); +} + +/* + * BnAssign + */ +___BnAssign___(m, md, n, nd, nl) BigNum m, n; int md, nd, nl; { + register int i; + for(i=0; i<nl; i++) + BnnSetDigit ((NtmpBig+ i), BnnGetDigit ((n+ nd + i))); + for(i=0; i<nl; i++) + BnnSetDigit ((m+ md + i), BnnGetDigit ((NtmpBig+ i))); +} + +TestBnAssign(e) struct testenv *e; { + int md, nd, nl; + + e->depend = "(BnGetDigit, BnSetDigit)"; + for(md = 0; md <= TESTLENGTH; md++) + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl=0; ((nl<=TESTLENGTH-nd) && (nl<=TESTLENGTH-md)); nl++) { + TestCountInc(); + ResetTest(0); + BnnAssign ((RN(0)+ md), ( RN(0)+ nd), nl); + ___BnAssign___(SN(0), md, SN(0), nd, nl); + if(Check(1)) { + sprintf(e->hist, "%s(m, %d, n, %d, %d)", e->name, + md, nd, nl); + if(ShowDiff1(e, 0, 0, "n", md, nl)) return(1); + } } + return(FALSE); +} + + +/* + * BnNumDigits + */ +___BnNumDigits___(n, nd, nl) register BigNum n; register int nd, nl; { + + while(nl != 0) { + nl--; + if(!BnnIsDigitZero (*(n+ nd + nl))) break; + } + return(nl + 1); +} + +TestBnNumDigits(e) struct testenv *e; { + int nd0, nl0, nd, nl, l1, l2; + + e->depend = "(BnIsDigitZero)"; + for(nd0 = 0; nd0 <= TESTLENGTH; nd0++) + for(nl0 = 0; nl0 <= TESTLENGTH - nd0; nl0++) + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) { + TestCountInc(); + ResetTest(0); + BnnSetToZero ((RN(0)+ nd0), nl0); + BnnSetToZero ((SN(0)+ nd0), nl0); + l1 = BnnNumDigits ((RN(0)+ nd), nl); + l2 = ___BnNumDigits___(SN(0), nd, nl); + if(Check(1) || l1 != l2) { + sprintf(e->hist, "%s(n, %d, %d)", e->name, nd, nl); + if(ShowDiff1(e, l1, l2, "n", nd, nl)) return(1); + } } + return(FALSE); +} + +/* + * BnNumLeadingZeroBitsInDigit + */ +__BnNumLeadingZeroBitsInDigit__(n, nd) BigNum n; int nd; { + int p = 0; + + if(BnnIsDigitZero (*(n+ nd))) return(BN_DIGIT_SIZE); + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + *( Ntmp2+ 1) = BnnShiftLeft ((Ntmp2+ 0), 1, 1); + while(BnnIsDigitZero (*(Ntmp2+ 1))) { + *( Ntmp2+ 1) = BnnShiftLeft ((Ntmp2+ 0), 1, 1); + p++; + } + return(p); +} + +TestBnNumLeadingZeroBitsInDigit(e) struct testenv *e; { + int nd; int l1, l2; + + + e->depend = "(BnShiftLeft, BnIsDigitZero)"; + ResetTest(0); + for(nd = 0; nd < TESTLENGTH; nd++) { + TestCountInc(); + l1 = BnnNumLeadingZeroBitsInDigit (*(RN(0)+ nd)); + l2 = __BnNumLeadingZeroBitsInDigit__(SN(0), nd); + if(Check(1) || l1 != l2) { + sprintf(e->hist, "%s(n, %d)", e->name, nd); + if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1); + } } + return(FALSE); +} + +/* + * BnIsDigitZero + */ +___BnIsDigitZero___(n, nd) BigNum n; int nd; { + if(BnnGetDigit ((n+ nd)) == 0) return(1); + return(0); +} + +TestBnIsDigitZero(e) struct testenv *e; { + int nd; int l1, l2; + + e->depend = "()"; + ResetTest(0); + for(nd = 0; nd < TESTLENGTH; nd++) { + TestCountInc(); + l1 = BnnIsDigitZero (*(RN(0)+ nd)); + l2 = ___BnIsDigitZero___(SN(0), nd); + if(Check(1) || ((l1 == 0) && (l2 != 0)) || + ((l1 != 0) && (l2 == 0))) { + sprintf(e->hist, "%s(n, %d)", e->name, nd); + if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1); + } } + return(FALSE); +} + +/* + * BnIsDigitNormalized + */ +___BnIsDigitNormalized___(n, nd) BigNum n; int nd; { + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + *( Ntmp2+ 1) = BnnShiftLeft ((Ntmp2+ 0), 1, 1); + if(BnnIsDigitZero (*(Ntmp2+ 1))) return(0); + return(1); +} + +TestBnIsDigitNormalized(e) struct testenv *e; { + int nd; int l1, l2; + + e->depend = "(BnShiftLeft, BnIsDigitZero)"; + ResetTest(0); + for(nd = 0; nd < TESTLENGTH; nd++) { + TestCountInc(); + l1 = BnnIsDigitNormalized (*(RN(0)+ nd)); + l2 = ___BnIsDigitNormalized___(SN(0), nd); + if(Check(1) || ((l1 == 0) && (l2 != 0)) || + ((l1 != 0) && (l2 == 0))) { + sprintf(e->hist, "%s(n, %d)", e->name, nd); + if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1); + } } + return(FALSE); +} + +/* + * BnIsDigitOdd + */ +___BnIsDigitOdd___(n, nd) BigNum n; int nd; { + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + *( Ntmp2+ 1) = BnnShiftRight ((Ntmp2+ 0), 1, 1); + if(BnnIsDigitZero (*(Ntmp2+ 1))) return(0); + return(1); +} + +TestBnIsDigitOdd(e) struct testenv *e; { + int nd; int l1, l2; + + e->depend = "(BnShiftRight, BnIsDigitZero)"; + ResetTest(0); + for(nd = 0; nd < TESTLENGTH; nd++) { + TestCountInc(); + l1 = BnnIsDigitOdd (*(RN(0)+ nd)); + l2 = ___BnIsDigitOdd___(SN(0), nd); + if(Check(1) || ((l1 == 0) && (l2 != 0)) || + ((l1 != 0) && (l2 == 0))) { + sprintf(e->hist, "%s(n, %d)", e->name, nd); + if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1); + } } + return(FALSE); +} + +/* + * BnCompareDigits + */ +___BnCompareDigits___(n, nd, m, md) BigNum n, m; int nd, md; { + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + BnnComplement ((Ntmp2+ 0), 1); + if(BnnAdd ((Ntmp2+ 0), 1, ( m+ md), 1, (BigNumCarry) 0)) return(-1); + BnnComplement ((Ntmp2+ 0), 1); + if(BnnIsDigitZero (*(Ntmp2+ 0))) return(0); + return(1); +} + +TestBnCompareDigits(e) struct testenv *e; { + int nd, md; int l1, l2; + + e->depend = "(BnComplement, BnAdd, BnIsDigitZero)"; + ResetTest(0); + ResetTest(1); + for(nd = 0; nd < TESTLENGTH; nd++) + for(md = 0; md < TESTLENGTH; md++) { + TestCountInc(); + l1 = BnnCompareDigits (*(RN(0)+ nd), *( RN(1)+ md)); + l2 = ___BnCompareDigits___(SN(0), nd, SN(1), md); + if(Check(2) || l1 != l2) { + sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md); + if(ShowDiff2(e, l1, l2, "n", nd, 1, "m", md, 1)) + return(1); + } } + return(FALSE); +} + +/* + * BnComplement + */ +___BnComplement___(n, nd, nl) BigNum n; int nd, nl; { + int i; + + BnnSetDigit ((Ntmp2+ 0), 0); + BnnSubtractBorrow ((Ntmp2+ 0), 1, 0); + for(i = 0; i < nl; i++) + BnnXorDigits ((n+ nd + i), *( Ntmp2+ 0)); +} + +TestBnComplement(e) struct testenv *e; { + int nd, nl; + + e->depend = "(BnSubtractBorrow, BnXorDigits)"; + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) { + TestCountInc(); + ResetTest(0); + BnnComplement ((RN(0)+ nd), nl); + ___BnComplement___(SN(0), nd, nl); + if(Check(1)) { + sprintf(e->hist, "%s(n, %d, %d)", e->name, nd, nl); + if(ShowDiff1(e, 0, 0, "n", nd, nl)) return(1); + } } + return(FALSE); +} + +/* + * BnAndDigits + */ +___BnAndDigits___(n, nd, m, md) BigNum n, m; int nd, md; { + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + BnnOrDigits ((Ntmp2+ 0), *( m+ md)); + BnnXorDigits ((Ntmp2+ 0), *( m+ md)); + BnnXorDigits ((n+ nd), *( Ntmp2+ 0)); +} + +TestBnAndDigits(e) struct testenv *e; { + int nd, md; + + e->depend = "(BnOrDigits, BnXorDigits)"; + ResetTest(1); + for(nd = 0; nd < TESTLENGTH; nd++) + for(md = 0; md < TESTLENGTH; md++) { + TestCountInc(); + ResetTest(0); + BnnAndDigits ((RN(0)+ nd), *( RN(1)+ md)); + ___BnAndDigits___(SN(0), nd, SN(1), md); + if(Check(2)) { + sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md); + if(ShowDiff2(e, 0, 0, "n", nd, 1, "m", md, 1)) + return(1); + } } + return(FALSE); +} + +/* + * BnOrDigits + */ +___BnOrDigits___(n, nd, m, md) BigNum n, m; int nd, md; { + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + BnnAndDigits ((Ntmp2+ 0), *( m+ md)); + BnnXorDigits ((Ntmp2+ 0), *( m+ md)); + BnnXorDigits ((n+ nd), *( Ntmp2+ 0)); +} + +TestBnOrDigits(e) struct testenv *e; { + int nd, md; + + e->depend = "(BnAndDigits, BnXorDigits)"; + ResetTest(1); + for(nd = 0; nd < TESTLENGTH; nd++) + for(md = 0; md < TESTLENGTH; md++) { + TestCountInc(); + ResetTest(0); + BnnOrDigits ((RN(0)+ nd), *( RN(1)+ md)); + ___BnOrDigits___(SN(0), nd, SN(1), md); + if(Check(2)) { + sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md); + if(ShowDiff2(e, 0, 0, "n", nd, 1, "m", md, 1)) + return(1); + } } + return(FALSE); +} + +/* + * BnXorDigits + */ +___BnXorDigits___(n, nd, m, md) BigNum n, m; int nd, md; { + BnnAssign ((Ntmp2+ 0), ( n+ nd), 1); + BnnAndDigits ((Ntmp2+ 0), *( m+ md)); + BnnComplement ((Ntmp2+ 0), 1); + BnnOrDigits ((n+ nd), *( m+ md)); + BnnAndDigits ((n+ nd), *( Ntmp2+ 0)); +} + +TestBnXorDigits(e) struct testenv *e; { + int nd, md; + + e->depend = "(BnAndDigits, BnComplement, BnOrDigits)"; + ResetTest(1); + for(nd = 0; nd < TESTLENGTH; nd++) + for(md = 0; md < TESTLENGTH; md++) { + TestCountInc(); + ResetTest(0); + BnnXorDigits ((RN(0)+ nd), *( RN(1)+ md)); + ___BnXorDigits___(SN(0), nd, SN(1), md); + if(Check(2)) { + sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md); + if(ShowDiff2(e, 0, 0, "n", nd, 1, "m", md, 1)) + return(1); + } } + return(FALSE); +} + +/* + * BnShiftLeft + */ +___BnShiftLeft___(n, nd, nl, m, md, s) BigNum n, m; int nd, nl, md; int s; { + BnnSetDigit ((m+ md), 2); + BnnSetDigit ((Ntmp2+ 0), 1); + while(s--) { + BnnSetToZero ((NtmpBig+ 0), 2); + BnnMultiplyDigit ((NtmpBig+ 0), 2, ( Ntmp2+ 0), 1, *( m+ md)); + BnnAssign ((Ntmp2+ 0), ( NtmpBig+ 0), 1); + } + BnnSetToZero ((NtmpBig+ 0), nl + 1); + BnnMultiplyDigit ((NtmpBig+ 0), nl + 1, ( n+ nd), nl, *( Ntmp2+ 0)); + BnnAssign ((n+ nd), ( NtmpBig+ 0), nl); + BnnAssign ((m+ md), ( NtmpBig+ nl), 1); +} + +TestBnShiftLeft(e) struct testenv *e; { + int nd, nl, md; int s; + + e->depend = "(BnSetToZero, BnMultiplyDigit)"; + ResetTest(1); + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) + for(md = 0; md < 2; md++) + for(s = 0; s < BN_DIGIT_SIZE; s++) { + TestCountInc(); + ResetTest(0); + *( RN(1)+ md) = BnnShiftLeft ((RN(0)+ nd), nl, s); + ___BnShiftLeft___(SN(0), nd, nl, SN(1), md, s); + if(Check(2)) { + sprintf(e->hist, "%s(n, %d, %d, m, %d, %d)", + e->name, nd, nl, md, s); + if(ShowDiff2(e, 0, 0, "n", nd, nl, "m", md, 1)) + return(1); + } } + return(FALSE); +} + +/* + * BnShiftRight + */ +___BnShiftRight___(n, nd, nl, m, md, s) BigNum n, m; int nd, nl, md; int s; { + if((nl == 0) || (s == 0)) { + BnnSetDigit ((m+ md), 0); + return; + } + BnnAssign ((NtmpBig+ 0), ( n+ nd), nl); + *( NtmpBig+ nl) = BnnShiftLeft ((NtmpBig+ 0), nl, BN_DIGIT_SIZE - s); + BnnAssign ((n+ nd), ( NtmpBig+ 1), nl); + BnnAssign ((m+ md), ( NtmpBig+ 0), 1); +} + +TestBnShiftRight(e) struct testenv *e; { + int nd, nl, md; int s; + + e->depend = "(BnShiftLeft)"; + ResetTest(1); + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) + for(md = 0; md < 2; md++) + for(s = 0; s < BN_DIGIT_SIZE; s++) { + TestCountInc(); + ResetTest(0); + *( RN(1)+ md) = BnnShiftRight ((RN(0)+ nd), nl, s); + ___BnShiftRight___(SN(0), nd, nl, SN(1), md, s); + if(Check(2)) { + sprintf(e->hist, "%s(n, %d, %d, m, %d, %d)", + e->name, nd, nl, md, s); + if(ShowDiff2(e, 0, 0, "n", nd, nl, "m", md, 1)) + return(1); + } } + return(FALSE); +} + +/* + * BnAddCarry + */ +BigNumCarry +___BnAddCarry___(n, nd, nl, r) BigNum n; int nd, nl; int r;{ + if(r == 0) return(0); + BnnComplement ((n+ nd), nl); + r = BnnSubtractBorrow ((n+ nd), nl, 0); + BnnComplement ((n+ nd), nl); + if(r == 0) return(1); + return(0); +} + +TestBnAddCarry(e) struct testenv *e; { + int nd, nl; int r, l1, l2; + + e->depend = "(BnComplement, BnSubtractBorrow)"; + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) + for(r = 0; r < 2; r++) { + TestCountInc(); + ResetTest(0); + l1 = BnnAddCarry ((RN(0)+ nd), nl, r); + l2 = ___BnAddCarry___(SN(0), nd, nl, r); + if(Check(1) || l1 != l2) { + sprintf(e->hist, "%s(n, %d, %d, %d)", + e->name, nd, nl, r); + if(ShowDiff1(e, l1, l2, "n", nd, nl)) return(1); + } } + return(FALSE); +} + +/* + * BnAdd + */ +BigNumCarry +___BnAdd___(n, nd, nl, m, md, ml, r) BigNum n, m; int nd, nl, md, ml; BigNumCarry r;{ + BnnComplement ((m+ md), ml); + r = BnnSubtract ((n+ nd), ml, ( m+ md), ml, r); + BnnComplement ((m+ md), ml); + return(BnnAddCarry ((n+ nd + ml), nl - ml, r)); +} + +TestBnAdd(e) struct testenv *e; { + int nd, nl, md, ml; int l1, l2; BigNumCarry r; + + e->depend = "(BnComplement, BnSubtract, BnAddCarry)"; + ResetTest(1); + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) + for(md = 0; md <= TESTLENGTH - nl; md++) + for(ml = 0; ml <= nl ; ml++) + for(r = 0; r < 2; r++) { + TestCountInc(); + ResetTest(0); + l1 = BnnAdd ((RN(0)+ nd), nl, ( RN(1)+ md), ml, r); + l2 = ___BnAdd___(SN(0), nd, nl, SN(1), md, ml, r); + if(Check(2) || l1 != l2) { + sprintf(e->hist, "%s(n, %d, %d, m, %d, %d, %d)", + e->name, nd, nl, md, ml, r); + if(ShowDiff2(e, l1, l2, "n", nd, nl, "m", md, ml)) + return(1); + } } + return(FALSE); +} + +/* + * BnSubtractBorrow + */ +BigNumCarry +___BnSubtractBorrow___(n, nd, nl, r) BigNum n; int nd, nl; BigNumCarry r;{ + if(r == 1) return(1); + BnnComplement ((n+ nd), nl); + r = BnnAddCarry ((n+ nd), nl, (BigNumCarry) 1); + BnnComplement ((n+ nd), nl); + if(r == 0) return(1); + return(0); +} + +TestBnSubtractBorrow(e) struct testenv *e; { + int nd, nl; int l1, l2; BigNumCarry r; + + e->depend = "(BnComplement, BnAddCarry)"; + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) + for(r = 0; r < 2; r++) { + TestCountInc(); + ResetTest(0); + l1 = BnnSubtractBorrow ((RN(0)+ nd), nl, r); + l2 = ___BnSubtractBorrow___(SN(0), nd, nl, r); + if(Check(1) || l1 != l2) { + sprintf(e->hist, "%s(n, %d, %d, %d)", + e->name, nd, nl, r); + if(ShowDiff1(e, l1, l2, "n", nd, nl)) return(1); + } } + return(FALSE); +} + +/* + * BnSubtract + */ +BigNumCarry +___BnSubtract___(n, nd, nl, m, md, ml, r) BigNum n, m; int nd, nl, md, ml; BigNumCarry r;{ + BnnComplement ((m+ md), ml); + r = BnnAdd ((n+ nd), ml, ( m+ md), ml, r); + BnnComplement ((m+ md), ml); + return(BnnSubtractBorrow ((n+ nd + ml), nl - ml, r)); +} + +TestBnSubtract(e) struct testenv *e; { + int nd, nl, md, ml; int l1, l2; BigNumCarry r; + + e->depend = "(BnComplement, BnAdd, BnSubtractBorrow)"; + ResetTest(1); + for(nd = 0; nd <= TESTLENGTH; nd++) + for(nl = 0; nl <= TESTLENGTH - nd; nl++) + for(md = 0; md <= TESTLENGTH - nl; md++) + for(ml = 0; ml <= nl ; ml++) + for(r = 0; r < 2; r++) { + TestCountInc(); + ResetTest(0); + l1 = BnnSubtract ((RN(0)+ nd), nl, ( RN(1)+ md), ml, r); + l2 = ___BnSubtract___(SN(0), nd, nl, SN(1), md, ml, r); + if(Check(2) || l1 != l2) { + sprintf(e->hist, "%s(n, %d, %d, m, %d, %d, %d)", + e->name, nd, nl, md, ml, r); + if(ShowDiff2(e, l1, l2, "n", nd, nl, "m", md, ml)) + return(1); + } } + return(FALSE); +} + +/* + * BnMultiplyDigit + */ +BigNumCarry +___BnMultiplyDigit___(p, pd, pl, n, nd, nl, m, md) BigNum p, n, m; int pd, pl, nd, nl, md; { + BigNumCarry r = 0, ret = 0; + + BnnAssign ((Ntmp2+ 0), ( m+ md), 1); + BnnAssign ((NtmpBig+ 0), ( n+ nd), nl); + BnnSetToZero ((NtmpBig+ nl), 1); + while(!BnnIsDigitZero (*(Ntmp2+ 0))) { + if(BnnIsDigitOdd (*(Ntmp2+ 0))) { + r = BnnAdd ((p+ pd), pl, ( NtmpBig+ 0), nl + 1, (BigNumCarry) 0); + if((ret == 0) && (r == 1)) ret = 1; + else if((ret == 1) && (r == 1)) ret = 2; + } + *( Ntmp2+ 1) = BnnShiftRight ((Ntmp2+ 0), 1, 1); + *( Ntmp2+ 1) = BnnShiftLeft ((NtmpBig+ 0), nl + 1, 1); + if(!BnnIsDigitZero (*(Ntmp2+ 1))) ret = 3; + } + return(ret); +} + +TestBnMultiplyDigit(e) struct testenv *e; { + int pd, pl, nd, nl, md; int l1, l2; + + e->depend = "(BnSetToZero, BnIsDigitZero, BnIsDigitOdd, BnAdd, BnShiftRight, BnShiftLeft)"; + ResetTest(1); + ResetTest(2); + for(pd = 0; pd <= TESTLENGTH; pd++) + for(pl = 0; pl <= TESTLENGTH - pd; pl++) + for(nd = 0; nd <= TESTLENGTH - pl; nd++) + for(nl = 0; nl < pl ; nl++) + for(md = 0; md < TESTLENGTH; md++) { + TestCountInc(); + ResetTest(0); + l1 = BnnMultiplyDigit ((RN(0)+pd), pl, (RN(1)+nd), nl, *(RN(2)+md)); + l2 = ___BnMultiplyDigit___(SN(0),pd,pl,SN(1),nd,nl,SN(2),md); + if(Check(3) || l1 != l2) { + sprintf(e->hist, + "BnMultiplyDigit(p, %d, %d, n, %d, %d, m, %d)", + pd, pl, nd, nl, md); + if(ShowDiff3(e,l1,l2,"p",pd,pl,"n",nd,nl,"m",md,1)) + return(1); + } } + return(FALSE); +} + +/* + * BnDivideDigit + */ +TestBnDivideDigit(e) struct testenv *e; { + int nd, nl, md, qd, rd, l2; + + e->depend = "(BnSetToZero, BnMultiplyDigit, BnCompareDigits)"; + ResetTest(2); + ResetTest(3); + for(nd = 0; nd <= TESTLENGTH - 2; nd++) + for(nl = 2; nl <= TESTLENGTH - nd; nl++) + for(md = 0; md < TESTLENGTH; md++) + for(qd = 0; qd < TESTLENGTH - nl + 1 ; qd++) + for(rd = 0; rd < 2; rd++) + if((!BnnIsDigitZero (*(RN(3)+ md))) && + (BnnCompareDigits (*(RN(2)+ nd+nl-1), *( RN(3)+ md)) == -1)) { + TestCountInc(); + ResetTest(0); + ResetTest(1); + *( RN(1)+ rd) = BnnDivideDigit ((RN(0)+ qd), ( RN(2)+ nd), nl, *( RN(3)+ md)); + BnnAssign ((SN(0)+ qd), ( RN(0)+ qd), nl - 1); + BnnAssign ((SN(1)+ rd), ( RN(1)+ rd), 1); + BnnSetToZero ((SN(2)+ nd), nl); + BnnAssign ((SN(2)+ nd), ( SN(1)+ rd), 1); + l2 = BnnMultiplyDigit ((SN(2)+nd), nl, ( SN(0)+qd), nl - 1, *( SN(3)+ md)); + if(Check(4) || l2 != 0) { + sprintf(e->hist, + "BnDivideDigit(q, %d, r, %d, n, %d, %d, m, %d)", + qd, rd, nd, nl, md); + if(ShowDiff4(e, 0, l2, "q", qd, nl - 1, "r", rd, 1, + "n", nd, nl, "m", md, 1)) + return(TRUE); + } } + return(FALSE); +} + +/* + * BnMultiply + */ +___BnMultiply___(p, pd, pl, m, md, ml, n, nd, nl) BigNum p, m, n; int pd, pl, md, ml, nd, nl; { + int ret; + + for (ret = 0; nl-- > 0; pd++, nd++, pl--) + ret += BnnMultiplyDigit ((p+ pd), pl, ( m+ md), ml, *( n+ nd)); + return(ret); +} + +TestBnMultiply(e) struct testenv *e; { + BigNumLength pd, pl, nd, nl, md, ml; int l1, l2; + + e->depend = "(BnSetToZero, BnMultiplyDigit)"; + ResetTest(1); + ResetTest(2); + for(pd = 0; pd <= TESTLENGTH; pd++) + for(pl = 0; pl <= TESTLENGTH - pd && pl <= TESTLENGTH/2; pl++) + for(nd = 0; nd <= TESTLENGTH - pl; nd++) + for(nl = 0; nl < pl && nl <= TESTLENGTH/3; nl++) + { + if (nl <= pl-nl) + { + /* Test squaring */ + TestCountInc(); + ResetTest(0); + l1 = BnnMultiply ((RN(0)+pd), pl, (RN(1)+nd), nl, (RN(1)+nd), nl); + l2 = ___BnMultiply___(SN(0),pd,pl,SN(1),nd,nl,SN(1),nd,nl); + if(Check(3) || l1 != l2) { + sprintf(e->hist, + "BnMultiply(p, %d, %d, n, %d, %d, n, %d, %d)", + pd, pl, nd, nl, nd, nl); + if(ShowDiff3(e,l1,l2,"p",pd,pl,"n",nd,nl,"n",nd,nl)) + return(1); + } + + } + for(md = 0; md <= TESTLENGTH; md++) + for (ml = 0; ml <= pl-nl && ml <= TESTLENGTH/3 && md+ml <= TESTLENGTH; ml++) { + TestCountInc(); + ResetTest(0); + l1 = BnnMultiply ((RN(0)+pd), pl, (RN(1)+nd), nl, (RN(2)+md), ml); + l2 = ___BnMultiply___(SN(0),pd,pl,SN(1),nd,nl,SN(2),md,ml); + if(Check(3) || l1 != l2) { + sprintf(e->hist, + "BnMultiply(p, %d, %d, n, %d, %d, m, %d, %d)", + pd, pl, nd, nl, md, ml); + if(ShowDiff3(e,l1,l2,"p",pd,pl,"n",nd,nl,"m",md,ml)) + return(1); + } } } + return(FALSE); +} + +/* + * Main + */ +typedef struct { + int (*TestFnt)(); + char *NameFnt; +} TESTONE; +TESTONE AllTest[] = { + Generique, "Generic Functions", + TestBnSetToZero, "BnSetToZero", + TestBnAssign, "BnAssign", + TestBnNumDigits, "BnNumDigits", + TestBnNumLeadingZeroBitsInDigit, "BnNumLeadingZeroBitsInDigit", + TestBnIsDigitZero, "BnIsDigitZero", + TestBnIsDigitNormalized, "BnIsDigitNormalized", + TestBnIsDigitOdd, "BnIsDigitOdd", + TestBnCompareDigits, "BnCompareDigits", + TestBnComplement, "BnComplement", + TestBnAndDigits, "BnAndDigits", + TestBnOrDigits, "BnOrDigits", + TestBnXorDigits, "BnXorDigits", + TestBnShiftLeft, "BnShiftLeft", + TestBnShiftRight, "BnShiftRight", + TestBnAddCarry, "BnAddCarry", + TestBnAdd, "BnAdd", + TestBnSubtractBorrow, "BnSubtractBorrow", + TestBnSubtract, "BnSubtract", + TestBnMultiplyDigit, "BnMultiplyDigit", + TestBnDivideDigit, "BnDivideDigit", + TestBnMultiply, "BnMultiply", +}; + +main(n, s) int n; char **s; { + struct testenv realenv, *e = &realenv; + int i, j, nbtest, SizeAllTest; + + /* Initialisations de l'environnement de test. */ + e->flag = 1; + e->depend = "()"; + /* Allocation des 2 nombres globaux. */ + Ntmp2 = BnAlloc(2); + NtmpBig = BnAlloc(2 * TESTLENGTH); + NumbProto = BnAlloc(TESTLENGTH); + /* Creation du nombre prototype. */ + BnnSetDigit ((NumbProto+ 0), 0); /* Les 2 premiers a` ze'ro. */ + BnnSetDigit ((NumbProto+ 1), 0); + for(i=0; i < TESTLENGTH/4 - 1; i++) /* Le premier quart est la */ + BnnSetDigit ((NumbProto+ i + 2), i + 1); /* suite 1, 2, 3, ... */ + /* Le 2nd quart est le 1er shifte de BN_DIGIT_SIZE - 2. 0x4000 0x8000 ...*/ + BnnAssign ((NumbProto+ QTL + 1), ( NumbProto+ 2), QTL - 1); + *( NumbProto+ 0) = BnnShiftLeft ((NumbProto+ QTL + 1), QTL - 1, BN_DIGIT_SIZE - 2); + /* La 2nd moitie est l'inverse logique de la 1ere */ + BnnAssign ((NumbProto+ DTL), ( NumbProto+ 0), DTL); + BnnComplement ((NumbProto+ DTL), DTL); + /* Allocation des nombres utilise's */ + for(i=0; i < 5; i++) { + RN(i) = BnAlloc(TESTLENGTH); + SN(i) = BnAlloc(TESTLENGTH); + } + if(n > 1 && s[1][0] == '-') { + CallDummy = atoi(s[1]+1); + n--; + s++; + } + if(n == 1) { + printf("%s [-CallDummy#] v|a|TestNum\n", s[0]); + } + /* On y va */ + SizeAllTest = (sizeof(AllTest)/sizeof(AllTest[0])); + for(i = 1; i < n; i++) { + if(s[i][0] == 'm') { + /* 0 = No skip; 1 = skip to next; else STOP */ + e->flag = atoi(&s[i][1]); + } else if(s[i][0] == 'a') { + for(i = 0; i < SizeAllTest; i++) + dotest(e, i); + } else if(s[i][0] == 'v') { + for(j = 0; j < SizeAllTest; j++) + seetest(j); + } else { + nbtest = atoi(s[i]); + if((nbtest < 0) || (nbtest >= SizeAllTest)) + printf("Test %d is invalid\n", nbtest); + else dotest(e, nbtest); +} } } + +dotest(e, n) struct testenv *e; int n; { + seetest(n); + TestCount = 0; + e->name = AllTest[n].NameFnt; + if(((*(AllTest[n].TestFnt)) (e)) && e->flag > 1) exit(0); + printf("%d tests were performed\n", TestCount); +} + +seetest(n) int n; { + printf("%d. Testing %s\n", n, AllTest[n].NameFnt); +} + diff --git a/otherlibs/num/bignum/h/BigNum.h b/otherlibs/num/bignum/h/BigNum.h new file mode 100644 index 000000000..604a9c0a9 --- /dev/null +++ b/otherlibs/num/bignum/h/BigNum.h @@ -0,0 +1,144 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Thu Feb 20 18:41:41 GMT+1:00 1992 by shand */ +/* modified_on Thu Oct 31 16:41:47 1991 by herve */ +/* modified_on Wed Jul 5 10:19:33 GMT+2:00 1989 by bertin */ +/* Adapted to Caml Light by Xavier Leroy, Mon May 9. */ + +/* BigN.h - Types and structures for clients of BigNum */ + +#if !defined(_stdc_) +#define _NO_PROTO +#endif + + + /******** representation of a bignum ******/ +/* +** <--------------------------- nl ----------------------------> +** | Least Most | +** |Significant| | | |Significant| +** |BigNumDigit| | | |BigNumDigit| +** |___________|___________|___________|___________|___________| +** ^ (sometimes +** | is zero) +** nn +*/ + +/* signals BigNum.h already included */ +#define BIGNUM + + /*************** sizes ********************/ + +#define BN_BYTE_SIZE 8 +#ifdef CAML_LIGHT +#define BN_WORD_SIZE (sizeof (long) * BN_BYTE_SIZE - 2) +#else +#define BN_WORD_SIZE (sizeof (int) * BN_BYTE_SIZE) +#endif +#define BN_DIGIT_SIZE (sizeof (BigNumDigit) * BN_BYTE_SIZE) + +/* notes: */ +/* BN_BYTE_SIZE: number of bits in a byte */ +/* BN_WORD_SIZE: number of bits in an "int" in the target language */ +/* BN_DIGIT_SIZE: number of bits in a digit of a BigNum */ + + + /****** results of compare functions ******/ + + /* Note: we don't use "enum" to interface with Modula2+, Lisp, ... */ +#define BN_LT -1 +#define BN_EQ 0 +#define BN_GT 1 + + /*************** boolean ******************/ + +#define TRUE 1 +#define FALSE 0 + +typedef unsigned long BigNumDigit; + +#ifndef BigZBoolean +typedef int Boolean; +#define BigZBoolean +#endif + +#ifndef __ +#if defined(_NO_PROTO) +#define __(args) () +#else +#define __(args) args +#endif +#endif + + /* bignum types: digits, big numbers, carries ... */ + +typedef BigNumDigit * BigNum; /* A big number is a digit pointer */ +typedef BigNumDigit BigNumCarry; /* Either 0 or 1 */ +typedef unsigned long BigNumProduct; /* The product of two digits */ +/* BigNumLength must be int as nl is in the code, remember int is 16 bits on MSDOS - jch */ +typedef unsigned long BigNumLength; /* The length of a bignum */ +typedef int BigNumCmp; /* result of comparison */ + +/* */ + + + /************ functions of bn.c ***********/ + +extern void BnnInit __((void)); +extern void BnnClose __((void)); + +extern Boolean BnnIsZero __((BigNum nn, BigNumLength nl)); +extern BigNumCarry BnnMultiply __((BigNum pp,BigNumLength pl, BigNum nn, BigNumLength nl, BigNum mm, BigNumLength ml)); +extern void BnnDivide __((BigNum nn, BigNumLength nl, BigNum dd, BigNumLength dl)); +extern BigNumCmp BnnCompare __((BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl)); + + /*********** functions of KerN.c **********/ +extern void BnnSetToZero __((BigNum nn, BigNumLength nl)); +extern void BnnAssign __((BigNum mm, BigNum nn, BigNumLength nl)); +extern void BnnSetDigit __((BigNum nn, BigNumDigit d)); +extern BigNumDigit BnnGetDigit __((BigNum nn)); +extern BigNumLength BnnNumDigits __((BigNum nn, BigNumLength nl)); +extern BigNumDigit BnnNumLeadingZeroBitsInDigit __((BigNumDigit d)); +extern Boolean BnnDoesDigitFitInWord __((BigNumDigit d)); +extern Boolean BnnIsDigitZero __((BigNumDigit d)); +extern Boolean BnnIsDigitNormalized __((BigNumDigit d)); +extern Boolean BnnIsDigitOdd __((BigNumDigit d)); +extern BigNumCmp BnnCompareDigits __((BigNumDigit d1, BigNumDigit d2)); +extern void BnnComplement __((BigNum nn, BigNumLength nl)); +extern void BnnAndDigits __((BigNum n, BigNumDigit d)); +extern void BnnOrDigits __((BigNum n, BigNumDigit d)); +extern void BnnXorDigits __((BigNum n, BigNumDigit d)); +extern BigNumDigit BnnShiftLeft __((BigNum mm, BigNumLength ml, int nbits)); +extern BigNumDigit BnnShiftRight __((BigNum mm, BigNumLength ml, int nbits)); +extern BigNumCarry BnnAddCarry __((BigNum nn, BigNumLength nl, BigNumCarry carryin)); +extern BigNumCarry BnnAdd __((BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl, BigNumCarry carryin)); +extern BigNumCarry BnnSubtractBorrow __((BigNum nn, BigNumLength nl, BigNumCarry carryin)); +extern BigNumCarry BnnSubtract __((BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl, BigNumCarry carryin)); +extern BigNumCarry BnnMultiplyDigit __((BigNum mm, BigNumLength ml, BigNum nn, BigNumLength nl, BigNumDigit d)); +extern BigNumDigit BnnDivideDigit __((BigNum qq, BigNum nn, BigNumLength nl, BigNumDigit d)); + +/* */ + + /* some functions can be written with macro-procedures */ + + +#ifndef BNNMACROS_OFF +/* the functions BnnIsZero and BnnCompareDigits are not macro procedures + since they use parameters twice, and that can produce bugs if + you pass a parameter like x++ + */ +#define BnnSetDigit(nn,d) (*(nn) = (d)) +#define BnnGetDigit(nn) (*(nn)) +#define BnnDoesDigitFitInWord(d) (BN_DIGIT_SIZE > BN_WORD_SIZE ? ((d) >= (BigNumDigit)1 << BN_WORD_SIZE ? FALSE : TRUE) : TRUE) +#define BnnIsDigitZero(d) ((d) == 0) +#define BnnIsDigitNormalized(d) ((d) & (((BigNumDigit) 1) << (BN_DIGIT_SIZE - 1)) ? TRUE : FALSE) +#define BnnIsDigitOdd(d) ((d) & ((BigNumDigit) 1) ? TRUE : FALSE) +#define BnnAndDigits(nn, d) (*(nn) &= (d)) +#define BnnOrDigits(nn, d) (*(nn) |= (d)) +#define BnnXorDigits(nn, d) (*(nn) ^= (d)) + +#endif + + +#ifdef MSDOS +#define realaddr(p) ((((long)(p) & (65535 << 16)) >> 12)+((long)(p) & 65535)) +#endif diff --git a/otherlibs/num/bignum/h/BigZ.h b/otherlibs/num/bignum/h/BigZ.h new file mode 100644 index 000000000..aaab0a2b7 --- /dev/null +++ b/otherlibs/num/bignum/h/BigZ.h @@ -0,0 +1,97 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* Last modified_on Fri Oct 5 16:45:46 GMT+1:00 1990 by herve */ +/* modified_on Thu Mar 22 21:29:09 GMT+1:00 1990 by shand */ + +/* BigZ.h: Types and structures for clients of BigZ */ + + + /* BigZ sign */ + + +#define BZ_PLUS 1 +#define BZ_ZERO 0 +#define BZ_MINUS -1 +#define BzSign BigNumCmp + + + /* BigZ compare result */ + + +#define BZ_LT BN_LT +#define BZ_EQ BN_EQ +#define BZ_GT BN_GT +#define BzCmp BigNumCmp + + + /* BigZ number */ + +#ifndef BIGNUM +#include "BigNum.h" +#endif + +struct BigZHeader +{ + BigNumLength Size; + BzSign Sign; +}; + + +struct BigZStruct +{ + struct BigZHeader Header; + BigNumDigit Digits [16]; +}; + + +typedef struct BigZStruct * BigZ; + +/* */ + + + /*********** macros of bz.c **********/ + + +#define BzGetSize(z) ((BigNumLength)(z)->Header.Size) +#define BzGetSign(z) ((z)->Header.Sign) + +#define BzSetSize(z,s) (z)->Header.Size = s +#define BzSetSign(z,s) (z)->Header.Sign = s + +#define BzGetOppositeSign(z) (-(z)->Header.Sign) + + + /*********** functions of bz.c **********/ + +extern void BzInit __((void)); +extern void BzClose __((void)); + +extern BigZ BzCreate __((BigNumLength)); +extern void BzFree __((BigZ)); +extern void BzFreeString __((char *)); + +extern BigNumLength BzNumDigits __((BigZ)); + +extern BigZ BzCopy __((BigZ)); +extern BigZ BzNegate __((BigZ)); +extern BigZ BzAbs __((BigZ)); +extern BigNumCmp BzCompare __((BigZ, BigZ)); + +extern BigZ BzAdd __((BigZ, BigZ)); +extern BigZ BzSubtract __((BigZ, BigZ)); +extern BigZ BzMultiply __((BigZ, BigZ)); +extern BigZ BzDivide __((BigZ, BigZ, BigZ *)); +extern BigZ BzDiv __((BigZ, BigZ)); +extern BigZ BzMod __((BigZ, BigZ)); + +extern BigZ BzFromString __((char *, BigNumDigit)); +extern char * BzToString __((BigZ, BigNumDigit)); + +extern BigZ BzFromInteger __((int)); +extern int BzToInteger __((BigZ)); + +extern BigZ BzFromBigNum __((BigNum, BigNumLength)); +extern BigNum BzToBigNum __((BigZ, BigNumLength *)); + + /*********** functions of bzf.c **********/ + +extern BigZ BzFactorial __((BigZ)); diff --git a/otherlibs/num/bignum/h/BntoBnn.h b/otherlibs/num/bignum/h/BntoBnn.h new file mode 100644 index 000000000..a01679a0f --- /dev/null +++ b/otherlibs/num/bignum/h/BntoBnn.h @@ -0,0 +1,111 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988 */ +/* Last modified on Wed Feb 14 16:20:34 GMT+1:00 1990 by herve */ +/* modified on 17-OCT-1989 20:23:23.17 by Jim Lawton SDE/Galway */ + +/* BntoBnn.h: allowing to use the new interfaces of KerN */ + + +#ifdef __STDC__ +#include <stdlib.h> +#else +#ifndef VMS +extern char *malloc(); +#endif +#endif + + /* old types of Bn */ + +typedef unsigned int BigNumType; /* A BigNum's type */ + +struct BigNumHeader /* The header of a BigNum */ +{ + BigNumType type; + int length; +}; + + + /* macros of old types of Bn */ + +#define BN_TYPE(n) (((struct BigNumHeader *) n) - 1)->type +#define BN_LENGTH(n) (((struct BigNumHeader *) n) - 1)->length + + + /* macros of functions of Bn to functions Bnn */ + +#define BnIsZero(n, nd, nl) BnnIsZero ((n+nd), nl) +#define BnMultiply(p, pd, pl, m, md, ml, n, nd, nl) BnnMultiply ((p+pd), pl, (m+md), ml, (n+nd), nl) +#define BnDivide(n, nd, nl, d, dd, dl) BnnDivide ((n+nd), nl, (d+dd), dl) +#define BnCompare(m, md, ml, n, nd, nl) BnnCompare ((m+md), ml, (n+nd), nl) +#define BnSetToZero(n, nd, nl) BnnSetToZero ((n+nd), nl) +#define BnAssign(m, md, n, nd, nl) BnnAssign ((m+md), (n+nd), nl) +#define BnSetDigit(n, nd, d) BnnSetDigit ((n+nd), d) +#define BnGetDigit(n, nd) BnnGetDigit ((n+nd)) +#define BnNumDigits(n, nd, nl) BnnNumDigits ((n+nd), nl) +#define BnNumLeadingZeroBitsInDigit(n, nd) BnnNumLeadingZeroBitsInDigit (*(n+nd)) +#define BnDoesDigitFitInWord(n, nd) BnnDoesDigitFitInWord (*(n+nd)) +#define BnIsDigitZero(n, nd) BnnIsDigitZero (*(n+nd)) +#define BnIsDigitNormalized(n, nd) BnnIsDigitNormalized (*(n+nd)) +#define BnIsDigitOdd(n, nd) BnnIsDigitOdd (*(n+nd)) +#define BnCompareDigits(m, md, n, nd) BnnCompareDigits (*(m+md), *(n+nd)) +#define BnComplement(n, nd, nl) BnnComplement ((n+nd), nl) +#define BnAndDigits(m, md, n, nd) BnnAndDigits ((m+md), *(n+nd)) +#define BnOrDigits(m, md, n, nd) BnnOrDigits ((m+md), *(n+nd)) +#define BnXorDigits(m, md, n, nd) BnnXorDigits ((m+md), *(n+nd)) +#define BnShiftLeft(m, md, ml, n, nd, nbits) *(n+nd) = BnnShiftLeft ((m+md), ml, nbits) +#define BnShiftRight(m, md, ml, n, nd, nbits) *(n+nd) = BnnShiftRight ((m+md), ml, nbits) +#define BnAddCarry(n, nd, nl, carryin) BnnAddCarry ((n+nd), nl, carryin) +#define BnAdd(m, md, ml, n, nd, nl, carryin) BnnAdd ((m+md), ml, (n+nd), nl, carryin) +#define BnSubtractBorrow(n, nd, nl, carryin) BnnSubtractBorrow ((n+nd), nl, carryin) +#define BnSubtract(m, md, ml, n, nd, nl, carryin) BnnSubtract ((m+md), ml, (n+nd), nl, carryin) +#define BnMultiplyDigit(p, pd, pl, m, md, ml, n, nd) BnnMultiplyDigit ((p+pd), pl, (m+md), ml, *(n+nd)) +#define BnDivideDigit(q, qd, r, rd, n, nd, nl, d, dd) *(r+rd) = BnnDivideDigit ((q+qd), (n+nd), nl, *(d+dd)) + + + /* old functions of Bn */ + +/* + * Creation and access to type and length fields. + */ + +/* Allocates a BigNum structure and returns a pointer to it */ +BigNum BnAlloc(size) int size; { + register BigNum n; + + n = (BigNum) ((char *) malloc(sizeof(struct BigNumHeader) + + size * sizeof(BigNumDigit)) + + sizeof(struct BigNumHeader)); + BN_LENGTH(n) = size; + return(n); +} + +/* Allocates a BigNum, inserts its Type, and returns a pointer to it */ +BigNum BnCreate(type, size) BigNumType type; int size; { + register BigNum n; + + n = BnAlloc(size); + BN_TYPE(n) = type; + BnSetToZero(n, 0, size); + return(n); +} + +/* Frees a BigNum structure */ +int BnFree(n) BigNum n; { + free(((struct BigNumHeader *) n) - 1); + return 1; +} + +/* Returns the BigNum's Type */ +BigNumType BnGetType(n) BigNum n; { + return(BN_TYPE(n)); +} + +/* Sets the BigNum's Type */ +void BnSetType(n, type) BigNum n; BigNumType type; { + BN_TYPE(n) = type; +} + +/* Returns the number of digits allocated for the BigNum */ +int BnGetSize(n) BigNum n; { + return(BN_LENGTH(n)); +} + diff --git a/otherlibs/num/bignum/s/68KerN.s b/otherlibs/num/bignum/s/68KerN.s new file mode 100644 index 000000000..1b84ae0fb --- /dev/null +++ b/otherlibs/num/bignum/s/68KerN.s @@ -0,0 +1,403 @@ +| Copyright Digital Equipment Corporation & INRIA 1988, 1989 +| +| KerN for the 68020 : MIT syntax +| [Bepaul] +| + .text + + .globl _BnnSetToZero +_BnnSetToZero: BSTZnn = 4 + BSTZnl = 8 + movl sp@(BSTZnn),a0 + movl sp@(BSTZnl),d0 + dbf d0,BSTZ1 | if(nl--) goto BSTZ1; + rts | return; +BSTZ1: clrl a0@+ | *(nn++) = 0; + dbf d0,BSTZ1 | if(nl--) goto BSTZ1; + rts | return; + + .globl _BnnAssign +_BnnAssign: BAGmm = 4 + BAGnn = 8 + BAGnl = 12 + movl sp@(BAGmm),a0 + movl sp@(BAGnn),a1 + movl sp@(BAGnl),d0 + cmpl a1,a0 + jcc BAG2 | if(mm >= nn) goto BAG2; + dbf d0,BAG1 | if(nl--) goto BAG1; + rts | return; +BAG1: movl a1@+,a0@+ | *(mm++) = *(nn++); + dbf d0,BAG1 | if(nl--) goto BAG1; + rts | return; +BAG2: jls BAG4 | if(mm <= nn) goto BAG4; + lea a0@(0,d0:l:4),a0 | mm = &mm[nl]; + lea a1@(0,d0:l:4),a1 | nn = &nn[nl]; + dbf d0,BAG3 | if(nl--) goto BAG3; + rts | return; +BAG3: movl a1@-,a0@- | *(--mm) = *(--nn); + dbf d0,BAG3 | if(nl--) goto BAG3; +BAG4: rts | return; + + .globl _BnnSetDigit +_BnnSetDigit: BSDnn = 4 + BSDd = 8 + movl sp@(BSDnn),a0 + movl sp@(BSDd),a0@ | *nn = d; + rts | return; + + .globl _BnnGetDigit +_BnnGetDigit: BGDnn = 4 + movl sp@(BGDnn),a0 + movl a0@,d0 | return(*nn); + rts + + .globl _BnnNumDigits +_BnnNumDigits: BNDnn = 4 + BNDnl = 8 + movl sp@(BNDnn),a0 + movl sp@(BNDnl),d0 + lea a0@(0,d0:l:4),a0 | nn = &nn[nl]; + dbf d0,BND1 | if(nl--) goto BND1; + moveq #1,d0 + rts | return(1); +BND1: tstl a0@- + jne BND3 | if(*(--nn) != 0) goto BND3; + dbf d0,BND1 | if(nl--) goto BND1; + moveq #1,d0 + rts | return(1); +BND3: addql #1,d0 + rts | return(nl + 1); + + .globl _BnnNumLeadingZeroBitsInDigit +_BnnNumLeadingZeroBitsInDigit: BLZd = 4 + bfffo sp@(BLZd){#0:#32},d0 + rts + + .globl _BnnDoesDigitFitInWord +_BnnDoesDigitFitInWord: BDFd = 4 + moveq #1,d0 | C_VERSION + rts + + .globl _BnnIsDigitZero +_BnnIsDigitZero: BDZd = 4 + clrl d0 + tstl sp@(BDZd) + seq d0 + rts | return(d == 0); + + .globl _BnnIsDigitNormalized +_BnnIsDigitNormalized: BDNd = 4 + clrl d0 + tstw sp@(BDNd) + smi d0 + rts | return(d < 0); + + .globl _BnnIsDigitOdd +_BnnIsDigitOdd: BDOd = 4 + clrl d0 + movw sp@(BDOd+2),cc + scs d0 + rts | return(d & 1); + + .globl _BnnCompareDigits +_BnnCompareDigits: BCDd1 = 4 + BCDd2 = 8 + movl sp@(BCDd1),d1 + cmpl sp@(BCDd2),d1 + bhi BCDsup | if(d1 > d2) goto BCDsup; + sne d0 + extbl d0 + rts | return(-(d1 < d2)); +BCDsup: moveq #1,d0 + rts | return(1); + + .globl _BnnComplement +_BnnComplement: BCMnn = 4 + BCMnl = 8 + movl sp@(BCMnn),a0 + movl sp@(BCMnl),d0 + dbf d0,BCM1 | if(nl--) goto BCM1; + rts | return; +BCM1: notl a0@+ | *(nn++) ^= -1; + dbf d0,BCM1 | if(nl--) goto BCM1; + rts | return; + + .globl _BnnAndDigits +_BnnAndDigits: BADnn = 4 + BADd = 8 + movl sp@(BADnn),a0 + movl sp@(BADd),d0 + andl d0,a0@ | *n &= d; + rts | return; + + .globl _BnnOrDigits +_BnnOrDigits: BODnn = 4 + BODd = 8 + movl sp@(BODnn),a0 + movl sp@(BODd),d0 + orl d0,a0@ | *n |= d; + rts | return; + + .globl _BnnXorDigits +_BnnXorDigits: BXDnn = 4 + BXDd = 8 + movl sp@(BXDnn),a0 + movl sp@(BXDd),d0 + eorl d0,a0@ | *n ^= d; + rts | return; + + .globl _BnnShiftLeft +_BnnShiftLeft: BSLmm = 4 + BSLml = 8 + BSLnbi = 12 + clrl d0 | res = 0; + movl sp@(BSLnbi),d1 + jne BSL0 | if(nbi) goto BSL0; + rts | return(res); +BSL0: movl sp@(BSLmm),a0 + moveml #0x3C00,sp@- | Save 4 registers + movl sp@(BSLml + 16),d2 + moveq #32,d3 | rnbi = BN_DIGIT_SIZE; + subl d1,d3 | rnbi -= nbi; + dbf d2,BSL1 | if(ml--) goto BSL1; + moveml a7@+,#0x003C | Restore 4 registers + rts | return(res); +BSL1: movl a0@,d4 | save = *mm; + movl d4,d5 | X = save; + lsll d1,d5 | X <<= nbi; + orl d0,d5 | X |= res; + movl d5,a0@+ | *(mm++) = X; + movl d4,d0 | res = save; + lsrl d3,d0 | res >>= rnbi; + dbf d2,BSL1 | if(ml--) goto BSL1; + moveml a7@+,#0x003C | Restore 4 registers + rts | return(res); + + .globl _BnnShiftRight +_BnnShiftRight: BSRmm = 4 + BSRml = 8 + BSRnbi = 12 + clrl d0 | res = 0; + movl sp@(BSRnbi),d1 + jne BSR0 | if(nbi) goto BSR0; + rts | return(res); +BSR0: movl sp@(BSRmm),a0 + moveml #0x3C00,sp@- | Save 4 registers + movl sp@(BSRml + 16),d2 + lea a0@(0,d2:l:4),a0 | mm = &mm[ml]; + moveq #32,d3 | lnbi = BN_DIGIT_SIZE; + subl d1,d3 | lnbi -= nbi; + dbf d2,BSR1 | if(ml--) goto BSR1; + moveml a7@+,#0x003C | Restore 4 registers + rts | return(res); +BSR1: movl a0@-,d4 | save = *(--mm); + movl d4,d5 | X = save; + lsrl d1,d5 | X >>= nbi; + orl d0,d5 | X |= res; + movl d5,a0@ | *mm = X; + movl d4,d0 | res = save; + lsll d3,d0 | res <<= lnbi; +BSR2: dbf d2,BSR1 | if(ml--) goto BSR1; + moveml a7@+,#0x003C | Restore 4 registers + rts | return(res); + + .globl _BnnAddCarry +_BnnAddCarry: BACnn = 4 + BACnl = 8 + BACcar = 12 + movl sp@(BACcar),d0 | + jeq BAC2 | if(car == 0) return(car); + movl sp@(BACnl),d0 | + jeq BAC3 | if(nl == 0) return(1); + movl sp@(BACnn),a0 + subql #1,d0 | nl--; +BAC1: addql #1,a0@+ | ++(*nn++); + dbcc d0,BAC1 | if(Carry || nl--) goto BAC1 + scs d0 + negb d0 + extbl d0 +BAC2: rts | return(Carry) +BAC3: moveq #1,d0 + rts | return(1); + + .globl _BnnAdd +_BnnAdd: BADDmm = 4 + BADDml = 8 + BADDnn = 12 + BADDnl = 16 + BADDcar = 20 + movl sp@(BADDmm),a0 + movl sp@(BADDnn),a1 + movl sp@(BADDnl),d1 + subl d1,sp@(BADDml) | ml -= nl; + tstl d1 + jne BADD1 | if(nl) goto BADD1 + tstl sp@(BADDcar) || + jne BADD7 | if(car) goto BADD7 + clrl d0 + rts | return(0); +BADD1: subql #1,d1 | nl--; + movl sp@(BADDcar),d0 + negb d0 | /* Bit No 4 */ + movw d0,cc | X = car; + movl d2,sp@- ||| Save register. +BADDX: movl a1@+,d0 + movl a0@,d2 + addxl d0,d2 | N = *mm + *(nn++) + X + movl d2,a0@+ | X = N >> 32; *(mn++) = N; + dbf d1,BADDX | if(nl--) goto BADDX + movl sp@+,d2 ||| Restore register. + movw cc,d0 + andw #0x10,d0 + jne BADD7 | if(X) goto BADD7; + clrl d0 | return(0); + rts +BADD7: movl sp@(BADDml),d0 + jeq BADD9 | if(ml == 0) return(1); + subql #1,d0 | ml--; +BADD8: addql #1,a0@+ | ++(*mm++); + dbcc d0,BADD8 | if(Carry || ml--) goto BADD8 + scs d0 + negb d0 + extbl d0 + rts | return(Carry) +BADD9: moveq #1,d0 + rts | return(1); + + .globl _BnnSubtractBorrow +_BnnSubtractBorrow: BSBnn = 4 + BSBnl = 8 + BSBcar = 12 + movl sp@(BSBcar),d0 + jne BSB2 | if(car) return(car); + movl sp@(BSBnl),d0 + jeq BSB3 | if(nl == 0) return(0); + movl sp@(BSBnn),a0 + subql #1,d0 | nl--; +BSB1: subql #1,a0@+ | (*nn++)--; + dbcc d0,BSB1 | if(Carry || nl--) goto BSB1 + scc d0 + negb d0 + extbl d0 +BSB2: rts | return(Carry) +BSB3: moveq #0,d0 + rts | return(0); + + .globl _BnnSubtract +_BnnSubtract: BSmm = 4 + BSml = 8 + BSnn = 12 + BSnl = 16 + BScar = 20 + movl sp@(BSmm),a0 + movl sp@(BSnn),a1 + movl sp@(BSnl),d1 + subl d1,sp@(BSml) | ml -= nl; + tstl d1 + jne BS1 | if(nl) goto BS1 + tstl sp@(BScar) + jeq BS7 | if(!car) goto BS7 + moveq #1,d0 + rts | return(1); +BS1: subql #1,d1 | nl--; + movl sp@(BScar),d0 + negb d0 | /* Bit No 4 */ + notb d0 + movw d0,cc | X = ~car; + movl d2,sp@- ||| Save register. +BSX: movl a1@+,d0 + movl a0@,d2 + subxl d0,d2 | N = *mm - *(nn++) - X + movl d2,a0@+ | X = N >> 32; *(mm++) = N; + dbf d1,BSX | if(nl--) goto BSX + movl sp@+,d2 ||| Restore register. + movw cc,d0 + andw #0x10,d0 + jne BS7 | if(X) goto BS7; + moveq #1,d0 | return(1); + rts +BS7: movl sp@(BSml),d1 + jeq BS9 | if(ml == 0) goto BS9; + subql #1,d1 | ml--; +BS8: subql #1,a0@+ | --(*m++); + dbcc d1,BS8 | if(Carry || ml--) goto BS8 + scc d0 + negb d0 + extbl d0 + rts | return(C) +BS9: clrl d0 + rts | return(0); + + .globl _BnnMultiplyDigit +_BnnMultiplyDigit: BMDpp = 4 + BMDpl = 8 + BMDmm = 12 + BMDml = 16 + BMDd = 20 + movl sp@(BMDd),d0 + jne BMD1 | if(d) goto BMD1; + rts | return(0); +BMD1: cmpl #1,d0 + jne BMD2 | if(d != 1) goto BMD2; + clrl sp@(BMDd) + bra _BnnAdd | BnnAdd(p,pl,m,ml,0); +BMD2: movl sp@(BMDpp),a0 + movl sp@(BMDmm),a1 + movl sp@(BMDml),d1 + subl d1,sp@(BMDpl) | pl -= ml; + moveml #0x3c00,sp@- | Save 4 registers + clrl d2 | low = 0; + clrl d5 + bra BMD6 | goto BMD6; +BMD3: movl a1@+,d4 | X = *(mm++); + mulul d0,d3:d4 | X *= d; + addl d2,d4 | X += low; + addxl d5,d3 | X(hight) += Carry; + addl a0@,d4 | X += *pp; + addxl d5,d3 | X(hight) += Carry; + movl d4,a0@+ | *(pp++) = X(low); + movl d3,d2 | low = X(hight); +BMD6: dbf d1,BMD3 | if(ml--) goto BMD3; + movl d2,d0 + moveml a7@+,#0x003C | Restore 4 registers + addl d0,a0@+ | *(pp++) += low; + bcs BMD7 | if(Carry) goto BMD7; + clrl d0 + rts | return(0); +BMD7: movl sp@(BMDpl),d0 + subql #1,d0 | pl--; + jeq BMD10 | if(!pl) goto BM10; + subql #1,d0 | pl--; +BMD8: addql #1,a0@+ | ++(*pp++); +BMD9: dbcc d0,BMD8 | if(Carry || pl--) goto BMD8 + scs d0 + negb d0 + extbl d0 + rts | return(Carry); +BMD10: moveq #1,d0 + rts | return(1); + + .globl _BnnDivideDigit +_BnnDivideDigit: BDDqq = 12 + BDDnn = 16 + BDDnl = 20 + BDDd = 24 + moveml #0x3000,sp@- | Save 2 registers + movl sp@(BDDqq),a1 + movl sp@(BDDnn),a0 + movl sp@(BDDnl),d0 + movl sp@(BDDd),d1 + lea a0@(0,d0:l:4),a0 | nn = &nn[nl]; + subql #1,d0 | nl--; + lea a1@(0,d0:l:4),a1 | qq = &qq[nl]; + movl a0@-,d2 || X(hight) = *(--nn); + bra BDD2 | goto BDD2; +BDD1: movl a0@-,d3 | X(low) = *(--nn); + divul d1,d2:d3 | X(low) = X / d; + | X(hight) = X % d; + movl d3,a1@- | *(--qq) = X(low); +BDD2: dbf d0,BDD1 | if(nl--) goto BDD1; + movl d2,d0 || return(X(hight)); + moveml a7@+,#0x000C | Restore 2 registers + rts diff --git a/otherlibs/num/bignum/s/68KerN_mot.s b/otherlibs/num/bignum/s/68KerN_mot.s new file mode 100644 index 000000000..6baa43803 --- /dev/null +++ b/otherlibs/num/bignum/s/68KerN_mot.s @@ -0,0 +1,410 @@ +| Copyright Digital Equipment Corporation & INRIA 1988, 1989 +| +| KerN for the 68020 : MOTOROLA syntax +| [Bepaul] +| + SECTION 10 + + XDEF _BnnSetToZero +BSTZnn EQU 4 +BSTZnl EQU 8 +_BnnSetToZero MOVE.L BSTZnn(A7),A0 + MOVE.L BSTZnl(A7),D0 + DBF D0,BSTZ1 | if(nl--) goto BSTZ1; + RTS | return; +BSTZ1 CLR.L (A0)+ | *(nn++) = 0; + DBF D0,BSTZ1 | if(nl--) goto BSTZ1; + RTS | return; + + XDEF _BnnAssign +BAGmm EQU 4 +BAGnn EQU 8 +BAGnl EQU 12 +_BnnAssign MOVE.L BAGmm(A7),A0 + MOVE.L BAGnn(A7),A1 + MOVE.L BAGnl(A7),D0 + CMP.L A1,A0 + BCC BAG2 | if(mm >= nn) goto BAG2; + DBF D0,BAG1 | if(nl--) goto BAG1; + RTS | return; +BAG1 MOVE.L (A1)+,(A0)+ | *(mm++) = *(nn++); + DBF D0,BAG1 | if(nl--) goto BAG1; + RTS | return; +BAG2 BLS BAG4 | if(mm <= nn) goto BAG4; + LEA 0(A0,D0.L*4),A0 | mm = &mm[nl]; + LEA 0(A1,D0.L*4),A1 | nn = &nn[nl]; + DBF D0,BAG3 | if(nl--) goto BAG3; + RTS | return; +BAG3 MOVE.L -(A1),-(A0) | *(--mm) = *(--nn); + DBF D0,BAG3 | if(nl--) goto BAG3; +BAG4 RTS | return; + + XDEF _BnnSetDigit +BSDnn EQU 4 +BSDd EQU 8 +_BnnSetDigit MOVE.L BSDnn(A7),A0 + MOVE.L BSDd(A7),(A0) | *nn = d; + RTS | return; + + XDEF _BnnGetDigit +BGDnn EQU 4 +_BnnGetDigit MOVE.L BGDnn(A7),A0 + MOVE.L (A0),D0 | return(*nn); + RTS + + XDEF _BnnNumDigits +BNDnn EQU 4 +BNDnl EQU 8 +_BnnNumDigits MOVE.L BNDnn(A7),A0 + MOVE.L BNDnl(A7),D0 + LEA 0(A0,D0.L*4),A0 | nn = &nn[nl]; + DBF D0,BND1 | if(nl--) goto BND1; + MOVEQ #1,D0 + RTS | return(1); +BND1 TST.L -(A0) + BNE BND3 | if(*(--nn) != 0) goto BND3; + DBF D0,BND1 | if(nl--) goto BND1; + MOVEQ #1,D0 + RTS | return(1); +BND3 ADDQ.L #1,D0 + RTS | return(nl + 1); + + XDEF _BnnNumLeadingZeroBitsInDigit +BLZd EQU 4 +_BnnNumLeadingZeroBitsInDigit + BFFFO BLZd(A7){#0:#32},D0 + RTS + + XDEF _BnnDoesDigitFitInWord +BDFd EQU 4 +_BnnDoesDigitFitInWord + MOVEQ #1,D0 | C_VERSION + RTS + + XDEF _BnnIsDigitZero +BDZd EQU 4 +_BnnIsDigitZero CLR.L D0 + TST.L BDZd(A7) + SEQ D0 + RTS | return(d == 0); + + XDEF _BnnIsDigitNormalized +BDNd EQU 4 +_BnnIsDigitNormalized + CLR.L D0 + TST.W BDNd(A7) + SMI D0 + RTS | return(d < 0); + + XDEF _BnnIsDigitOdd +BDOd EQU 4 +_BnnIsDigitOdd CLR.L D0 + MOVE BDOd+2(A7),CCR + SCS D0 + RTS | return(d & 1); + + XDEF _BnnCompareDigits +BCDd1 EQU 4 +BCDd2 EQU 8 +_BnnCompareDigits + MOVE.L BCDd1(A7),D1 + CMP.L BCDd2(A7),D1 + BHI BCDsup | if(d1 > d2) goto BCDsup; + SNE D0 + EXTB.L D0 + RTS | return(-(d1 < d2)); +BCDsup MOVEQ #1,D0 + RTS | return(1); + + XDEF _BnnComplement +BCMnn EQU 4 +BCMnl EQU 8 +_BnnComplement MOVE.L BCMnn(A7),A0 + MOVE.L BCMnl(A7),D0 + DBF D0,BCM1 | if(nl--) goto BCM1; + RTS | return; +BCM1 NOT.L (A0)+ | *(nn++) ^= -1; + DBF D0,BCM1 | if(nl--) goto BCM1; + RTS | return; + + XDEF _BnnAndDigits +BADnn EQU 4 +BADd EQU 8 +_BnnAndDigits MOVE.L BADnn(A7),A0 + MOVE.L BADd(A7),D0 + AND.L D0,(A0) | *n &= d; + RTS | return; + + XDEF _BnnOrDigits +BODnn EQU 4 +BODd EQU 8 +_BnnOrDigits MOVE.L BODnn(A7),A0 + MOVE.L BODd(A7),D0 + OR.L D0,(A0) | *n |= d; + RTS | return; + + XDEF _BnnXorDigits +BXDnn EQU 4 +BXDd EQU 8 +_BnnXorDigits + MOVE.L BXDnn(A7),A0 + MOVE.L BXDd(A7),D0 + EOR.L D0,(A0) | *n ^= d; + RTS | return; + + XDEF _BnnShiftLeft +BSLmm EQU 4 +BSLml EQU 8 +BSLnbi EQU 12 +_BnnShiftLeft CLR.L D0 | res = 0; + MOVE.L BSLnbi(A7),D1 + BNE BSL0 | if(nbi) goto BSL0; + RTS | return(res); +BSL0 MOVE.L BSLmm(A7),A0 + MOVEM.L D2-D5,-(A7) | Save 4 registers + MOVE.L BSLml+16(A7),D2 + MOVEQ #32,D3 | rnbi = BN_DIGIT_SIZE; + SUB.L D1,D3 | rnbi -= nbi; + DBF D2,BSL1 | if(ml--) goto BSL1; + MOVEM.L (A7)+,D2-D5 | Restore 4 registers + RTS | return(res); +BSL1 MOVE.L (A0),D4 | save = *mm; + MOVE.L D4,D5 | X = save; + LSL.L D1,D5 | X <<= nbi; + OR.L D0,D5 | X |= res; + MOVE.L D5,(A0)+ | *(mm++) = X; + MOVE.L D4,D0 | res = save; + LSR.L D3,D0 | res >>= rnbi; + DBF D2,BSL1 | if(ml--) goto BSL1; + MOVEM.L (A7)+,D2-D5 | Restore 4 registers + RTS | return(res); + + XDEF _BnnShiftRight +BSRmm EQU 4 +BSRml EQU 8 +BSRnbi EQU 12 +_BnnShiftRight CLR.L D0 | res = 0; + MOVE.L BSRnbi(A7),D1 + BNE BSR0 | if(nbi) goto BSR0; + RTS | return(res); +BSR0 MOVE.L BSRmm(A7),A0 + MOVEM.L D2-D5,-(A7) | Save 4 registers + MOVE.L BSRml+16(A7),D2 + LEA 0(A0,D2.L*4),A0 | mm = &mm[ml]; + MOVEQ #32,D3 | lnbi = BN_DIGIT_SIZE; + SUB.L D1,D3 | lnbi -= nbi; + DBF D2,BSR1 | if(ml--) goto BSR1; + MOVEM.L (A7)+,D2-D5 | Restore 4 registers + RTS | return(res); +BSR1 MOVE.L -(A0),D4 | save = *(--mm); + MOVE.L D4,D5 | X = save; + LSR.L D1,D5 | X >>= nbi; + OR.L D0,D5 | X |= res; + MOVE.L D5,(A0) | *mm = X; + MOVE.L D4,D0 | res = save; + LSL.L D3,D0 | res <<= lnbi; +BSR2 DBF D2,BSR1 | if(ml--) goto BSR1; + MOVEM.L (A7)+,D2-D5 | Restore 4 registers + RTS | return(res); + + XDEF _BnnAddCarry +BACnn EQU 4 +BACnl EQU 8 +BACcar EQU 12 +_BnnAddCarry MOVE.L BACcar(A7),D0 | + BEQ BAC2 | if(car == 0) return(car); + MOVE.L BACnl(A7),D0 | + BEQ BAC3 | if(nl == 0) return(1); + MOVE.L BACnn(A7),A0 + SUBQ.L #1,D0 | nl--; +BAC1 ADDQ.L #1,(A0)+ | ++(*nn++); + DBCC D0,BAC1 | if(Carry || nl--) goto BAC1 + SCS D0 + NEG.B D0 + EXTB.L D0 +BAC2 RTS | return(Carry) +BAC3 MOVEQ #1,D0 + RTS | return(1); + + XDEF _BnnAdd +BADDmm EQU 4 +BADDml EQU 8 +BADDnn EQU 12 +BADDnl EQU 16 +BADDcar EQU 20 +_BnnAdd MOVE.L BADDmm(A7),A0 + MOVE.L BADDnn(A7),A1 + MOVE.L BADDnl(A7),D1 + SUB.L D1,BADDml(A7) | ml -= nl; + TST.L D1 + BNE BADD1 | if(nl) goto BADD1 + TST.L BADDcar(A7) || + BNE BADD7 | if(car) goto BADD7 + CLR.L D0 + RTS | return(0); +BADD1 SUBQ.L #1,D1 | nl--; + MOVE.L BADDcar(A7),D0 + NEG.B D0 | /* Bit No 4 */ + MOVE D0,CCR | X = car; + MOVE.L D2,-(A7) ||| Save register. +BADDX MOVE.L (A1)+,D0 + MOVE.L (A0),D2 + ADDX.L D0,D2 | N = *mm + *(nn++) + X + MOVE.L D2,(A0)+ | X = N >> 32; *(mn++) = N; + DBF D1,BADDX | if(nl--) goto BADDX + MOVE.L (A7)+,D2 ||| Restore register. + MOVE CCR,D0 + AND.W #0x10,D0 + BNE BADD7 | if(X) goto BADD7; + CLR.L D0 | return(0); + RTS +BADD7 MOVE.L BADDml(A7),D0 + BEQ BADD9 | if(ml == 0) return(1); + SUBQ.L #1,D0 | ml--; +BADD8 ADDQ.L #1,(A0)+ | ++(*mm++); + DBCC D0,BADD8 | if(Carry || ml--) goto BADD8 + SCS D0 + NEG.B D0 + EXTB.L D0 + RTS | return(Carry) +BADD9 MOVEQ #1,D0 + RTS | return(1); + + XDEF _BnnSubtractBorrow +BSBnn EQU 4 +BSBnl EQU 8 +BSBcar EQU 12 +_BnnSubtractBorrow + MOVE.L BSBcar(A7),D0 + BNE BSB2 | if(car) return(car); + MOVE.L BSBnl(A7),D0 + BEQ BSB3 | if(nl == 0) return(0); + MOVE.L BSBnn(A7),A0 + SUBQ.L #1,D0 | nl--; +BSB1 SUBQ.L #1,(A0)+ | (*nn++)--; + DBCC D0,BSB1 | if(Carry || nl--) goto BSB1 + SCC D0 + NEG.B D0 + EXTB.L D0 +BSB2 RTS | return(Carry) +BSB3 MOVEQ #0,D0 + RTS | return(0); + + XDEF _BnnSubtract +BSmm EQU 4 +BSml EQU 8 +BSnn EQU 12 +BSnl EQU 16 +BScar EQU 20 +_BnnSubtract MOVE.L BSmm(A7),A0 + MOVE.L BSnn(A7),A1 + MOVE.L BSnl(A7),D1 + SUB.L D1,BSml(A7) | ml -= nl; + TST.L D1 + BNE BS1 | if(nl) goto BS1 + TST.L BScar(A7) + BEQ BS7 | if(!car) goto BS7 + MOVEQ #1,D0 + RTS | return(1); +BS1 SUBQ.L #1,D1 | nl--; + MOVE.L BScar(A7),D0 + NEG.B D0 | /* Bit No 4 */ + NOT.B D0 + MOVE D0,CCR | X = ~car; + MOVE.L D2,-(A7) ||| Save register. +BSX MOVE.L (A1)+,D0 + MOVE.L (A0),D2 + SUBX.L D0,D2 | N = *mm - *(nn++) - X + MOVE.L D2,(A0)+ | X = N >> 32; *(mm++) = N; + DBF D1,BSX | if(nl--) goto BSX + MOVE.L (A7)+,D2 ||| Restore register. + MOVE CCR,D0 + AND.W #0x10,D0 + BNE BS7 | if(X) goto BS7; + MOVEQ #1,D0 | return(1); + RTS +BS7 MOVE.L BSml(A7),D1 + BEQ BS9 | if(ml == 0) goto BS9; + SUBQ.L #1,D1 | ml--; +BS8 SUBQ.L #1,(A0)+ | --(*m++); + DBCC D1,BS8 | if(Carry || ml--) goto BS8 + SCC D0 + NEG.B D0 + EXTB.L D0 + RTS | return(C) +BS9 CLR.L D0 + RTS | return(0); + + XDEF _BnnMultiplyDigit +BMDpp EQU 4 +BMDpl EQU 8 +BMDmm EQU 12 +BMDml EQU 16 +BMDd EQU 20 +_BnnMultiplyDigit + MOVE.L BMDd(A7),D0 + BNE BMD1 | if(d) goto BMD1; + RTS | return(0); +BMD1 CMP.L #1,D0 + BNE BMD2 | if(d != 1) goto BMD2; + CLR.L BMDd(A7) + BRA _BnnAdd | BnnAdd(p,pl,m,ml,0); +BMD2 MOVE.L BMDpp(A7),A0 + MOVE.L BMDmm(A7),A1 + MOVE.L BMDml(A7),D1 + SUB.L D1,BMDpl(A7) | pl -= ml; + MOVEM.L D2-D5,-(A7) | Save 4 registers + CLR.L D2 | low = 0; + CLR.L D5 + BRA BMD6 | goto BMD6; +BMD3 MOVE.L (A1)+,D4 | X = *(mm++); + MULU.L D0,D3:D4 | X *= d; + ADD.L D2,D4 | X += low; + ADDX.L D5,D3 | X(hight) += Carry; + ADD.L (A0),D4 | X += *pp; + ADDX.L D5,D3 | X(hight) += Carry; + MOVE.L D4,(A0)+ | *(pp++) = X(low); + MOVE.L D3,D2 | low = X(hight); +BMD6 DBF D1,BMD3 | if(ml--) goto BMD3; + MOVE.L D2,D0 + MOVEM.L (A7)+,D2-D5 | Restore 4 registers + ADD.L D0,(A0)+ | *(pp++) += low; + BCS BMD7 | if(Carry) goto BMD7; + CLR.L D0 + RTS | return(0); +BMD7 MOVE.L BMDpl(A7),D0 + SUBQ.L #1,D0 | pl--; + BEQ BMD10 | if(!pl) goto BM10; + SUBQ.L #1,D0 | pl--; +BMD8 ADDQ.L #1,(A0)+ | ++(*pp++); +BMD9 DBCC D0,BMD8 | if(Carry || pl--) goto BMD8 + SCS D0 + NEG.B D0 + EXTB.L D0 + RTS | return(Carry); +BMD10 MOVEQ #1,D0 + RTS | return(1); + + XDEF _BnnDivideDigit +BDDqq EQU 12 +BDDnn EQU 16 +BDDnl EQU 20 +BDDd EQU 24 +_BnnDivideDigit MOVEM.L D2-D3,-(A7) | Save 2 registers + MOVE.L BDDqq(A7),A1 + MOVE.L BDDnn(A7),A0 + MOVE.L BDDnl(A7),D0 + MOVE.L BDDd(A7),D1 + LEA 0(A0,D0.L*4),A0 | nn = &nn[nl]; + SUBQ.L #1,D0 | nl--; + LEA 0(A1,D0.l*4),A1 | qq = &qq[nl]; + MOVE.L -(A0),D2 || X(hight) = *(--nn); + BRA BDD2 | goto BDD2; +BDD1 MOVE.L -(A0),D3 | X(low) = *(--nn); + DIVU.L D1,D2:D3 | X(low) = X / d; + | X(hight) = X % d; + MOVE.L D3,-(A1) | *(--qq) = X(low); +BDD2 DBF D0,BDD1 | if(nl--) goto BDD1; + MOVE.L D2,D0 || return(X(hight)); + MOVEM.L (A7)+,D2-D3 | Restore 2 registers + RTS diff --git a/otherlibs/num/bignum/s/68KerN_sony.s b/otherlibs/num/bignum/s/68KerN_sony.s new file mode 100644 index 000000000..ef5ae6aae --- /dev/null +++ b/otherlibs/num/bignum/s/68KerN_sony.s @@ -0,0 +1,426 @@ +/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */ +/* */ +/* KerN for the 68020 : SONY syntax */ +/* [Bepaul] */ +/* */ + .text + + .globl _BnnSetToZero +_BnnSetToZero: + .set BSTZnn,4 + .set BSTZnl,8 + move.l BSTZnn(sp),a0 + move.l BSTZnl(sp),d0 + dbf d0,BSTZ1 /* if(nl--) goto BSTZ1; */ + rts /* return; */ +BSTZ1: clr.l (a0)+ /* *(nn++) = 0; */ + dbf d0,BSTZ1 /* if(nl--) goto BSTZ1; */ + rts /* return; */ + + .globl _BnnAssign +_BnnAssign: + .set BAGmm,4 + .set BAGnn,8 + .set BAGnl,12 + move.l BAGmm(sp),a0 + move.l BAGnn(sp),a1 + move.l BAGnl(sp),d0 + cmp.l a1,a0 + bcc BAG2 /* if(mm >= nn) goto BAG2; */ + dbf d0,BAG1 /* if(nl--) goto BAG1; */ + rts /* return; */ +BAG1: move.l (a1)+,(a0)+ /* *(mm++) = *(nn++); */ + dbf d0,BAG1 /* if(nl--) goto BAG1; */ + rts /* return; */ +BAG2: bls BAG4 /* if(mm <= nn) goto BAG4; */ + lea (0,a0,d0.l*4),a0 /* mm = &mm[nl]; */ + lea (0,a1,d0.l*4),a1 /* nn = &nn[nl]; */ + dbf d0,BAG3 /* if(nl--) goto BAG3; */ + rts /* return; */ +BAG3: move.l -(a1),-(a0) /* *(--mm) = *(--nn); */ + dbf d0,BAG3 /* if(nl--) goto BAG3; */ +BAG4: rts /* return; */ + + .globl _BnnSetDigit +_BnnSetDigit: + .set BSDnn,4 + .set BSDd,8 + move.l BSDnn(sp),a0 + move.l BSDd(sp),(a0) /* *nn = d; */ + rts /* return; */ + + .globl _BnnGetDigit +_BnnGetDigit: + .set BGDnn,4 + move.l BGDnn(sp),a0 + move.l (a0),d0 /* return(*nn); */ + rts + + .globl _BnnNumDigits +_BnnNumDigits: + .set BNDnn,4 + .set BNDnl,8 + move.l BNDnn(sp),a0 + move.l BNDnl(sp),d0 + lea (0,a0,d0.l*4),a0 /* nn = &nn[nl]; */ + dbf d0,BND1 /* if(nl--) goto BND1; */ + moveq #1,d0 + rts /* return(1); */ +BND1: tst.l -(a0) + bne BND3 /* if(*(--nn) != 0) goto BND3; */ + dbf d0,BND1 /* if(nl--) goto BND1; */ + moveq #1,d0 + rts /* return(1); */ +BND3: addq.l #1,d0 + rts /* return(nl + 1); */ + + .globl _BnnNumLeadingZeroBitsInDigit +_BnnNumLeadingZeroBitsInDigit: + .set BLZd,4 + bfffo BLZd(sp){0:32},d0 + rts + + .globl _BnnDoesDigitFitInWord +_BnnDoesDigitFitInWord: + .set BDFd,4 + moveq #1,d0 /* C_VERSION */ + rts + + .globl _BnnIsDigitZero +_BnnIsDigitZero: + .set BDZd,4 + clr.l d0 + tst.l BDZd(sp) + seq d0 + rts /* return(d == 0); */ + + .globl _BnnIsDigitNormalized +_BnnIsDigitNormalized: + .set BDNd,4 + clr.l d0 + tst.w BDNd(sp) + smi d0 + rts /* return(d < 0); */ + + .globl _BnnIsDigitOdd +_BnnIsDigitOdd: + .set BDOd,4 + clr.l d0 + move.w BDOd+2(sp),ccr + scs d0 + rts /* return(d & 1); */ + + .globl _BnnCompareDigits +_BnnCompareDigits: + .set BCDd1,4 + .set BCDd2,8 + move.l BCDd1(sp),d1 + cmp.l BCDd2(sp),d1 + bhi BCDsup /* if(d1 > d2) goto BCDsup; */ + sne d0 + extb.l d0 + rts /* return(-(d1 < d2)); */ +BCDsup: moveq #1,d0 + rts /* return(1); */ + + .globl _BnnComplement +_BnnComplement: + .set BCMnn,4 + .set BCMnl,8 + move.l BCMnn(sp),a0 + move.l BCMnl(sp),d0 + dbf d0,BCM1 /* if(nl--) goto BCM1; */ + rts /* return; */ +BCM1: not.l (a0)+ /* *(nn++) ^= -1; */ + dbf d0,BCM1 /* if(nl--) goto BCM1; */ + rts /* return; */ + + .globl _BnnAndDigits +_BnnAndDigits: + .set BADnn,4 + .set BADd,8 + move.l BADnn(sp),a0 + move.l BADd(sp),d0 + and.l d0,(a0) /* *n &= d; */ + rts /* return; */ + + .globl _BnnOrDigits +_BnnOrDigits: + .set BODnn,4 + .set BODd,8 + move.l BODnn(sp),a0 + move.l BODd(sp),d0 + or.l d0,(a0) /* *n |= d; */ + rts /* return; */ + + .globl _BnnXorDigits +_BnnXorDigits: + .set BXDnn,4 + .set BXDd,8 + move.l BXDnn(sp),a0 + move.l BXDd(sp),d0 + eor.l d0,(a0) /* *n ^= d; */ + rts /* return; */ + + .globl _BnnShiftLeft +_BnnShiftLeft: + .set BSLmm,4 + .set BSLml,8 + .set BSLnbi,12 + clr.l d0 /* res = 0; */ + move.l BSLnbi(sp),d1 + bne BSL0 /* if(nbi) goto BSL0; */ + rts /* return(res); */ +BSL0: move.l BSLmm(sp),a0 + movem.l #0x3C00,-(sp) /* Save 4 registers */ + move.l BSLml + 16(sp),d2 + moveq #32,d3 /* rnbi = BN_DIGIT_SIZE; */ + sub.l d1,d3 /* rnbi -= nbi; */ + dbf d2,BSL1 /* if(ml--) goto BSL1; */ + movem.l (a7)+,#0x003C /* Restore 4 registers */ + rts /* return(res); */ +BSL1: move.l (a0),d4 /* save = *mm; */ + move.l d4,d5 /* X = save; */ + lsl.l d1,d5 /* X <<= nbi; */ + or.l d0,d5 /* X |= res; */ + move.l d5,(a0)+ /* *(mm++) = X; */ + move.l d4,d0 /* res = save; */ + lsr.l d3,d0 /* res >>= rnbi; */ + dbf d2,BSL1 /* if(ml--) goto BSL1; */ + movem.l (a7)+,#0x003C /* Restore 4 registers */ + rts /* return(res); */ + + .globl _BnnShiftRight +_BnnShiftRight: + .set BSRmm,4 + .set BSRml,8 + .set BSRnbi,12 + clr.l d0 /* res = 0; */ + move.l BSRnbi(sp),d1 + bne BSR0 /* if(nbi) goto BSR0; */ + rts /* return(res); */ +BSR0: move.l BSRmm(sp),a0 + movem.l #0x3C00,-(sp) /* Save 4 registers */ + move.l BSRml + 16(sp),d2 + lea (0,a0,d2.l*4),a0 /* mm = &mm[ml]; */ + moveq #32,d3 /* lnbi = BN_DIGIT_SIZE; */ + sub.l d1,d3 /* lnbi -= nbi; */ + dbf d2,BSR1 /* if(ml--) goto BSR1; */ + movem.l (a7)+,#0x003C /* Restore 4 registers */ + rts /* return(res); */ +BSR1: move.l -(a0),d4 /* save = *(--mm); */ + move.l d4,d5 /* X = save; */ + lsr.l d1,d5 /* X >>= nbi; */ + or.l d0,d5 /* X |= res; */ + move.l d5,(a0) /* *mm = X; */ + move.l d4,d0 /* res = save; */ + lsl.l d3,d0 /* res <<= lnbi; */ +BSR2: dbf d2,BSR1 /* if(ml--) goto BSR1; */ + movem.l (a7)+,#0x003C /* Restore 4 registers */ + rts /* return(res); */ + + .globl _BnnAddCarry +_BnnAddCarry: + .set BACnn,4 + .set BACnl,8 + .set BACcar,12 + move.l BACcar(sp),d0 /* */ + beq BAC2 /* if(car == 0) return(car); */ + move.l BACnl(sp),d0 /* */ + beq BAC3 /* if(nl == 0) return(1); */ + move.l BACnn(sp),a0 + subq.l #1,d0 /* nl--; */ +BAC1: addq.l #1,(a0)+ /* ++(*nn++); */ + dbcc d0,BAC1 /* if(Carry || nl--) goto BAC1 */ + scs d0 + neg.b d0 + extb.l d0 +BAC2: rts /* return(Carry) */ +BAC3: moveq #1,d0 + rts /* return(1); */ + + .globl _BnnAdd +_BnnAdd: + .set BADDmm,4 + .set BADDml,8 + .set BADDnn,12 + .set BADDnl,16 + .set BADDcar,20 + move.l BADDmm(sp),a0 + move.l BADDnn(sp),a1 + move.l BADDnl(sp),d1 + sub.l d1,BADDml(sp) /* ml -= nl; */ + tst.l d1 + bne BADD1 /* if(nl) goto BADD1 */ + tst.l BADDcar(sp) /*| */ + bne BADD7 /* if(car) goto BADD7 */ + clr.l d0 + rts /* return(0); */ +BADD1: subq.l #1,d1 /* nl--; */ + move.l BADDcar(sp),d0 + neg.b d0 /* Bit No 4 */ + move.w d0,ccr /* X = car; */ + move.l d2,-(sp) /*|| Save register. */ +BADDX: move.l (a1)+,d0 + move.l (a0),d2 + addx.l d0,d2 /* N = *mm + *(nn++) + X */ + move.l d2,(a0)+ /* X = N >> 32; *(mn++) = N; */ + dbf d1,BADDX /* if(nl--) goto BADDX */ + move.l (sp)+,d2 /*|| Restore register. */ + move.w ccr,d0 + and.w #0x10,d0 + bne BADD7 /* if(X) goto BADD7; */ + clr.l d0 /* return(0); */ + rts +BADD7: move.l BADDml(sp),d0 + beq BADD9 /* if(ml == 0) return(1); */ + subq.l #1,d0 /* ml--; */ +BADD8: addq.l #1,(a0)+ /* ++(*mm++); */ + dbcc d0,BADD8 /* if(Carry || ml--) goto BADD8 */ + scs d0 + neg.b d0 + extb.l d0 + rts /* return(Carry) */ +BADD9: moveq #1,d0 + rts /* return(1); */ + + .globl _BnnSubtractBorrow +_BnnSubtractBorrow: + .set BSBnn,4 + .set BSBnl,8 + .set BSBcar,12 + move.l BSBcar(sp),d0 + bne BSB2 /* if(car) return(car); */ + move.l BSBnl(sp),d0 + beq BSB3 /* if(nl == 0) return(0); */ + move.l BSBnn(sp),a0 + subq.l #1,d0 /* nl--; */ +BSB1: subq.l #1,(a0)+ /* (*nn++)--; */ + dbcc d0,BSB1 /* if(Carry || nl--) goto BSB1 */ + scc d0 + neg.b d0 + extb.l d0 +BSB2: rts /* return(Carry) */ +BSB3: moveq #0,d0 + rts /* return(0); */ + + .globl _BnnSubtract +_BnnSubtract: + .set BSmm,4 + .set BSml,8 + .set BSnn,12 + .set BSnl,16 + .set BScar,20 + move.l BSmm(sp),a0 + move.l BSnn(sp),a1 + move.l BSnl(sp),d1 + sub.l d1,BSml(sp) /* ml -= nl; */ + tst.l d1 + bne BS1 /* if(nl) goto BS1 */ + tst.l BScar(sp) + beq BS7 /* if(!car) goto BS7 */ + moveq #1,d0 + rts /* return(1); */ +BS1: subq.l #1,d1 /* nl--; */ + move.l BScar(sp),d0 + neg.b d0 /* Bit No 4 */ + not.b d0 + move.w d0,ccr /* X = ~car; */ + move.l d2,-(sp) /*|| Save register. */ +BSX: move.l (a1)+,d0 + move.l (a0),d2 + subx.l d0,d2 /* N = *mm - *(nn++) - X */ + move.l d2,(a0)+ /* X = N >> 32; *(mm++) = N; */ + dbf d1,BSX /* if(nl--) goto BSX */ + move.l (sp)+,d2 /*|| Restore register. */ + move.w ccr,d0 + and.w #0x10,d0 + bne BS7 /* if(X) goto BS7; */ + moveq #1,d0 /* return(1); */ + rts +BS7: move.l BSml(sp),d1 + beq BS9 /* if(ml == 0) goto BS9; */ + subq.l #1,d1 /* ml--; */ +BS8: subq.l #1,(a0)+ /* --(*m++); */ + dbcc d1,BS8 /* if(Carry || ml--) goto BS8 */ + scc d0 + neg.b d0 + extb.l d0 + rts /* return(C) */ +BS9: clr.l d0 + rts /* return(0); */ + + .globl _BnnMultiplyDigit +_BnnMultiplyDigit: + .set BMDpp,4 + .set BMDpl,8 + .set BMDmm,12 + .set BMDml,16 + .set BMDd,20 + move.l BMDd(sp),d0 + bne BMD1 /* if(d) goto BMD1; */ + rts /* return(0); */ +BMD1: cmp.l #1,d0 + bne BMD2 /* if(d != 1) goto BMD2; */ + clr.l BMDd(sp) + bra _BnnAdd /* BnnAdd(p,pl,m,ml,0); */ +BMD2: move.l BMDpp(sp),a0 + move.l BMDmm(sp),a1 + move.l BMDml(sp),d1 + sub.l d1,BMDpl(sp) /* pl -= ml; */ + movem.l #0x3c00,-(sp) /* Save 4 registers */ + clr.l d2 /* low = 0; */ + clr.l d5 + bra BMD6 /* goto BMD6; */ +BMD3: move.l (a1)+,d4 /* X = *(mm++); */ + mulu.l d0,d3:d4 /* X *= d; */ + add.l d2,d4 /* X += low; */ + addx.l d5,d3 /* X(hight) += Carry; */ + add.l (a0),d4 /* X += *pp; */ + addx.l d5,d3 /* X(hight) += Carry; */ + move.l d4,(a0)+ /* *(pp++) = X(low); */ + move.l d3,d2 /* low = X(hight); */ +BMD6: dbf d1,BMD3 /* if(ml--) goto BMD3; */ + move.l d2,d0 + movem.l (a7)+,#0x003C /* Restore 4 registers */ + add.l d0,(a0)+ /* *(pp++) += low; */ + bcs BMD7 /* if(Carry) goto BMD7; */ + clr.l d0 + rts /* return(0); */ +BMD7: move.l BMDpl(sp),d0 + subq.l #1,d0 /* pl--; */ + beq BMD10 /* if(!pl) goto BM10; */ + subq.l #1,d0 /* pl--; */ +BMD8: addq.l #1,(a0)+ /* ++(*pp++); */ +BMD9: dbcc d0,BMD8 /* if(Carry || pl--) goto BMD8 */ + scs d0 + neg.b d0 + extb.l d0 + rts /* return(Carry); */ +BMD10: moveq #1,d0 + rts /* return(1); */ + + .globl _BnnDivideDigit +_BnnDivideDigit: + .set BDDqq,12 + .set BDDnn,16 + .set BDDnl,20 + .set BDDd,24 + movem.l #0x3000,-(sp) /* Save 2 registers */ + move.l BDDqq(sp),a1 + move.l BDDnn(sp),a0 + move.l BDDnl(sp),d0 + move.l BDDd(sp),d1 + lea (0,a0,d0.l*4),a0 /* nn = &nn[nl]; */ + subq.l #1,d0 /* nl--; */ + lea (0,a1,d0.l*4),a1 /* qq = &qq[nl]; */ + move.l -(a0),d2 /*| X(hight) = *(--nn); */ + bra BDD2 /* goto BDD2; */ +BDD1: move.l -(a0),d3 /* X(low) = *(--nn); */ + divu.l d1,d2:d3 /* X(low) = X / d; */ + /* X(hight) = X % d; */ + move.l d3,-(a1) /* *(--qq) = X(low); */ +BDD2: dbf d0,BDD1 /* if(nl--) goto BDD1; */ + move.l d2,d0 /*| return(X(hight)); */ + movem.l (a7)+,#0x000C /* Restore 2 registers */ + rts diff --git a/otherlibs/num/bignum/s/RS6000KerN.s b/otherlibs/num/bignum/s/RS6000KerN.s new file mode 100644 index 000000000..e7a63b659 --- /dev/null +++ b/otherlibs/num/bignum/s/RS6000KerN.s @@ -0,0 +1,468 @@ +# Copyright Digital Equipment Corporation & INRIA 1988, 1989 +# +# KerN for the RS6000 +# [Bepaul] +# +# La plupart du code est celui ge'ne're' par le compilo C (Cha^peau!) +# + .set RES,3 + .set CA1,3 + .set CA2,4 + .set CA3,5 + .set CA4,6 + .set CA5,7 + .set X4,7 + .set X3,8 + .set X2,9 + .set X1,10 + + .set NN1,CA1 + .set MM1,CA1 + .set D1,CA1 + .set NN2,CA2 + .set NL2,CA2 + .set ML2,CA2 + .set D2,CA2 + .set NN3,CA3 + .set NL3,CA3 + .set NL4,CA4 + + .toc +T.bignum_dat: .tc bignum_dat[TC],bignum_dat[RW] + .csect bignum_dat[RW] + .csect bignum_txt[PR] + + .globl .BnnSetToZero # BnnSetToZero(nn, nl) +.BnnSetToZero: cmpi 0,NL2,0 # if(nl <= 0) return; + bler + mtctr NL2 # ctr = nl; + lil X1,0 # cte = 0; + ai NN1,NN1,-4 # nn--; +BSTZ1: stu X1,4(NN1) # *(++nn) = cte; + bdn BSTZ1 # if(--ctr != 0) goto BSTZ1; + br # return; + + .globl .BnnAssign # BnnAssign(mm, nn, nl) +.BnnAssign: cmpi 0,NL3,0 # if(nl <= 0) return; + bler + mtctr NL3 # ctr = nl; + cmpl 0,MM1,NN2 # if(mm >= nn) goto BAG2; + bge BAG2 + ai MM1,MM1,-4 # mm--; + ai NN2,NN2,-4 # nn--; +BAG1: lu X1,4(NN2) # X = *(++nn); + stu X1,4(MM1) # *(++mm) = X; + bdn BAG1 # if(--ctr != 0) goto BAG1; + br +BAG2: beqr # if(mm == nn) return; + sli X1,NL3,2 + a NN2,NN2,X1 # nn += nl; + a MM1,MM1,X1 # mm += nl; +BAG3: lu X1,-4(NN2) # X = *(--nn); + stu X1,-4(MM1) # *(--mm) = X; + bdn BAG3 # (if(--ctr != 0) goto BAG3; + br # return; + + .globl .BnnSetDigit # BnnSetDigit(nn, d) +.BnnSetDigit: st D2,0(NN1) + br + + .globl .BnnGetDigit # BnnGetDigit(nn) +.BnnGetDigit: l RES,0(NN1) + br + + .globl .BnnNumDigits # BnnNumDigits(nn, nl) +.BnnNumDigits: cmpi 0,NL2,0 # if(nl <= 0) return(1); + ble BND2 + sli X1,NL2,2 + a NN1,NN1,X1 # nn += nl; + mtctr NL2 # ctr = nl; +BND1: lu X1,-4(NN1) # X = *(--nn); + cmpi 0,X1,0 # if(X != 0) goto BND3 + bne BND3 + bdn BND1 # if(--ctr != 0) goto BND1; +BND2: lil RES,1 # return(1); + br +BND3: mfctr RES # return(ctr); + br + + .globl .BnnNumLeadingZeroBitsInDigit # (d) +.BnnNumLeadingZeroBitsInDigit: + cntlz RES,D1 # Yeah! + br + + .globl .BnnDoesDigitFitInWord # (d) +.BnnDoesDigitFitInWord: + lil RES,1 # return(1); + br + + .globl .BnnIsDigitZero # BnnIsDigitZero(d) +.BnnIsDigitZero: # Use the fact that nabs(d) >=0 <=> d == 0 + nabs RES,D1 + rlinm RES,RES,1,31,31 # sign in the lowest bit. + xoril RES,RES,1 # get the inverse. + br + + .globl .BnnIsDigitNormalized # (d) +.BnnIsDigitNormalized: + rlinm RES,D1,1,31,31 # sign in the lowest bit. + br + + .globl .BnnIsDigitOdd # BnnIsDigitOdd(d) +.BnnIsDigitOdd: rlinm RES,D1,0,31,31 # only the lowest bit. + br + + .globl .BnnCompareDigits # BnnCompareDigits(d1, d2) +.BnnCompareDigits: + cmpl 0,D1,D2 # if(d1 == d2) return(0); + beq BSD0 + bgt BCDsup # if(d1 > d2) return(1); + lil RES,-1 # return(-1); +BSDret: br +BCDsup: lil RES,1 # return(1); + br +BSD0: lil RES,0 # return(0); + br + + .globl .BnnComplement #.BnnComplement(nn, nl) +.BnnComplement: cmpi 0,NL2,0 # if(nl <= 0) return; + bler + ai NN1,NN1,-4 # nn--; + mtctr NL2 # ctr = nl; +BCM1: l X1,4(NN1) # X = nn[1]; + sfi X1,X1,-1 # X ^= -1; + stu X1,4(NN1) # *++nn = X; + bdn BCM1 # if(--ctr > 0) goto BCM1 + br # return; + + .globl .BnnAndDigits # BnnAndDigits(nn, d) +.BnnAndDigits: l X1,0(NN1) # X = *nn; + and X1,X1,D2 # X &= d; + st X1,0(NN1) # *nn = X; + br + + .globl .BnnOrDigits # BnnOrDigits(nn, d) +.BnnOrDigits: l X1,0(NN1) # X = *nn; + or X1,X1,D2 # X |= d; + st X1,0(NN1) # *nn = X; + br + + .globl .BnnXorDigits # BnnXorDigits(nn, d) +.BnnXorDigits: l X1,0(NN1) # X = *nn; + xor X1,X1,D2 # X ^= d; + st X1,0(NN1) # *nn = X; + br + + .globl .BnnShiftLeft # BnnShiftLeft(mm, ml, nbits) +# here and in the next funxtion we use the fact that MM1 == RES. + .set NBI,CA3; .set SMM,X1; .set RNB,X2; .set SX,X3; .set SY,ML2 +.BnnShiftLeft: oril SMM,MM1,0 + lil RES,0 # res = 0; + cmpi 0,NBI,0 # if(nbits == 0) return(res); + beqr + cmpi 0,ML2,0 # if(ml <= 0) return(res); + bler + sfi RNB,NBI,32 # rnbits = 32 - nbits; + ai SMM,SMM,-4 # mm--; + mtctr ML2 # ctr = ml; +BSL1: l SX,4(SMM) # X = mm[1]; + sl SY,SX,NBI # Y = X << nbits; + or SY,SY,RES # Y |= res; + stu SY,4(SMM) # *(++mm) = Y; + sr RES,SX,RNB # res = X >> rnbits; + bdn BSL1 # if(--ctr > 0) goto BSL1 + br # return(res); + + .globl .BnnShiftRight # BnnShiftRight(mm, ml, nbits) +.BnnShiftRight: sli X1,ML2,2 # mm += ml; + a SMM,MM1,X1 + lil RES,0 # res = 0; + cmpi 0,NBI,0 # if(nbits == 0) return(res); + beqr + cmpi 0,ML2,0 # if(ml <= 0) return(res); + bler + sfi RNB,NBI,32 # rnbits = 32 - nbits; + mtctr ML2 # ctr = ml; +BSR1: lu SX,-4(SMM) # X = *(--mm); + sr SY,SX,NBI # Y = X >> nbits; + or SY,SY,RES # Y |= res; + st SY,0(SMM) # *(mm) = Y; + sl RES,SX,RNB # res = X << rnbits; + bdn BSR1 # if(--ctr > 0) goto BSR1 + br # return(res); + + .globl .BnnAddCarry # BnnAddCarry(nn, nl, carryin) + .set CARRY,CA3 # also for BnnSubtractBorrow +.BnnAddCarry: cmpi 0,CARRY,0 # if(carryin == 0) return(0); + beq BAC3 + cmpi 0,NL2,0 # if(nl == 0) return(1); + beq BAC2 + ai NN1,NN1,-4 # nn--; + mtctr NL2 # ctr = nl; +BAC1: l X1,4(NN1) # X = nn[1]; + ai. X1,X1,1 # X++; + stu X1,4(NN1) # *(++nn) = X; + bne BAC3 # if(X != 0) return(0); + bdn BAC1 # if(--ctr > 0) goto BAC1 +BAC2: lil RES,1 # return(1); + br +BAC3: lil RES,0 # return(0); + br + + .globl .BnnAdd # BnnAdd(mm, ml, nn, nl, carryin) + .set CARRYIN,CA5 # also for BnnSubtract. +.BnnAdd: sf ML2,NL4,ML2 # ml -= nl; + ai NN3,NN3,-4 # nn--; + ai MM1,MM1,-4 # mm--; carry = 1; + cmpi 0,NL4,0 # if(nl == 0) goto BADD2; + beq BADD2 + mtctr NL4 # ctr = nl; + cmpi 0,CARRYIN,0 # if(carryin) goto BADD1; + bne BADD1 + ai X1,X1,0 # carry = 0; +BADD1: lu X2,4(NN3) # Y = *(++nn); + l X1,4(MM1) # X = mm[1]; + ae X1,X1,X2 # X = X + Y + carry; carry = ?? + stu X1,4(MM1) # *(++mm) = X; + bdn BADD1 # if(--ctr > 0) goto BADD1 + lil X2,0 + ae CARRYIN,X2,X2 # carryin = carry; +BADD2: cmpi 0,CARRYIN,0 # if(carryin == 0) return(0); + beq BADD5 + cmpi 0,ML2,0 # if(ml == 0) return(1); + beq BADD4 + mtctr ML2 # ctr = ml; +BADD3: l X1,4(MM1) # X = mm[1]; + ai. X1,X1,1 # X++; + stu X1,4(MM1) # *(++mm) = X; + bne BADD5 # if(X != 0) return(0); + bdn BADD3 # if(--ctr > 0) goto BADD3; +BADD4: lil RES,1 # return(1); + br +BADD5: lil RES,0 # return(0); + br + + .globl .BnnSubtractBorrow # (nn, nl, carryin) +.BnnSubtractBorrow: + cmpi 0,CARRY,1 # if(carryin == 1) return(1); + beq BSB3 + cmpi 0,NL2,0 # if(nl == 0) return(0); + beq BSB2 + ai NN1,NN1,-4 # nn--; + mtctr NL2 # ctr = nl; +BSB1: l X1,4(NN1) # X = nn[1]; + si X2,X1,1 # Y= X-1; + stu X2,4(NN1) # *(++nn) = Y; + cmpi 0,X1,0 + bne BSB3 # if(X != 0) return(1); + bdn BSB1 # if(--ctr > 0) goto BSB1 +BSB2: lil RES,0 # return(0); + br +BSB3: lil RES,1 # return(1); + br + + .globl .BnnSubtract # BnnSubtract(mm, ml, nn, nl, carryin) +.BnnSubtract: sf ML2,NL4,ML2 # ml -= nl; + ai NN3,NN3,-4 # nn--; + ai MM1,MM1,-4 # mm--; carry = 1; + cmpi 0,NL4,0 # if(nl == 0) goto BS2 + beq BS2 + mtctr NL4 # ctr = nl; + cmpi 0,CARRYIN,0 # if(carryin) goto BS1 + bne BS1 + ai X1,X1,0 # carry = 0; +BS1: lu X2,4(NN3) # Y = *(++nn); + l X1,4(MM1) # X = mm[1]; + sfe X1,X2,X1 # X = X - (Y + carry); carry = ?? + stu X1,4(MM1) # *(++mm) = X; + bdn BS1 # if(--ctr > 0) goto BS1 + lil CA5,0 + ae CA5,CA5,CA5 # carryin = carry; +BS2: cmpi 0,CA5,1 # if(carryin == 0) return(1); + beq BS5 + cmpi 0,ML2,0 # if(ml == 0) return(0); + beq BS4 + mtctr ML2 # ctr = ml; +BS3: l X1,4(MM1) # X = mm[1]; + si X2,X1,1 # Y= X-1; + stu X2,4(MM1) # *(++mm) = Y; + cmpi 0,X1,0 # if(X != 0) return(1); + bne BS5 + bdn BS3 # if(--ctr > 0) goto BS3 +BS4: lil RES,0 # return(0); + br +BS5: lil RES,1 # return(1); + br + + .globl .BnnMultiplyDigit # BnnMultiplyDigit(pp, pl, mm, ml, d) + .set PP,CA1; .set PL,CA2; .set MM,CA3; .set ML,CA4; .set D,CA5 + .set LOW,X1; .set HIGHT,X2; .set OHIGHT,X3 +.BnnMultiplyDigit: + cmpi 0,D,0 # if(d == 0) return(0); + beq BMD7 +BMD1: cmpi 0,D,1 # if(d != 1) goto BMD2; + bne BMD2 + lil CA5,0 # return(BnnAdd(pp, pl, mm, ml, 0)); + b .BnnAdd +BMD2: sf PL,ML,PL # pl -= ml; + ai MM,MM,-4 # mm--; + ai PP,PP,-4 # pp--; + cmpi 0,ML,0 # if(ml == 0) return(0); + beq BMD7 + mtctr ML # ctr = ml; + lil OHIGHT,0 # OldHight = 0; + cmpi 0,D,0 # if(D < 0) goto BMD8; + blt BMD8 +BMD3: lu LOW,4(MM) # Low = mm[1]; + mul HIGHT,LOW,D # Hight:MQ = Low*d + cmpi 0,LOW,0 # if(Low>=0) pas de correction. + bge BMD4 + a HIGHT,HIGHT,D # Correction multiplication signe'. +BMD4: mfmq LOW # Low = MQ; + a LOW,LOW,OHIGHT # Low += OldHight; + aze HIGHT,HIGHT # Hight += carry; + l OHIGHT,4(PP) # *++pp += Low; + a LOW,LOW,OHIGHT + stu LOW,4(PP) + aze OHIGHT,HIGHT # OldHight = Hight + carry; + bdn BMD3 # if(--ctr > 0) goto BMD3; +BMD40: l LOW,4(PP) # *(++pp) += OldHight; + a LOW,LOW,OHIGHT + stu LOW,4(PP) + lil LOW,0 # if(carry == 0) return(0); + aze. LOW,LOW + beq BMD7 + si. PL,PL,1 # pl--; + ble BMD6 # if(pl <= 0) return(1); + mtctr PL # ctr = pl; +BMD5: l X1,4(PP) # X = pp[1]; + ai. X1,X1,1 # X++; + stu X1,4(PP) # *(++pp) = X; + bne BMD7 # if(X != 0) return(0); + bdn BMD5 # if(--ctr > 0) goto BMD5; +BMD6: lil RES,1 # return(1); + br +BMD7: lil RES,0 # return(0); + br + +BMD8: lu LOW,4(MM) # Low = mm[1]; + mul HIGHT,LOW,D # Hight:MQ = Low*d + a HIGHT,HIGHT,LOW # Correction pour d<0... + cmpi 0,LOW,0 # if(Low>=0) pas de correction. + bge BMD9 + a HIGHT,HIGHT,D # Correction multiplication signe'. +BMD9: mfmq LOW # Low = MQ; + a LOW,LOW,OHIGHT # Low += OldHight; + aze HIGHT,HIGHT # Hight += carry; + l OHIGHT,4(PP) # *pp += Low; + a LOW,LOW,OHIGHT + stu LOW,4(PP) + aze OHIGHT,HIGHT # OldHight = Hight + carry; + bdn BMD8 # if(--ctr > 0) goto BMD8; + b BMD40 # goto BMD40; + + .globl .BnnDivideDigit # BnnDivideDigit(qq, nn, nl, d) + .set QQ,CA1; .set NN,CA2; .set NL,CA3; .set DD,CA4 + .set SQQ,X1; .set R,CA1; .set Q,X2; .set NLOW,X2; .set DQ,X3 + .set BITS,X4; .set AUX,CA3 +.BnnDivideDigit: + sli X1,NL,2 + a NN,NN,X1 # nn = &nn[nl]; + a SQQ,QQ,X1 # qq = &qq[nl]; + si SQQ,SQQ,4 # qq--; + lu R,-4(NN) # R = *(--nn); + si. NL,NL,1 # nl--; + bler # if(nl <= 0) return(R); + mtctr NL # ctr = nl; + sri DQ,DD,1 # D'= D / 2; + cmpi 0,DD,0 # if(D<0) goto BDDinf; + blt BDDinf +# D > 0 +BDDsup: lu NLOW,-4(NN) # Low = *(--nn); + cmpl 0,R,DQ # if (R < D') goto BDDsupinf; + blt BDDsupinf + andil. BITS,NLOW,1 # bits = Low & 1; + sri NLOW,NLOW,1 # Low >>= 1; + andil. AUX,R,1 # aux = R & 1; + sri R,R,1 # R >>= 1; + sli AUX,AUX,31 # Low |= aux << 31; + or NLOW,NLOW,AUX + mtmq NLOW # MQ = Low; + div Q,R,DD # Q=R:MQ/D; MQ=R:MQ%D; + mfmq R # R=MQ; + sli R,R,1 # R <<= 1; + sli Q,Q,1 # Q <<= 1; + a R,R,BITS # R+=bits; + cmpl 0,R,DD # si R<D => ok + blt BDDsup1 + ai Q,Q,1 # Q++; + sf R,DD,R # R-=D; +BDDsup1: stu Q,-4(SQQ) # *(--qq)=Q; + bdn BDDsup # if(--ctr > 0) goto BDDsup; + br # return(R); +BDDsupinf: mtmq NLOW # MQ = XL; + div Q,R,DD # Q=R:MQ/D; MQ=R:MQ%D; + mfmq R # R=MQ; + stu Q,-4(SQQ) # *(--qq)=Q; + bdn BDDsup # if(--ctr > 0) goto BDDsup; + br # return(R); + +# D < 0 +BDDinf: lu NLOW,-4(NN) # Low = *(--nn); + andil. BITS,NLOW,7 # bits = Low & 7; + sri NLOW,NLOW,3 # Low >>= 3; + andil. AUX,R,7 # aux = R & 7; + sri R,R,3 # R >>= 3; + sli AUX,AUX,29 # Low |= aux << 29; + or NLOW,NLOW,AUX + mtmq NLOW # MQ = Low; + div Q,R,DQ # Q=R:MQ/D'; MQ=R:MQ%D'; + mfmq R # R=MQ + sli R,R,1 # R *= 2; + andil. AUX,DD,1 # if((D & 1) == 0) rien a retrancher; + cmpli 0,AUX,0 + beq BDDi4 +# R <- R - Q + cmpl 0,R,Q # On teste avant de faire la diff. + blt BDDi3 # la diff est < 0 + sf R,Q,R # la diff est > 0 + b BDDi4 +BDDi3: sf R,Q,R # On met a` jour + si Q,Q,1 # Q--; + a R,R,DD # R += D; +# R <- 2R; Q <- 2Q; +BDDi4: cmpl 0,R,DQ # On teste avant de faire la mult. + blt BDDi41 # Ca va passer.. + bne BDDi40 # Ca va casser... + cmpli 0,AUX,0 # d0 = 1 ca passe... + bne BDDi41 +BDDi40: sli Q,Q,1 # Q *= 2; + sli R,R,1 # R *= 2; + ai Q,Q,1 # Q++; + sf R,DD,R # R -= D; + b BDDi5 +BDDi41: sli Q,Q,1 # Q *= 2; + sli R,R,1 # R *= 2; +# R <- 2R; Q <- 2Q; +BDDi5: cmpl 0,R,DQ # On teste avant de faire la mult. + blt BDDi51 # Ca va passer.. + bne BDDi50 # Ca va casser... + cmpli 0,AUX,0 # d0 = 1 ca passe... + bne BDDi51 +BDDi50: sli Q,Q,1 # Q *= 2; + sli R,R,1 # R *= 2; + ai Q,Q,1 # Q++; + sf R,DD,R # R -= D; + b BDDi6 +BDDi51: sli Q,Q,1 # Q *= 2; + sli R,R,1 # R *= 2; +# R += bits; +BDDi6: sf AUX,BITS,DD # pour tester sans de'bordement.. + cmpl 0,R,AUX + blt BDDi61 # Ca va passer.. + ai Q,Q,1 # Q++; + sf R,DD,R # R -= D; +BDDi61: a R,R,BITS # R += bits; + stu Q,-4(SQQ) # *(--qq)=Q; + bdn BDDinf # if(--ctr > 0) goto BDDinf; + br diff --git a/otherlibs/num/bignum/s/alphaKerN.s b/otherlibs/num/bignum/s/alphaKerN.s new file mode 100644 index 000000000..f9785794d --- /dev/null +++ b/otherlibs/num/bignum/s/alphaKerN.s @@ -0,0 +1,2511 @@ + .ugen + .verstamp 3 11 + .data + .align 3 + .align 0 +$$4: + .ascii "@(#)KerN.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\X0A\X00" + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnSetToZero + .loc 2 63 + # 63 { + .ent BnnSetToZero 2 +BnnSetToZero: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 63 + + .loc 2 65 + # 64 BigNum nnlim; + # 65 if (nl <= 0) + beq $17, $33 + .loc 2 66 + # 66 return; + .loc 2 67 + # 67 nnlim = nn+nl-1; + s8addq $17, $16, $0 + addq $0, -8, $0 + .loc 2 68 + # 68 do *nn = 0; while(nn++ < nnlim); +$32: + .loc 2 68 + + stq $31, 0($16) + cmpult $16, $0, $17 + addq $16, 8, $16 + bne $17, $32 + .loc 2 69 + # 69 } +$33: + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnSetToZero + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnAssign + .loc 2 80 + # 80 { + .ent BnnAssign 2 +BnnAssign: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + bis $16, $16, $1 + .loc 2 80 + + .loc 2 82 + # 81 BigNum nnlim; + # 82 if (nl <= 0) + beq $18, $37 + .loc 2 83 + # 83 return; + .loc 2 84 + # 84 nnlim = nn+nl; + sll $18, 3, $16 + addq $16, $17, $19 + bis $19, $19, $0 + .loc 2 88 + # 85 #ifdef MSDOS + # 86 if (realaddr(mm) < realaddr(nn) || realaddr(mm) > realaddr(nnlim)) + # 87 #else + # 88 if ((mm < nn) || ( mm > nnlim)) + cmpult $1, $17, $2 + bne $2, $34 + cmpult $19, $1, $3 + beq $3, $35 + .loc 2 90 + # 89 #endif + # 90 do *mm++ = *nn++; while(nn < nnlim); +$34: + .loc 2 90 + + ldq $4, 0($17) + stq $4, 0($1) + addq $1, 8, $1 + addq $17, 8, $17 + cmpult $17, $0, $5 + bne $5, $34 + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 +$35: + .loc 2 95 + # 91 else + # 92 #ifdef MSDOS + # 93 if (realaddr(mm) > realaddr(nn)) + # 94 #else + # 95 if (mm > nn) + cmpult $17, $1, $6 + beq $6, $37 + .loc 2 97 + # 96 #endif + # 97 { + .loc 2 98 + # 98 mm += nl; + addq $1, $16, $1 + .loc 2 99 + # 99 do *--mm = *--nnlim; while(nn < nnlim); +$36: + .loc 2 99 + + addq $1, -8, $18 + bis $18, $18, $16 + bis $18, $18, $1 + addq $0, -8, $0 + ldq $7, 0($0) + stq $7, 0($16) + cmpult $17, $0, $8 + bne $8, $36 + .loc 2 101 + # 100 } + # 101 } +$37: + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnAssign + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnSetDigit + .loc 2 113 + # 113 { + .ent BnnSetDigit 2 +BnnSetDigit: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 113 + + .loc 2 114 + # 114 *nn = d; + stq $17, 0($16) + .loc 2 115 + # 115 } + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnSetDigit + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnGetDigit + .loc 2 126 + # 126 { + .ent BnnGetDigit 2 +BnnGetDigit: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 126 + + .loc 2 127 + # 127 return (*nn); + ldq $0, 0($16) + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnGetDigit + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnNumDigits + .loc 2 140 + # 140 { + .ent BnnNumDigits 2 +BnnNumDigits: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 140 + + .loc 2 141 + # 141 nn += nl; + s8addq $17, $16, $16 + .loc 2 143 + # 142 + # 143 while (nl != 0 && *--nn == 0) + beq $17, $39 + addq $16, -8, $16 + ldq $1, 0($16) + bne $1, $39 +$38: + .loc 2 144 + # 144 nl--; + addq $17, -1, $17 + beq $17, $39 + addq $16, -8, $16 + ldq $2, 0($16) + beq $2, $38 +$39: + .loc 2 146 + # 145 + # 146 return (nl == 0 ? 1 : nl); + bis $17, $17, $16 + cmoveq $17, 1, $16 + bis $16, $16, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnNumDigits + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnNumLeadingZeroBitsInDigit + .loc 2 158 + # 158 { + .ent BnnNumLeadingZeroBitsInDigit 2 +BnnNumLeadingZeroBitsInDigit: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + bis $16, $16, $1 + .loc 2 158 + + .loc 2 159 + # 159 register int p = 0; + bis $31, $31, $17 + .loc 2 160 + # 160 if (BN_DIGIT_SIZE == 16 || BN_DIGIT_SIZE == 32 || BN_DIGIT_SIZE == 64) + .loc 2 161 + # 161 { + .loc 2 162 + # 162 register BigNumDigit mask = (~(BigNumDigit)0) << (BN_DIGIT_SIZE/2); + ldiq $0, -4294967296 + .loc 2 163 + # 163 register BigNumLength maskl = BN_DIGIT_SIZE/2; + ldiq $16, 32 + .loc 2 165 + # 164 + # 165 if (d == 0) + bne $1, $40 + .loc 2 166 + # 166 return (BN_DIGIT_SIZE); + ldiq $0, 64 + .livereg 0x807F0002,0x3FC00000 + ret $31, ($26), 1 +$40: + .loc 2 168 + # 167 while (maskl) + # 168 { + .loc 2 169 + # 169 if ((d & mask) == 0) + and $1, $0, $2 + bne $2, $41 + .loc 2 170 + # 170 { + .loc 2 171 + # 171 p += maskl; + addq $17, $16, $17 + addl $17, 0, $17 + .loc 2 172 + # 172 d <<= maskl; + sll $1, $16, $1 +$41: + .loc 2 174 + # 173 } + # 174 maskl >>= 1; + srl $16, 1, $16 + .loc 2 175 + # 175 mask <<= maskl; + sll $0, $16, $0 + bne $16, $40 + .loc 2 189 + # 189 return (p); + bis $17, $17, $0 +$42: + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnNumLeadingZeroBitsInDigit + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnDoesDigitFitInWord + .loc 2 203 + # 203 { + .ent BnnDoesDigitFitInWord 2 +BnnDoesDigitFitInWord: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 203 + + .loc 2 205 + # 204 /* The C compiler must evaluate the predicate at compile time */ + # 205 if (BN_DIGIT_SIZE > BN_WORD_SIZE) + .loc 2 206 + # 206 return (d >= ((BigNumDigit)1) << BN_WORD_SIZE ? FALSE : TRUE); + cmpult $16, 4294967296, $17 + bis $17, $17, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnDoesDigitFitInWord + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnIsDigitZero + .loc 2 218 + # 218 { + .ent BnnIsDigitZero 2 +BnnIsDigitZero: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 218 + + .loc 2 219 + # 219 return (d == 0); + cmpeq $16, 0, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnIsDigitZero + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnIsDigitNormalized + .loc 2 232 + # 232 { + .ent BnnIsDigitNormalized 2 +BnnIsDigitNormalized: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 232 + + .loc 2 233 + # 233 return (d & (((BigNumDigit)1) << (BN_DIGIT_SIZE - 1)) ? TRUE : FALSE); + ldil $17, 1 + cmovge $16, 0, $17 + bis $17, $17, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnIsDigitNormalized + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnIsDigitOdd + .loc 2 245 + # 245 { + .ent BnnIsDigitOdd 2 +BnnIsDigitOdd: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 245 + + .loc 2 246 + # 246 return (d & 1 ? TRUE : FALSE); + ldil $17, 1 + cmovlbc $16, 0, $17 + bis $17, $17, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnIsDigitOdd + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnCompareDigits + .loc 2 260 + # 260 { + .ent BnnCompareDigits 2 +BnnCompareDigits: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 260 + + .loc 2 261 + # 261 return (d1 > d2 ? BN_GT : (d1 == d2 ? BN_EQ : BN_LT)); + cmpult $17, $16, $1 + beq $1, $43 + ldil $16, 1 + br $31, $44 +$43: + subq $16, $17, $2 + ldil $0, -1 + cmoveq $2, 0, $0 + bis $0, $0, $16 +$44: + bis $16, $16, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnCompareDigits + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnComplement + .loc 2 273 + # 273 { + .ent BnnComplement 2 +BnnComplement: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 273 + + .loc 2 276 + # 274 BigNum nnlim; + # 275 + # 276 if (nl <= 0) + beq $17, $46 + .loc 2 277 + # 277 return; + .loc 2 278 + # 278 nnlim = nn+nl; + s8addq $17, $16, $0 + .loc 2 279 + # 279 do +$45: + .loc 2 280 + # 280 { + .loc 2 281 + # 281 nn++; + addq $16, 8, $16 + .loc 2 282 + # 282 nn[-1] = ~nn[-1]; + ldq $1, -8($16) + ornot $31, $1, $2 + stq $2, -8($16) + cmpult $16, $0, $3 + bne $3, $45 + .loc 2 285 + # 283 } + # 284 while (nn < nnlim); + # 285 } +$46: + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnComplement + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnAndDigits + .loc 2 297 + # 297 { + .ent BnnAndDigits 2 +BnnAndDigits: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 297 + + .loc 2 298 + # 298 *n &= d; + ldq $1, 0($16) + and $1, $17, $2 + stq $2, 0($16) + .loc 2 299 + # 299 } + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnAndDigits + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnOrDigits + .loc 2 310 + # 310 { + .ent BnnOrDigits 2 +BnnOrDigits: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 310 + + .loc 2 311 + # 311 *n |= d; + ldq $1, 0($16) + or $1, $17, $2 + stq $2, 0($16) + .loc 2 312 + # 312 } + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnOrDigits + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnXorDigits + .loc 2 323 + # 323 { + .ent BnnXorDigits 2 +BnnXorDigits: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 323 + + .loc 2 324 + # 324 *n ^= d; + ldq $1, 0($16) + xor $1, $17, $2 + stq $2, 0($16) + .loc 2 325 + # 325 } + .livereg 0x007F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnXorDigits + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnShiftLeft + .loc 2 341 + # 341 { + .ent BnnShiftLeft 2 +BnnShiftLeft: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + bis $16, $16, $1 + addl $18, 0, $18 + .loc 2 341 + + .loc 2 342 + # 342 register BigNumDigit res = 0, save; + bis $31, $31, $19 + .loc 2 346 + # 343 int rnbits; + # 344 + # 345 + # 346 if (nbits != 0) + beq $18, $48 + ldiq $21, 1 + .loc 2 347 + # 347 { + .loc 2 348 + # 348 rnbits = BN_DIGIT_SIZE - nbits; + .loc 2 350 + # 349 + # 350 while (ml-- > 0) + cmpule $21, $17, $16 + addq $17, -1, $17 + beq $16, $48 + bis $18, $18, $0 + ldiq $2, 64 + subq $2, $0, $20 + addl $20, 0, $20 +$47: + .loc 2 351 + # 351 { + .loc 2 352 + # 352 save = *mm; + ldq $18, 0($1) + .loc 2 353 + # 353 *mm++ = (save << nbits) | res; + sll $18, $0, $3 + or $3, $19, $4 + stq $4, 0($1) + addq $1, 8, $1 + .loc 2 354 + # 354 res = save >> rnbits; + srl $18, $20, $19 + cmpule $21, $17, $16 + addq $17, -1, $17 + bne $16, $47 +$48: + .loc 2 358 + # 355 } + # 356 } + # 357 + # 358 return (res); + bis $19, $19, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnShiftLeft + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnShiftRight + .loc 2 373 + # 373 { + .ent BnnShiftRight 2 +BnnShiftRight: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + addl $18, 0, $18 + .loc 2 373 + + .loc 2 374 + # 374 register BigNumDigit res = 0, save; + bis $31, $31, $19 + .loc 2 378 + # 375 int lnbits; + # 376 + # 377 + # 378 if (nbits != 0) + beq $18, $50 + ldiq $1, 1 + .loc 2 379 + # 379 { + .loc 2 380 + # 380 mm += ml; + s8addq $17, $16, $16 + .loc 2 381 + # 381 lnbits = BN_DIGIT_SIZE - nbits; + .loc 2 383 + # 382 + # 383 while (ml-- > 0) + cmpule $1, $17, $20 + addq $17, -1, $17 + beq $20, $50 + bis $18, $18, $0 + ldiq $2, 64 + subq $2, $0, $21 + addl $21, 0, $21 +$49: + .loc 2 384 + # 384 { + .loc 2 385 + # 385 save = *(--mm); + addq $16, -8, $16 + ldq $18, 0($16) + .loc 2 386 + # 386 *mm = (save >> nbits) | res; + srl $18, $0, $3 + or $3, $19, $4 + stq $4, 0($16) + .loc 2 387 + # 387 res = save << lnbits; + sll $18, $21, $19 + cmpule $1, $17, $20 + addq $17, -1, $17 + bne $20, $49 +$50: + .loc 2 391 + # 388 } + # 389 } + # 390 + # 391 return (res); + bis $19, $19, $0 + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnShiftRight + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnAddCarry + .loc 2 408 + # 408 { + .ent BnnAddCarry 2 +BnnAddCarry: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + .loc 2 408 + + .loc 2 409 + # 409 if (carryin == 0) + bne $18, $51 + .loc 2 410 + # 410 return (0); + bis $31, $31, $0 + .livereg 0x807F0002,0x3FC00000 + ret $31, ($26), 1 +$51: + .loc 2 412 + # 411 + # 412 if (nl == 0) + bne $17, $52 + .loc 2 413 + # 413 return (1); + ldiq $0, 1 + .livereg 0x807F0002,0x3FC00000 + ret $31, ($26), 1 +$52: + ldiq $19, 1 + .loc 2 415 + # 414 + # 415 while (nl > 0 && !(++(*nn++))) + cmpule $19, $17, $0 + beq $0, $54 + ldq $1, 0($16) + addq $1, 1, $2 + stq $2, 0($16) + ldq $18, 0($16) + cmpeq $18, 0, $18 + addq $16, 8, $16 + beq $18, $54 +$53: + .loc 2 416 + # 416 nl--; + addq $17, -1, $17 + cmpule $19, $17, $0 + beq $0, $54 + ldq $3, 0($16) + addq $3, 1, $4 + stq $4, 0($16) + ldq $18, 0($16) + cmpeq $18, 0, $18 + addq $16, 8, $16 + bne $18, $53 +$54: + .loc 2 418 + # 417 + # 418 return (nl > 0 ? 0 : 1); + bis $31, $31, $18 + cmoveq $0, 1, $18 + bis $18, $18, $0 +$55: + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnAddCarry + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnAdd + .loc 2 433 + # 433 { + .ent BnnAdd 2 +BnnAdd: + .option O2 + ldgp $gp, 0($27) + lda $sp, -16($sp) + stq $26, 0($sp) + .mask 0x04000000, -16 + .frame $sp, 16, $26, 0 + .prologue 1 + bis $16, $16, $1 + bis $17, $17, $2 + .loc 2 433 + + .loc 2 434 + # 434 register BigNumProduct c = carryin; + bis $20, $20, $21 + .loc 2 437 + # 435 + # 436 + # 437 ml -= nl; + subq $2, $19, $2 + .loc 2 439 + # 438 /* test computed at compile time */ + # 439 if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + ldiq $17, 1 + .loc 2 450 + # 450 { + .loc 2 453 + # 451 register BigNumProduct save; + # 452 + # 453 while (nl > 0) + cmpult $19, $17, $3 + bne $3, $59 +$56: + .loc 2 454 + # 454 { + .loc 2 455 + # 455 save = *mm; + ldq $0, 0($1) + .loc 2 456 + # 456 c += save; + addq $21, $0, $21 + .loc 2 457 + # 457 if (c < save) + cmpult $21, $0, $4 + beq $4, $57 + .loc 2 458 + # 458 { + .loc 2 459 + # 459 *(mm++) = *(nn++); + ldq $5, 0($18) + stq $5, 0($1) + addq $1, 8, $1 + addq $18, 8, $18 + .loc 2 460 + # 460 c = 1; + bis $17, $17, $21 + br $31, $58 +$57: + .loc 2 463 + # 461 } + # 462 else + # 463 { + .loc 2 464 + # 464 save = *(nn++); + ldq $0, 0($18) + addq $18, 8, $18 + .loc 2 465 + # 465 c += save; + addq $21, $0, $21 + .loc 2 466 + # 466 *(mm++) = c; + stq $21, 0($1) + addq $1, 8, $1 + .loc 2 467 + # 467 c = (c < save) ? 1 : 0; + cmpult $21, $0, $16 + ldiq $21, 1 + cmoveq $16, 0, $21 +$58: + .loc 2 469 + # 468 } + # 469 nl--; + addq $19, -1, $19 + cmpult $19, $17, $6 + beq $6, $56 +$59: + .loc 2 473 + # 470 } + # 471 } + # 472 + # 473 return (BnnAddCarry (mm, ml, (BigNumCarry) c)); + bis $1, $1, $16 + bis $2, $2, $17 + bis $21, $21, $18 + .livereg 0x0001F002,0x00000000 + jsr $26, BnnAddCarry + ldgp $gp, 0($26) + .livereg 0xFC7F0002,0x3FC00000 + ldq $26, 0($sp) + lda $sp, 16($sp) + ret $31, ($26), 1 + .end BnnAdd + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnSubtractBorrow + .loc 2 490 + # 490 { + .ent BnnSubtractBorrow 2 +BnnSubtractBorrow: + .option O2 + ldgp $gp, 0($27) + .frame $sp, 0, $26, 0 + .prologue 1 + bis $16, $16, $1 + .loc 2 490 + + .loc 2 491 + # 491 if (carryin == 1) + subq $18, 1, $2 + bne $2, $60 + .loc 2 492 + # 492 return (1); + ldiq $0, 1 + .livereg 0x807F0002,0x3FC00000 + ret $31, ($26), 1 +$60: + .loc 2 493 + # 493 if (nl == 0) + bne $17, $61 + .loc 2 494 + # 494 return (0); + bis $31, $31, $0 + .livereg 0x807F0002,0x3FC00000 + ret $31, ($26), 1 +$61: + ldiq $19, 1 + .loc 2 496 + # 495 + # 496 while (nl > 0 && !((*nn++)--)) + cmpule $19, $17, $0 + beq $0, $63 + ldq $18, 0($1) + cmpeq $18, 0, $16 + addq $18, -1, $3 + stq $3, 0($1) + addq $1, 8, $1 + beq $16, $63 +$62: + .loc 2 497 + # 497 nl--; + addq $17, -1, $17 + cmpule $19, $17, $0 + beq $0, $63 + ldq $18, 0($1) + cmpeq $18, 0, $16 + addq $18, -1, $4 + stq $4, 0($1) + addq $1, 8, $1 + bne $16, $62 +$63: + .loc 2 499 + # 498 + # 499 return (nl > 0 ? 1 : 0); + ldil $16, 1 + cmoveq $0, 0, $16 + bis $16, $16, $0 +$64: + .livereg 0xFC7F0002,0x3FC00000 + ret $31, ($26), 1 + .end BnnSubtractBorrow + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnSubtract + .loc 2 514 + # 514 { + .ent BnnSubtract 2 +BnnSubtract: + .option O2 + ldgp $gp, 0($27) + lda $sp, -16($sp) + stq $26, 0($sp) + .mask 0x04000000, -16 + .frame $sp, 16, $26, 0 + .prologue 1 + bis $16, $16, $1 + bis $17, $17, $2 + .loc 2 514 + + .loc 2 515 + # 515 register BigNumProduct c = carryin; + bis $20, $20, $21 + .loc 2 519 + # 516 register BigNumDigit invn; + # 517 + # 518 + # 519 ml -= nl; + subq $2, $19, $2 + .loc 2 521 + # 520 /* test computed at compile time */ + # 521 if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + ldiq $17, 1 + .loc 2 533 + # 533 { + .loc 2 536 + # 534 register BigNumProduct save; + # 535 + # 536 while (nl > 0) + cmpult $19, $17, $3 + bne $3, $68 +$65: + .loc 2 537 + # 537 { + .loc 2 538 + # 538 save = *mm; + ldq $0, 0($1) + .loc 2 539 + # 539 invn = *(nn++) ^ -1; + ldq $16, 0($18) + xor $16, -1, $16 + addq $18, 8, $18 + .loc 2 540 + # 540 c += save; + addq $21, $0, $21 + .loc 2 542 + # 541 + # 542 if (c < save) + cmpult $21, $0, $4 + beq $4, $66 + .loc 2 543 + # 543 { + .loc 2 544 + # 544 *(mm++) = invn; + stq $16, 0($1) + addq $1, 8, $1 + .loc 2 545 + # 545 c = 1; + bis $17, $17, $21 + br $31, $67 +$66: + .loc 2 548 + # 546 } + # 547 else + # 548 { + .loc 2 549 + # 549 c += invn; + addq $21, $16, $21 + .loc 2 550 + # 550 *(mm++) = c; + stq $21, 0($1) + addq $1, 8, $1 + .loc 2 551 + # 551 c = (c < invn) ? 1 : 0; + cmpult $21, $16, $0 + ldiq $21, 1 + cmoveq $0, 0, $21 +$67: + .loc 2 553 + # 552 } + # 553 nl--; + addq $19, -1, $19 + cmpult $19, $17, $5 + beq $5, $65 +$68: + .loc 2 557 + # 554 } + # 555 } + # 556 + # 557 return (BnnSubtractBorrow (mm, ml, (BigNumCarry) c)); } + bis $1, $1, $16 + bis $2, $2, $17 + bis $21, $21, $18 + .livereg 0x0001F002,0x00000000 + jsr $26, BnnSubtractBorrow + ldgp $gp, 0($26) + .livereg 0xFC7F0002,0x3FC00000 + ldq $26, 0($sp) + lda $sp, 16($sp) + ret $31, ($26), 1 + .end BnnSubtract + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnMultiplyDigit + .loc 2 577 + # 577 { + .ent BnnMultiplyDigit 2 +BnnMultiplyDigit: + .option O2 + ldgp $gp, 0($27) + lda $sp, -16($sp) + stq $26, 0($sp) + .mask 0x04000000, -16 + .frame $sp, 16, $26, 0 + .prologue 1 + bis $16, $16, $1 + bis $17, $17, $3 + .loc 2 577 + + .loc 2 578 + # 578 register BigNumProduct c = 0; + bis $31, $31, $21 + .loc 2 581 + # 579 + # 580 + # 581 if (d == 0) + bne $20, $69 + .loc 2 582 + # 582 return (0); + bis $31, $31, $0 + br $31, $77 +$69: + .loc 2 584 + # 583 + # 584 if (d == 1) + subq $20, 1, $4 + bne $4, $70 + .loc 2 585 + # 585 return (BnnAdd (pp, pl, mm, ml, (BigNumCarry) 0)); + bis $1, $1, $16 + bis $3, $3, $17 + bis $31, $31, $20 + .livereg 0x0001FC02,0x00000000 + jsr $26, BnnAdd + ldgp $gp, 0($26) + br $31, $77 +$70: + .loc 2 587 + # 586 + # 587 pl -= ml; + subq $3, $19, $3 + .loc 2 589 + # 588 /* test computed at compile time */ + # 589 if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + .loc 2 610 + # 610 { + .loc 2 613 + # 611 #ifdef __alpha /* _hack_to_produce_east_to_modify_assembler */ + # 612 register BigNumDigit X0, m_digit,Lo,Hi; + # 613 while (ml != 0) + beq $19, $73 + and $19, 3, $0 + negq $0, $0 + bis $0, $0, $2 + beq $2, $72 + addq $0, $19, $2 +$71: + addq $19, -1, $19 + ldq $0, 0($1) + ldq $16, 0($18) + addq $18, 8, $18 + addq $0, $21, $0 + cmpult $0, $21, $21 + mulq $20, $16, $5 + addq $5, $0, $17 + cmpult $17, $0, $6 + addq $21, $6, $21 + stq $17, 0($1) + addq $1, 8, $1 + umulh $20, $16, $7 + addq $21, $7, $21 + subq $2, $19, $8 + bne $8, $71 + beq $19, $73 +$72: + .loc 2 614 + # 614 { + .loc 2 615 + # 615 ml--; + .loc 2 616 + # 616 X0 = *pp; + ldq $0, 0($1) + .loc 2 617 + # 617 m_digit = *(mm++); + ldq $16, 0($18) + addq $18, 8, $18 + .loc 2 618 + # 618 X0 += c; + addq $0, $21, $0 + .loc 2 619 + # 619 c = X0 < c; + cmpult $0, $21, $21 + .loc 2 620 + # 620 Lo = X0 + (d * m_digit); + .loc 2 621 + # 621 c += Lo < X0; + mulq $20, $16, $22 + addq $22, $0, $17 + cmpult $17, $0, $23 + addq $21, $23, $21 + .loc 2 622 + # 622 *(pp++) = Lo; + stq $17, 0($1) + addq $1, 8, $1 + .loc 2 623 + # 623 c += asm("umulh %a0, %a1, %v0",d,m_digit); + umulh $20, $16, $24 + addq $21, $24, $21 + ldq $0, 0($1) + ldq $16, 0($18) + addq $18, 8, $18 + addq $0, $21, $0 + cmpult $0, $21, $21 + mulq $20, $16, $25 + addq $25, $0, $17 + cmpult $17, $0, $27 + addq $21, $27, $21 + stq $17, 0($1) + addq $1, 8, $1 + umulh $20, $16, $4 + addq $21, $4, $21 + ldq $0, 0($1) + ldq $16, 0($18) + addq $18, 8, $18 + addq $0, $21, $0 + cmpult $0, $21, $21 + mulq $20, $16, $5 + addq $5, $0, $17 + cmpult $17, $0, $6 + addq $21, $6, $21 + stq $17, 0($1) + addq $1, 8, $1 + umulh $20, $16, $7 + addq $21, $7, $21 + addq $19, -4, $19 + ldq $0, 0($1) + ldq $16, 0($18) + addq $18, 8, $18 + addq $0, $21, $0 + cmpult $0, $21, $21 + mulq $20, $16, $8 + addq $8, $0, $17 + cmpult $17, $0, $22 + addq $21, $22, $21 + stq $17, 0($1) + addq $1, 8, $1 + umulh $20, $16, $23 + addq $21, $23, $21 + bne $19, $72 +$73: + .loc 2 661 + # 661 X0 = *pp; + ldq $0, 0($1) + .loc 2 662 + # 662 c += X0; + addq $21, $0, $21 + .loc 2 663 + # 663 *(pp++) = c; + stq $21, 0($1) + addq $1, 8, $1 + .loc 2 665 + # 664 + # 665 if (c >= X0) + cmpult $21, $0, $24 + bne $24, $74 + .loc 2 666 + # 666 return (0); + bis $31, $31, $0 + br $31, $77 +$74: + .loc 2 668 + # 667 + # 668 pl--; + addq $3, -1, $3 + .loc 2 669 + # 669 while (pl != 0 && !(++(*pp++))) + cmpeq $3, 0, $0 + xor $0, 1, $0 + beq $0, $76 + ldq $25, 0($1) + addq $25, 1, $27 + stq $27, 0($1) + ldq $16, 0($1) + cmpeq $16, 0, $16 + addq $1, 8, $1 + beq $16, $76 +$75: + .loc 2 670 + # 670 pl--; + addq $3, -1, $3 + cmpeq $3, 0, $0 + xor $0, 1, $0 + beq $0, $76 + ldq $4, 0($1) + addq $4, 1, $5 + stq $5, 0($1) + ldq $16, 0($1) + cmpeq $16, 0, $16 + addq $1, 8, $1 + bne $16, $75 +$76: + .loc 2 672 + # 671 + # 672 return (pl != 0 ? 0 : 1); + bis $31, $31, $16 + cmoveq $0, 1, $16 + bis $16, $16, $0 +$77: + .livereg 0xFC7F0002,0x3FC00000 + ldq $26, 0($sp) + lda $sp, 16($sp) + ret $31, ($26), 1 + .end BnnMultiplyDigit + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnMultiply2Digit + .loc 2 704 + # 704 { + .ent BnnMultiply2Digit 2 +BnnMultiply2Digit: + .option O2 + ldgp $gp, 0($27) + lda $sp, -416($sp) + stq $26, 0($sp) + stq $9, 8($sp) + stq $10, 16($sp) + stq $11, 24($sp) + stq $12, 32($sp) + stq $13, 40($sp) + stq $14, 48($sp) + stq $15, 56($sp) + .mask 0x0400FE00, -416 + .frame $sp, 416, $26, 48 + .prologue 1 + bis $16, $16, $11 + stq $17, 376($sp) + bis $18, $18, $9 + bis $20, $20, $14 + bis $21, $21, $15 + .loc 2 704 + + .loc 2 706 + # 705 BigNumDigit c0, c1, p0, p1; + # 706 if ((ml & 1)) + blbc $19, $78 + .loc 2 707 + # 707 { + .loc 2 708 + # 708 return + bis $11, $11, $16 + ldq $17, 376($sp) + bis $9, $9, $18 + bis $14, $14, $20 + stq $19, 392($sp) + .livereg 0x0001FC02,0x00000000 + jsr $26, BnnMultiplyDigit + ldgp $gp, 0($26) + ldq $19, 392($sp) + bis $0, $0, $10 + addq $11, 8, $16 + ldq $17, 376($sp) + addq $17, -1, $17 + bis $9, $9, $18 + bis $15, $15, $20 + .livereg 0x0001FC02,0x00000000 + jsr $26, BnnMultiplyDigit + ldgp $gp, 0($26) + addq $0, $10, $0 + br $31, $90 +$78: + .loc 2 712 + # 709 BnnMultiplyDigit (pp, pl, mm, ml, d0) + # 710 + BnnMultiplyDigit (pp+1, pl-1, mm, ml, d1); + # 711 } + # 712 c0 = c1 = 0; + bis $31, $31, $12 + bis $31, $31, $0 + .loc 2 725 + # 725 if (d0 >= d1) + cmpult $14, $15, $22 + bne $22, $82 + .loc 2 726 + # 726 { + .loc 2 728 + # 727 BigNumDigit d0_1, c2, c3, ctmp1; + # 728 d0_1 = d0-d1; + subq $14, $15, $13 + stq $13, 328($sp) + .loc 2 730 + # 729 + # 730 while (ml != 0) + beq $19, $86 + stq $19, 392($sp) + stq $9, 384($sp) +$79: + ldq $19, 392($sp) + ldq $9, 384($sp) + .loc 2 731 + # 731 { + .loc 2 733 + # 732 BigNumDigit m0,m1; + # 733 m0 = mm[0]; + ldq $7, 0($9) + .loc 2 734 + # 734 m1 = mm[1]; + ldq $8, 8($9) + .loc 2 735 + # 735 if (m0 >= m1) + cmpult $7, $8, $23 + bne $23, $80 + .loc 2 736 + # 736 { + .loc 2 740 + # 737 BigNumDigit m0_1; + # 738 BigNumDigit d0m0l, d0m0h, d1m1l, d1m1h, dfl, dfh; + # 739 BigNumDigit t0, t1, t2; + # 740 d0m0l = d0*m0; + .loc 2 741 + # 741 d0m0h = asm("umulh %a0, %a1, %v0", d0,m0); + umulh $14, $7, $5 + bis $5, $5, $20 + .loc 2 742 + # 742 m0_1 = m0-m1; + .loc 2 743 + # 743 d1m1l = d1*m1; + .loc 2 744 + # 744 d1m1h = asm("umulh %a0, %a1, %v0", d1,m1); + .loc 2 745 + # 745 dfl = d0_1*m0_1; + .loc 2 746 + # 746 dfh = asm("umulh %a0, %a1, %v0", d0_1,m0_1); + .loc 2 747 + # 747 p0 = pp[0]; + ldq $6, 0($11) + .loc 2 748 + # 748 p1 = pp[1]; + ldq $21, 8($11) + .loc 2 749 + # 749 p0 += c0; + addq $6, $0, $6 + .loc 2 750 + # 750 ctmp1 = p0 < c0; + cmpult $6, $0, $26 + .loc 2 751 + # 751 p1 += c1; + addq $21, $12, $21 + .loc 2 752 + # 752 c2 = p1 < c1; + cmpult $21, $12, $18 + .loc 2 753 + # 753 p1 += ctmp1; + addq $21, $26, $21 + .loc 2 754 + # 754 c2 += p1 < ctmp1; + cmpult $21, $26, $24 + addq $18, $24, $18 + .loc 2 755 + # 755 p0 += d0m0l; + mulq $14, $7, $2 + addq $6, $2, $6 + .loc 2 756 + # 756 c1 = p0 < d0m0l; + .loc 2 758 + # 757 /* compute: t2:t1:t0 = d0*m0 + d1*m1 */ + # 758 t0 = d0m0l+d1m1l; + .loc 2 759 + # 759 ctmp1 = t0 < d0m0l; + .loc 2 760 + # 760 t1 = d0m0h+d1m1h; + .loc 2 761 + # 761 t2 = t1 < d0m0h; + .loc 2 762 + # 762 t1 += ctmp1; + umulh $15, $8, $10 + addq $5, $10, $19 + mulq $15, $8, $9 + addq $2, $9, $4 + cmpult $4, $2, $20 + addq $19, $20, $16 + bis $16, $16, $0 + .loc 2 763 + # 763 t2 += t1 < ctmp1; + .loc 2 767 + # 764 /* t2:t1:t0 = d0*m0 + d1*m1 */ + # 765 /* dfh:dfl = d0*m0 + d1*m1 - d0*m1 - d1*m0 */ + # 766 /* compute: t2:t1:t0 = t2:t1:t0 - dfh:dfl */ + # 767 ctmp1 = t0 < dfl; + .loc 2 768 + # 768 t0 -= dfl; + .loc 2 769 + # 769 t2 -= t1 < dfh; + subq $7, $8, $1 + cmpult $19, $5, $25 + cmpult $16, $20, $27 + addq $25, $27, $22 + ldq $23, 328($sp) + xor $23, $1, $24 + cmpult $16, $24, $25 + subq $22, $25, $3 + .loc 2 770 + # 770 t1 -= dfh; + umulh $13, $1, $27 + subq $0, $27, $0 + .loc 2 771 + # 771 t2 -= t1 < ctmp1; + mulq $13, $1, $16 + cmpult $4, $16, $17 + cmpult $0, $17, $23 + subq $3, $23, $3 + .loc 2 772 + # 772 t1 -= ctmp1; + subq $0, $17, $0 + .loc 2 774 + # 773 /* t2:t1:t0 = d0*m1 + d1*m0 */ + # 774 ultra_parnoid(t0, t1, t2, d0, d1, m0, m1); + .loc 2 775 + # 775 d0m0h += c1; + cmpult $6, $2, $24 + addq $5, $24, $20 + .loc 2 776 + # 776 p1 += d0m0h; + addq $21, $20, $21 + .loc 2 777 + # 777 c2 += p1 < d0m0h; + cmpult $21, $20, $22 + addq $18, $22, $18 + .loc 2 778 + # 778 p1 += t0; + subq $4, $16, $19 + addq $21, $19, $21 + .loc 2 779 + # 779 c2 += p1 < t0; + cmpult $21, $19, $25 + addq $18, $25, $18 + .loc 2 780 + # 780 t1 += c2; + addq $0, $18, $0 + .loc 2 781 + # 781 t2 += t1 < c2; + cmpult $0, $18, $27 + addq $3, $27, $3 + .loc 2 782 + # 782 c2 = t1 + d1m1l; + addq $0, $9, $16 + bis $16, $16, $18 + .loc 2 783 + # 783 c3 = t2 + d1m1h + (c2 < t1); + addq $3, $10, $23 + cmpult $16, $0, $24 + addq $23, $24, $19 + br $31, $81 +$80: + .loc 2 786 + # 784 } + # 785 else + # 786 { + .loc 2 790 + # 787 BigNumDigit m0_1; + # 788 BigNumDigit d0m0l, d0m0h, d1m1l, d1m1h, dfl, dfh; + # 789 BigNumDigit t0, t1, t2; + # 790 d0m0l = d0*m0; + .loc 2 791 + # 791 d0m0h = asm("umulh %a0, %a1, %v0", d0,m0); + umulh $14, $7, $5 + bis $5, $5, $20 + .loc 2 792 + # 792 m0_1 = -m0+m1; + .loc 2 793 + # 793 d1m1l = d1*m1; + .loc 2 794 + # 794 d1m1h = asm("umulh %a0, %a1, %v0", d1,m1); + .loc 2 795 + # 795 dfl = d0_1*m0_1; + .loc 2 796 + # 796 dfh = asm("umulh %a0, %a1, %v0", d0_1,m0_1); + .loc 2 797 + # 797 p0 = pp[0]; + ldq $6, 0($11) + .loc 2 798 + # 798 p1 = pp[1]; + ldq $21, 8($11) + .loc 2 799 + # 799 p0 += c0; + addq $6, $0, $6 + .loc 2 800 + # 800 ctmp1 = p0 < c0; + cmpult $6, $0, $26 + .loc 2 801 + # 801 p1 += c1; + addq $21, $12, $21 + .loc 2 802 + # 802 c2 = p1 < c1; + cmpult $21, $12, $18 + .loc 2 803 + # 803 p1 += ctmp1; + addq $21, $26, $21 + .loc 2 804 + # 804 c2 += p1 < ctmp1; + cmpult $21, $26, $22 + addq $18, $22, $18 + .loc 2 805 + # 805 p0 += d0m0l; + mulq $14, $7, $2 + addq $6, $2, $6 + .loc 2 806 + # 806 c1 = p0 < d0m0l; + .loc 2 807 + # 807 t0 = d0m0l+d1m1l; + .loc 2 808 + # 808 ctmp1 = t0 < d0m0l; + .loc 2 809 + # 809 t1 = d0m0h+d1m1h; + .loc 2 810 + # 810 t2 = t1 < d0m0h; + .loc 2 811 + # 811 t1 += ctmp1; + .loc 2 812 + # 812 t2 += t1 < ctmp1; + umulh $15, $8, $10 + addq $5, $10, $19 + mulq $15, $8, $9 + addq $2, $9, $4 + cmpult $4, $2, $20 + addq $19, $20, $16 + cmpult $19, $5, $25 + cmpult $16, $20, $27 + addq $25, $27, $1 + .loc 2 816 + # 813 /* t2:t1:t0 = d0*m0 + d1*m1 */ + # 814 /* dfh:dfl = - d0*m0 - d1*m1 + d0*m1 + d1*m0 */ + # 815 /* compute: t2:t1:t0 = t2:t1:t0 + dfh:dfl */ + # 816 t0 += dfl; + .loc 2 817 + # 817 ctmp1 = t0 < dfl; + .loc 2 818 + # 818 t1 += dfh; + subq $8, $7, $3 + ldq $23, 328($sp) + xor $23, $3, $24 + addq $16, $24, $17 + .loc 2 819 + # 819 t2 += t1 < dfh; + umulh $13, $3, $22 + cmpult $17, $22, $25 + addq $1, $25, $1 + .loc 2 820 + # 820 t1 += ctmp1; + mulq $13, $3, $16 + addq $4, $16, $0 + cmpult $0, $16, $19 + addq $17, $19, $17 + .loc 2 821 + # 821 t2 += t1 < ctmp1; + cmpult $17, $19, $27 + addq $1, $27, $1 + .loc 2 823 + # 822 /* t2:t1:t0 = d0*m1 + d1*m0 */ + # 823 ultra_parnoid(t0, t1, t2, d0, d1, m0, m1); + .loc 2 824 + # 824 d0m0h += c1; + cmpult $6, $2, $23 + addq $5, $23, $20 + .loc 2 825 + # 825 p1 += d0m0h; + addq $21, $20, $21 + .loc 2 826 + # 826 c2 += p1 < d0m0h; + cmpult $21, $20, $24 + addq $18, $24, $18 + .loc 2 827 + # 827 p1 += t0; + addq $21, $0, $21 + .loc 2 828 + # 828 c2 += p1 < t0; + cmpult $21, $0, $22 + addq $18, $22, $18 + .loc 2 829 + # 829 t1 += c2; + addq $17, $18, $17 + .loc 2 830 + # 830 t2 += t1 < c2; + cmpult $17, $18, $25 + addq $1, $25, $1 + .loc 2 831 + # 831 c2 = t1 + d1m1l; + addq $17, $9, $0 + bis $0, $0, $18 + .loc 2 832 + # 832 c3 = t2 + d1m1h + (c2 < t1); + addq $1, $10, $27 + cmpult $0, $17, $23 + addq $27, $23, $19 +$81: + ldq $16, 392($sp) + .loc 2 835 + # 833 } + # 834 + # 835 pp[0] = p0; + stq $6, 0($11) + .loc 2 836 + # 836 pp[1] = p1; + stq $21, 8($11) + .loc 2 837 + # 837 pp += 2; + addq $11, 16, $11 + .loc 2 838 + # 838 pl -= 2; + ldq $24, 376($sp) + addq $24, -2, $22 + stq $22, 376($sp) + .loc 2 839 + # 839 c0 = c2; + bis $18, $18, $0 + .loc 2 840 + # 840 c1 = c3; + bis $19, $19, $12 + .loc 2 841 + # 841 ml -= 2; + addq $16, -2, $16 + .loc 2 842 + # 842 mm += 2; + ldq $25, 384($sp) + addq $25, 16, $27 + stq $27, 384($sp) + stq $16, 392($sp) + bne $16, $79 + br $31, $86 +$82: + .loc 2 846 + # 843 } + # 844 } + # 845 else + # 846 { + .loc 2 848 + # 847 BigNumDigit d0_1, c2, c3, ctmp1; + # 848 d0_1 = d1-d0; + subq $15, $14, $13 + stq $13, 120($sp) + .loc 2 850 + # 849 + # 850 while (ml != 0) + beq $19, $86 + stq $19, 392($sp) + stq $9, 384($sp) +$83: + ldq $19, 392($sp) + ldq $9, 384($sp) + .loc 2 851 + # 851 { + .loc 2 853 + # 852 BigNumDigit m0,m1; + # 853 m0 = mm[0]; + ldq $7, 0($9) + .loc 2 854 + # 854 m1 = mm[1]; + ldq $8, 8($9) + .loc 2 855 + # 855 if (m0 >= m1) + cmpult $7, $8, $23 + bne $23, $84 + .loc 2 856 + # 856 { + .loc 2 860 + # 857 BigNumDigit m0_1; + # 858 BigNumDigit d0m0l, d0m0h, d1m1l, d1m1h, dfl, dfh; + # 859 BigNumDigit t0, t1, t2; + # 860 d0m0l = d0*m0; + .loc 2 861 + # 861 d0m0h = asm("umulh %a0, %a1, %v0", d0,m0); + umulh $14, $7, $5 + bis $5, $5, $20 + .loc 2 862 + # 862 m0_1 = m0-m1; + .loc 2 863 + # 863 d1m1l = d1*m1; + .loc 2 864 + # 864 d1m1h = asm("umulh %a0, %a1, %v0", d1,m1); + .loc 2 865 + # 865 dfl = d0_1*m0_1; + .loc 2 866 + # 866 dfh = asm("umulh %a0, %a1, %v0", d0_1,m0_1); + .loc 2 867 + # 867 p0 = pp[0]; + ldq $6, 0($11) + .loc 2 868 + # 868 p1 = pp[1]; + ldq $21, 8($11) + .loc 2 869 + # 869 p0 += c0; + addq $6, $0, $6 + .loc 2 870 + # 870 ctmp1 = p0 < c0; + cmpult $6, $0, $26 + .loc 2 871 + # 871 p1 += c1; + addq $21, $12, $21 + .loc 2 872 + # 872 c2 = p1 < c1; + cmpult $21, $12, $18 + .loc 2 873 + # 873 p1 += ctmp1; + addq $21, $26, $21 + .loc 2 874 + # 874 c2 += p1 < ctmp1; + cmpult $21, $26, $24 + addq $18, $24, $18 + .loc 2 875 + # 875 p0 += d0m0l; + mulq $14, $7, $2 + addq $6, $2, $6 + .loc 2 876 + # 876 c1 = p0 < d0m0l; + .loc 2 878 + # 877 /* compute: t2:t1:t0 = d0*m0 + d1*m1 */ + # 878 t0 = d0m0l+d1m1l; + .loc 2 879 + # 879 ctmp1 = t0 < d0m0l; + .loc 2 880 + # 880 t1 = d0m0h+d1m1h; + .loc 2 881 + # 881 t2 = t1 < d0m0h; + .loc 2 882 + # 882 t1 += ctmp1; + .loc 2 883 + # 883 t2 += t1 < ctmp1; + umulh $15, $8, $10 + addq $5, $10, $19 + mulq $15, $8, $9 + addq $2, $9, $4 + cmpult $4, $2, $20 + addq $19, $20, $16 + cmpult $19, $5, $22 + cmpult $16, $20, $25 + addq $22, $25, $1 + .loc 2 887 + # 884 /* t2:t1:t0 = d0*m0 + d1*m1 */ + # 885 /* dfh:dfl = - d0*m0 - d1*m1 + d0*m1 + d1*m0 */ + # 886 /* compute: t2:t1:t0 = t2:t1:t0 + dfh:dfl */ + # 887 t0 += dfl; + .loc 2 888 + # 888 ctmp1 = t0 < dfl; + .loc 2 889 + # 889 t1 += dfh; + subq $7, $8, $3 + ldq $27, 120($sp) + xor $27, $3, $23 + addq $16, $23, $17 + .loc 2 890 + # 890 t2 += t1 < dfh; + umulh $13, $3, $24 + cmpult $17, $24, $22 + addq $1, $22, $1 + .loc 2 891 + # 891 t1 += ctmp1; + mulq $13, $3, $16 + addq $4, $16, $0 + cmpult $0, $16, $19 + addq $17, $19, $17 + .loc 2 892 + # 892 t2 += t1 < ctmp1; + cmpult $17, $19, $25 + addq $1, $25, $1 + .loc 2 894 + # 893 /* t2:t1:t0 = d0*m1 + d1*m0 */ + # 894 ultra_parnoid(t0, t1, t2, d0, d1, m0, m1); + .loc 2 895 + # 895 d0m0h += c1; + cmpult $6, $2, $27 + addq $5, $27, $20 + .loc 2 896 + # 896 p1 += d0m0h; + addq $21, $20, $21 + .loc 2 897 + # 897 c2 += p1 < d0m0h; + cmpult $21, $20, $23 + addq $18, $23, $18 + .loc 2 898 + # 898 p1 += t0; + addq $21, $0, $21 + .loc 2 899 + # 899 c2 += p1 < t0; + cmpult $21, $0, $24 + addq $18, $24, $18 + .loc 2 900 + # 900 t1 += c2; + addq $17, $18, $17 + .loc 2 901 + # 901 t2 += t1 < c2; + cmpult $17, $18, $22 + addq $1, $22, $1 + .loc 2 902 + # 902 c2 = t1 + d1m1l; + addq $17, $9, $0 + bis $0, $0, $18 + .loc 2 903 + # 903 c3 = t2 + d1m1h + (c2 < t1); + addq $1, $10, $25 + cmpult $0, $17, $27 + addq $25, $27, $19 + br $31, $85 +$84: + .loc 2 906 + # 904 } + # 905 else + # 906 { + .loc 2 910 + # 907 BigNumDigit m0_1; + # 908 BigNumDigit d0m0l, d0m0h, d1m1l, d1m1h, dfl, dfh; + # 909 BigNumDigit t0, t1, t2; + # 910 d0m0l = d0*m0; + .loc 2 911 + # 911 d0m0h = asm("umulh %a0, %a1, %v0", d0,m0); + umulh $14, $7, $5 + bis $5, $5, $20 + .loc 2 912 + # 912 m0_1 = -m0+m1; + .loc 2 913 + # 913 d1m1l = d1*m1; + .loc 2 914 + # 914 d1m1h = asm("umulh %a0, %a1, %v0", d1,m1); + .loc 2 915 + # 915 dfl = d0_1*m0_1; + .loc 2 916 + # 916 dfh = asm("umulh %a0, %a1, %v0", d0_1,m0_1); + .loc 2 917 + # 917 p0 = pp[0]; + ldq $6, 0($11) + .loc 2 918 + # 918 p1 = pp[1]; + ldq $21, 8($11) + .loc 2 919 + # 919 p0 += c0; + addq $6, $0, $6 + .loc 2 920 + # 920 ctmp1 = p0 < c0; + cmpult $6, $0, $26 + .loc 2 921 + # 921 p1 += c1; + addq $21, $12, $21 + .loc 2 922 + # 922 c2 = p1 < c1; + cmpult $21, $12, $18 + .loc 2 923 + # 923 p1 += ctmp1; + addq $21, $26, $21 + .loc 2 924 + # 924 c2 += p1 < ctmp1; + cmpult $21, $26, $23 + addq $18, $23, $18 + .loc 2 925 + # 925 p0 += d0m0l; + mulq $14, $7, $2 + addq $6, $2, $6 + .loc 2 926 + # 926 c1 = p0 < d0m0l; + .loc 2 927 + # 927 t0 = d0m0l+d1m1l; + .loc 2 928 + # 928 ctmp1 = t0 < d0m0l; + .loc 2 929 + # 929 t1 = d0m0h+d1m1h; + .loc 2 930 + # 930 t2 = t1 < d0m0h; + .loc 2 931 + # 931 t1 += ctmp1; + umulh $15, $8, $10 + addq $5, $10, $19 + mulq $15, $8, $9 + addq $2, $9, $4 + cmpult $4, $2, $20 + addq $19, $20, $16 + bis $16, $16, $0 + .loc 2 932 + # 932 t2 += t1 < ctmp1; + .loc 2 936 + # 933 /* t2:t1:t0 = d0*m0 + d1*m1 */ + # 934 /* dfh:dfl = d0*m0 + d1*m1 - d0*m1 - d1*m0 */ + # 935 /* compute: t2:t1:t0 = t2:t1:t0 - dfh:dfl */ + # 936 ctmp1 = t0 < dfl; + .loc 2 937 + # 937 t0 -= dfl; + .loc 2 938 + # 938 t2 -= t1 < dfh; + subq $8, $7, $1 + cmpult $19, $5, $24 + cmpult $16, $20, $22 + addq $24, $22, $25 + ldq $27, 120($sp) + xor $27, $1, $23 + cmpult $16, $23, $24 + subq $25, $24, $3 + .loc 2 939 + # 939 t1 -= dfh; + umulh $13, $1, $22 + subq $0, $22, $0 + .loc 2 940 + # 940 t2 -= t1 < ctmp1; + mulq $13, $1, $16 + cmpult $4, $16, $17 + cmpult $0, $17, $27 + subq $3, $27, $3 + .loc 2 941 + # 941 t1 -= ctmp1; + subq $0, $17, $0 + .loc 2 943 + # 942 /* t2:t1:t0 = d0*m1 + d1*m0 */ + # 943 ultra_parnoid(t0, t1, t2, d0, d1, m0, m1); + .loc 2 944 + # 944 d0m0h += c1; + cmpult $6, $2, $23 + addq $5, $23, $20 + .loc 2 945 + # 945 p1 += d0m0h; + addq $21, $20, $21 + .loc 2 946 + # 946 c2 += p1 < d0m0h; + cmpult $21, $20, $25 + addq $18, $25, $18 + .loc 2 947 + # 947 p1 += t0; + subq $4, $16, $19 + addq $21, $19, $21 + .loc 2 948 + # 948 c2 += p1 < t0; + cmpult $21, $19, $24 + addq $18, $24, $18 + .loc 2 949 + # 949 t1 += c2; + addq $0, $18, $0 + .loc 2 950 + # 950 t2 += t1 < c2; + cmpult $0, $18, $22 + addq $3, $22, $3 + .loc 2 951 + # 951 c2 = t1 + d1m1l; + addq $0, $9, $16 + bis $16, $16, $18 + .loc 2 952 + # 952 c3 = t2 + d1m1h + (c2 < t1); + addq $3, $10, $27 + cmpult $16, $0, $23 + addq $27, $23, $19 +$85: + ldq $16, 392($sp) + .loc 2 955 + # 953 } + # 954 + # 955 pp[0] = p0; + stq $6, 0($11) + .loc 2 956 + # 956 pp[1] = p1; + stq $21, 8($11) + .loc 2 957 + # 957 pp += 2; + addq $11, 16, $11 + .loc 2 958 + # 958 pl -= 2; + ldq $25, 376($sp) + addq $25, -2, $24 + stq $24, 376($sp) + .loc 2 959 + # 959 c0 = c2; + bis $18, $18, $0 + .loc 2 960 + # 960 c1 = c3; + bis $19, $19, $12 + .loc 2 961 + # 961 ml -= 2; + addq $16, -2, $16 + .loc 2 962 + # 962 mm += 2; + ldq $22, 384($sp) + addq $22, 16, $27 + stq $27, 384($sp) + stq $16, 392($sp) + bne $16, $83 +$86: + .loc 2 965 + # 963 } + # 964 } + # 965 p0 = pp[0]; + ldq $6, 0($11) + .loc 2 966 + # 966 p1 = pp[1]; + ldq $21, 8($11) + .loc 2 967 + # 967 p0 += c0; + addq $6, $0, $6 + .loc 2 968 + # 968 pp[0] = p0; + stq $6, 0($11) + .loc 2 969 + # 969 c1 += p0 < c0; + cmpult $6, $0, $23 + addq $12, $23, $12 + .loc 2 970 + # 970 p1 += c1; + addq $21, $12, $21 + .loc 2 971 + # 971 pp[1] = p1; + stq $21, 8($11) + .loc 2 973 + # 972 + # 973 if (c1 <= p1) + cmpult $21, $12, $25 + bne $25, $87 + .loc 2 974 + # 974 { + .loc 2 978 + # 975 #ifdef PARANOID + # 976 assert(sc == 0 && BnnCompare(sp, sl, rp, sl) == BN_EQ); + # 977 #endif + # 978 return (0); + bis $31, $31, $0 + br $31, $90 +$87: + ldq $17, 376($sp) + .loc 2 981 + # 979 } + # 980 + # 981 pl -= 2; + addq $17, -2, $17 + .loc 2 982 + # 982 pp+=2; + addq $11, 16, $11 + .loc 2 983 + # 983 while (pl != 0 && !(++(*pp++))) + cmpeq $17, 0, $0 + xor $0, 1, $0 + beq $0, $89 + ldq $24, 0($11) + addq $24, 1, $22 + stq $22, 0($11) + ldq $16, 0($11) + cmpeq $16, 0, $16 + addq $11, 8, $11 + beq $16, $89 +$88: + .loc 2 984 + # 984 pl--; + addq $17, -1, $17 + cmpeq $17, 0, $0 + xor $0, 1, $0 + beq $0, $89 + ldq $27, 0($11) + addq $27, 1, $23 + stq $23, 0($11) + ldq $16, 0($11) + cmpeq $16, 0, $16 + addq $11, 8, $11 + bne $16, $88 +$89: + .loc 2 990 + # 985 + # 986 #ifdef PARANOID + # 987 assert(sc == (pl != 0 ? 0 : 1)); + # 988 assert(BnnCompare(sp, sl, rp, sl) == BN_EQ); + # 989 #endif + # 990 return (pl != 0 ? 0 : 1); + bis $31, $31, $16 + cmoveq $0, 1, $16 + bis $16, $16, $0 +$90: + .livereg 0xFC7F0002,0x3FC00000 + ldq $26, 0($sp) + ldq $9, 8($sp) + ldq $10, 16($sp) + ldq $11, 24($sp) + ldq $12, 32($sp) + ldq $13, 40($sp) + ldq $14, 48($sp) + ldq $15, 56($sp) + lda $sp, 416($sp) + ret $31, ($26), 1 + .end BnnMultiply2Digit + .text + .align 4 + .file 2 "c/KerN.c" + .globl BnnDivideDigit + .loc 2 1019 + # 1019 { + .ent BnnDivideDigit 2 +BnnDivideDigit: + .option O2 + ldgp $gp, 0($27) + lda $sp, -240($sp) + stq $26, 0($sp) + stq $9, 8($sp) + stq $10, 16($sp) + stq $11, 24($sp) + stq $12, 32($sp) + .mask 0x04001E00, -240 + .frame $sp, 240, $26, 48 + .prologue 1 + bis $16, $16, $10 + bis $17, $17, $12 + bis $18, $18, $11 + bis $19, $19, $5 + .loc 2 1019 + + .loc 2 1021 + # 1020 /* test computed at compile time */ + # 1021 if (sizeof (BigNumProduct) > sizeof (BigNumDigit)) + .loc 2 1042 + # 1042 { + .loc 2 1053 + # 1053 k = BnnNumLeadingZeroBitsInDigit (d); + bis $5, $5, $16 + stq $5, 216($sp) + .livereg 0x0001C002,0x00000000 + jsr $26, BnnNumLeadingZeroBitsInDigit + ldgp $gp, 0($26) + ldq $5, 216($sp) + addl $0, 0, $16 + stl $16, 176($sp) + .loc 2 1054 + # 1054 if (k != 0) + beq $16, $91 + .loc 2 1055 + # 1055 { + .loc 2 1056 + # 1056 prev_qq = qq[-1]; + ldq $22, -8($10) + stq $22, 104($sp) + .loc 2 1057 + # 1057 orig_nl = nl; + stq $11, 168($sp) + .loc 2 1058 + # 1058 d <<= k; + ldl $23, 176($sp) + sll $5, $23, $5 + .loc 2 1059 + # 1059 BnnShiftLeft (nn, nl, k); + bis $12, $12, $16 + bis $11, $11, $17 + bis $23, $23, $18 + stq $5, 216($sp) + .livereg 0x0001E002,0x00000000 + jsr $26, BnnShiftLeft + ldgp $gp, 0($26) + ldq $5, 216($sp) +$91: + .loc 2 1062 + # 1060 } + # 1061 + # 1062 nn += nl; + s8addq $11, $12, $12 + .loc 2 1063 + # 1063 nl--; + addq $11, -1, $11 + .loc 2 1064 + # 1064 qq += nl; + s8addq $11, $10, $10 + .loc 2 1066 + # 1065 + # 1066 ch = HIGH (d); + srl $5, 32, $6 + bis $6, $6, $26 + .loc 2 1067 + # 1067 cl = LOW (d); + and $5, 4294967295, $8 + bis $8, $8, $9 + .loc 2 1069 + # 1068 + # 1069 rl = *(--nn); + addq $12, -8, $12 + ldq $7, 0($12) + .loc 2 1071 + # 1070 + # 1071 while (nl != 0) + beq $11, $103 +$92: + .loc 2 1072 + # 1072 { + .loc 2 1073 + # 1073 nl--; + addq $11, -1, $11 + .loc 2 1074 + # 1074 rh = rl; + bis $7, $7, $1 + .loc 2 1075 + # 1075 rl = *(--nn); + addq $12, -8, $12 + ldq $7, 0($12) + .loc 2 1076 + # 1076 qa = rh / ch; /* appr. quotient */ + divqu $1, $6, $0 + bis $0, $0, $3 + .loc 2 1079 + # 1077 + # 1078 /* Compute ph, pl */ + # 1079 pl = cl * qa; + .loc 2 1080 + # 1080 ph = ch * qa; + .loc 2 1081 + # 1081 ph += HIGH (pl); + mulq $9, $0, $18 + mulq $6, $0, $24 + srl $18, 32, $25 + addq $24, $25, $19 + bis $19, $19, $17 + .loc 2 1082 + # 1082 pl = L2H (pl); + sll $18, 32, $20 + bis $20, $20, $16 + .loc 2 1085 + # 1083 + # 1084 /* While ph:pl > rh:rl, decrement qa, adjust qh:ql */ + # 1085 while (ph > rh || ph == rh && pl > rl) + cmpult $1, $19, $27 + bne $27, $93 + divqu $1, $26, $0 + mulq $26, $0, $22 + mulq $9, $0, $23 + srl $23, 32, $24 + addq $22, $24, $25 + subq $25, $1, $27 + bne $27, $96 + cmpult $7, $20, $23 + beq $23, $96 +$93: + .loc 2 1086 + # 1086 { + .loc 2 1087 + # 1087 qa--; + addq $3, -1, $3 + .loc 2 1088 + # 1088 SUB (ph, pl, ch, L2H (cl)); + sll $8, 32, $0 + cmpult $16, $0, $22 + beq $22, $94 + .loc 2 1088 + + .loc 2 1088 + + subq $16, $0, $16 + .loc 2 1088 + + subq $17, $6, $17 + addq $17, -1, $17 + br $31, $95 +$94: + .loc 2 1088 + + .loc 2 1088 + + subq $16, $0, $16 + .loc 2 1088 + + subq $17, $6, $17 +$95: + .loc 2 1088 + + cmpult $1, $17, $24 + bne $24, $93 + subq $17, $1, $25 + bne $25, $96 + cmpult $7, $16, $27 + bne $27, $93 +$96: + .loc 2 1091 + # 1089 } + # 1090 + # 1091 SUB (rh, rl, ph, pl); + cmpult $7, $16, $23 + beq $23, $97 + .loc 2 1091 + + .loc 2 1091 + + subq $7, $16, $7 + .loc 2 1091 + + subq $1, $17, $1 + addq $1, -1, $1 + br $31, $98 +$97: + .loc 2 1091 + + .loc 2 1091 + + subq $7, $16, $7 + .loc 2 1091 + + subq $1, $17, $1 +$98: + .loc 2 1091 + + .loc 2 1094 + # 1092 + # 1093 /* Top half of quotient is correct; save it */ + # 1094 *(--qq) = L2H (qa); + addq $10, -8, $18 + bis $18, $18, $2 + bis $18, $18, $10 + sll $3, 32, $22 + stq $22, 0($2) + .loc 2 1095 + # 1095 qa = (L2H (rh) | HIGH (rl)) / ch; + sll $1, 32, $24 + srl $7, 32, $25 + or $24, $25, $4 + divqu $4, $6, $0 + bis $0, $0, $3 + .loc 2 1099 + # 1096 + # 1097 /* Approx low half of q */ + # 1098 /* Compute ph, pl, again */ + # 1099 pl = cl * qa; + .loc 2 1100 + # 1100 ph = ch * qa; + .loc 2 1101 + # 1101 ph += HIGH (pl); + .loc 2 1102 + # 1102 pl = LOW (pl) | L2H (LOW (ph)); + mulq $9, $0, $19 + mulq $6, $0, $27 + srl $19, 32, $23 + addq $27, $23, $20 + and $19, 4294967295, $22 + and $20, 4294967295, $24 + sll $24, 32, $25 + or $22, $25, $16 + .loc 2 1103 + # 1103 ph = HIGH (ph); + srl $20, 32, $21 + bis $21, $21, $17 + .loc 2 1106 + # 1104 + # 1105 /* While ph:pl > rh:rl, decrement qa, adjust qh:ql */ + # 1106 while (ph > rh || ph == rh && pl > rl) + cmpult $1, $21, $27 + bne $27, $99 + divqu $4, $26, $0 + mulq $26, $0, $23 + mulq $9, $0, $24 + srl $24, 32, $22 + addq $23, $22, $25 + srl $25, 32, $27 + subq $27, $1, $24 + bne $24, $102 + cmpult $7, $16, $23 + beq $23, $102 +$99: + .loc 2 1107 + # 1107 { + .loc 2 1108 + # 1108 qa--; + addq $3, -1, $3 + .loc 2 1109 + # 1109 SUB (ph, pl, 0, d); + cmpult $16, $5, $22 + beq $22, $100 + .loc 2 1109 + + .loc 2 1109 + + subq $16, $5, $16 + .loc 2 1109 + + addq $17, -1, $17 + br $31, $101 +$100: + .loc 2 1109 + + .loc 2 1109 + + subq $16, $5, $16 + .loc 2 1109 + +$101: + .loc 2 1109 + + cmpult $1, $17, $25 + bne $25, $99 + subq $17, $1, $27 + bne $27, $102 + cmpult $7, $16, $24 + bne $24, $99 +$102: + .loc 2 1113 + # 1110 } + # 1111 + # 1112 /* Subtract ph:pl from rh:rl; we know rh will be 0 */ + # 1113 rl -= pl; + subq $7, $16, $7 + .loc 2 1114 + # 1114 *qq |= qa; + ldq $23, 0($10) + or $23, $3, $22 + stq $22, 0($10) + bne $11, $92 +$103: + .loc 2 1118 + # 1115 } + # 1116 + # 1117 /* Denormalize dividend */ + # 1118 if (k != 0) { + ldl $25, 176($sp) + beq $25, $106 + .loc 2 1118 + + .loc 2 1119 + # 1119 if((qq > nn) && (qq < &nn[orig_nl])) { + cmpult $12, $10, $27 + beq $27, $104 + ldq $19, 168($sp) + s8addq $19, $12, $24 + cmpult $10, $24, $23 + beq $23, $104 + .loc 2 1119 + + .loc 2 1121 + # 1120 /* Overlap between qq and nn. Care of *qq! */ + # 1121 orig_nl = (qq - nn); + .loc 2 1122 + # 1122 BnnShiftRight (nn, orig_nl, k); + bis $12, $12, $16 + subq $10, $12, $17 + sra $17, 3, $17 + bis $25, $25, $18 + stq $17, 88($sp) + stq $7, 152($sp) + .livereg 0x0001E002,0x00000000 + jsr $26, BnnShiftRight + ldgp $gp, 0($26) + ldq $17, 88($sp) + ldq $7, 152($sp) + .loc 2 1123 + # 1123 nn[orig_nl - 1] = prev_qq; + ldq $22, 104($sp) + addq $17, -1, $27 + s8addq $27, $12, $24 + stq $22, 0($24) + br $31, $106 +$104: + ldq $19, 168($sp) + .loc 2 1124 + # 1124 } else if(qq == nn) { + subq $10, $12, $23 + bne $23, $105 + .loc 2 1124 + + .loc 2 1125 + # 1125 BnnShiftRight(&nn[orig_nl - 1], 1, k); + addq $19, -1, $25 + s8addq $25, $12, $16 + ldiq $17, 1 + ldl $18, 176($sp) + stq $7, 152($sp) + .livereg 0x0001E002,0x00000000 + jsr $26, BnnShiftRight + ldgp $gp, 0($26) + ldq $7, 152($sp) + br $31, $106 +$105: + .loc 2 1126 + # 1126 } else { + .loc 2 1127 + # 1127 BnnShiftRight (nn, orig_nl, k); + bis $12, $12, $16 + bis $19, $19, $17 + ldl $18, 176($sp) + stq $7, 152($sp) + .livereg 0x0001E002,0x00000000 + jsr $26, BnnShiftRight + ldgp $gp, 0($26) + ldq $7, 152($sp) +$106: + .loc 2 1129 + # 1128 } } + # 1129 return (rl >> k); + ldl $27, 176($sp) + srl $7, $27, $0 + .livereg 0xFC7F0002,0x3FC00000 + ldq $26, 0($sp) + ldq $9, 8($sp) + ldq $10, 16($sp) + ldq $11, 24($sp) + ldq $12, 32($sp) + lda $sp, 240($sp) + ret $31, ($26), 1 + .end BnnDivideDigit diff --git a/otherlibs/num/bignum/s/hpKerN.s b/otherlibs/num/bignum/s/hpKerN.s new file mode 100644 index 000000000..f6d53f37e --- /dev/null +++ b/otherlibs/num/bignum/s/hpKerN.s @@ -0,0 +1,814 @@ +; Copyright Digital Equipment Corporation & INRIA 1988, 1989 +; +; KerN for the HP 9000 600/700/800 (PA-RISC 1.1 only) +; LERCIER Reynald (april 1993) +; + + + + .SPACE $TEXT, SORT=8 + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnSetToZero + .PROC + .CALLINFO + .ENTRY ; (nn, nl) + comb,<= %arg1, %r0, L$BSTZ0 ; if (nl <= 0) goto L$BSTZ0 + nop +L$BSTZ1 addibf,<= -1, %arg1, L$BSTZ1 ; while (nl-->0) + stwm %r0, 4(0, %arg0) ; { *(nn++)=0 } +L$BSTZ0 bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnAssign + .PROC + .CALLINFO + .ENTRY ; (mm, nn, nl) + comb,<= %arg2, %r0, L$BAG0 ; if (nl <= 0) goto L$BAG0 + nop + comb,>>=,n %arg0, %arg1, L$BAG1 ; if (mm>=nn) goto L$BAG1 +L$BAG2 ldwm 4(%arg1), %r19 ; X=*(nn++) + addibf,<= -1, %arg2, L$BAG2 ; if ((nl--)>=0) goto L$BAG2 + stwm %r19, 4(%arg0) ; *(mm++)=X + bv,n %r0(%r2) ; return +L$BAG1 comb,=,n %arg0, %arg1, L$BAG0 ; if (mm==nn) goto L$BAG0 + shd %arg2, %r0, 30, %r19 ; X = nl <<2 + add %arg0, %r19, %arg0 ; mm+=X + add %arg1, %r19, %arg1 ; nn+=X +L$BAG3 ldwm -4(%arg1), %r19 ; X=*(--nn) + addibf,<= -1, %arg2, L$BAG3 ; if (--nl>=0) goto L$BAG3 + stwm %r19, -4(%arg0) ; *(--mm)=X +L$BAG0 bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnSetDigit + .PROC + .CALLINFO + .ENTRY ; (nn, d) + bv %r0(%r2) ; return + .EXIT + stws %arg1, 0(0, %arg0) ; *nn = d + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnGetDigit + .PROC + .CALLINFO + .ENTRY ; (nn) + bv %r0(%r2) + .EXIT + ldws 0(0, %arg0), %ret0 ; return (*nn) + .PROCEND + + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnNumDigits + .PROC + .CALLINFO + .ENTRY ; (nn, nl) + comb,<=,n %arg1, %r0, L$BND0 ; if (nl <= 0) goto L$BND0 + shd %arg1, %r0, 30, %r19 ; X = nl<<2 + add %arg0, %r19, %arg0 ; nn+=nl + ldwm -4(%arg0), %r19 ; X=*(--nn) +L$BND2 comb,<> %r19, %r0, L$BND1 ; if (X != 0) goto L$BND1 + nop + addibf,<= -1, %arg1, L$BND2 ; if ((--nl)>0) goto L$BND2 + ldwm -4(%arg0), %r19 ; X=*(--nn) +L$BND0 bv %r0(%r2) ; return(1) + ldi 1, %ret0 +L$BND1 bv %r0(%r2) ; return(nl) + copy %arg1, %ret0 + .EXIT + .PROCEND + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnNumLeadingZeroBitsInDigit + .PROC + .CALLINFO + .ENTRY ; (d) + ldi 0, %ret0 ; p=0 + comb,<>,n %r0, %arg0, L$BLZ1 ; if (d<>0) goto L$BLZ1 + bv %r0(%r2) ; return(32) + ldi 32, %ret0 +L$BLZ2 addi 1, %ret0, %ret0 ; p++ +L$BLZ1 comib,< 0, %arg0, L$BLZ2 ; if (d>0) goto L$BLZ2; + shd %arg0, %r0, 31, %arg0 ; d<<=1 + bv,n %r0(%r2) ; return(p) + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnDoesDigitFitInWord + .PROC + .CALLINFO + .ENTRY + bv %r0(%r2) ; return + ldi 1, %ret0 + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnIsDigitZero + .PROC + .CALLINFO + .ENTRY ; (d) + ldi 1, %ret0 + or,= %r0, %arg0, %r0 ; if (d==0) return(1) + ldi 0, %ret0 ; return(0) + bv,n %r0(%r2) + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnIsDigitNormalized + .PROC + .CALLINFO + .ENTRY + bv %r0(%r2) ; return + extru %arg0, 0, 1, %ret0 ; the leftmost bit + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnIsDigitOdd + .PROC + .CALLINFO + .ENTRY + bv %r0(%r2) ; return + extru %arg0, 31, 1, %ret0 ; the rightmost bit + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnCompareDigits + .PROC + .CALLINFO + .ENTRY ; (d1, d2) + comb,= %arg0, %arg1, L$BCD0 ; if (d1==d2) goto L$BCD0 + ldi 0, %ret0 ; return(0) + comb,>> %arg0, %arg1, L$BCD0 ; if (d1>d2) goto L$BCD0 + ldi 1, %ret0 ; return(1) + ldi -1, %ret0 ; return(-1) +L$BCD0 bv,n %r0(%r2) + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnComplement + .PROC + .CALLINFO + .ENTRY ; (nn, nl) + comb,<=,n %arg1, %r0, L$BCM0 ; if (nl <= 0) goto L$BCM0 + ldi -1, %ret0 ; cste=-1 +L$BCM1 ldw (%arg0), %r19 ; X=*(nn) + xor %r19, %ret0, %r19 ; X ^= cste + addibf,<= -1, %arg1, L$BCM1 ; if ((--nl)>=0) goto L$BCM1 + stwm %r19, 4(%arg0) ; *(nn++)=X +L$BCM0 bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnAndDigits + .PROC + .CALLINFO + .ENTRY ; (nn, d) + ldw (%arg0), %r19 ; X=*nn + and %r19, %arg1, %r19 ; X &= d + stw %r19, (%arg0) ; *nn=X + bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnOrDigits + .PROC + .CALLINFO + .ENTRY ; (nn, d) + ldw (%arg0), %r19 ; X=*nn + or %r19, %arg1, %r19 ; X &= d + stw %r19, (%arg0) ; *nn=X + bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnXorDigits + .PROC + .CALLINFO + .ENTRY ; (nn, d) + ldw (%arg0), %r19 ; X=*nn + xor %r19, %arg1, %r19 ; X &= d + stw %r19, (%arg0) ; *nn=X + bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + +; convention for BnnShiftLeft, BnnShiftRight +nn1 .REG %arg0 +nl1 .REG %arg1 +nbits .REG %arg2 +res .REG %ret0 +X .REG %r19 +Y .REG %r20 +Z .REG %r21 +W .REG %r22 + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnShiftLeft + .PROC + .CALLINFO + .ENTRY ; (nn1, nl1, nbits) + ldi 0, res ; res=0 + comb,= nbits, %r0, L$BSL0 ; if (nbits = 0) goto L$BSL0 + nop + comb,<= nl1, %r0, L$BSL0 ; if (nl1 <= 0) goto L$BSL0 + nop + subi 32, nbits, nbits ; nbits-=32 + mtsar nbits +L$BSL1 ldw (nn1), X ; X=*(nn1) + vshd X, %r0, Y ; Y= X<<nbits + or Y, res, Y ; Y|=res + vshd %r0, X, res ; res= X>>nbits + addibf,<= -1, nl1, L$BSL1 ; if ((nl1--)>=0) goto L$BSL1 + stwm Y, 4(nn1) ; *(nn1++)=Y +L$BSL0 bv,n %r0(%r2) ; return + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnShiftRight + .PROC + .CALLINFO + .ENTRY ; (nn1, nl1, nbits) + ldi 0, res ; res=0 + comb,= nbits, %r0, L$BSR0 ; if (nbits = 0) goto L$BSR0 + nop + comb,<=,n nl1, %r0, L$BSR0 ; if (nl1 <= 0) goto L$BSR0 + mtsar nbits + shd nl1, %r0, 30, Y ; Y=nl1<<2 + add Y, nn1, nn1 ; nn1+=Y +L$BSR1 ldwm -4(nn1), X ; X=*(--nn1) + vshd %r0, X, Y ; Y= X>>nbits + or Y, res, Y ; Y|=res + vshd X, %r0, res ; res= X<<rnbits + addibf,<= -1, nl1, L$BSR1 ; if ((nl1--)>=0) goto L$BSR1 + stw Y, (nn1) ; *(nn1)=Y +L$BSR0 bv,n %r0(%r2) ; return + .EXIT + .PROCEND + +; convention for BnnAddCarry, BnnSubtractBorrow +carryin .REG %arg2 + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnAddCarry + .PROC + .CALLINFO + .ENTRY ; (nn1, nl1, carryin) + comb,= carryin, %r0, L$BAC0 ; if (carryin == 0) goto L$BAC0 + nop + comb,<=,n nl1, %r0, L$BAC1 ; if (nl1<= 0) goto L$BAC1 + ldw (nn1), X ; X=*(nn1) +L$BAC2 addi,UV 1, X, X ; X++ + b L$BAC0 ; if (X<2^32) goto L$BAC0 + stwm X, 4(nn1) ; *(nn1++)=X + addibf,<=,n -1, nl1, L$BAC2 ; if ((nl1--)>=0) goto L$BAC2 + ldw (nn1), X ; X=*(nn1) +L$BAC1 bv %r0(%r2) ; return(1) + ldi 1, res +L$BAC0 bv %r0(%r2) ; return(0) + ldi 0, res + .EXIT + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnSubtractBorrow + .PROC + .CALLINFO + .ENTRY ; (nn1, nl1, d) + comib,= 1, carryin, L$BSB1 ; if (carryin == 1) goto L$BSB1 + nop + comb,<=,n nl1, %r0, L$BSB0 ; if (nl1<= 0) goto L$BSB0 + ldw (nn1), X ; X=*(nn1) +L$BSB2 addi,nuv -1, X, X ; X-- + b L$BSB1 ; if (X!=-1) goto L$BSB1 + stwm X, 4(nn1) ; *(nn1++)=X + addibf,<=,n -1, nl1, L$BSB2 ; if ((nl1--)>=0) goto L$BSB2 + ldw (nn1), X ; X=*(nn1) +L$BSB0 bv %r0(%r2) ; return(0) + ldi 0, res +L$BSB1 bv %r0(%r2) ; return(1) + ldi 1, res + .EXIT + .PROCEND + +; convention for BnnAdd, BnnSubtract +mm2 .REG %arg0 +ml2 .REG %arg1 +nn2 .REG %arg2 +nl2 .REG %arg3 + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnAdd + .PROC + .CALLINFO + .ENTER ; (mm2, ml2, nn2, nl2, carryin) + sub ml2, nl2, ml2 ; ml2 -= nl2 + ldw -52(0, %r30), res ; res=carryin + comb,=,n nl2, %r0, L$BADD2 ; if (nl2==0) goto L$BADD2 +L$BADD1 ldwm 4(nn2), X ; X = *(nn2++) + ldw (mm2), Y ; Y = *(mm2) + copy res, Z ; Z=res + ldi 0, res ; res=0 + add,nuv Y, Z, Y ; Y+=Z; + ldi 1, res ; if (Y>=2^32) res=1 Y-=2^32 + add,nuv Y, X, Y ; Y+=X + ldi 1, res ; if (Y>=2^32) res=1 Y-=2^32 + addibf,<= -1, nl2, L$BADD1 ; if ((nl2--)>=0) goto L$BADD1 + stwm Y, 4(mm2) ; *(mm2++)=Y +L$BADD2 comclr,<> res, %r0, %r0 ; if (res<>0) skip next operation + b,n L$BADD4 ; return(0) + comclr,<> ml2, %r0, %r0 ; if (ml2<>0) skip next operation + b L$BADD5 ; return(1) + ldw (mm2), X ; X=*mm2 +L$BADD3 addi,uv 1, X, X ; X++ + b L$BADD4 ; if (X<2^32) goto L$BADD4 + stwm X, 4(mm2) ; *(mm2++)=X + addibf,<= -1, ml2, L$BADD3 ; if ((ml2--)>=0) goto L$BADD3 + ldw (mm2), X ; X=*mm2 + b,n L$BADD5 ; return(1) +L$BADD4 ldi 0, res +L$BADD5 .LEAVE + .PROCEND + + + .SPACE $TEXT + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnSubtract + .PROC + .CALLINFO + .ENTRY ; (mm2, ml2, nn2, nl2, carryin) + sub ml2, nl2, ml2 ; ml2 -= nl2 + ldw -52(0, %r30), res ; res=carryin + subi 1, res, res ; res=1-res + comb,=,n nl2, %r0, L$BS2 ; if (nl2==0) goto L$BS2 +L$BS1 ldwm 4(nn2), X ; X = *(nn2++) + ldw (mm2), Y ; Y = *(mm2) + copy res, Z ; Z=res + ldi 0, res ; res=0 + sub,>>= Y, Z, Y ; Y-=Z; + ldi 1, res ; if (Y<=0) res=1 Y+=2^32 + sub,>>= Y, X, Y ; Y-=X + ldi 1, res ; if (Y<=0) res=1 Y+=2^32 + addibf,<= -1, nl2, L$BS1 ; if ((nl2--)>=0) goto L$BS1 + stwm Y, 4(mm2) ; *(mm2++)=Y +L$BS2 comb,= res, %r0, L$BS4 ; if (res==0) goto L$BS4 + nop + comb,=,n ml2, %r0, L$BS5 ; if (ml2==0) goto L$BS5 + ldw (mm2), X ; X=*mm2 +L$BS3 addi,nuv -1, X, X ; X-- + b L$BS4 ; if (X!=-1) goto L$BS4 + stwm X, 4(mm2) ; *(mm2++)=X + addibf,<=,n -1, ml2, L$BS3 ; if ((ml2--)>=0) goto L$BS3 + ldw (mm2), X ; X=*mm2 +L$BS5 bv %r0(%r2) ; return(0) + ldi 0, res +L$BS4 bv %r0(%r2) ; return(1) + ldi 1,res + + .EXIT + .PROCEND + + +; conventions for BnnMultiplyDigit +pp .REG %arg0 +pl1 .REG %arg1 +mm .REG %arg2 +ml .REG %arg3 +X1 .REG %r22 +X3 .REG %r1 +dm .REG %r29 +fLd .REG %fr5L +fHd .REG %fr5R +fLm .REG %fr7L +fHm .REG %fr8L + + + .SPACE $TEXT$ + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnMultiplyDigit + .PROC + .CALLINFO CALLER, FRAME=8, SAVE_RP + .ENTER ; (pp, pl1, mm, ml, dm) + + ldw -108(0, %r30), dm ; dm + comb,= dm, %r0, L$BMD7 ; if (dm==0) goto L$BMD7 + nop + comib,<>,n 1, dm, L$BMD2 ; if (dm<>1) goto L$BMD2 + .CALL ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR ;in=24,25,26;out=28; + bl BnnAdd, %r2 ; return(BnnAdd(pp, pl1, mm, ml, 0)) + stw %r0, -52(0, %r30) + b,n L$BMD8 + +L$BMD2 comb,= ml, %r0, L$BMD7 ; if (ml==0) goto L$BMD7 + nop + sub pl1, ml, pl1 ; pl1-=ml + + ldo -52(%r30), %r21 + extru dm, 31, 16, X ; Ld=dm & (2^16-1); + stws X, 0(0, %r21) + fldws 0(0, %r21), fLd + extru dm, 15, 16, X ; Hd=dm>>16; + stws X, 0(0, %r21) + fldws 0(0, %r21), fHd + ldi 0, dm ; dm=0 + +L$BMD3 ldwm 4(mm), X1 ; X1=*(mm++) + extru X1, 31, 16, X ; Lm=X1 & (2^16-1) + stws X, 0(0, %r21) + fldws 0(0, %r21), fLm + extru X1, 15, 16, X ; Hm=X1>>16 + stws X, 0(0, %r21) + fldws 0(0, %r21), fHm + + xmpyu fHm, fHd, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), X3 + + xmpyu fLm, fHd, %fr4 + fstws %fr4R, -4(0, %r21) + + xmpyu fHm, fLd, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), X1 + + xmpyu fLm, fLd, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), X + + add,nuv X, dm, dm + ldo 1(X3), X3 + ldws -4(0, %r21), X + add,nuv X1, X, X1 ; X1+=X + addil L%(65536), X3 ; if overflow X3+=2^16; + extru X1, 15, 16, X ; X = X1 >> 16 + add X3, X, X3 ; X3+=X + zdep X1, 15, 16, X1 ; X1 =<< 16 + add,nuv dm, X1, dm ; dm+=X1 + ldo 1(X3), X3 ; if overflow X3++; + ldws (pp), X ; X=*(pp) + add,nuv X, dm, dm ; dm+=X; + ldo 1(X3), X3 ; if overflow X3++; + stwm dm, 4(pp) ; *(pp++)=dm + addib,>,n -1, ml, L$BMD3 ; if ((--ml)>0) goto L$BMD3 + copy X3, dm ; dm=X3 + + ldo -1(pl1), pl1 ; pl1-- + ldi 0, dm ; dm=0 + ldw (pp), X ; X=*pp + add,nuv X, X3, X ; X+= X3 + ldi 1, dm ; if overflow dm=1; + comb,= dm, %r0, L$BMD7 ; if (dm==0) goto L$BMD7 + stwm X, 4(pp) ; *(pp++)=X + comb,=,n pl1, %r0, L$BMD9 ; if (pl1==0) goto L$BMD9 + ldw (pp), X +L$BMD4 addi,uv 1, X, X ; X++ + b L$BMD7 ; if no overflow goto L$BMD7 + stwm X, 4(pp) ; *(pp++)=X + addib,>,n -1, pl1, L$BMD4 ; if ((--pl1)>0) goto L$BMD4 + ldw (pp), X ; X=*(pp) +L$BMD9 b L$BMD8 ; return(1) + ldi 1, res +L$BMD7 ldi 0, res ; return(0) +L$BMD8 .LEAVE + .PROCEND + +; conventions for BnnDivideDigit +qq .REG %r3 +nn .REG %r4 +nl .REG %r5 +dd .REG %r6 +ch .REG %r7 +cl .REG %r8 +k .REG %r9 +f_qq .REG %r10 +o_nl .REG %r11 +rh .REG %r12 +rl .REG %r13 +ph .REG %r14 +pl .REG %r15 +qa .REG %r16 +fcl .REG %fr5L +fch .REG %fr6L +fqa .REG %fr7L + + + + .SPACE $TEXT$ + .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24 +BnnDivideDigit + .PROC + .CALLINFO CALLER, FRAME=0, ENTRY_GR=16, SAVE_RP + .ENTER ; (qq, nn, nl, dd) + copy %arg0, qq ; qq=%arg0 + copy %arg1, nn ; nn=%arg1 + copy %arg2, nl ; nl=%arg2 + copy %arg3, dd ; dd=%arg3 + .CALL ;in=%arg0 ;out=%ret0 ; res=BnnNumLeadingZeroBitsInDigit(dd) + bl BnnNumLeadingZeroBitsInDigit, %r2 + copy dd, %arg0 + comib,= 0, res, L$BDD1 ; k=res; if (k==0) goto L$BDD1 + copy res, k + ldw (qq), f_qq ; f_qq=*qq + copy nl, o_nl ; o_nl=nl + subi 32, k, X + mtsar X + vshd dd, %r0, dd ; dd<<=k + copy nn, %arg0 + copy nl, %arg1 + .CALL ;in=%arg0, %arg1, %arg2 ; out=%ret0 + bl BnnShiftLeft, %r2 ; BnnShiftLeft(nn, nl, k) + copy k, %arg2 + +L$BDD1 shd nl, %r0, 30, X ; X=nl<<2 + add nn, X, nn ; nn+=nl + addi -1, nl, nl ; nl-- + shd nl, %r0, 30, X ; X=nl<<2 + add qq, X, qq ; qq+=nl + extru dd, 15, 16, ch ; ch=dd>>16 + extru dd, 31, 16, cl ; cl=dd & (2^16-1) + ldo -48(%r30), %r21 + stws cl, 0(0, %r21) + fldws 0(0, %r21), fcl + stws ch, 0(0, %r21) + fldws 0(0, %r21), fch + comib,= 0, nl, L$BDD3 ; if (nl==0) goto L$BDD3 + ldwm -4(nn), rl ; rl=*(--nn) + +L$BDD2 copy rl, rh ; rh=rl + ldwm -4(nn), rl ; rl=*(--nn) + + copy rh, %arg0 + .CALL ;in=25,26;out=29; (MILLICALL) + bl $$divU,%r31 ; %r29=rh/ch + copy ch, %arg1 + copy %r29, qa ; qa=%r29 + + stws qa, 0(0, %r21) + fldws 0(0, %r21), fqa + xmpyu fcl, fqa, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), pl + xmpyu fch, fqa, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), %r29 + + shd %r0, pl, 16, X ; X=pl>>16 + add %r29, X, ph ; ph=X+%r29 + comb,>> ph, rh, L$BDD84 ; if (ph>rh) goto L$BDD84 + shd pl, %r0, 16, pl ; pl<<=16 + comb,<> ph, rh, L$BDD88 ; if (ph!=rh) goto L$BDD88 + nop + comb,<<=,n pl, rl, L$BDD88 ; if (pl<=rl) goto L$BDD88 +L$BDD84 shd cl, %r0, 16, X ; X = cl << 16 +L$BDD85 comb,<<= X, pl, L$BDD86 ; if (X<=pl) goto L$BDD86 + addi -1, qa, qa ; qa-- + addi -1, ph, ph ; ph-- +L$BDD86 sub pl, X, pl ; pl-=X + sub ph, ch, ph ; ph-=ch + comb,>> ph, rh, L$BDD85 ; if (ph>rh) goto L$BDD85 + nop + comb,<> ph, rh, L$BDD88 ; if (ph!=rh) goto L$BDD88 + nop + comb,>> pl, rl, L$BDD85 ; if (pl>rl) goto L$BDD85 + nop +L$BDD88 comb,<<=,n pl, rl, L$BDD89 ; if (pl<=rl) goto L$BDD89 + addi -1, rh, rh ; rh-- +L$BDD89 sub rl, pl, rl ; rl-=pl + sub rh, ph, rh ; rh-=ph + shd qa, %r0, 16, X ; X=qa<<16 + stwm X, -4(qq) ; *(--qq)=X + shd rh, %r0, 16, X ; X=rh<<16 + shd %r0, rl, 16, qa ; qa=rl>>16 + or qa, X, qa ; qa |=X + copy qa, %arg0 + .CALL ;in=25,26;out=29; (MILLICALL) + bl $$divU,%r31 ; %r29=qa/ch + copy ch, %arg1 + copy %r29, qa ; qa=%r29 + + stws qa, 0(0, %r21) + fldws 0(0, %r21), fqa + xmpyu fcl, fqa, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), pl + xmpyu fch, fqa, %fr4 + fstws %fr4R, 0(0, %r21) + ldws 0(0, %r21), %r29 + + shd %r0, pl, 16, X ; X=pl>>16 + add %r29, X, ph ; ph+=X + extru pl, 31, 16, pl ; pl &= (2^16-1) + shd ph, %r0, 16, X ; X = ph<<16 + shd %r0, ph, 16, ph ; ph >>=16 + comb,>> ph, rh, L$BDD41 ; if (ph>rh) goto L$BDD41 + or X, pl, pl ; pl |= X + comb,<> ph, rh, L$BDD44 ; if (ph!=rh) goto L$BDD44 + nop + comb,<<= pl, rl, L$BDD44 ; if (pl<=rl) goto L$BDD44 + nop +L$BDD41 comb,<<= dd, pl, L$BDD42 ; if (dd<=pl) goto L$BDD42 + addi -1, qa, qa ; qa-- + addi -1, ph, ph ; ph-- +L$BDD42 comb,>> ph, rh, L$BDD41 ; if (ph>rh) goto L$BDD4 + sub pl, dd, pl ; pl-=dd + comb,<> ph, rh, L$BDD44 ; if (ph!=rh) goto L$BDD44 + nop + comb,>>,n pl, rl, L$BDD41 ; if (pl>rl) goto L$BDD41 + nop +L$BDD44 sub rl, pl, rl ; rl-=pl + ldw (qq), X ; X=*qq + or X, qa, X ; X |= qa + addib,> -1, nl, L$BDD2 ; if ((--nl)>0) goto L$BDD2 + stws X, (qq) ; *qq=X + + +L$BDD3 comib,= 0, k, L$BDD5 ; if (k==0) goto L$BDD5 + nop + comb,<<,n qq, nn, L$BDD31 ; if (qq<nn) goto L$BDD31 + shd o_nl, %r0, 30, Y + add nn, Y, X ; X=nn+o_nl + comb,<<= X, qq, L$BDD31 ; if (X<=qq) goto L$BDD31 + nop + sub qq, nn, o_nl ; o_nl=qq-nn + shd %r0, o_nl, 2, o_nl ; o_nl>>=2 + ldw (qq), W ; W=*qq + stws f_qq, (qq) ; *qq=f_qq + copy nn, %arg0 + addi 1, o_nl, %arg1 ; %arg1=o_nl+1 + .CALL ;in=%arg0, %arg1, %arg2 ;out=%ret0 + bl BnnShiftRight, %r2 ; BnnShiftRight(nn, o_nl, k) + copy k, %arg2 + b L$BDD5 + stws W, (qq) ; *qq=W +L$BDD31 comb,<>,n qq, nn, L$BDD32 ; if (qq<>nn) goto L$BDD32 + addi -1, o_nl, o_nl ; o_nl-- + shd o_nl, %r0, 30, o_nl ; o_nl<<=2 + add nn, o_nl, nn ; nn+=o_nl + ldi 1, o_nl +L$BDD32 copy nn, %arg0 + copy o_nl, %arg1 + .CALL ;in=%arg0, %arg1, %arg2 ;out=%ret0 + bl BnnShiftRight, %r2 ; BnnShiftRight(nn, o_nl, k) + copy k, %arg2 + +L$BDD5 mtsar k + vshd %r0, rl, res ; return(rl>>k) +L$BDD6 .LEAVE + .PROCEND + + + .SPACE $TEXT$ + .SUBSPA $LIT$,QUAD=0,ALIGN=8,ACCESS=44,SORT=16 +$THIS_LIT$ + + .SUBSPA $LITSTATIC$,QUAD=0,ALIGN=8,ACCESS=44,SORT=16 +$THIS_LITSTATIC$ + + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SUBSPA $CODE$ + .SPACE $PRIVATE$,SORT=16 + .SUBSPA $DATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=16 +$THIS_DATA$ + + .SUBSPA $SHORTDATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=16 +$THIS_SHORTDATA$ + + .SUBSPA $BSS$,QUAD=1,ALIGN=8,ACCESS=31,ZERO,SORT=82 +$THIS_BSS$ + + .SUBSPA $SHORTBSS$,QUAD=1,ALIGN=8,ACCESS=31,ZERO,SORT=80 +$THIS_SHORTBSS$ + + .SUBSPA $STATICDATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=16 +$THIS_STATICDATA$ + .ALIGN 4 + .STRINGZ "@(#)KerN.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\n" + .SUBSPA $SHORTSTATICDATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=24 +$THIS_SHORTSTATICDATA$ + + .SPACE $TEXT$ + .SUBSPA $CODE$ + .EXPORT BnnSetToZero,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR + .IMPORT bzero,CODE + .SUBSPA $CODE$ + .EXPORT BnnAssign,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR + .IMPORT bcopy,CODE + .SUBSPA $CODE$ + .EXPORT BnnSetDigit,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR + .SUBSPA $CODE$ + .EXPORT BnnGetDigit,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnNumDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnNumLeadingZeroBitsInDigit,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnDoesDigitFitInWord,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnIsDigitZero,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnIsDigitNormalized,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnIsDigitOdd,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnCompareDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnComplement,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR + .SUBSPA $CODE$ + .EXPORT BnnAndDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR + .SUBSPA $CODE$ + .EXPORT BnnOrDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR + .SUBSPA $CODE$ + .EXPORT BnnXorDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR + .SUBSPA $CODE$ + .EXPORT BnnShiftLeft,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnShiftRight,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnAddCarry,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnAdd,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnSubtractBorrow,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnSubtract,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR + .SUBSPA $CODE$ + .EXPORT BnnMultiplyDigit,ENTRY,PRIV_LEV=0,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR + .IMPORT $$mulU,MILLICODE + .SUBSPA $CODE$ + .EXPORT BnnDivideDigit,ENTRY,PRIV_LEV=0,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR + .IMPORT $$divU,MILLICODE + .IMPORT $$remU,MILLICODE + .END diff --git a/otherlibs/num/bignum/s/i960KerN.s b/otherlibs/num/bignum/s/i960KerN.s new file mode 100644 index 000000000..2a23b6489 --- /dev/null +++ b/otherlibs/num/bignum/s/i960KerN.s @@ -0,0 +1,928 @@ +/* +** (c) Copyright 1989 Digital Equipment Corporation +** +** Last modified_on Mon Apr 9 20:18:11 GMT+2:00 1990 by shand +** modified_on Tue Apr 3 19:48:27 GMT+2:00 1990 by sills@notok.enet.dec.com +** +** KerN for 80960KA +** +** Author: Glenn Sills +** Date: 1.1 +** Version: 1 +** +*/ + + +/* +** BnnSetToZero(nn, nl) +** BigNum nn; +** int nl; +** +** Set all of the digits specified by nn length nl to zero +** +** nn -> g0 +** nl -> g1 +*/ + +.file "kern.s" +.text +.align 2 +.globl _BnnSetToZero +.leafproc _BnnSetToZero + +_BnnSetToZero: + mov g14,g7 /* Preserve the return address */ + ldconst 0,g14 /* Must always load g14 with 0 for*/ + /* branch and link procs */ + + cmpobe 0,g1,.bstzxt /* if (!nl) return */ + + subo 1,g1,g1 + shlo 2,g1,g1 /* Do some pointer arithmetic */ + addc g0,g1,g1 /* nl = nn + nl*byte_per_digit */ + /* (I happen to know that */ + /* bytes_per_digit is 4 on 960 */ + +.bstzlp: /* Do { */ + ldconst 0,g3 + st g3,(g0) /* *nn = 0 */ + addc 4,g0,g0 /* } while (++nn <= nl) */ + cmpoble g0,g1,.bstzlp + +.bstzxt: + bx (g7) /* Return voidly */ + +/* +** void BnnAssign(mm, nn, nl) +** Bignum mm, nn; +** int nl; +** +** Copies nn to mm. We copy from back to front to defend against +** over lapping bignums. +** +** mm -> g0 +** nn -> g1 +** nl -> g2 +*/ + +.globl _BnnAssign +.leafproc _BnnAssign + +_BnnAssign: + mov g14,g7 /* Mandatory saving of g14 */ + cmpo 0,g2 + mov 0,g14 + be .baexit + subo 1,g2,g2 /* Prepare for some pointer */ + cmpo g0,g1 + shlo 2,g2,g2 /* Arithmetic */ + be .baexit /* if (mm == nn) exit */ + /* if (mm >> nn) */ + bg .balast1 /* then */ + /* Copy from last to first */ + + addo g2,g1,g2 + +.ba1last: + ld (g1),g3 + addo 4,g1,g1 /* *mm++ == *nn++ */ + st g3,(g0) + addo 4,g0,g0 + cmpo g1,g2 + ble .ba1last /* while (nl > 0) */ + bx (g7) + +.balast1: + mov g1,g4 + addo g2,g0,g0 + addo g2,g1,g1 /* nn += nl */ + +.baloop: + ld (g1),g3 + subo 4,g1,g1 /* *mm-- == *nn-- */ + st g3,(g0) + subo 4,g0,g0 + cmpo g1,g4 + bge .baloop + +.baexit: + bx (g7) /* Return voidly */ + + +/* +** void BnnSetDigit(nn,d) +** BigNum nn; +** int d; +** +** Sets a single digit of N to the passed value +** +** g0 -> nn +** g1 -> d +** +*/ + +.globl _BnnSetDigit +.leafproc _BnnSetDigit +.align 2 + +_BnnSetDigit: + mov g14,g7 /* Mandatory saving of g14 */ + ldconst 0,g14 + + st g1,(g0) /* *nn = d */ + bx (g7) /* Return ustedes */ + + +/* +** BigNumDigit BnnGetDigit (nn) +** BigNum nn; +** +** Returns digit pointed to by nn +** +** g0 -> nn +*/ + +.globl _BnnGetDigit +.leafproc _BnnGetDigit +.align 2 + +_BnnGetDigit: + mov g14,g7 + ldconst 0,g14 + + ld (g0),g0 + bx (g7) + + +/* +** BigNumLength BnnNumDigits(nn, nl) +** Bignum nn; +** int nl; +** +** Returns the total number of digits in nn not counting leading +** zeros. +** +** g0 -> nn +** g1 -> nl +** +*/ + +.globl _BnnNumDigits +.leafproc _BnnNumDigits + +_BnnNumDigits: + mov g14,g7 + ldconst 0,g14 + + +.bndnot0: + subo 1,g1,g2 + shlo 2,g2,g2 + addo g0,g2,g0 + +.bndloop: + cmpobe 0,g1,.bndret1 /* while (nl && *nn == 0) */ + ld (g0),g3 + cmpobne 0,g3,.bndrett /* --nl; */ + subo 4,g0,g0 + subo 1,g1,g1 + b .bndloop + +.bndret1: + ldconst 1,g0 /* If nl == 0 return 1 */ + bx (g7) + +.bndrett: + mov g1,g0 + bx (g7) + + +/* +** BigNumDigit BnnNumLeadingZeroBitsInDigit(d) +** BigNumDigit d; +** +** How many leading zero bits are there in the digit? HUH??? +** +** g0 -> d; +** +*/ + +.globl _BnnNumLeadingZeroBitsInDigit +.leafproc _BnnNumLeadingZeroBitsInDigit + +_BnnNumLeadingZeroBitsInDigit: + mov g14,g7 + ldconst 0,g14 + + scanbit g0, g1 + bo .bzidnz + ldconst 32,g0 + bx (g7) + +.bzidnz: + subo g1,31,g0 + + bx (g7) + +/* +** Boolean BnnDoesDigitFitInWord(d) +** BigNumDigit d; +** +** Returns true if the digit d can fit in BNN_WORD_SIZE bits. +** On the 80960, it always can. +** +** g0 -> d +*/ +.globl _BnnDoesDigitFitInWord +.leafproc _BnnDoesDigitFitInWord + +_BnnDoesDigitFitInWord: + + mov g14,g7 + ldconst 0,g14 + + ldconst 1,g0 + bx (g7) + + +/* +** Boolean BnnIsDigitZero (d) +** BigNumDigit d; +** +** Returns TRUE iff digit = 0. We can do this! +** +** +** g0 -> d +** +*/ + +.globl _BnnIsDigitZero +.leafproc _BnnIsDigitZero + +_BnnIsDigitZero: + + mov g14,g7 + ldconst 0,g14 + + cmpobne 0,g0, .bidz1 + ldconst 1,g0 + bx (g7) + +.bidz1: + ldconst 0,g0 + bx (g7) + + + +/* +** Boolean BnnIsDigitNormalized (d) +** BigNumDigit d +** +** Returns TRUE iff Base/2 <= digit < Base +** i.e., if digit's leading bit is 1 +** +** g0 -> d +*/ + +.globl _BnnIsDigitNormalized +.leafproc _BnnIsDigitNormalized + +_BnnIsDigitNormalized: + + mov g14,g7 + ldconst 0,g14 + + scanbit g0,g0 + cmpobe 31,g0,.bidnt + ldconst 0,g0 + bx (g7) + +.bidnt: + ldconst 1,g0 + bx (g7) + + +/* +** Boolean BnnIsDigitOdd (d) +** BigNumDigit d; +** +** Returns TRUE iff digit is odd +** +** g0 -> d +*/ + +.globl _BnnIsDigitOdd +.leafproc _BnnIsDigitOdd + +_BnnIsDigitOdd: + mov g14,g7 + ldconst 0, g14 + + and 1, g0, g0 + bx (g7) + + +/* +** BigNumCmp BnnCompareDigits (d1, d2) +** BigNumDigit d1, d2 +** +** Compares digits and returns +** +** BNN_GREATER d1 > d2 +** BNN_EQUAL d1 == d2 +** BNN_LESS d1 < d2 +** +** g0 -> d1 +** g1 -> d2 +*/ + +.globl _BnnCompareDigits +.leafproc _BnnCompareDigits + +_BnnCompareDigits: + + mov g14,g7 + ldconst 0,g14 + + cmpobe g0,g1,.bcdequal + bg .bcdgreater + ldconst -1,g0 /* BNN_LESS */ + bx (g7) + +.bcdequal: + ldconst 0,g0 /* BNN_EQUAL */ + bx (g7) + +.bcdgreater: + ldconst 1,g0 /*BNN_GREATER */ + bx (g7) + + + +/* +** BnnComplement(nn, nl) +** BigNum nn +** int nl +** +** Complement nn and store result in nn +** +** g0 -> nn +** g1 -> nl +** +*/ + +.globl _BnnComplement +.leafproc _BnnComplement + +_BnnComplement: + + mov g14,g7 + ldconst 0,g14 + + cmpobe 0,g1,.bcexit + + subo 1,g1,g1 + shlo 2,g1,g1 + addo g1,g0,g1 + + ldconst 0xffffffff,g3 +.bcloop: + ld (g0),g2 + xor g3,g2,g2 + st g2, (g0) + addo 4,g0,g0 + cmpoble g0,g1,.bcloop + +.bcexit: + bx (g7) + + +/* +** BnnAndDigits(n,d) +** BigNum nn +** BigNumDigit d +** +** And the digit d with the first digit in n +** +** g0 -> nn +** g1 -> d +** +*/ + +.globl _BnnAndDigits +.leafproc _BnnAndDigits + +_BnnAndDigits: + mov g14,g7 + ldconst 0,g14 + + ld (g0),g2 + and g1,g2,g2 + st g2,(g0) + + bx (g7) + + +/* +** BnnOrDigits(n,d) +** BigNum nn +** BigNumDigit d +** +** Returns the logical computation nn[0] |= d; +** +** g0 -> nn +** g1 -> d +** +*/ + +.globl _BnnOrDigits +.leafproc _BnnOrDigits + +_BnnOrDigits: + mov g14,g7 + ldconst 0,g14 + + ld (g0),g2 + or g1,g2,g2 + st g2,(g0) + + bx (g7) + + +/* +** void BnnXorDigits (n, d) +** BigNum n +** BigNumDigit d +** +** Returns the logical computation n[0] XOR d in n[0] +** +** g0 -> n +** g1 -> d +** +*/ + +.globl _BnnXorDigits +.leafproc _BnnXorDigits + +_BnnXorDigits: + mov g14,g7 + ldconst 0,g14 + + ld (g0),g2 + xor g1,g2,g2 + st g2,(g0) + + bx (g7) + + +/* +** BigNumDigit BnnShiftLeft (mm, ml, nbits) +** BigNum mm +** int ml +** int nbits +** +** Shifts M left by "nbits", filling with 0s. +** Returns the leftmost "nbits" of M in a digit. +** Assumes 0 <= nbits < BNN_DIGIT_SIZE. +** +** g0 -> mm +** g1 -> ml +** g2 -> nbits +*/ + +.globl _BnnShiftLeft +.leafproc _BnnShiftLeft + +_BnnShiftLeft: + + mov g14,g7 + ldconst 0,g14 + cmpo 0,g1 + be .bslexit0 + subo 1,g1,g1 + shlo 2,g1,g1 + addo g1,g0,g1 /* nl += nn i.e. get the final address */ + mov g0,g3 /* Save beginning of mm */ + ldconst 0,g0 /* pre-load result with 0 */ + cmpo 0,g2 + be .bslexit + ldconst 32,g6 /* BNN_DIGIT_SIZE */ + subo g2,g6,g6 + +.blsloop: + ld (g3),g4 /* Access *mm */ + shlo g2,g4,g5 /* *mm == (*mm << nbits) */ + or g5,g0,g5 /* or in remaining bits from last op */ + st g5,(g3) /* save the stuff */ + shro g6,g4,g0 /* Save the left over high bits */ + /* for the next time through the loop */ + addo 4,g3,g3 /* Increment to next address */ + cmpi g3,g1 + ble .blsloop + +.bslexit: + bx (g7) /* Note that g0 holds bits that where */ + /* Shifted out at the end */ + +.bslexit0: + mov 0,g0 + bx (g7) +/* +** BigNumDigit BnnShiftRight (mm, ml, nbits) +** BigNum mm; +** int ml; +** int nbits; +** +** Shifts M right by "nbits", filling with 0s. +** Returns the rightmost "nbits" of M in a digit. +** Assumes 0 <= nbits < BNN_DIGIT_SIZE. +** +** g0 -> mm +** g1 -> ml +** g2 -> nbits +** +** Returns result in g0 +** +*/ +.globl _BnnShiftRight +.leafproc _BnnShiftRight + +_BnnShiftRight: + mov g14,g7 + ldconst 0,g14 + mov g0,g3 /*Save mm in g3 and preload result */ + ldconst 0,g0 + + cmpobe 0,g1,.bsrexit /* If this is a zero length Bignum or */ + cmpobe 0,g2,.bsrexit /* there are no bits to shift, exit */ + + subo 1,g1,g1 /* Prepare for pointer arithmetic */ + shlo 2,g1,g1 + addo g3,g1,g1 /*Point to the last element in the array*/ + + + ldconst 32,g8 /* BNN_DIGIT_SIZE */ + subo g2,g8,g6 + +.bsrloop: + ld (g1),g4 /* *mm = (*mm >> nbits)| leftover bits */ + /* from the last time through the loop */ + shro g2,g4,g5 + or g0,g5,g5 + st g5,(g1) + shlo g6,g4,g0 + subo 4,g1,g1 + cmpobge g1,g3,.bsrloop + +.bsrexit: + bx (g7) /* Bits shifted out are still in g0! */ + + +/* +** BigNumCarry BnnAddCarry (nn, nl, carryin) +** BigNum nn; +** int nl; +** BigNumCarry carryin; +** +** Performs the sum N + CarryIn => N. Returns the CarryOut. +** +** g0 -> nn +** g1 -> nl +** g2 -> carryin +** +** Result is in g0 +** +*/ + +.globl _BnnAddCarry +.leafproc _BnnAddCarry + +_BnnAddCarry: + mov g14,g7 + ldconst 0,g14 + + cmpobe 0,g2,.bacexit0 /* If carry == 0 return 0 */ + cmpobe 0,g1,.bacexit1 /* If nl == 0 return 1 */ + +.bacloop: + subo 1,g1,g1 /* --nl */ + ld (g0),g3 /* g3= *nn */ + addo 1,g3,g3 /* ++g3 */ + st g3,(g0) /* *nn = g3 */ + addo 4,g0,g0 /* ++nn */ + cmpobne 0,g3,.bacexit0 /* if (g3) then return 0 */ + cmpibl 0,g1,.bacloop /* If (nl) continue loop */ + +.bacexit1: + ldconst 1,g0 + bx (g7) + +.bacexit0: + ldconst 0,g0 + bx (g7) + + + + +/* +** BigNumCarry BnnSubtractBorrow (nn, nl, carryin) +** BigNum nn; +** int nl; +** BigNumCarry carryin; +** +** Performs the difference N + CarryIn - 1 => N. Returns the CarryOut. +** +** g0 -> nn +** g1 -> nl +** g2 -> carryin +*/ + +.globl _BnnSubtractBorrow +.leafproc _BnnSubtractBorrow + +_BnnSubtractBorrow: + mov g14,g7 + ldconst 0,g14 + + cmpibe 1,g2,.bsbexit1 /* If Carry return 1 */ + cmpobe 0,g1,.bsbexit0 /* If (!nl) return 0 */ + +.bsbloop: + subi 1,g1,g1 /* --nl */ + ld (g0),g3 /* g3 = *nn */ + mov g3,g5 /* g5 = *nn */ + subo 1,g3,g3 /* --g3 */ + st g3,(g0) /* *nn = g3 */ + addo 4,g0,g0 + cmpobne 0,g5,.bsbexit1 + cmpibl 0,g1,.bsbloop + +.bsbexit0: + ldconst 0,g0 + bx (g7) + +.bsbexit1: + ldconst 1,g0 + bx (g7) + + + +/* +** BigNumCarry BnnSubtract (mm, ml, nn, nl, carryin) +** BigNum mm, nn; +** int ml; +** int nl; +** BigNumCarry carryin; +** +** Performs the difference M - N + CarryIn - 1 => M. +** Returns the CarryOut. +** Assumes Size(M) >= Size(N). +** +** g0 -> mm +** g1 -> ml +** g2 -> nn +** g3 -> nl +** g4 -> carryin +** +*/ + +.globl _BnnSubtract + + +_BnnSubtract: + subo g3,g1,g1 + cmpibe 0,g3,.bslpe /* While (--nl >= 0) */ + + ldconst -1,r5 +.bsloop: + subi 1,g3,g3 + ld (g0),g5 /* g5 = *mm */ + ld (g2),g6 /* g6 = *nn */ + xor r5,g6,g6 /* g6 = (*nn) ^ -1 */ + addo g4,g5,g4 /* c += *mm */ + cmpobge g4,g5,.bsgt /* if (c < *mm) { */ + mov g6,g5 /* *mm = invn */ + ldconst 1,g4 /* c = 1 */ + b .cleanup /* } */ +.bsgt: + addo g4,g6,g4 /* else { c += g6 */ + mov g4,g5 /* *mm = c */ + cmpobl g4,g6, .bsset1 /* if (c < g6) then c=1 */ + ldconst 0,g4 /* else c = 0 */ + b .cleanup /* } */ +.bsset1: + ldconst 1,g4 + +.cleanup: + st g5,(g0) + addo 4,g0,g0 + addo 4,g2,g2 + cmpibl 0,g3,.bsloop /* While (--nl >= 0) */ + +.bslpe: + mov g4,g2 + lda .bsexit,g14 + bal _BnnSubtractBorrow + +.bsexit: + ret + + +/* +** BigNumCarry BnnMultiplyDigit (pp, pl, mm, ml, d) + +** BigNum pp, mm; +** int pl, ml; +** BigNumDigit d; +** +** Performs the product: +** Q = P + M * d +** BB = BBase(P) +** Q mod BB => P +** Q div BB => CarryOut +** Returns the CarryOut. +** Assumes Size(P) >= Size(M) + 1. +** +** +** g0 -> pp +** g1 -> pl +** g2 -> mm +** g3 -> ml +** g4 -> d +*/ + +.globl _BnnMultiplyDigit + +_BnnMultiplyDigit: + cmpo 0,g4 + be .bmdexit0 /* if the multiplier is 0 */ + cmpo 1,g4 + be .bmdbnnadd + subo g3,g1,g1 /* pl -= ml */ + mov 0,g6 /* Carry = 0 */ + cmpo 0,g3 + mov 0,g7 + be .bmdbye /* While (m--) */ + +.bmdlp1: + ld (g2),r3 /* r3 = *mm */ + subo 1,g3,g3 + ld (g0),r4 /* r4 = *p */ + /* r5 = *(p++) */ + emul g4,r3,r6 /* r6-r7 = *mm x d */ + cmpo 1,0 /* Clear the carry bit */ + addc r4,r6,r6 + addc 0,r7,r7 + addc r6,g6,g6 + addc r7,g7,g7 + st g6,(g0) /* *p = C */ + mov g7,g6 /* c >> = BN_DIGIT_SIZE */ + addo 4,g0,g0 + mov 0,g7 + addo 4,g2,g2 + cmpo 0,g3 + bl .bmdlp1 /* While (m--) */ + + cmpobl 0,g1, .bmdlp2 + mov g6,g0 + ret + +.bmdlp2: + ld (g0),r4 + cmpo 1,0 + addc g6,r4,g6 + addc 0,g7,g7 + st g6,(g0) + mov g7,g6 + subo 1,g1,g1 + mov 0,g7 + addo 4,g0,g0 + cmpobl 0,g1,.bmdlp2 + mov g6,g0 + ret + + +.bmdbye: + mov 0,g0 + ret + +.bmdexit0: + mov 0,g0 /* its a sure bet the result */ + ret + +.bmdbnnadd: + mov 0,g4 /* Just add the 2 bignums */ + call _BnnAdd /* of adding the 2 */ + ret + + +/* +** BigNumDigit BnnDivideDigit (qq, nn, nl, d) +** BigNum qq, nn; +** int nl; +** BigNumDigit d; +** +** Performs the quotient: N div d => Q +** Returns R = N mod d +** Assumes leading digit of N < d, and d > 0. +** +** g0 -> qq +** g1 -> nn +** g2 -> nl +** g3 -> d +*/ + +.globl _BnnDivideDigit +.leafproc _BnnDivideDigit + +_BnnDivideDigit: + mov g14,g7 /* Do standard leafproc stuff */ + ldconst 0,g14 + cmpo 0,g2 + be .bddret0 /* Is this a Null length BIGNUM? */ + cmpo 0,g3 + be .bddret0 /* Is the divisor zero? */ + +.bddndz: + subo 1,g2,g2 + shlo 2,g2,g5 + addo g1,g5,g1 /* nn += nl */ + subo 4,g5,g5 /* --nl */ + addo g0,g5,g0 /* qq += nl */ + ld (g1),g9 /* Preset remainder */ + subo 4,g1,g1 /* --nn */ + cmpo 0,g2 + be .bddexit +.bddloop: + subo 1,g2,g2 /* --nl */ + ld (g1),g8 /* LSB of quad is next digit */ + ediv g3,g8,g8 /* remainder =quad%d, */ + st g9,(g0) /* *qq = quad/d */ + subo 4,g0,g0 /* --qq */ + subo 4,g1,g1 /* --nn */ + cmpo 0,g2 + mov g8,g9 + bne .bddloop /* } */ + +.bddexit: + mov g9,g0 /* Return (remainder) */ + bx (g7) + +.bddret0: + mov 0,g0 + bx (g7) + + +/* +** BigNumCarry BnnAdd (mm, ml, nn, nl, carryin) +** BigNum mm, nn; +** int ml; +** int nl; +** BigNumCarry carryin; +** +** Performs the sum M + N + CarryIn => M. +** Returns the CarryOut. Assumes Size(M) >= Size(N). +** +** g0 -> mm +** g1 -> ml +** g2 -> nn +** g3 -> nl +** g4 -> caryin; +** +** Result is in g0 and M (of course!) +*/ + +.text +.align 2 +.globl _BnnAdd + +_BnnAdd: + + + subo g3,g1,g1 /* ml -= nl */ + shlo 1,g4,g4 + cmpobe 0,g3,.bafni /* if (!nl) */ + + +.balp: + modac 02,g4,g4 + ld (g0),g5 /* g5 = *mm */ + ld (g2),g6 /* g6 = *nn */ + addc g6,g5,g7 /* g7 = *m + *n */ + modac 00,00,g4 /* Save the carry bit */ + st g7,(g0) /* *m = g7 */ + addo 4,g0,g0 /* ++m */ + addo 4,g2,g2 /* ++n */ + subi 1,g3,g3 /* --nl */ + cmpobl 0,g3,.balp + +.bafni: + shro 1,g4,g4 + and 01,g4,g2 + lda .bazit,g14 + bal _BnnAddCarry + +.bazit: + ret + + diff --git a/otherlibs/num/bignum/s/mipsKerN.s b/otherlibs/num/bignum/s/mipsKerN.s new file mode 100644 index 000000000..672312ff8 --- /dev/null +++ b/otherlibs/num/bignum/s/mipsKerN.s @@ -0,0 +1,1382 @@ + # Copyright Digital Equipment Corporation & INRIA 1988, 1989 + # Last modified_on Tue Jul 31 17:48:45 GMT+2:00 1990 by shand + # modified_on Fri Mar 2 16:53:50 GMT+1:00 1990 by herve + # + # KerN for Mips + # Paul Zimmermann & Robert Ehrlich & Bernard Paul Serpette + # & Mark Shand + # + .text + .align 2 + .globl BnnSetToZero + .ent BnnSetToZero # (nn nl) +BnnSetToZero: + .frame $sp, 0, $31 + sll $9,$5,2 # nl <<= 2; + beq $5,$0,BSTZ2 # if(nl == 0) goto BSTZ2; + andi $8,$9,0x1c + lw $10,BSTZTable($8) + addu $9,$4 # nl += nn; + addu $4,$8 + j $10 +BSTZE8: +BSTZLoop: addu $4,32 # nn++; + sw $0,-32($4) # *nn = 0; +BSTZE7: sw $0,-28($4) +BSTZE6: sw $0,-24($4) +BSTZE5: sw $0,-20($4) +BSTZE4: sw $0,-16($4) # *nn = 0; +BSTZE3: sw $0,-12($4) +BSTZE2: sw $0,-8($4) +BSTZE1: sw $0,-4($4) + bne $4,$9,BSTZLoop # if(nn != nl) goto BSTZLoop; +BSTZ2: j $31 # return; + .rdata +BSTZTable: + .word BSTZE8 + .word BSTZE1 + .word BSTZE2 + .word BSTZE3 + .word BSTZE4 + .word BSTZE5 + .word BSTZE6 + .word BSTZE7 + .text + .end BnnSetToZero + + .align 2 + .globl BnnAssign + .ent BnnAssign # (mm nn nl) +BnnAssign: + .frame $sp, 0, $31 + ble $4,$5,BAG2 # if(mm <= nn) goto BAG2; + sll $12,$6,2 # X = nl << 2; + addu $4,$12 # mm += X; + addu $5,$12 # nn += X; + b BAG4 # goto BAG4; +BAG1: lw $12,($5) # X = *(nn); + sw $12,($4) # *(mm) = X + addu $4,4 # mm++; + addu $5,4 # nn++; + subu $6,1 # nl--; +BAG2: bnez $6,BAG1 # if(nl) goto BAG1; + j $31 # return; +BAG3: subu $4,4 # mm--; + subu $5,4 # nn--; + lw $12,($5) # X = *(nn); + sw $12,($4) # *(mm) = X; + subu $6,1 # nl--; +BAG4: bnez $6,BAG3 # if(nl) goto BAG3; + j $31 # return; + .end BnAssign + + .align 2 + .globl BnnSetDigit + .ent BnnSetDigit # (nn d) +BnnSetDigit: + sw $5,0($4) # *nn = d; + j $31 # return; + .end BnnSetDigit + + .align 2 + .globl BnnGetDigit + .ent BnnGetDigit # (nn) +BnnGetDigit: + lw $2,0($4) # return(*nn); + j $31 + .end BnnGetDigit + + .align 2 + .globl BnnNumDigits + .ent BnnNumDigits # (nn nl) +BnnNumDigits: + .frame $sp, 0, $31 + sll $12,$5,2 + addu $4,$12 # nn = &nn[nl]; + b BND2 # goto BND2; +BND1: subu $5,1 # nl--; + subu $4,4 # nn--; + lw $12,0($4) # X = *nn; + bnez $12,BND3 # if(X) goto BND3; +BND2: bnez $5,BND1 # if(nl) goto BND1; + li $2,1 # return(1); + j $31 +BND3: addu $2,$5,1 # return(nl); + j $31 + .end BnnNumDigits + + .align 2 + .globl BnnNumLeadingZeroBitsInDigit + .ent BnnNumLeadingZeroBitsInDigit # (d) +BnnNumLeadingZeroBitsInDigit: + .frame $sp, 0, $31 + move $2,$0 # p = 0; + bne $4,0,BLZ2 # if(!d) goto BLZ2; + li $2,32 # return(32); + j $31 +BLZ1: addu $2,1 # p++; + sll $4,1 # d <<= 1; +BLZ2: bgtz $4,BLZ1 # while (d>0) goto BLZ1 + j $31 # return(p); + .end BnnNumLeadingZeroBitsInDigit + + .align 2 + .globl BnnDoesDigitFitInWord + .ent BnnDoesDigitFitInWord # (d) +BnnDoesDigitFitInWord: + .frame $sp, 0, $31 + li $2,1 # return(1); + j $31 + .end BnnDoesDigitFitInWord + + .align 2 + .globl BnnIsDigitZero + .ent BnnIsDigitZero # (d) +BnnIsDigitZero: + .frame $sp, 0, $31 + seq $2,$4,0 # return(d == 0); + j $31 + .end BnnIsDigitZero + + .align 2 + .globl BnnIsDigitNormalized + .ent BnnIsDigitNormalized # (d) +BnnIsDigitNormalized: + .frame $sp, 0, $31 + slt $2,$4,$0 # return(d < 0); + j $31 + .end BnnIsDigitNormalized + + .align 2 + .globl BnnIsDigitOdd + .ent BnnIsDigitOdd # (d) +BnnIsDigitOdd: + .frame $sp, 0, $31 + and $2,$4,1 # return(d & 1); + j $31 + .end BnnIsDigitOdd + + .align 2 + .globl BnnCompareDigits + .ent BnnCompareDigits # (d1 d2) +BnnCompareDigits: + .frame $sp, 0, $31 + # 254 return ((d1 > d2) - (d1 < d2)); + sltu $8,$5,$4 # t0 = (d2 < d1); + sltu $9,$4,$5 # t1 = (d1 < d2); + sub $2,$8,$9 # return t0-t1; + j $31 + .end BnnCompareDigits + + .align 2 + .globl BnnComplement + .ent BnnComplement # (nn nl) +BnnComplement: + .frame $sp, 0, $31 + sll $8,$5,2 # bytes = nl*4; + beq $5,$0,BCM2 # if(nl == 0) goto BCM2; + add $8,$4 # lim = nn+bytes; +BCM1: + lw $14,0($4) # X = *nn; + nor $14,$0 # X ^= -1; + sw $14,0($4) # *nn = X + addu $4,4 # nn++; + bne $8,$4,BCM1 # if(nl != 0) goto BCM1; +BCM2: j $31 # return; + .end BnnComplement + + .align 2 + .globl BnnAndDigits + .ent BnnAndDigits # (nn d) +BnnAndDigits: + .frame $sp, 0, $31 + lw $14,0($4) # X = *nn; + and $14,$5 # X &= d; + sw $14,0($4) # *nn = X; + j $31 # return; + .end BnnAndDigits + + .align 2 + .globl BnnOrDigits + .ent BnnOrDigits # (nn d) +BnnOrDigits: + .frame $sp, 0, $31 + lw $14,0($4) # X = *nn; + or $14,$5 # X |= d; + sw $14,0($4) # *nn = X; + j $31 # return; + .end BnnOrDigits + + .align 2 + .globl BnnXorDigits + .ent BnnXorDigits # (nn d) +BnnXorDigits: + .frame $sp, 0, $31 + lw $14,0($4) # X = *nn; + xor $14,$5 # X ^= d; + sw $14,0($4) # *nn = X; + j $31 # return; + .end BnnXorDigits + + .align 2 + .globl BnnShiftLeft + .ent BnnShiftLeft # (mm ml nbi) +BnnShiftLeft: + .frame $sp, 0, $31 + move $2,$0 # res = 0; + beq $6,0,BSL2 # if(nbi == 0) goto BSL2; + li $14,32 # rnbi = 32; + subu $14,$6 # rnbi -= nbi; + beq $5,0,BSL2 # if(ml == 0) goto BSL2; + sll $15,$5,2 # bytes = 4*ml; + addu $15,$4 # lim = mm+size; +BSL1: + lw $25,0($4) # save = *mm; + sll $24,$25,$6 # X = save << nbi; + or $24,$2 # X |= res; + sw $24,0($4) # *mm = X; + addu $4,4 # mm++; + srl $2,$25,$14 # res = save >> rnbi; + bne $4,$15,BSL1 # if(mm != lim) goto BSL1; +BSL2: j $31 # return(res); + .end BnnShiftLeft + + .align 2 + .globl BnnShiftRight + .ent BnnShiftRight # (mm ml nbi) +BnnShiftRight: + .frame $sp, 0, $31 + move $2,$0 # res = 0; + beq $6,0,BSR2 # if(nbi == 0) goto BSR2; + sll $14,$5,2 # bytes = ml*4; + beq $5,0,BSR2 # if(ml == 0) goto BSR2 + addu $15,$4,$14 # lim = mm; mm += bytes; + li $14,32 # lnbi = 32; + subu $14,$6 # lnbi -= nbi; +BSR1: + subu $15,4 # mm--; + lw $25,0($15) # save = *mm; + srl $24,$25,$6 # X = save >> nbi; + or $24,$2 # X |= res + sw $24,0($15) # *mm = X; + sll $2,$25,$14 # res = save << lnbi; + bne $15,$4,BSR1 # if(mm != lim) goto BSR1; +BSR2: j $31 # return(res); + .end BnnShiftRight + + .align 2 + .globl BnnAddCarry + .ent BnnAddCarry # (nn nl car) +BnnAddCarry: + .frame $sp, 0, $31 + beq $6,0,BAC3 # if(car == 0) return(0); + beq $5,0,BAC2 # if(nl == 0) return(1); +BAC1: subu $5,1 # nl--; + lw $9,0($4) # X = *nn; + addu $9,1 # X++; + sw $9,0($4) # *nn = X; + addu $4,4 # nn++; + bne $9,$0,BAC3 # if(X) goto BAC3; + bne $5,$0,BAC1 # if(nl) goto BAC1; +BAC2: li $2,1 # return(1); + j $31 +BAC3: li $2,0 # return(0); + j $31 + .end BnnAddCarry + + .align 2 + .globl BnnAdd + .ent BnnAdd # (mm ml nn nl car) +BnnAdd: + .frame $sp, 0, $31 + lw $2, 16($sp) # c = carryin; + subu $5,$7 # ml -= nl; + bne $7,$0,BADD1 # if(nl) goto BADD1; + bne $2,$0,BADD2 # if(c) goto BADD2; +BADD0: j $31 # return(c) +BADD1a: # carry, save == 0 + # hence (*nn == 0 && carry == 0) || (*nn == -1 && carry == 1) + # in either case, *mm++ += 0; carry is preserved + addu $4,4 # mm++; + beq $7,$0,BADD2 +BADD1: subu $7,1 # nl--; + lw $15,0($6) # save = *nn; + addu $6,4 # nn++; + addu $15,$2 # save += c; + beq $15,$0,BADD1a # if (save == 0); + # no carry + lw $10,0($4) # X = *mm; + addu $4,4 # mm++; + addu $10,$15 # X += save; + sw $10,-4($4) # mm[-1] = X + sltu $2,$10,$15 # c = (X < save); + bne $7,$0,BADD1 # if(nl) goto BADD1; + +BADD2: beq $5,0,BADD0 # if(ml == 0) return(c); + beq $2,0,BADD0 # if(c == 0) return(0); +BADD3: subu $5,1 # ml--; + lw $9,0($4) # X = *mm; + addu $9,1 # X++; + sw $9,0($4) # *mm = X; + addu $4,4 # mm++; + bne $9,$0,BADD4 # if(X) return(0); + bne $5,$0,BADD3 # if(ml) goto BADD3; + j $31 # return(1); +BADD4: move $2,$0 # return(0) + j $31 + .end BnnAdd + + .align 2 + .globl BnnSubtractBorrow + .ent BnnSubtractBorrow # (nn nl car) +BnnSubtractBorrow: + .frame $sp, 0, $31 + bne $6,0,BSB3 # if(car) return(1); + beq $5,0,BSB2 # if(nl == 0) return(0); +BSB1: subu $5,1 # nl--; + lw $9,0($4) # X = *nn; + subu $10,$9,1 # Y = X - 1; + sw $10,0($4) # *nn = Y; + addu $4,4 # nn++; + bne $9,$0,BSB3 # if(X) return(1); + bne $5,$0,BSB1 # if(nl) goto BSB1; +BSB2: li $2,0 # return(0); + j $31 +BSB3: li $2,1 # return(1); + j $31 + .end BnnSubtractBorrow + + .align 2 + .globl BnnSubtract + .ent BnnSubtract 2 # (mm ml nn nl car) +BnnSubtract: + .frame $sp, 0, $31 + subu $5,$7 # ml -= nl; + lw $2, 16($sp) # car; + xor $14,$2,1 # c = !car + bne $7,$0,BS1 # if(nl) goto BS1; + bne $2,$0,BS0 # if(!c) goto BS0 + bne $5,$0,BSB1 # if (ml != 0) goto Borrow +BS0: j $31 # $r2 == 1; return(1) +BS1a: # sub == 0 + # hence (*nn == 0 && carry == 0) || (*nn == -1 && carry == 1) + # in either case, *mm++ -= 0; carry is preserved + addu $4,4 + beq $7,$0,BS2 +BS1: subu $7,1 # nl--; + lw $12,0($6) # sub = *nn; + addu $6,4 # nn++; + addu $12,$14 # sub += c; + beq $12,$0,BS1a # if(sub == 0) goto BS1a + lw $15,0($4) # X = *mm + addu $4,4 # mm++; + subu $10,$15,$12 # Y = X-sub (sub != 0) + sw $10,-4($4) # *mm = Y + sltu $14,$15,$10 # c = (Y > X) (note: X != Y) + bne $7,$0,BS1 # if(nl) goto BS1; + +BS2: beq $14,$0,BS3 # if (!c) return (!c) + bne $5,$0,BSB1 # if (ml != 0) goto Borrow +BS3: xor $2,$14,1 # return(!c); + j $31 + .end BnnSubtract + + .align 2 + .globl BnnMultiplyDigit + .ent BnnMultiplyDigit # (pp pl mm ml d) +BnnMultiplyDigit: + .frame $sp, 0, $31 + lw $8, 16($sp) # d; + move $9,$0 # low = 0; + li $2,1 # load 1 for comparison + beq $8,0,BMD7 # if(d == 0) return(0); + move $10,$0 # carry1 = 0 + bne $8,$2,BMDFastLinkage # if(d!=1)goto BMDFastLinkage; + sw $0, 16($sp) + b BnnAdd # BnnAdd(pp, pl, mm, ml, 0); + + # FastLinkage entry point takes 5th parameter in r8 + # and two extra parameters in r9,r10 which must add to + # less than 2^32 and that are added to pp[0] + # used from BnnMultiply squaring code. +BMDFastLinkage: + subu $5,$7 # pl -= ml; + move $11,$0 # inc = 0 + # move $15,$0 save = 0; logically needed, but use is + # such that we can optimize out + beq $7,$0,BMD6 # if(ml==0) goto BMD6; + sll $7,$7,2 # ml *= 4; + addu $7,$7,$6 # ml = &mm[ml] +BMD3: lw $13,0($6) # X = *mm; + addu $6,4 # mm++; + multu $13,$8 # HI-LO = X * d; + sltu $12,$15,$11 # carry2 = (save < inc) + lw $15,0($4) # save = *pp; + addu $9,$10 # low += carry1; + addu $9,$12 # low += carry2; + addu $15,$15,$9 # save = save + low; + sltu $10,$15,$9 # carry1 = (save < low) + addu $4,4 # pp++; + mflo $11 # inc = LO; + mfhi $9 # low = HI; + addu $15,$11 # save += inc; + sw $15,-4($4) # *pp = save; + bne $7,$6,BMD3 # if(mm != ml) goto BMD3; +BMD6: sltu $12,$15,$11 # carry2 = (save < inc) + lw $15,($4) # save = *pp; + addu $9,$10 # low += carry1; + addu $9,$12 # low += carry2; + addu $9,$15 # low += save; + sw $9,0($4) # *pp = low; + addu $4,4 # pp++; + bltu $9,$15,BMD8 # if(low < save) goto BMD8; +BMD7: move $2, $0 # return(0); + j $31 +BMD8: subu $5,1 # pl--; + beq $5,0,BMD10 # if(ml == 0) return(1); +BMD9: subu $5,1 # pl--; + lw $9,0($4) # X = *pp; + addu $9,1 # X++; + sw $9,0($4) # *pp = X; + addu $4,4 # pp++; + bne $9,$0,BMD7 # if(X) return(0); + bne $5,$0,BMD9 # if(pl) goto BMD9; +BMD10: li $2,1 # return(1); + j $31 + .end BnnMultiplyDigit + + .align 2 + .globl BnnDivideDigit + .ent BnnDivideDigit # (qq nn nl d) +BnnDivideDigit: + .frame $sp, 0, $31 + move $11,$31 + move $10,$4 + move $9,$5 + move $8,$6 + move $4,$7 # k = BnnNumLeadingZeroBitsInDigit(d); + jal BnnNumLeadingZeroBitsInDigit + move $6,$2 + beq $6,$0,BDD1 # if(k == 0) goto BDD1; + move $4,$9 + move $5,$8 + jal BnnShiftLeft # BnnShiftLeft(nn, nl, k); + lw $31,0($10) # first_qq = *qq; + move $5,$8 # o_nl = nl; + sll $7,$6 # d <<= k; +BDD1: sll $3,$8,2 + addu $9,$3 # nn = &nn[nl]; + subu $8,1 # nl--; + subu $3,4 + addu $10,$3 # qq = &qq[nl]; + srl $25,$7,16 # ch = HIGH(d); + and $2,$7,65535 # cl = LOW(d); + subu $9,4 # nn--; + lw $13,0($9) # rl = *nn; + beq $8,0,BDDx # if(nl == 0) goto BDDx; +BDD2: subu $8,1 # nl--; + move $12,$13 # rh = rl; + subu $9,4 # nn--; + lw $13,0($9) # rl = *nn; + divu $14,$12,$25 # qa = rh/ch; + multu $2,$14 # HI-LO = cl * qa; + mflo $24 # pl = LO; + multu $25,$14 # HI-LO = ch * qa; + mflo $15 # ph = LO; + srl $3,$24,16 # X = HIGH(pl); + addu $15,$3 # ph += X; + sll $24,16 # pl = L2H(pl); + bgtu $15,$12,BDD84 # if(ph > rh) goto BDD84; + bne $15,$12,BDD88 # if(ph != rh) goto BDD88; + bleu $24,$13,BDD88 # if(pl <= rl) goto BDD88; +BDD84: sll $3,$2,16 # X = L2H(cl); +BDD85: subu $14,1 # qa--; + bleu $3,$24,BDD86 # if(X <= pl) goto BDD86; + subu $15,1 # ph--; +BDD86: subu $24,$3 # pl -= X; + subu $15,$25 # ph -= ch; + bgtu $15,$12,BDD85 # if(ph > rh) goto BDD85; + bne $15,$12,BDD88 # if(ph != rh) goto BDD88; + bgtu $24,$13,BDD85 # if(pl > rl) goto BDD85; +BDD88: bleu $24,$13,BDD89 # if(pl <= rl) goto BDD89; + subu $12,1 # rh--; +BDD89: subu $13,$24 # rl -= pl; + subu $12,$15 # rh -= ph; + subu $10,4 # qq--; + sll $3,$14,16 # X = L2H(qa); + sw $3,0($10) # *qq = X; + sll $3,$12,16 # X = L2H(rh); + srl $14,$13,16 # qa = HIGH(rl); + or $14,$3 # qa |= X; + divu $14,$14,$25 # qa /= ch; + multu $2,$14 # HI-LO = cl * qa; + mflo $24 # pl = LO; + multu $25,$14 # HI-LO = ch * qa; + mflo $15 # ph = LO; + srl $3,$24,16 # X = HIGH(pl); + addu $15,$3 # ph += X; + and $24,65535 # pl = LOW(pl); + and $3,$15,65535 # X = LOW(ph); + sll $3,16 # X = L2H(X) + or $24,$3 # pl |= X; + srl $15,16 # ph = HIGH(ph); + bgtu $15,$12,BDD41 # if(ph > rh) goto BDD841; + bne $15,$12,BDD44 # if(ph != rh) goto BDD44; + bleu $24,$13,BDD44 # if(pl <= rl) goto BDD44; +BDD41: subu $14,1 # qa--; + bleu $7,$24,BDD42 # if(d <= pl) goto BDD42; + subu $15,1 # ph--; +BDD42: subu $24,$7 # pl -= d; + bgtu $15,$12,BDD41 # if(ph > rh) goto BDD841; + bne $15,$12,BDD44 # if(ph == rh) goto BDD44; + bgtu $24,$13,BDD41 # if(pl > rl) goto BDD41; +BDD44: subu $13,$24 # rl -= pl; + lw $3,0($10) # X = *qq; + or $3,$14 # X |= qa + sw $3,0($10) # *qq = X; + bne $8,0,BDD2 +BDDx: beq $6,0,BDD46 # if(k = 0) goto BDD46; + bleu $10,$9,BDD45 # if(qq < nn) goto BDD45; + sll $3,$5,2 + addu $3,$9 # X = &nn[o_nl]; + bleu $3,$10,BDD45 # if(X <= qq) goto BDD45; + subu $5,$10,$9 # o_nl = qq - nn; + srl $5,2 # o_nl >>= 2; + lw $8,0($10) # X = *qq; + sw $31,0($10) # *qq = first_qq; + addu $5,1 # o_nl++; + move $4,$9 # BnnShiftRight(nn, o_nl, k); + jal BnnShiftRight + sw $8,0($10) # X = *qq; + srl $2,$13,$6 # return(rl >> k); + j $11 +BDD45: bne $10,$9,BDD451 # if(qq == nn) goto BDD451; + subu $5,1 # o_nl--; + sll $5,2 + addu $9,$5 # nn = &nn[o_nl]; + li $5,1 # o_nl = 1; +BDD451: move $4,$9 # BnnShiftRight(nn, o_nl, k); + jal BnnShiftRight +BDD46: srl $2,$13,$6 # return(rl >> k); + j $11 + .end BnnDivideDigit + + ############################################################################# + # Karatsuba Multiplication for Mips. + # Mark Shand & Jean Vuillemin, May 1989. + # + # Basic operation is to compute: (a1.B + a0) * (b1.B + b0) + # B is the base; a1,a0,b1,b0 <= B-1 + # We compute PL = a0.b0 + # PM = (a1-a0).(b0-b1) + # PH = a1.b1 + # Then: + # (a1.B + a0) * (b1.B + b0) = PL + B.(PM+PL+PH) + B.B.PH + # + # Overall operation is BigNum mm * d0_d1. + # Each cycle computes m0_m1 * d0_d1 + # to avoid underflow in (a1-a0) and (b0-b1) and the + # extra adds that it would entail, the main loop is + # broken into four variants: + # BM2DLLoop d0 >= d1, m0 <= m1 + # BM2DNLLoop d0 >= d1, m0 > m1 + # BM2DHLoop d0 < d1, m0 >= m1 + # BM2DNHLoop d0 < d1, m0 < m1 + # mm is assumed to be even length. + # + # The code within the loops is written on the assumption of an + # infinite supply of registers. Each name is used in a single + # assignment. Name are then assigned to the finite set of registers + # based on an analysis of lifetime of each name--this is the purpose + # of the "defines" at the start of the routine. + + .align 2 + .globl BnnMultiply2Digit + .globl BnnM2DFastLink +#define c0 $2 /* low carry */ +#define tb1 $2 +#define tc1 $2 +#define tj1 $2 +#define tn1 $2 +#define tq1 $2 +#define tz1 $2 +#define tA2 $2 +#define c1 $3 /* high carry */ +#define th2 $3 +#define ti2 $3 +#define pH3 $3 +#define tx3 $3 +#define ty3 $3 +#define ss $4 +#define sl $5 +#define mm $6 +#define ml $7 +#define mlim $7 +#define d0 $8 +#define d1 $9 +#define ds $10 /* d0+d1 mod base */ +#define t_z $11 +#define tC3 $11 +#define s0 $11 +#define ta0 $11 +#define td0 $11 +#define te1 $11 +#define tf1 $11 +#define s1 $11 +#define to2 $11 +#define tp2 $11 +#define ts2 $11 +#define pM1 $11 +#define m0 $12 +#define ms $12 /* b0+b1 mod base */ +#define tr2 $12 +#define tu3 $12 +#define tv3 $12 +#define pL0 $13 +#define tg1 $13 +#define tk2 $13 +#define tm2 $13 +#define tt2 $13 +#define tw2 $13 +#define t_1 $14 +#define pL1 $14 +#define pH2 $14 +#define pM2 $14 +#define tB2 $14 +#define m1 $15 +#define borrow $15 + # Special "friends" entry point--allows fast non-standard procedure linkage. + # Permits passing d0:d1 in r8-r9 and a low-order 64-bit integer in r2-r3 + # that is added to final result. + # Used from BnnMultiply and most highly optimized version of PRL's RSA + # implemenatation. + .ent BnnM2DFastLink +BnnM2DFastLink: + .frame $sp, 0, $31 + subu sl,ml + blez ml,BM2D6 + lw m0,0(mm) + b BnnM2DFLAux + .end BnnM2DFastLink # (ss sl mm ml d0, d1) + + .ent BnnMultiply2Digit # (ss sl mm ml d0, d1) +BnnMultiply2Digit: + .frame $sp, 0, $31 + + .set noreorder + lw d0, 16($sp) # d0; + lw d1, 20($sp) # d1; + li c0,0 + li c1,0 + blez ml,BM2D6 # if(ml <= 0) goto end_loop; + # BDSLOT + subu t_1,d0,1 # t_1 = d0-1 + .set reorder + or t_z,d0,d1 # t_z = (d0 | d1) + beq t_z,0,BM2D7 # if(d0.d1 == 0) + # return(0); + lw m0,0(mm) + or t_1,d1 # t_1 = (d0-1)|d1 + subu sl,ml # sl -= ml; + beq t_1,0,BM2DADD0 # if(d0.d1 != 1) + # BnnAdd(pp, pl, mm, ml, 0); + .set noreorder +BnnM2DFLAux: + multu d0,m0 +#define EnableOddLength 1 +#ifdef EnableOddLength +#define t_odd $15 +#define t_a $15 +#define t_b $14 +#define t_c $15 +#define t_d $15 +#define t_e $14 +#define t_f $13 +#define t_g $15 + # the ifdef'ed code handles case when length of mm is odd. + and t_odd,ml,1 + sll mlim,ml,2 # ml *= 4; + beq t_odd,$0,BM2DmlEven + addu mlim,mlim,mm # mlim = mm+ml; + lw s0,0(ss) + addu mm,4 + addu ss,4 + mflo t_a + mfhi t_b + addu s0,t_a,s0 + sltu t_c,s0,t_a + multu d1,m0 + lw m0,0(mm) + addu t_d,t_c,t_b + mflo t_e + mfhi t_f + addu c0,t_e,t_d + sltu t_g,c0,t_e + multu d0,m0 + addu c1,t_g,t_f + beq mm,mlim,BM2D6 + # BDSLOT + sw s0,-4(ss) + +BM2DmlEven: +#else EnableOddLength + sll mlim,ml,2 # ml *= 4; + addu mlim,mlim,mm # mlim = mm+ml; +#endif EnableOddLength + lw m1,4(mm) # ml *= 4; + bltu d0,d1,BM2DHighBig # expands to 2 instructions + # BDSLOT + nop + bltu m1,m0,BM2DLNeg # expands to 2 instructions + # BDSLOT + subu ds,d0,d1 + b BM2DLPEntry + # BDSLOT + lw s0,0(ss) + +BM2DLLoop: + lw m0,0(mm) + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + multu m0,d0 + addu ss,8 + sltu tA2,tz1,pM1 + addu tB2,pM2,tA2 # tB2 = pM2 + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu c0,tB2,tw2 # c0 = pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + lw m1,4(mm) + sltu tC3,c0,tB2 + bltu m1,m0,BM2DLNeg # expands to 2 instructions + # BDSLOT + addu c1,ty3,tC3 + +BM2DLPos: + lw s0,0(ss) +BM2DLPEntry: + subu ms,m1,m0 + addu ta0,s0,c0 # ta0 = (s0+c0)%B + mfhi pL1 + mflo pL0 + sltu tb1,ta0,c0 + addu tc1,pL1,tb1 # tc1 = pL1 + (s0+c0)/B + multu m1,d1 + addu td0,pL0,ta0 # td0 = (pL0+s0+c0)%B + sw td0,0(ss) # (pL0+s0+c0)%B -> ss[0] FIN + sltu te1,td0,pL0 + addu tf1,tc1,te1 # tf1 = pL1 + (pL0+s0+c0)/B + addu tg1,pL0,c1 # tg1 = (pL0+c1)%B + sltu th2,tg1,c1 + addu ti2,pL1,th2 # ti2 = pL1 + (pL0+c1)/B + addu tj1,tg1,tf1 # tj1 = (pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tk2,tj1,tg1 + lw s1,4(ss) + addu tm2,ti2,tk2 # tm2 = pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B + mfhi pH3 + mflo pH2 + addu tn1,tj1,s1 # tn1 = (s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu to2,tn1,s1 + multu ms,ds + addu tp2,pH3,to2 # tp2 = pH3 + (s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tq1,pH2,tn1 # tq1 = (pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tr2,tq1,pH2 + addu ts2,tp2,tr2 # ts2 = pH3 + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tt2,pH2,tm2 # tt2 = (pH2+pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + sltu tu3,tt2,pH2 + addu tv3,pH3,tu3 # tv3 = pH3 + (pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + addu tw2,ts2,tt2 # tw2 = pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + sltu tx3,tw2,ts2 + addu ty3,tv3,tx3 # ty3 = pH3 + (pH3+(pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + addu mm,8 + mflo pM1 + mfhi pM2 + bne mlim,mm,BM2DLLoop # if(mm!=mlim) goto BM2DLLoop; + # BDSLOT + addu tz1,pM1,tq1 # tz1 = (pM1+pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + + .set reorder + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + addu ss,8 + sltu tA2,tz1,pM1 + addu tB2,pM2,tA2 # tB2 = pM2 + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu c0,tB2,tw2 # c0 = pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + sltu tC3,c0,tB2 + addu c1,ty3,tC3 + b BM2D6 + .set noreorder + +BM2DNLLoop: + lw m0,0(mm) + subu tz1,tq1,pM1 # tz1 = (-pM1+pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + multu m0,d0 + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + addu ss,8 + addu tB2,pM2,borrow + sltu tC3,tw2,tB2 + lw m1,4(mm) + subu c0,tw2,tB2 # c0 = -pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + bgeu m1,m0,BM2DLPos # expands to 2 instructions + # BDSLOT + subu c1,ty3,tC3 + +BM2DLNeg: + lw s0,0(ss) + subu ms,m0,m1 + addu ta0,s0,c0 # ta0 = (s0+c0)%B + mfhi pL1 + mflo pL0 + sltu tb1,ta0,c0 + addu tc1,pL1,tb1 # tc1 = pL1 + (s0+c0)/B + multu m1,d1 + addu td0,pL0,ta0 # td0 = (pL0+s0+c0)%B + sw td0,0(ss) # (pL0+s0+c0)%B -> ss[0] FIN + sltu te1,td0,pL0 + addu tf1,tc1,te1 # tf1 = pL1 + (pL0+s0+c0)/B + addu tg1,pL0,c1 # tg1 = (pL0+c1)%B + sltu th2,tg1,c1 + addu ti2,pL1,th2 # ti2 = pL1 + (pL0+c1)/B + addu tj1,tg1,tf1 # tj1 = (pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tk2,tj1,tg1 + lw s1,4(ss) + addu tm2,ti2,tk2 # tm2 = pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B + mfhi pH3 + mflo pH2 + addu tn1,tj1,s1 # tn1 = (s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu to2,tn1,s1 + multu ms,ds + addu tp2,pH3,to2 # tp2 = pH3 + (s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tq1,pH2,tn1 # tq1 = (pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tr2,tq1,pH2 + addu ts2,tp2,tr2 # ts2 = pH3 + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tt2,pH2,tm2 # tt2 = (pH2+pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + sltu tu3,tt2,pH2 + addu tv3,pH3,tu3 # tv3 = pH3 + (pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + addu tw2,ts2,tt2 # tw2 = pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + sltu tx3,tw2,ts2 + addu ty3,tv3,tx3 # ty3 = pH3 + (pH3+(pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + # Subtract ds + # sltu borrow,tw2,ds + # subu tw2,ds + # subu ty3,borrow + # End Subtract + addu mm,8 + mflo pM1 + mfhi pM2 + bne mlim,mm,BM2DNLLoop # if(mm!=mlim) goto BM2DNLLoop; + # BDSLOT + sltu borrow,tq1,pM1 + + .set reorder + subu tz1,tq1,pM1 # tz1 = (-pM1+pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + addu ss,8 + addu tB2,pM2,borrow + sltu tC3,tw2,tB2 + subu c0,tw2,tB2 # c0 = -pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + subu c1,ty3,tC3 + b BM2D6 + .set noreorder +BM2DHighBig: + bltu m0,m1,BM2DHNeg # expands to 2 instructions + subu ds,d1,d0 + # BDSLOT + b BM2DHEntry + # BDSLOT + lw s0,0(ss) + +BM2DHLoop: + lw m0,0(mm) + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + multu m0,d0 + addu ss,8 + sltu tA2,tz1,pM1 + addu tB2,pM2,tA2 # tB2 = pM2 + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu c0,tB2,tw2 # c0 = pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + lw m1,4(mm) + sltu tC3,c0,tB2 + bltu m0,m1,BM2DHNeg # expands to 2 instructions + # BDSLOT + addu c1,ty3,tC3 + +BM2DHPos: + lw s0,0(ss) +BM2DHEntry: + subu ms,m0,m1 + addu ta0,s0,c0 # ta0 = (s0+c0)%B + mfhi pL1 + mflo pL0 + sltu tb1,ta0,c0 + addu tc1,pL1,tb1 # tc1 = pL1 + (s0+c0)/B + multu m1,d1 + addu td0,pL0,ta0 # td0 = (pL0+s0+c0)%B + sw td0,0(ss) # (pL0+s0+c0)%B -> ss[0] FIN + sltu te1,td0,pL0 + addu tf1,tc1,te1 # tf1 = pL1 + (pL0+s0+c0)/B + addu tg1,pL0,c1 # tg1 = (pL0+c1)%B + sltu th2,tg1,c1 + addu ti2,pL1,th2 # ti2 = pL1 + (pL0+c1)/B + addu tj1,tg1,tf1 # tj1 = (pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tk2,tj1,tg1 + lw s1,4(ss) + addu tm2,ti2,tk2 # tm2 = pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B + mfhi pH3 + mflo pH2 + addu tn1,tj1,s1 # tn1 = (s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu to2,tn1,s1 + multu ms,ds + addu tp2,pH3,to2 # tp2 = pH3 + (s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tq1,pH2,tn1 # tq1 = (pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tr2,tq1,pH2 + addu ts2,tp2,tr2 # ts2 = pH3 + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tt2,pH2,tm2 # tt2 = (pH2+pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + sltu tu3,tt2,pH2 + addu tv3,pH3,tu3 # tv3 = pH3 + (pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + addu tw2,ts2,tt2 # tw2 = pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + sltu tx3,tw2,ts2 + addu ty3,tv3,tx3 # ty3 = pH3 + (pH3+(pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + addu mm,8 + mflo pM1 + mfhi pM2 + bne mlim,mm,BM2DHLoop # if(mm!=mlim) goto BM2DHLoop; + # BDSLOT + addu tz1,pM1,tq1 # tz1 = (pM1+pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + + .set reorder + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + addu ss,8 + sltu tA2,tz1,pM1 + addu tB2,pM2,tA2 # tB2 = pM2 + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu c0,tB2,tw2 # c0 = pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + sltu tC3,c0,tB2 + addu c1,ty3,tC3 + b BM2D6 + .set noreorder + +BM2DNHLoop: + lw m0,0(mm) + subu tz1,tq1,pM1 # tz1 = (-pM1+pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + multu m0,d0 + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + addu ss,8 + addu tB2,pM2,borrow + sltu tC3,tw2,tB2 + lw m1,4(mm) + subu c0,tw2,tB2 # c0 = -pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + bgeu m0,m1,BM2DHPos # expands to 2 instructions + # BDSLOT + subu c1,ty3,tC3 + +BM2DHNeg: + lw s0,0(ss) + subu ms,m1,m0 + addu ta0,s0,c0 # ta0 = (s0+c0)%B + mfhi pL1 + mflo pL0 + sltu tb1,ta0,c0 + addu tc1,pL1,tb1 # tc1 = pL1 + (s0+c0)/B + multu m1,d1 + addu td0,pL0,ta0 # td0 = (pL0+s0+c0)%B + sw td0,0(ss) # (pL0+s0+c0)%B -> ss[0] FIN + sltu te1,td0,pL0 + addu tf1,tc1,te1 # tf1 = pL1 + (pL0+s0+c0)/B + addu tg1,pL0,c1 # tg1 = (pL0+c1)%B + sltu th2,tg1,c1 + addu ti2,pL1,th2 # ti2 = pL1 + (pL0+c1)/B + addu tj1,tg1,tf1 # tj1 = (pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tk2,tj1,tg1 + lw s1,4(ss) + addu tm2,ti2,tk2 # tm2 = pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B + mfhi pH3 + mflo pH2 + addu tn1,tj1,s1 # tn1 = (s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu to2,tn1,s1 + multu ms,ds + addu tp2,pH3,to2 # tp2 = pH3 + (s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tq1,pH2,tn1 # tq1 = (pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sltu tr2,tq1,pH2 + addu ts2,tp2,tr2 # ts2 = pH3 + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + addu tt2,pH2,tm2 # tt2 = (pH2+pL1 + (pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + sltu tu3,tt2,pH2 + addu tv3,pH3,tu3 # tv3 = pH3 + (pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + addu tw2,ts2,tt2 # tw2 = pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + sltu tx3,tw2,ts2 + addu ty3,tv3,tx3 # ty3 = pH3 + (pH3+(pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B)/B+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)/B + # Subtract ds + # sltu borrow,tw2,ds + # subu tw2,ds + # subu ty3,borrow + # End Subtract + addu mm,8 + mflo pM1 + mfhi pM2 + bne mlim,mm,BM2DNHLoop # if(mm!=mlim) goto BM2DHLoop; + # BDSLOT + sltu borrow,tq1,pM1 + + .set reorder + subu tz1,tq1,pM1 # tz1 = (-pM1+pH2+s1+pL1+pL0+c1 + (pL0+s0+c0)/B)%B + sw tz1,4(ss) # (pM1+pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B -> ss[1] FIN + addu ss,8 + addu tB2,pM2,borrow + sltu tC3,tw2,tB2 + subu c0,tw2,tB2 # c0 = -pM2+pH3+(pH2+pL1+(pL1+(pL0+s0+c0)/B+pL0+c1)/B)%B + (pM1+(pH2+s1+pL1+pL0+c1+(pL0+s0+c0)/B)%B+pH2+s1+(pL1+pL0+c1+(pL0+s0+c0)/B)%B)/B + subu c1,ty3,tC3 + # b BM2D6 + +BM2D6: + lw s0,0(ss) # s0 = *ss; + addu c0,s0 # c0 = (c0+s0)%B + sltu $12,c0,s0 # r = (c0+s0)/B + lw s1,4(ss) # + sw c0,0(ss) # *ss = c0; + addu c1,s1 # c1 = (c1+s1)%B + sltu c0,c1,s1 # c0 = (c1+s1)/B + addu c1,$12 # c1 = (c1+s1+(c0+s0)/B)%B + sltu $12,c1,$12 # r = ((c1+s1)%B+(c0+s0)/B)/B + sw c1,4(ss) + addu c0,$12 # c0 = (c1+s1+(c0+s0)/B)/B + addu ss,8 # ss+=2; + bne c0,0,BM2D8 # if(c0) goto BM2D8; +BM2D7: li $2,0 # return(0); + j $31 +BM2D8: subu $5,2 # sl-=2; + blez $5,BM2D10 # if(sl <= 0) return(1); +BM2D9: subu $5,1 # pl--; + lw $9,0($4) # X = *pp; + addu $9,1 # X++; + sw $9,0($4) # *ss = X; + bne $9,$0,BM2D7 # if(X) return(0); + addu $4,4 # ss++; + bgtz $5,BM2D9 # if(sl > 0) goto BM2D9; +BM2D10: li $2,1 # return(1); + j $31 + + #============================================================================== + +BM2DADD0: li c0,0 +BM2DADD1: subu $7,1 # nl--; + lw $15,0($4) # save = *mm; + addu $4,4 # mm++; + addu $15,$2 # save += c; + sltu $14,$15,$2 # c' = (save < c); + lw $10,0($6) # X = *nn; + addu $6,4 # nn++; + addu $10,$15 # X += save; + sw $10,-4($4) # mm[-1] = X + sltu $15,$10,$15 # save = (X < save); + addu $2,$15,$14 # c = c' + save; + bne $7,$0,BM2DADD1 # if(nl) goto BM2DADD1; + + beq $5,0,BM2D10 # if(ml == 0) return(c); + beq $2,0,BM2DADD3 # if(c == 0) return(0); +BM2DADD2: subu $5,1 # ml--; + lw $9,0($4) # X = *mm; + addu $9,1 # X++; + sw $9,0($4) # *mm = X; + addu $4,4 # mm++; + bne $9,$0,BM2DADD3 # if(X) return(0); + bne $5,$0,BM2DADD2 # if(ml) goto BM2DADD2; + j $31 # return(1); +BM2DADD3: move $2,$0 # return(0) + j $31 +#undef c0 +#undef tb1 +#undef tc1 +#undef tj1 +#undef tn1 +#undef tq1 +#undef tz1 +#undef tA2 +#undef c1 +#undef th2 +#undef ti2 +#undef pH3 +#undef tx3 +#undef ty3 +#undef ss +#undef sl +#undef mm +#undef ml +#undef mlim +#undef d0 +#undef d1 +#undef ds +#undef t_z +#undef tC3 +#undef s0 +#undef ta0 +#undef td0 +#undef te1 +#undef tf1 +#undef s1 +#undef to2 +#undef tp2 +#undef ts2 +#undef pM1 +#undef m0 +#undef ms +#undef tr2 +#undef tu3 +#undef tv3 +#undef pL0 +#undef tg1 +#undef tk2 +#undef tm2 +#undef tt2 +#undef tw2 +#undef t_1 +#undef pL1 +#undef pH2 +#undef pM2 +#undef tB2 +#undef m1 +#undef borrow +#ifdef EnableOddLength +#undef t_odd +#undef t_a +#undef t_b +#undef t_c +#undef t_d +#undef t_e +#undef t_f +#undef t_g +#endif EnableOddLength + .end BnnMultiply2Digit + + .align 2 + .globl BnnMultiply + #.loc 2 40 + # 40 { + .ent BnnMultiply 2 +BnnMultiply: + subu $sp, 56 + sw $31, 52($sp) + sw $22, 48($sp) + sd $20, 40($sp) + sd $18, 32($sp) + sd $16, 24($sp) + .mask 0x807F0000, -4 + .frame $sp, 56, $31 + move $17, $4 + move $18, $5 + move $21, $6 + move $22, $7 + lw $16, 72($sp) + lw $19, 76($sp) + #.loc 2 74 + # 74 if (nl & 1) + and $14, $19, 1 + bne $6, $16, $37 + move $20, $0 + beq $7, $19, $38 + #.loc 2 73 + # 73 c = 0; +$37: + move $20, $0 + bne $14, $0, $32 + b $33 +$32: + #.loc 2 76 + # 75 { + # 76 c += BnnMultiplyDigit (pp, pl, mm, ml, *nn); + move $4, $17 + move $5, $18 + move $6, $21 + move $7, $22 + lw $15, 0($16) + sw $15, 16($sp) + jal BnnMultiplyDigit + move $20, $2 + #.loc 2 77 + # 77 pp++, nn++, nl--, pl--; + addu $17, $17, 4 + addu $16, $16, 4 + addu $19, $19, -1 + addu $18, $18, -1 + #.loc 2 78 + # 78 } +$33: + #.loc 2 79 + # 79 if ((ml & 1) && nl) + and $24, $22, 1 + beq $24, $0, $34 + beq $19, 0, $34 + #.loc 2 81 + # 80 { + # 81 c += BnnMultiplyDigit (pp, pl, nn, nl, *mm); + move $4, $17 + move $5, $18 + move $6, $16 + move $7, $19 + lw $25, 0($21) + sw $25, 16($sp) + jal BnnMultiplyDigit + addu $20, $20, $2 + #.loc 2 82 + # 82 pp++, mm++, ml--, pl--; + addu $17, $17, 4 + addu $21, $21, 4 + addu $22, $22, -1 + addu $18, $18, -1 + #.loc 2 83 + # 83 } +$34: + #.loc 2 84 + # 84 while (nl > 0) + bleu $19, 0, $36 +$35: + #.loc 2 86 + # 85 { + # 86 c += BnnMultiply2Digit (pp, pl, mm, ml, nn[0], nn[1]); + move $4, $17 + move $5, $18 + move $6, $21 + move $7, $22 + lw $8, 0($16) + lw $9, 4($16) + li $2, 0 + li $3, 0 + jal BnnM2DFastLink + addu $20, $20, $2 + #.loc 2 87 + # 87 pp += 2, nn += 2, nl -= 2, pl -= 2; + addu $17, $17, 8 + addu $16, $16, 8 + addu $19, $19, -2 + addu $18, $18, -2 + #.loc 2 88 + # 88 } + #.loc 2 88 + bgtu $19, 0, $35 +$36: + #.loc 2 89 + # 89 return c; + move $2, $20 + ld $16, 24($sp) + ld $18, 32($sp) + ld $20, 40($sp) + lw $22, 48($sp) + lw $31, 52($sp) + addu $sp, 56 + j $31 +$38: + # We no longer need r21, r22 since nn == mm && nl == ml + li $21, 0 + beq $14, $0, $40 # if ((nl&1) == 0) goto $40 + lw $21, 0($16) # r10 = d = *nn + multu $21, $21 # d*d + lw $12, 0($17) # r12 = *pp + addu $16, 4 # nn++ + addu $8, $21, $21 # d2 = 2*d + addu $17, 8 # pp += 2 + mflo $13 # d*d % 2^32 + addu $13, $12 # r13 = new pp[0] = (*pp + d*d) % 2^32 + sltu $10, $13, $12 # r10 = carry = (*pp + d*d) / 2^32 + mfhi $9 # r9 = save = d*d / 2^32 + subu $4, $17, 4 # arg1 = pp-1 + subu $5, $18, 1 # arg2 = pl-1 + subu $18, 2 # pl -= 2 + subu $19, 1 # nl-- + move $6, $16 # arg3 = nn + move $7, $19 + sw $13, -8($17) + jal BMDFastLinkage # BnnMultiplyDigit(r4,r5,r6,r7,r8)+(r9+r10)%2^32 + addu $20, $2 + sra $21,31 +$40: + # 84 while (nl > 0) + bleu $19, 0, $42 +$41: + # 85 { + # compute d0:d1*d0:d1+p0:p1+c0:c1 -> p0:p1:c0:c1 with maximal overlap of + # single cycle instruction with multiplier operation. + # + # observe a*b+c+d <= 2^64-1 for all a,b,c,d < 2^32 + # we can exploit this property to minimize carry tests + # Accordingly, computation can be organized as follows: + # d0*d0 -> l0:l1 d0*d1 -> m0:m1 d1*d1 -> h0:h1 + # + # c0 c1 L1 M1 + # p0 p1 M0 N1 + # l0:l1 m0:m1 m0:m1 h0:h1 + # ===== ===== ===== ===== + # L0:L1 M0:M1 N0:N1 H0:H1 + # -> P0 P1 C0:C1 + # + lw $8, 0($16) + lw $15, 4($16) + multu $8, $8 # d0*d0 + and $2, $8, $21 # c0 = d0*sgn(n[-1]) + and $3, $15, $21 # c1 = d1*sgn(n[-1]) + slt $22, $21, $0 # r22 = n[-1] < 0 + sra $21, $15, 31 + lw $10, 0($17) # r10 = p0 + lw $11, 4($17) # r11 = p1 + addu $17, 16 # pp += 4 + addu $10, $2 # r10 = L(p0+c0) + sltu $2, $10, $2 # r2 = H(p0+c0) + addu $11, $3 # r11 = L(p1+c1) + sltu $3, $11, $3 # r3 = H(p1+c1) + # enough computation to prevent a stall + mflo $12 # l0 + mfhi $13 # l1 + addu $10, $12 # r10 = L0 = L(p0+c0+l0) + sw $10,-16($17) # pp[-4] = L0 + multu $8, $15 # d0*d1 + addu $16, 8 # nn += 2 + sltu $12, $10, $12 # r12 = H(L(p0+c0)+l0) + # r12+r2 = H(p0+c0+l0) + addu $12, $13 # assert r12 == 0 || r2 == 0 + addu $12, $2 # r12 = L1 = l1+H(p0+c0+l0) + # Free: 2,9,10,13,14; Used: r11:r3 = p1+c1 r8=d0 r15=d1 r12=L1 + slt $14, $8, $0 # r14 = n[0] < 0 + addu $8, $8 # r8 = L(2*d0) + addu $8, $22 # r8 = L(2*d0+(n[-1] < 0)) + addu $9, $15, $15 # r9 = L(2*d1) + addu $9, $14 # r9 = L(2*d1+(d0 < 0)) + subu $18, 4 # pl -= 4 + subu $19, 2 # nl -= 2 + # enough computation to prevent a stall + mflo $10 # m0 + mfhi $14 # m1 + addu $11, $10 # r11 = M0 = L(p1+c1+m0) + sltu $13, $11, $10 # r13 = H(L(p1+c1)+m0) + # r13+r3 = H(p0+c0+l0) + multu $15, $15 # d1*d1 + addu $13, $14 # assert before r11 == 0 || r3 == 0 + addu $13, $3 # r13 = M1 = m1+H(p1+c1+m0) + # Free: 2,3,15; Used: r8:r9 = 2*d0:d1 r10=m0 r11=M0 r12=L1 r13=M1 r14=m1 + addu $10, $11 # r10 = L(m0+M0) + sltu $11, $10, $11 # r11 = H(m0+M0) + addu $10, $12 # r10 = N0 = L(M0+m0+L1) + sw $10, -12($17) # pp[-3] = N0 + sltu $12, $10, $12 # r12 = H(L(m0+M0)+L1) + # r12+r11 = H(M0+m0+L1) + addu $14, $11 # assert r11 == 0 || r12 == 0 + addu $14, $12 # r14 = N1 = m1+H(M0+m0+L1) + addu $14, $13 # r14 = L(M1+N1) + sltu $13, $14, $13 # r13 = H(M1+N1) + # enough computation to prevent a stall + mflo $10 # h0 + mfhi $11 # h1 + addu $2, $10, $14 # c0 = L(M1+N1+h0) + sltu $14, $2, $14 # r14 = H(L(M1+N1)+h0) + # r14+r13 = H(M1+N1+h0) + addu $3, $11, $14 # assert r14 == 0 || r13 == 0 + addu $3, $13 # c1 = H(M1+N1+h0) + addu $4, $17, -8 # arg1 = pp-2 + addu $5, $18, 2 # arg2 = pl+2 + move $6, $16 # arg3 = nn + move $7, $19 # arg4 = nl + jal BnnM2DFastLink + addu $20, $20, $2 + # 88 } + bgtu $19, 0, $41 +$42: + # 89 return c; + move $2, $20 + ld $16, 24($sp) + ld $18, 32($sp) + ld $20, 40($sp) + lw $22, 48($sp) + lw $31, 52($sp) + addu $sp, 56 + j $31 + .end BnnMultiply diff --git a/otherlibs/num/bignum/s/nsKerN.s b/otherlibs/num/bignum/s/nsKerN.s new file mode 100644 index 000000000..7df2f9eb2 --- /dev/null +++ b/otherlibs/num/bignum/s/nsKerN.s @@ -0,0 +1,427 @@ +# Copyright Digital Equipment Corporation & INRIA 1988, 1989 +# +# KerN for NS32032 +# Francis Dupont +# + .text + + .globl _BnnSetToZero + .align 2 +_BnnSetToZero: .set BSTZnn,4 + .set BSTZnl,8 + movd BSTZnn(sp),r0 + movd BSTZnl(sp),r1 + acbd 0,r1,BSTZ1 # ?? test a 0 + rapide ?? + ret 0 +BSTZ1: movqd 0,0(r0) # *nn = 0; + addqd 4,r0 # nn++; + acbd -1,r1,BSTZ1 # if!(--nl) goto BSTZ1; + ret 0 + + .globl _BnnAssign + .align 2 +_BnnAssign: .set BAGmm,4 + .set BAGnn,8 + .set BAGnl,12 + movd BAGnl(sp),r0 + movd BAGnn(sp),r1 + movd BAGmm(sp),r2 + cmpd r2,r1 + bge BAG1 # if(mm >= nn) goto BAG1; + movsd # bcopy(nn, mm, 4*nl); + ret 0 +BAG1: addr r2[r0:d],r2 # mm = &mm[nl]; + addr r1[r0:d],r1 # nn = &nn[nl]; + addqd -4,r2 # mm--; + addqd -4,r1 # nn--; + movsd b # revbcopy(nn, mm, 4*nl); + ret 0 + + .globl _BnnSetDigit + .align 2 +_BnnSetDigit: .set BSDnn,4 + .set BSDd,8 + movd BSDd(sp),0(BSDnn(sp)) # *nn = d; + ret 0 + + .globl _BnnGetDigit + .align 2 +_BnnGetDigit: .set BGDnn,4 + movd 0(BGDnn(sp)),r0 # return(*nn); + ret 0 + + .globl _BnnNumDigits + .align 2 +_BnnNumDigits: .set BNDnn,4 + .set BNDnl,8 + movd BNDnl(sp),r0 + cmpqd 0,r0 + beq BND2 # if(nl == 0) return(1); + addr 0(BNDnn(sp))[r0:d],r1 # nn = &nn[nd]; +BND1: addqd -4,r1 # --nn; + cmpqd 0,0(r1) + bne BND3 # if(*nn != 0) return(nl); + acbd -1,r0,BND1 # if(!--nl) goto BND1; +BND2: movqd 1,r0 # return(1); +BND3: ret 0 + + .globl _BnnNumLeadingZeroBitsInDigit + .align 2 +_BnnNumLeadingZeroBitsInDigit: .set BLZd,4 + movd BLZd(sp),r1 + movd 31,r0 # ret = 31; +BLZ1: tbitd r0,r1 + bfs BLZ2 # if(d & 2^ret) goto BLZ2; + addqd -1,r0 + bcs BLZ1 # if(--ret) goto BLZ1; +BLZ2: negd r0,r0 + addd 31,r0 # return(31 - ret); + ret 0 + + .globl _BnnDoesDigitFitInWord + .align 2 +_BnnDoesDigitFitInWord: .set BDFd,4 + movqd 1,r0 # return(1); + ret 0 + + .globl _BnnIsDigitZero + .align 2 +_BnnIsDigitZero: .set BDZd,4 + cmpqd 0,BDZd(sp) # return(!d); + seqd r0 + ret 0 + + .globl _BnnIsDigitNormalized + .align 2 +_BnnIsDigitNormalized: .set BDNd,4 + tbitd 31,BDNd(sp) # return(d & 2^31); + sfsd r0 + ret 0 + + .globl _BnnIsDigitOdd + .align 2 +_BnnIsDigitOdd: .set BDOd,4 + movqd 1,r0 # return(d & 1); + andd BDOd(sp),r0 + ret 0 + + .globl _BnnCompareDigits + .align 2 +_BnnCompareDigits: .set BCDd1,4 + .set BCDd2,8 + cmpd BCDd1(sp),BCDd2(sp) + bhs BCD1 # if(d1 >= d2) + movqd -1,r0 # return(-1); + ret 0 +BCD1: sned r0 # return(d1 != d2); + ret 0 + + .globl _BnnComplement + .align 2 +_BnnComplement: .set BCMnn,4 + .set BCMnl,8 + movd BCMnl(sp),r1 + cmpqd 0,r1 + beq BCM2 # if(nl == 0) return; + movd BCMnn(sp),r0 +BCM1: comd 0(r0),0(r0) # *nn ^= -1; + addqd 4,r0 # nn++; + acbd -1,r1,BCM1 # if(!--nl) goto BCM1; +BCM2: ret 0 + + .globl _BnnAndDigits + .align 2 +_BnnAndDigits: .set BADnn,4 + .set BADd,8 + andd BADd(sp),0(BADnn(sp)) # *nn &= d; + ret 0 + + .globl _BnnOrDigits + .align 2 +_BnnOrDigits: .set BODnn,4 + .set BODd,8 + ord BODd(sp),0(BODnn(sp)) # *nn |= d; + ret 0 + + .globl _BnnXorDigits + .align 2 +_BnnXorDigits: .set BXDnn,4 + .set BXDd,8 + xord BXDd(sp),0(BXDnn(sp)) # *nn ^= d; + ret 0 + + .globl _BnnShiftLeft + .align 2 +_BnnShiftLeft: .set BSLmm,8 + .set BSLml,12 + .set BSLnbi,16 + enter [r3,r4,r5,r6],0 + movqd 0,r0 # res = 0; + movd BSLnbi(fp),r5 + cmpqd 0,r5 + beq BSL2 # if(nbi == 0) return(res); + movd BSLml(fp),r3 + cmpqd 0,r3 + beq BSL2 # if(ml == 0) return(res); + movd r5,r6 + subd 32,r6 # rnbi = nbi - BN_DIGIT_SIZE; + movd BSLmm(fp),r2 +BSL1: movd 0(r2),r1 # save = *mm; + movd r1,r4 # X = save; + lshd r5,r4 # X <<= nbi; + ord r0,r4 # X |= res; + movd r4,0(r2) # *mm = X; + addqd 4,r2 # mm++; + movd r1,r0 # res = save; + lshd r6,r0 # res <<= rnbi; + acbd -1,r3,BSL1 # if(!--nl) goto BSL1; +BSL2: exit [r3,r4,r5,r6] + ret 0 + + .globl _BnnShiftRight + .align 2 +_BnnShiftRight: .set BSRmm,8 + .set BSRml,12 + .set BSRnbi,16 + enter [r3,r4,r5,r6],0 + movqd 0,r0 # res = 0; + movd BSRnbi(fp),r1 + cmpqd 0,r1 # if(nbi == 0) return(res); + beq BSR2 + movd BSRml(fp),r3 + cmpqd 0,r3 + beq BSR2 # if(ml == 0) return(res); + addr @32,r6 + subd r1,r6 # rnbi = BN_DIGIT_SIZE - nbi; + negd r1,r5 # nbi = - nbi; + addr 0(BSRmm(fp))[r3:d],r2 # mm = &mm[ml]; +BSR1: addqd -4,r2 # mm--; + movd 0(r2),r1 # save = *mm; + movd r1,r4 # X = save; + lshd r5,r4 # X <<= nbi; + ord r0,r4 # X |= res + movd r4,0(r2) # *mm = X; + movd r1,r0 # res = save; + lshd r6,r0 # res <<= rnbi; + acbd -1,r3,BSR1 # if(!--nl) goto BSR1; +BSR2: exit [r3,r4,r5,r6] + ret 0 + + .globl _BnnAddCarry + .align 2 +_BnnAddCarry: .set BACnn,4 + .set BACnl,8 + .set BACcar,12 + cmpqd 0,BACcar(sp) + beq BAC3 # if(car == 0) return(0); + movd BACnl(sp),r0 + cmpqd 0,r0 # if(nl = 0) return(1); + beq BAC2 + movd BACnn(sp),r1 +BAC1: addqd 1,0(r1) # ++(*nn); + bcc BAC3 # if(!Carry) return(0); + addqd 4,r1 # nn++; + acbd -1,r0,BAC1 # if(!--nl) goto BAC1; +BAC2: movqd 1,r0 # return(1); + ret 0 +BAC3: movqd 0,r0 # return(0); + ret 0 + + .globl _BnnAdd + .align 2 +_BnnAdd: .set BADDmm,8 + .set BADDml,12 + .set BADDnn,16 + .set BADDnl,20 + .set BADDcar,24 + enter [r3,r4,r5],0 + movd BADDnl(fp),r4 + movd BADDcar(fp),r1 + movd BADDmm(fp),r2 + movd BADDnn(fp),r3 + movd BADDml(fp),r5 + subd r4,r5 # ml -= nl +BADD1: cmpqd 0,r4 + beq BADD4 # if(nl == 0) goto BADD4; + addqd -1,r4 # nl--; + addd 0(r2),r1 # car += *mm; + bcc BADD2 # if(!Carry) goto BADD2; + movd 0(r3),0(r2) # *mm = *nn; + addqd 4,r3 # nn++; + addqd 4,r2 # mm++; + movqd 1,r1 # car = 1 + br BADD1 # goto BADD1 +BADD2: movd 0(r3),r0 # save = *nn; + addqd 4,r3 # nn++; + addd r0,r1 # car += save; + movd r1,0(r2) # *mm = car; + addqd 4,r2 # mm++; + cmpd r1,r0 + slod r1 # car = (car < save) ? 1 : 0; + br BADD1 # goto BADD1; + +BADD4: cmpqd 0,r1 # if (car == 0) return(0); + beq BADD8 + cmpqd 0,r5 # if (ml == 0) return(1); + beq BADD9 +BADD5: addqd 1,0(r2) # ++(*mm); + bcc BADD8 # if(Carry) return(0): + addqd 4,r2 # mm++; + acbd -1,r5,BADD5 # if(!--ml) goto BADD5; +BADD9: movqd 1,r0 # return(1); + exit [r3,r4,r5] + ret 0 +BADD8: movqd 0,r0 # return(0); + exit [r3,r4,r5] + ret 0 + + .globl _BnnSubtractBorrow + .align 2 +_BnnSubtractBorrow: .set BSBnn,4 + .set BSBnl,8 + .set BSBcar,12 + cmpqd 1,BSBcar(sp) + beq BSB3 # if(car == 1) return(1); + movd BSBnl(sp),r0 + cmpqd 0,r0 + beq BSB2 # if(nl == 0) return(0); + movd BSBnn(sp),r1 +BSB1: addqd -1,0(r1) # (*nn)--; + bcs BSB3 # if(Carry) return(1); + addqd 4,r1 # nn++; + acbd -1,r0,BSB1 # if(!--nl) goto BSB1; +BSB2: ret 0 # return(nl); +BSB3: movqd 1,r0 # return(1); + ret 0 + + + .globl _BnnSubtract + .align 2 +_BnnSubtract: .set BSmm,8 + .set BSml,12 + .set BSnn,16 + .set BSnl,20 + .set BScar,24 + enter [r3,r4,r5,r6],0 + movd BSmm(fp),r4 + movd BSml(fp),r6 + movd BSnn(fp),r3 + movd BSnl(fp),r5 + movd BScar(fp),r1 + subd r5,r6 # ml -= nl; +BS1: cmpqd 0,r5 + beq BS4 # if (nl == 0) goto BS4; + addqd -1,r5 # nl--; + addd 0(r4),r1 # car += *mm; + bcc BS2 # if(!Carry) goto BS2; + comd 0(r3),0(r4) # *mm = ~*nn + addqd 4,r3 # nn++ + addqd 4,r4 # mm++ + movqd 1,r1 # car = 1; + br BS1 # goto BS1; +BS2: comd 0(r3),r0 # save = *nn; + addqd 4,r3 # nn++; + addd r0,r1 # car += save; + movd r1,0(r4) # *mm = car; + addqd 4,r4 # mm++; + cmpd r1,r0 + slod r1 # car = (car < save) ? 1 : 0; + br BS1 # goto BS1; + +BS4: cmpqd 1,r1 + beq BS8 # if(car == 1) return(1); + cmpqd 0,r6 + beq BS9 # if(ml != 0) return(0); +BS5: addqd -1,0(r4) # (*mm)--; + bcs BS8 # if(Carry) return(1); + addqd 4,r4 # mm++; + acbd -1,r6,BS5 # if(!--ml) goto BS5; +BS9: movqd 0,r0 # return(0); + exit [r3,r4,r5,r6] + ret 0 +BS8: movqd 1,r0 # return(1); + exit [r3,r4,r5,r6] + ret 0 + + .globl _BnnMultiplyDigit + .align 2 +_BnnMultiplyDigit: .set BMDpp,8 + .set BMDpl,12 + .set BMDmm,16 + .set BMDml,20 + .set BMDd,24 + enter [r3,r4,r5,r6,r7],0 + movd BMDd(fp),r0 + cmpqd 0,r0 + beq BMD10 # if(d == 0) return(0); + cmpqd 1,r0 + bne BMD1 # if(d != 1) goto BMD1; + exit [r3,r4,r5,r6,r7] + movqd 0,20(sp) + br _BnnAdd # BnAdd(pp,pl,mm,ml,0); +BMD1: movqd 0,r7 # c = 0; + movd BMDpp(fp),r4 + movd BMDml(fp),r5 + movd BMDpl(fp),r6 + subd r5,r6 # pl -= ml; + cmpqd 0,r5 + beq BMD7 # if(ml == 0) goto BMD7; + movd BMDmm(fp),r1 +BMD2: movd 0(r1),r2 # save = *mm; + addqd 4,r1 # mm++; + meid r0,r2 # X = d * save; + addd r7,r2 # X += c; + bcc BMD3 # if(Carry) XH++; + addqd 1,r3 +BMD3: addd r2,0(r4) # *pp += XL; + bcc BMD4 # if(Carry) XH++; + addqd 1,r3 +BMD4: addqd 4,r4 # pp++; + movd r3,r7 # c = XL; + acbd -1,r5,BMD2 # if(!--ml) goto BMD2; +BMD7: addd r7,0(r4) # *pp += c; + bcc BMD10 # if(!Carry) return(0); + addqd 4,r4 # pp++; + addqd -1,r6 # pl--; + cmpqd 0,r6 + beq BMD11 # if (pl == 0) goto BMD11; +BMD8: addqd 1,0(r4) # ++(*p); + bcc BMD10 # if(!Carry) return(0); + addqd 4,r4 # pp++; + acbd -1,r6,BMD8 # if(!--pl) goto BMD8; +BMD11: movqd 1,r0 # return(1); + exit [r3,r4,r5,r6,r7] + ret 0 +BMD10: movqd 0,r0 # return(0); + exit [r3,r4,r5,r6,r7] + ret 0 + + .globl _BnnDivideDigit + .align 2 +_BnnDivideDigit: .set BDDqq,8 + .set BDDnn,12 + .set BDDnl,16 + .set BDDd,20 + enter [r3,r4,r5],0 + movd BDDd(fp),r2 + movd BDDnl(fp),r3 + addr 0(BDDnn(fp))[r3:d],r4 # nn = &nn[nl]; + addqd -1,r3 # nl--; + addr 0(BDDqq(fp))[r3:d],r5 # qq = &qq[nl]; + addqd -4,r4 # nn--; + movd 0(r4),r1 # Xhig = *nn; + cmpqd 0,r3 + beq BDD2 # if(nl == 0) return(Xhig); +BDD1: addqd -4,r4 # --nn; + addqd -4,r5 # --qq; + movd 0(r4),r0 # Xlow = *nn; + deid r2,r0 # Xlow = X % c; + # Xhig = X / c; + movd r1,0(r5) # *qq = Xhig; + movd r0,r1 # Xhig = Xlow; + acbd -1,r3,BDD1 # if(!--nl) goto BDD1; + exit [r3,r4,r5] # return(Xlow); + ret 0 +BDD2: movd r1,r0 # return(Xlow); + exit [r3,r4,r5] + ret 0 diff --git a/otherlibs/num/bignum/s/pyramidKerN.s b/otherlibs/num/bignum/s/pyramidKerN.s new file mode 100644 index 000000000..51198b80a --- /dev/null +++ b/otherlibs/num/bignum/s/pyramidKerN.s @@ -0,0 +1,454 @@ +# Copyright Digital Equipment Corporation & INRIA 1988, 1989 +# +# KerN for Pyramid Architecture +# Bernard Paul Serpette +# + .text 0 + + .globl _BnnSetToZero +_BnnSetToZero: subw $1,pr1 # nl--; + blt BSTZ2 # if(nl < 0) return; +BSTZ1: movw $0,(pr0) # *nn = 0; + addw $4,pr0 # nn++; + subw $1,pr1 # nl--; + bge BSTZ1 # if(nl >= 0) goto BSTZ1; +BSTZ2: ret # return; + + .globl _BnnAssign +_BnnAssign: ucmpw pr1,pr0 + bgt BAG3 # if(mm > nn) goto BAG3; + subw $1,pr2 # nl--; + bge BAG2 # if(nl >= 0) goto BAG2; + ret +BAG1: addw $4,pr0 # mm++; + addw $4,pr1 # nn++; +BAG2: movw (pr1),(pr0) # *mm = *nn; + subw $1,pr2 # nl--; + bge BAG1 # if(nl >= 0) goto BAG1; + ret + +BAG3: mova (pr1)[pr2*0x4],pr1 # nn += nl; + mova (pr0)[pr2*0x4],pr0 # mm += nl; + subw $1,pr2 # nl--; + blt BAG5 # if(nl < 0) return; +BAG4: subw $4,pr0 # mm--; + subw $4,pr1 # nn--; + movw (pr1),(pr0) # *mm = *nn; + subw $1,pr2 # nl--; + bge BAG4 # if(nl >= 0) goto BAG4; +BAG5: ret + + .globl _BnnSetDigit +_BnnSetDigit: movw pr1,(pr0) # *nn = d; + ret + + .globl _BnnGetDigit +_BnnGetDigit: movw (pr0),pr0 # return(*nn); + ret + + .globl _BnnNumDigits +_BnnNumDigits: + mova (pr0)[pr1*0x4],pr0 # nn += nl; + br BND2 +BND1: subw $4,pr0 # nn--; + mtstw (pr0),pr2 + bne BND3 # if(*nn) goto BND3 + subw $1,pr1 # nl--; +BND2: mtstw pr1,pr2 + bne BND1 # if(nl) goto BND1; + movw $1,pr0 # return(1); + ret +BND3: movw pr1,pr0 # return(nl); + ret + + .globl _BnnNumLeadingZeroBitsInDigit +_BnnNumLeadingZeroBitsInDigit: + movw $0,pr1 # p = 0; + mtstw pr0,pr0 + bne BLZ2 # if(!d) goto BLZ2; + movw $32,pr0 # return(32); + ret +BLZ1: addw $1,pr1 # p++; + lshlw $1,pr0 # d <<= 1; +BLZ2: mtstw pr0,pr0 + bgt BLZ1 # if(d > 0) goto BLZ1; + movw pr1,pr0 # return(p); + ret + + .globl _BnnDoesDigitFitInWord +_BnnDoesDigitFitInWord: + movw $1,pr0 # return(1); + ret + + .globl _BnnIsDigitZero +_BnnIsDigitZero: + mtstw pr0,pr0 # set NZVC flags + mpsw pr0 # mov NZVC flags in register + andw $4,pr0 # return(Z); + ret + + .globl _BnnIsDigitNormalized +_BnnIsDigitNormalized: + mtstw pr0,pr0 # set NZVC flags + mpsw pr0 # mov NZVC flags in register + andw $8,pr0 # return(N); + ret + + .globl _BnnIsDigitOdd +_BnnIsDigitOdd: + andw $1,pr0 # return(d & 1); + ret + + .globl _BnnCompareDigits +_BnnCompareDigits: + ucmpw pr1,pr0 + bgt BCDsup + bne BCDinf + movw $0,pr0 + ret +BCDinf: movw $-1,pr0 + ret +BCDsup: movw $1,pr0 + ret + + .globl _BnnComplement +_BnnComplement: + subw $1,pr1 # nl--; + blt BCM2 # if(nl < 0) goto BCM2 +BCM1: mcomw (pr0),pr2 # tmp = *nn ^ -1; + movw pr2,(pr0) # *nn = tmp; + addw $4,pr0 # nn++; + subw $1,pr1 # nl--; + bge BCM1 # if(nl >= 0) goto BCM1; +BCM2: ret + + .globl _BnnAndDigits +_BnnAndDigits: andw (pr0),pr1 # d &= *nn; + movw pr1,(pr0) # *nn = d; + ret + + .globl _BnnOrDigits +_BnnOrDigits: orw (pr0),pr1 # d |= *nn; + movw pr1,(pr0) # *nn = d; + ret + + .globl _BnnXorDigits +_BnnXorDigits: xorw (pr0),pr1 # d ^= *nn; + movw pr1,(pr0) # *nn = d; + ret + + .globl _BnnShiftLeft +_BnnShiftLeft: movw $0,lr1 # res = 0; + mtstw pr2,pr2 + beq BSL2 # if(!nbi) return(res); + movw $32,lr2 # rnbi = 32; + subw pr2,lr2 # rnbi -= nbi; + subw $1,pr1 # ml--; + blt BSL2 # if(ml < 0) return(res); +BSL1: movw (pr0),lr0 # save = *mm; + movw lr0,pr3 # X = save; + lshlw pr2,pr3 # X <<= nbi; + orw lr1,pr3 # X |= res; + movw pr3,(pr0) # *mm = X; + addw $4,pr0 # mm++; + movw lr0,lr1 # res = save; + lshrw lr2,lr1 # res >>= rnbi; + subw $1,pr1 # ml--; + bge BSL1 # if(ml >= 0) goto BSL1; +BSL2: movw lr1,pr0 # return(res); + ret + + .globl _BnnShiftRight +_BnnShiftRight: movw $0,lr1 # res = 0; + mtstw pr2,pr2 + beq BSR2 # if(!nbi) return(res); + mova (pr0)[pr1*0x4],pr0 # mm += ml; + movw $32,lr2 # lnbi = 32; + subw pr2,lr2 # lnbi -= nbi; + subw $1,pr1 # ml--; + blt BSR2 # if(ml < 0) return(res); +BSR1: subw $4,pr0 # mm--; + movw (pr0),lr0 # save = *mm; + movw lr0,pr3 # X = save; + lshrw pr2,pr3 # X >>= nbi; + orw lr1,pr3 # X |= res; + movw pr3,(pr0) # *mm = X; + movw lr0,lr1 # res = save; + lshlw lr2,lr1 # res <<= lnbi; + subw $1,pr1 # ml--; + bge BSR1 # if(ml >= 0) goto BSR1; +BSR2: movw lr1,pr0 # return(res); + ret + + .globl _BnnAddCarry +_BnnAddCarry: mtstw pr2,pr2 + beq BAC3 # if(!carryin) return(0); + mtstw pr1,pr1 + beq BAC2 # if(!nl) return(1); + subw $1,pr1 # nl--; +BAC1: icmpw $0,(pr0) # Z = (++(nn) == 0); + bne BAC3 # if(!Z) goto BAC3; + addw $4,pr0 # nn++; + subw $1,pr1 # nl-- + bge BAC1 # if(nl >= 0) goto BAC1; +BAC2: movw $1,pr0 # return(1); + ret +BAC3: movw $0,pr0 # return(0); + ret + + .globl _BnnAdd +_BnnAdd: subw pr3,pr1 # ml -= nl; + mtstw pr3,pr3 + beq BADD5 # if(!nl) goto BADD5; +BADD1: subw $1,pr3 # nl--; +BADDX: movw (pr0),pr5 # X1 = *mm + bicpsw $1 + bispsw pr4 # Set the carry C; + addwc (pr2),pr5 # X1 += *nn + C; + mpsw pr4 + andw $1,pr4 # get the carry C; + movw pr5,(pr0) # *mm = X1; + addw $4,pr0 # mm++; + addw $4,pr2 # nn++; + subw $1,pr3 # nl--; + bge BADDX # if(nl >= 0) goto BADDX; +BADD5: mtstw pr4,pr4 + bne BADD7 # if(car) goto BADD7; +BADD6: movw $0,pr0 # return(0); + ret +BADD7: mtstw pr1,pr1 + beq BADD9 # if(!ml) return(1); + subw $1,pr1 # ml--; +BADD8: icmpw $0,(pr0) # Z = (++(mm) == 0); + bne BADD6 # if(!Z) goto BADD6; + addw $4,pr0 # nn++; + subw $1,pr1 # nl-- + bge BADD8 # if(nl >= 0) goto BADD8; +BADD9: movw $1,pr0 # return(1); + ret + + .globl _BnnSubtractBorrow +_BnnSubtractBorrow: + mtstw pr2,pr2 + bne BSB3 # if(carryin) return(1); + mtstw pr1,pr1 + beq BSB2 # if(!nl) return(1); + subw $1,pr1 # nl--; +BSB1: dcmpw $-1,(pr0) # Z = (--(nn) == -1); + bne BSB3 # if(!Z) goto BSB3; + addw $4,pr0 # nn++; + subw $1,pr1 # nl-- + bge BSB1 # if(nl >= 0) goto BSB1; +BSB2: movw $0,pr0 # return(0); + ret +BSB3: movw $1,pr0 # return(1); + ret + + + .globl _BnnSubtract +_BnnSubtract: subw pr3,pr1 # ml -= nl; + mtstw pr3,pr3 + beq BS5 # if(!nl) goto BS5; +BS1: subw $1,pr3 # nl--; +BSX: movw (pr0),pr5 # X1 = *mm + bicpsw $1 + bispsw pr4 # Set the carry C; + subwb (pr2),pr5 # X1 -= *nn + C; + mpsw pr4 + andw $1,pr4 # get the carry C; + movw pr5,(pr0) # *mm = X1; + addw $4,pr0 # mm++; + addw $4,pr2 # nn++; + subw $1,pr3 # nl--; + bge BSX # if(nl >= 0) goto BSX; +BS5: mtstw pr4,pr4 + beq BS7 # if(!car) goto BS7; +BS6: movw $1,pr0 # return(1); + ret +BS7: mtstw pr1,pr1 + beq BS9 # if(!ml) return(1); + subw $1,pr1 # ml--; +BS8: dcmpw $-1,(pr0) # Z = (--(mm) == -1); + bne BS6 # if(!Z) goto BS6; + addw $4,pr0 # nn++; + subw $1,pr1 # nl-- + bge BS8 # if(nl >= 0) goto BS8; +BS9: movw $0,pr0 # return(0); + ret + + .globl _BnnMultiplyDigit # (pp, pl, mm, ml, d) +_BnnMultiplyDigit: + mtstw pr4,pr4 + bne BMD1 # if(!d) return(0); + movw $0,pr0 + ret +BMD1: ucmpw $1,pr4 + bne BMD2 # if(d != 1) goto BMD2; + movw $0,pr4 + br _BnnAdd # BnnAdd(p,pl,m,ml,0); +BMD2: subw pr3,pr1 # pl -= ml; + movw $0,pr8 # Un zero. + movw pr8,pr7 # low = 0; + br BMD4 +BMD3: subw $1,pr3 # pl--; + movw (pr2),pr6 # X = *mm; + addw $4,pr2 # mm++; + uemul pr4,pr5 # X *= d; + addw pr7,pr6 # X += low; + addwc pr8,pr5 # X(hight) += Carry; + addw (pr0),pr6 # X += *pp; + addwc pr8,pr5 # X(hight) += Carry; + movw pr6,(pr0) # *pp = X(low); + addw $4,pr0 # pp++; + movw pr5,pr7 # low = X(Hight); +BMD4: mtstw pr3,pr3 + bne BMD3 # if(ml) goto BMD3; + addw (pr0),pr7 # low += *pp; + movw pr7,(pr0) # *pp = low; + bcs BMD7 # if(Carry) goto BMD7; +BMD6: movw $0,pr0 # return(0); + ret +BMD7: addw $4,pr0 # pp++; + subw $1,pr1 # pl--; + beq BMD10 # if(!pl) return(1); + subw $1,pr1 # pl--; +BMD8: icmpw $0,(pr0) # Z = (++(*pp) == 0) + bne BMD6 # if(!!Z) goto BADD6; + addw $4,pr0 # pp++; + subw $1,pr1 # pl-- + bge BMD8 # if(pl >= 0) goto BADD8; +BMD10: movw $1,pr0 # return(1); + ret + +# The 64 bits/32 bits unsigned division, like in Vaxes, must be simulated +#by a 64/32 signed division: +# +#N = D*Q + R +#D = 2D' + d0 +#Cas 1: 0 <= D < 2^31 +#------ +# Sous-cas 1: N < D'*2^32 -> Calcul direct signe' +# ----------- +# +# Sous-cas 2: N >= D'*2^32 +# ----------- +# N = 2N' + n0 +# N' = DQ' + R' (0 <= R' < D) +# N = 2DQ' + 2R' + n0 (0 <= 2R' + n0 < 2D) +# Si 2R' + n0 < D +# Q = 2Q' et R = 2R' + n0 +# sinon Q = 2Q' + 1 et R = 2R' + n0 - D +# +#Cas 2: 2^31 <= D < 2^32 +#------ +# N = 8N' + 4n2 + 2n1 + n0 +# N' = D'Q' + R' (0 <= R' <= D' - 1) +# N = 8D'Q' + 8R' + 4n2 + 2n1 + n0 +# N = 4DQ' + 8R' + 4n2 + 2n1 + n0 - 4Q'd0 +# N = 4DQ' + 2(2(2R' + n2 - Q'd0) + n1) + n0 (0 <= 2R' + n2 < D) +# Q' < 2^31 <= D +# -D <= R1 = 2R' + n2 - Q'd0 < D +# Si d0 = 1 et -D < R1 < 0 +# Q1 = Q' - 1; R1 = R1 + D +# N = 4Q1D + 2(2R1 + n1) + n0 +# Q0 = 2Q1; R0 = 2R1 + n1 +# Si R2 >= D +# Q0 = Q0 + 1; R2 = R2 - D +# N = 2Q0 + 2R0 + n0 +# Q = 2Q0; R = 2R0 + n0 +# Si R >= d +# Q = Q + 1; R = R - D + .globl _BnnDivideDigit # (qq, nn, nl, d) +_BnnDivideDigit: + subw $1,pr2 # nl--; + mova (pr1)[pr2*0x4],pr1 # nn += nl; + mova (pr0)[pr2*0x4],pr0 # qq += nl; + movw (pr1),pr4 # N(Hight) = *nn; + movw pr3,pr6 + lshrw $1,pr6 # D' = D >> 1; + mtstw pr3,pr3 + bge BDD2 + movw pr3,lr5 + andw $1,lr5 + movw $1,lr6 # lr6 <- 0x1FFFFFFF + lshlw $29,lr6 # pour le + subw $1,lr6 # shift arithme'tique + br BDD5 +BDD1: subw $4,pr1 # nn--; + movw (pr1),pr5 # N(low) = *nn; + ucmpw pr6,pr4 + blt BDD11 # if(N < D'*2^32) goto BDD11; + movw pr5,lr0 + andw $1,lr0 # n0 = N & 1; + ashrl $1,pr4 # N = N' = N / 2; + ediv pr3,pr4 # Q = N' / D + # R = N' % D + lshlw $1,pr4 # Q = 2Q + lshlw $1,pr5 # R = 2R; + addw lr0,pr5 # R = R + n0 + ucmpw pr3,pr5 + blt BDD12 # if(R < D) goto BDD12; + addw $1,pr4 # Q = Q + 1; + subw pr3,pr5 # R = R - D; + br BDD12 # goto BDD12 +BDD11: ediv pr3,pr4 # N(Hight) = N / d; + # N(low) = N % d; +BDD12: subw $4,pr0 # qq--; + movw pr4,(pr0) # *qq = X(low); + movw pr5,pr4 +BDD2: subw $1,pr2 + bge BDD1 + movw pr4,pr0 + ret + +BDD3: subw $4,pr1 # nn--; + movw (pr1),pr5 # N(low) = *nn; + movw pr5,lr0 + andw $1,lr0 # lr0 = n0 = N & 1; + movw pr5,lr1 + andw $2,lr1 # lr1 = 2n1 = N & 2; + movw pr5,lr2 + andw $4,lr2 # lr2 = 4n2 = N & 4; + ashrl $3,pr4 # N = N' = N / 8; + andw lr6,pr4 # shift arithme'tique!! + ediv pr6,pr4 # Q' = N' / D'; + # R' = N' % D'; + addw pr5,pr5 # R1 = 2 * R'; Q1 = Q'; + mtstw lr5,lr5 + beq BDD33 # if(d0 == 0) goto BDD33; + ucmpw pr4,pr5 + bge BDD32 # if(R1 >= Q') goto BDD32; + subw pr4,pr5 # R1 = R1 - Q' + subw $1,pr4 # Q1 = Q1 - 1; + addw pr3,pr5 # R1 = R1 + D; + br BDD33 +BDD32: subw pr4,pr5 # R1 = R1 - Q' +BDD33: addw pr4,pr4 # Q0 = 2 * Q1; + addw pr5,pr5 # R0 = 2 * R1; + bcs BDD4 + ucmpw pr3,pr5 + blt BDD40 # if(R0 < D) goto BDD40; +BDD4: addw $1,pr4 # Q0 = Q0 + 1; + subw pr3,pr5 # R0 = R0 - D +BDD40: addw pr4,pr4 # Q = 2 * Q0; + addw pr5,pr5 # R = 2 * R0; + bcs BDD41 + ucmpw pr3,pr5 + blt BDD42 # if(R < D) goto BDD42; +BDD41: addw $1,pr4 # Q = Q + 1; + subw pr3,pr5 # R = R - D; +BDD42: addw lr2,pr5 + addw lr1,pr5 + addw lr0,pr5 # R = R + lr2 + lr1 + lr0; + ucmpw pr3,pr5 + blt BDD43 # if(R < D) goto BDD43 + addw $1,pr4 # Q = Q + 1; + subw pr3,pr5 # R = R - D; +BDD43: subw $4,pr0 # qq--; + movw pr4,(pr0) # *qq = X(low); + movw pr5,pr4 +BDD5: subw $1,pr2 + bge BDD3 + movw pr4,pr0 + ret + diff --git a/otherlibs/num/bignum/s/sparcKerN.s b/otherlibs/num/bignum/s/sparcKerN.s new file mode 100644 index 000000000..2626d70c4 --- /dev/null +++ b/otherlibs/num/bignum/s/sparcKerN.s @@ -0,0 +1,643 @@ +! Copyright Digital Equipment Corporation 1991 +! Last modified_on Fri Mar 1 17:21:25 GMT+1:00 1991 by shand +! +! KerN for SPARC +! Mark Shand +! +! Implementation notes: +! +! Initial implementations of sparc offer very limited support for +! integer multiplication, so BnnMultiplyDigit is based on +! double precision floating point multiplies that compute +! a 16x32->48 bit result without round-off. Performance is +! not great, but is about twice as good as using the integer +! multiply primitives directly. +! +! BnnDivideDigit uses the unmodified assembly code produced +! by cc -O2 KerN.c +! + .seg "text" ! [internal] + .proc 16 + .global _BnnSetToZero +_BnnSetToZero: + deccc %o1 + bneg LBSZ3 ! is zero + andcc 1,%o1,%o2 + be LBSZ2 ! is odd + nop + dec 4,%o0 +LBSZ1: ! [internal] + inc 8,%o0 + st %g0,[%o0-4] +LBSZ2: + deccc 2,%o1 + bpos LBSZ1 + st %g0,[%o0] +LBSZ3: + retl + nop ! [internal] +! +! + .proc 16 + .global _BnnAssign +_BnnAssign: + cmp %o0,%o1 + bgt,a LBAG2 ! if(mm >= nn) goto LBAG2 + tst %o2 + be LBAGX + tst %o2 + be LBAGX ! if(nl==0) return + nop +LBAG1: + ld [%o1],%o3 + inc 4,%o1 + st %o3,[%o0] + deccc %o2 + bgt LBAG1 + inc 4,%o0 +LBAGX: + retl + nop +LBAG2: + be LBAGX ! if(nl==0) return + sll %o2,2,%o3 ! nl <<= 2 + add %o1,%o3,%o1 ! nn += nl + add %o0,%o3,%o0 ! mm += nl +LBAG3: + dec 4,%o1 + ld [%o1],%o3 ! %o3 = *--nn + dec 4,%o0 + deccc %o2 + bgt LBAG3 + st %o3,[%o0] ! *--mm = %o3 + retl + nop +! +! + .proc 16 + .global _BnnSetDigit +_BnnSetDigit: + retl + st %o1,[%o0] +! +! + .proc 14 + .global _BnnGetDigit +_BnnGetDigit: + retl + ld [%o0],%o0 +! +! + .proc 14 + .global _BnnNumDigits +_BnnNumDigits: + tst %o1 + sll %o1,2,%o3 + be LBND2 + add %o0,%o3,%o4 + dec 4,%o4 +LBND1: + ld [%o4],%o2 + tst %o2 + bne LBND2 + deccc %o1 + bne,a LBND1 + dec 4,%o4 +LBND2: + retl + add 1,%o1,%o0 +! +! + .proc 14 + .global _BnnNumLeadingZeroBitsInDigit +_BnnNumLeadingZeroBitsInDigit: + addcc %o0,%g0,%o5 ! %o5 = d + be LBLZX ! if(!d) goto BLZX + sethi %hi(0xffff0000),%o1 ! mask = 0xffff0000 + mov 1,%o0 ! p = 1 + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ1 + sll %o1,8,%o1 + sll %o5,16,%o5 + or 16,%o0,%o0 +LBLZ1: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ2 + sll %o1,4,%o1 + sll %o5,8,%o5 + or 8,%o0,%o0 +LBLZ2: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ3 + sll %o1,2,%o1 + sll %o5,4,%o5 + or 4,%o0,%o0 +LBLZ3: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ4 + nop + sll %o5,2,%o5 + or 2,%o0,%o0 +LBLZ4: + srl %o5,31,%o5 ! %o5 = (d & 0x80000000) != 0 + retl + xor %o0,%o5,%o0 +LBLZX: + retl + mov 32,%o0 + .proc 4 + .global _BnnDoesDigitFitInWord +_BnnDoesDigitFitInWord: + retl + mov 1,%o0 + .proc 4 + .global _BnnIsDigitZero +_BnnIsDigitZero: + tst %o0 + bne,a LBDZ0 + mov 0,%o1 + mov 1,%o1 +LBDZ0: + retl + add %g0,%o1,%o0 + .proc 4 + .global _BnnIsDigitNormalized +_BnnIsDigitNormalized: + retl + srl %o0,31,%o0 + .proc 4 + .global _BnnIsDigitOdd +_BnnIsDigitOdd: + retl + and %o0,1,%o0 + .proc 4 + .global _BnnCompareDigits +_BnnCompareDigits: + cmp %o0,%o1 + bleu LBCD1 + mov -1,%o0 + retl + mov 1,%o0 +LBCD1: ! [internal] + be,a LBCD2 + mov 0,%o0 +LBCD2: + retl + nop ! [internal] + .proc 16 + .global _BnnComplement +_BnnComplement: + deccc %o1 + bneg LE129 + nop +LY11: ! [internal] + ld [%o0],%o2 + xor %o2,-1,%o2 + st %o2,[%o0] + deccc %o1 + bpos LY11 + inc 4,%o0 +LE129: + retl + nop ! [internal] + .proc 16 + .global _BnnAndDigits +_BnnAndDigits: + ld [%o0],%o2 + and %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 16 + .global _BnnOrDigits +_BnnOrDigits: + ld [%o0],%o2 + or %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 16 + .global _BnnXorDigits +_BnnXorDigits: + ld [%o0],%o2 + xor %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 14 + .global _BnnShiftLeft +_BnnShiftLeft: + tst %o2 + be L77105 + mov 0,%o4 + deccc %o1 + mov 32,%o3 + bneg L77105 + sub %o3,%o2,%o3 +LY12: ! [internal] + ld [%o0],%o5 + sll %o5,%o2,%g1 + or %g1,%o4,%g1 + st %g1,[%o0] + deccc %o1 + srl %o5,%o3,%o4 + bpos LY12 + inc 4,%o0 +L77105: + retl + add %g0,%o4,%o0 + .proc 14 + .global _BnnShiftRight +_BnnShiftRight: + tst %o2 + be L77114 + mov 0,%o4 + sll %o1,2,%g1 + deccc %o1 + mov 32,%o3 + add %o0,%g1,%o0 + bneg L77114 + sub %o3,%o2,%o3 +LY13: ! [internal] + dec 4,%o0 + ld [%o0],%o5 + srl %o5,%o2,%g2 + or %g2,%o4,%g2 + deccc %o1 + sll %o5,%o3,%o4 + bpos LY13 + st %g2,[%o0] +L77114: + retl + add %g0,%o4,%o0 + .proc 14 + .global _BnnAddCarry ! (mm, ml, car) +_BnnAddCarry: + tst %o2 + be LBACX0 ! if(car == 0) return(0); + tst %o1 + be LBACX1 ! if(nl == 0) return(1); + nop +LBACL: + ld [%o0],%o3 + inccc %o3 + bcc LBACX0 + st %o3,[%o0] + deccc %o1 + bgt LBACL + inc 4,%o0 +LBACX1: + retl + mov 1,%o0 +LBACX0: + retl + mov 0,%o0 + .proc 14 + .global _BnnAdd ! (mm ml nn nl car) +_BnnAdd: + sub %o1,%o3,%o1 ! ml -= nl + tst %o3 + be,a _BnnAddCarry ! if (nl == 0) %o2 = car; goto AddCarry + mov %o4,%o2 +LBAD1: + ld [%o2],%o5 ! o5 = *nn + addcc -1,%o4,%g0 ! set C = carin + ld [%o0],%o4 ! o4 = *mm + inc 4,%o2 + addxcc %o5,%o4,%o5 ! o5 = *mm + *nn, C = carout + addx %g0,%g0,%o4 ! o4 = carout + st %o5,[%o0] + deccc %o3 + bne LBAD1 + inc 4,%o0 + b _BnnAddCarry + mov %o4,%o2 + .proc 14 + .global _BnnSubtractBorrow ! (mm, ml, car) +_BnnSubtractBorrow: + tst %o2 + bne LSBBX1 ! if(car == 1) return(1); + tst %o1 + be LSBBX0 ! if(nl == 0) return(0); + nop +LSBBL: + ld [%o0],%o3 + deccc %o3 + bcc LSBBX1 + st %o3,[%o0] + deccc %o1 + bgt LSBBL + inc 4,%o0 +LSBBX0: + retl + mov 0,%o0 +LSBBX1: + retl + mov 1,%o0 + .proc 14 + .global _BnnSubtract ! (mm ml nn nl car) +_BnnSubtract: + sub %o1,%o3,%o1 ! ml -= nl + tst %o3 + be,a _BnnSubtractBorrow ! if (nl == 0) %o2 = car; goto SubBorrow + mov %o4,%o2 +LSUB1: + ld [%o2],%o5 ! o5 = *nn + deccc %o4 ! set C = carin + ld [%o0],%o4 ! o4 = *mm + inc 4,%o2 + subxcc %o4,%o5,%o5 ! o5 = *mm + *nn, C = carout + mov 1,%o4 + subx %o4,%g0,%o4 ! o4 = carout + st %o5,[%o0] + deccc %o3 + bne LSUB1 + inc 4,%o0 + b _BnnSubtractBorrow + mov %o4,%o2 + .proc 14 + .global _BnnMultiplyDigit +_BnnMultiplyDigit: +!#PROLOGUE# 0 +!#PROLOGUE# 1 + tst %o4 + bne LMDnonzero + cmp %o4,1 + retl + mov 0,%o0 +LMDnonzero: + bne LMD0 + mov 0,%o5 + b _BnnAdd ! shortcut to BnnAdd + mov 0,%o4 ! carry in = 0 +LMD0: + save %sp,-96,%sp + tst %i3 + be L77007 + sub %i1,%i3,%l1 +LMD1: + ld [%i0],%l7 + mov %i4,%y + ld [%i2],%l0 + addcc %g0,%g0,%o0 ! initialize + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%l0,%o0; mulscc %o0,%l0,%o0; + mulscc %o0,%g0,%o0 ! align + tst %l0 + blt,a LMDsignfix + add %o0,%i4,%o0 +LMDsignfix: + mov %o0,%o1 + mov %y,%o0 + addcc %o0,%i5,%i1 + inc 4,%i2 + addx %o1,%g0,%i5 + addcc %l7,%i1,%l7 + addx %g0,%i5,%i5 + st %l7,[%i0] + deccc %i3 + bgt LMD1 + inc 4,%i0 +L77007: + tst %i5 + be LMDexit + deccc %l1 +LY3: ! [internal] + blt LMDexit + inc 4,%i0 + ld [%i0-4],%i1 + addcc %i1,%i5,%i1 + addxcc %g0,%g0,%i5 + st %i1,[%i0-4] + bne,a LY3 + deccc %l1 +LMDexit: + ret + restore %g0,%i5,%o0 + .proc 14 + .align 4 + .global _BnnDivideDigit + .proc 016 +_BnnDivideDigit: + !#PROLOGUE# 0 + save %sp,-120,%sp + !#PROLOGUE# 1 + mov %i0,%l3 + call _BnnNumLeadingZeroBitsInDigit,0 + mov %i3,%o0 + orcc %o0,%g0,%l6 + be L146 + mov %i1,%o0 + mov %i2,%l7 + sll %i3,%l6,%i3 + mov %l7,%o1 + ld [%l3-4],%o3 + mov %l6,%o2 + call _BnnShiftLeft,0 + st %o3,[%fp-20] +L146: + sll %i2,2,%o0 + add %i1,%o0,%i1 + add %i2,-1,%i2 + sll %i2,2,%o0 + add %l3,%o0,%l3 + add %i1,-4,%i1 + ld [%i1],%i0 + cmp %i2,0 + srl %i3,16,%l4 + sethi %hi(65535),%o0 + or %o0,%lo(65535),%o0 + be L148 + and %i3,%o0,%i4 + sll %i4,16,%l5 + mov %o0,%i5 +L163: + add %i2,-1,%i2 + mov %i0,%l1 + add %i1,-4,%i1 + ld [%i1],%i0 + mov %l1,%o0 + call .udiv,0 + mov %l4,%o1 + mov %o0,%l2 + mov %i4,%o0 + call .umul,0 + mov %l2,%o1 + mov %o0,%l0 + mov %l4,%o0 + call .umul,0 + mov %l2,%o1 + mov %o0,%o2 + srl %l0,16,%o0 + add %o2,%o0,%o2 + b L149 + sll %l0,16,%l0 +L154: + bleu L155 + add %l1,-1,%o0 + cmp %l5,%l0 +L172: + bleu L152 + add %l2,-1,%l2 + sub %l0,%l5,%l0 + add %o2,-1,%o0 + b L149 + sub %o0,%l4,%o2 +L152: + sub %l0,%l5,%l0 + sub %o2,%l4,%o2 +L149: + cmp %o2,%l1 + bgu L172 + cmp %l5,%l0 + cmp %o2,%l1 + be L154 + cmp %l0,%i0 + bleu L155 + add %l1,-1,%o0 + sub %i0,%l0,%i0 + b L156 + sub %o0,%o2,%l1 +L155: + sub %i0,%l0,%i0 + sub %l1,%o2,%l1 +L156: + add %l3,-4,%l3 + sll %l2,16,%o0 + st %o0,[%l3] + sll %l1,16,%o0 + srl %i0,16,%o1 + or %o0,%o1,%o0 + call .udiv,0 + mov %l4,%o1 + mov %o0,%l2 + mov %i4,%o0 + call .umul,0 + mov %l2,%o1 + mov %o0,%l0 + mov %l4,%o0 + call .umul,0 + mov %l2,%o1 + mov %o0,%o2 + srl %l0,16,%o0 + add %o2,%o0,%o2 + and %l0,%i5,%o1 + and %o2,%i5,%o0 + sll %o0,16,%o0 + or %o1,%o0,%l0 + b L157 + srl %o2,16,%o2 +L162: + bleu,a L173 + sub %i0,%l0,%i0 + cmp %i3,%l0 +L174: + bleu L160 + add %l2,-1,%l2 + sub %l0,%i3,%l0 + b L157 + add %o2,-1,%o2 +L160: + sub %l0,%i3,%l0 +L157: + cmp %o2,%l1 + bgu L174 + cmp %i3,%l0 + cmp %o2,%l1 + be L162 + cmp %l0,%i0 + sub %i0,%l0,%i0 +L173: + ld [%l3],%o0 + cmp %i2,0 + or %l2,%o0,%o0 + bne L163 + st %o0,[%l3] +L148: + cmp %l6,0 + be L164 + cmp %l3,%i1 + bleu L175 + sll %l7,2,%o0 + add %i1,%o0,%o0 + cmp %l3,%o0 + bgeu L165 + sub %l3,%i1,%o0 + sra %o0,2,%l7 + mov %i1,%o0 + mov %l7,%o1 + call _BnnShiftRight,0 + mov %l6,%o2 + sll %l7,2,%o0 + ld [%fp-20],%o3 + add %o0,%i1,%o0 + b L164 + st %o3,[%o0-4] +L165: + cmp %l3,%i1 +L175: + bne L167 + mov %i1,%o0 + sll %l7,2,%o0 + add %o0,-4,%o0 + add %i1,%o0,%o0 + b L170 + mov 1,%o1 +L167: + mov %l7,%o1 +L170: + call _BnnShiftRight,0 + mov %l6,%o2 +L164: + srl %i0,%l6,%i0 + ret + restore + .seg "data" ! [internal] +_copyright: + .half 0x4028 + .half 0x2329 + .half 0x4b65 + .half 0x724e + .half 0x2e63 + .half 0x3a20 + .half 0x636f + .half 0x7079 + .half 0x7269 + .half 0x6768 + .half 0x7420 + .half 0x4469 + .half 0x6769 + .half 0x7461 + .half 0x6c20 + .half 0x4571 + .half 0x7569 + .half 0x706d + .half 0x656e + .half 0x7420 + .half 0x436f + .half 0x7270 + .half 0x6f72 + .half 0x6174 + .half 0x696f + .half 0x6e20 + .half 0x2620 + .half 0x494e + .half 0x5249 + .half 0x4120 + .half 0x3139 + .half 0x3838 + .half 0x2c20 + .half 0x3139 + .half 0x3839 + .half 0xa00 diff --git a/otherlibs/num/bignum/s/sparcfpuKerN.s b/otherlibs/num/bignum/s/sparcfpuKerN.s new file mode 100644 index 000000000..5e0a6dfd0 --- /dev/null +++ b/otherlibs/num/bignum/s/sparcfpuKerN.s @@ -0,0 +1,741 @@ +! Copyright Digital Equipment Corporation 1991 +! Last modified_on Fri Jan 25 23:11:58 GMT+1:00 1991 by shand +! +! KerN for SPARC +! Mark Shand +! +! Implementation notes: +! +! Initial implementations of sparc offer very limited support for +! integer multiplication, so BnnMultiplyDigit is based on +! double precision floating point multiplies that compute +! a 16x32->48 bit result without round-off. Performance is +! not great, but is about twice as good as using the integer +! multiply primitives directly. +! +! BnnDivideDigit uses the unmodified assembly code produced +! by cc -O2 KerN.c +! + .seg "text" ! [internal] + .proc 16 + .global _BnnSetToZero +_BnnSetToZero: + deccc %o1 + bneg LBSZ3 ! is zero + andcc 1,%o1,%o2 + be LBSZ2 ! is odd + nop + dec 4,%o0 +LBSZ1: ! [internal] + inc 8,%o0 + st %g0,[%o0-4] +LBSZ2: + deccc 2,%o1 + bpos LBSZ1 + st %g0,[%o0] +LBSZ3: + retl + nop ! [internal] +! +! + .proc 16 + .global _BnnAssign +_BnnAssign: + cmp %o0,%o1 + bgt,a LBAG2 ! if(mm >= nn) goto LBAG2 + tst %o2 + be LBAGX + tst %o2 + be LBAGX ! if(nl==0) return + nop +LBAG1: + ld [%o1],%o3 + inc 4,%o1 + st %o3,[%o0] + deccc %o2 + bgt LBAG1 + inc 4,%o0 +LBAGX: + retl + nop +LBAG2: + be LBAGX ! if(nl==0) return + sll %o2,2,%o3 ! nl <<= 2 + add %o1,%o3,%o1 ! nn += nl + add %o0,%o3,%o0 ! mm += nl +LBAG3: + dec 4,%o1 + ld [%o1],%o3 ! %o3 = *--nn + dec 4,%o0 + deccc %o2 + bgt LBAG3 + st %o3,[%o0] ! *--mm = %o3 + retl + nop +! +! + .proc 16 + .global _BnnSetDigit +_BnnSetDigit: + retl + st %o1,[%o0] +! +! + .proc 14 + .global _BnnGetDigit +_BnnGetDigit: + retl + ld [%o0],%o0 +! +! + .proc 14 + .global _BnnNumDigits +_BnnNumDigits: + tst %o1 + sll %o1,2,%o3 + be LBND2 + add %o0,%o3,%o4 + dec 4,%o4 +LBND1: + ld [%o4],%o2 + tst %o2 + bne LBND2 + deccc %o1 + bne,a LBND1 + dec 4,%o4 +LBND2: + retl + add 1,%o1,%o0 +! +! + .proc 14 + .global _BnnNumLeadingZeroBitsInDigit +_BnnNumLeadingZeroBitsInDigit: + addcc %o0,%g0,%o5 ! %o5 = d + be LBLZX ! if(!d) goto BLZX + sethi %hi(0xffff0000),%o1 ! mask = 0xffff0000 + mov 1,%o0 ! p = 1 + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ1 + sll %o1,8,%o1 + sll %o5,16,%o5 + or 16,%o0,%o0 +LBLZ1: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ2 + sll %o1,4,%o1 + sll %o5,8,%o5 + or 8,%o0,%o0 +LBLZ2: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ3 + sll %o1,2,%o1 + sll %o5,4,%o5 + or 4,%o0,%o0 +LBLZ3: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ4 + nop + sll %o5,2,%o5 + or 2,%o0,%o0 +LBLZ4: + srl %o5,31,%o5 ! %o5 = (d & 0x80000000) != 0 + retl + xor %o0,%o5,%o0 +LBLZX: + retl + mov 32,%o0 + .proc 4 + .global _BnnDoesDigitFitInWord +_BnnDoesDigitFitInWord: + retl + mov 1,%o0 + .proc 4 + .global _BnnIsDigitZero +_BnnIsDigitZero: + tst %o0 + bne,a LBDZ0 + mov 0,%o1 + mov 1,%o1 +LBDZ0: + retl + add %g0,%o1,%o0 + .proc 4 + .global _BnnIsDigitNormalized +_BnnIsDigitNormalized: + retl + srl %o0,31,%o0 + .proc 4 + .global _BnnIsDigitOdd +_BnnIsDigitOdd: + retl + and %o0,1,%o0 + .proc 4 + .global _BnnCompareDigits +_BnnCompareDigits: + cmp %o0,%o1 + bleu LBCD1 + mov -1,%o0 + retl + mov 1,%o0 +LBCD1: ! [internal] + be,a LBCD2 + mov 0,%o0 +LBCD2: + retl + nop ! [internal] + .proc 16 + .global _BnnComplement +_BnnComplement: + deccc %o1 + bneg LE129 + nop +LY11: ! [internal] + ld [%o0],%o2 + xor %o2,-1,%o2 + st %o2,[%o0] + deccc %o1 + bpos LY11 + inc 4,%o0 +LE129: + retl + nop ! [internal] + .proc 16 + .global _BnnAndDigits +_BnnAndDigits: + ld [%o0],%o2 + and %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 16 + .global _BnnOrDigits +_BnnOrDigits: + ld [%o0],%o2 + or %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 16 + .global _BnnXorDigits +_BnnXorDigits: + ld [%o0],%o2 + xor %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 14 + .global _BnnShiftLeft +_BnnShiftLeft: + tst %o2 + be L77105 + mov 0,%o4 + deccc %o1 + mov 32,%o3 + bneg L77105 + sub %o3,%o2,%o3 +LY12: ! [internal] + ld [%o0],%o5 + sll %o5,%o2,%g1 + or %g1,%o4,%g1 + st %g1,[%o0] + deccc %o1 + srl %o5,%o3,%o4 + bpos LY12 + inc 4,%o0 +L77105: + retl + add %g0,%o4,%o0 + .proc 14 + .global _BnnShiftRight +_BnnShiftRight: + tst %o2 + be L77114 + mov 0,%o4 + sll %o1,2,%g1 + deccc %o1 + mov 32,%o3 + add %o0,%g1,%o0 + bneg L77114 + sub %o3,%o2,%o3 +LY13: ! [internal] + dec 4,%o0 + ld [%o0],%o5 + srl %o5,%o2,%g2 + or %g2,%o4,%g2 + deccc %o1 + sll %o5,%o3,%o4 + bpos LY13 + st %g2,[%o0] +L77114: + retl + add %g0,%o4,%o0 + .proc 14 + .global _BnnAddCarry ! (mm, ml, car) +_BnnAddCarry: + tst %o2 + be LBACX0 ! if(car == 0) return(0); + tst %o1 + be LBACX1 ! if(nl == 0) return(1); + nop +LBACL: + ld [%o0],%o3 + inccc %o3 + bcc LBACX0 + st %o3,[%o0] + deccc %o1 + bgt LBACL + inc 4,%o0 +LBACX1: + retl + mov 1,%o0 +LBACX0: + retl + mov 0,%o0 + .proc 14 + .global _BnnAdd ! (mm ml nn nl car) +_BnnAdd: + sub %o1,%o3,%o1 ! ml -= nl + tst %o3 + be,a _BnnAddCarry ! if (nl == 0) %o2 = car; goto AddCarry + mov %o4,%o2 +LBAD1: + ld [%o2],%o5 ! o5 = *nn + addcc -1,%o4,%g0 ! set C = carin + ld [%o0],%o4 ! o4 = *mm + inc 4,%o2 + addxcc %o5,%o4,%o5 ! o5 = *mm + *nn, C = carout + addx %g0,%g0,%o4 ! o4 = carout + st %o5,[%o0] + deccc %o3 + bne LBAD1 + inc 4,%o0 + b _BnnAddCarry + mov %o4,%o2 + .proc 14 + .global _BnnSubtractBorrow ! (mm, ml, car) +_BnnSubtractBorrow: + tst %o2 + bne LSBBX1 ! if(car == 1) return(1); + tst %o1 + be LSBBX0 ! if(nl == 0) return(0); + nop +LSBBL: + ld [%o0],%o3 + deccc %o3 + bcc LSBBX1 + st %o3,[%o0] + deccc %o1 + bgt LSBBL + inc 4,%o0 +LSBBX0: + retl + mov 0,%o0 +LSBBX1: + retl + mov 1,%o0 + .proc 14 + .global _BnnSubtract ! (mm ml nn nl car) +_BnnSubtract: + sub %o1,%o3,%o1 ! ml -= nl + tst %o3 + be,a _BnnSubtractBorrow ! if (nl == 0) %o2 = car; goto SubBorrow + mov %o4,%o2 +LSUB1: + ld [%o2],%o5 ! o5 = *nn + deccc %o4 ! set C = carin + ld [%o0],%o4 ! o4 = *mm + inc 4,%o2 + subxcc %o4,%o5,%o5 ! o5 = *mm + *nn, C = carout + mov 1,%o4 + subx %o4,%g0,%o4 ! o4 = carout + st %o5,[%o0] + deccc %o3 + bne LSUB1 + inc 4,%o0 + b _BnnSubtractBorrow + mov %o4,%o2 + .proc 14 + .global _BnnMultiplyDigit ! (pp pl mm ml d) +! Assembler version of BnnMultiplyDigit is derived from the +! following code. +! +! BigNumCarry +! BnnMultiplyDigit(pp, pl, mm, ml, d) +! register BigNum pp, mm; +! int pl, ml; +! BigNumDigit d; +! { +! register double fd, lowAlignR; +! register BigNumDigit carry = 0; +! +! fd = (double) d; +! lowAlignR = (65536.0*65536.0*65536.0*16.0); +! +! pl -= ml; +! +! while (ml--) +! { +! BigNumDigit md, pd; +! register BigNumDigit tmp0, tmp1; +! register double fmh, fml; +! double fmlxd, fmhxd; +! +! md = *mm++; +! pd = *pp; +! fml = (double) (int) (md & 0xffff); +! fmh = (double) (int) (md >> 16); +! fmlxd = fd*fml + lowAlignR; +! fmhxd = fd*fmh + lowAlignR; +! pd += carry; +! carry = (pd < carry); +! tmp0 = ((unsigned long *)(&fmlxd))[1]; +! carry += (((unsigned long *)(&fmlxd))[0]) &0xffff; +! if ((pd += tmp0) < tmp0) carry++; +! tmp0 = ((unsigned long *)(&fmhxd))[1]; +! tmp1 = tmp0 << 16; +! if ((pd += tmp1) < tmp1) carry++; +! carry += (tmp0 >> 16); +! carry += (((unsigned long *)(&fmhxd))[0]) << 16; +! /* assert carry:pd = d*md + *pp + carry(in) */ +! *pp++ = pd; +! } +! +! while (carry && pl--) +! { +! BigNumDigit pd; +! +! pd = *pp; +! carry = (pd += carry) < carry; +! *pp++ = pd; +! } +! return carry; +! } +_BnnMultiplyDigit: +!#PROLOGUE# 0 +!#PROLOGUE# 1 + save %sp,-120,%sp ! establish stack frame + st %i4,[%sp+LP61+32] ! mem = d + ld [%sp+LP61+32],%f0 ! f0 = d + fitod %f0,%f26 ! f26 = (double) d + mov 0,%i5 ! carry = 0 + tst %i4 ! if (i >= 0) + bge LBMD1 ! goto LBMD1 + sethi %hi(L2pwr32),%o0 + ldd [%o0+%lo(L2pwr32)],%f4 ! f4 = 2^32 + faddd %f26,%f4,%f26 ! f26 += 2^32 +LBMD1: + sethi %hi(L2pwr52),%o1 + ldd [%o1+%lo(L2pwr52)],%f24 ! f24 = 2^52 + tst %i3 ! ml? + be LBMDExit ! if (ml == 0) + sub %i1,%i3,%i1 ! goto LBMDExit; pl -= ml + st %g0,[%sp+LP61+32] ! clr [%sp+LP61+32] +LBMDpxdLoop: + ld [%i2],%o4 ! o4 = md = *mm + sth %o4,[%sp+LP61+34] ! o4 & 0xffff -> mem + ld [%sp+LP61+32],%f7 ! f7 <- mem + fitod %f7,%f30 ! fml = (double) (md & 0xffff) + srl %o4,16,%o4 ! o4 = md >> 16 + st %o4,[%sp+LP61+32] ! i4 -> mem + ! fitod + 8 cycles. f30 ready on SS1 + fmuld %f26,%f30,%f12 ! f12 = fd * fml + ld [%sp+LP61+32],%f9 ! f9 <- mem + fitod %f9,%f28 ! fmh = (double) (md >> 16) + ld [%i0],%l7 ! pd = l7 = *pp + inc 4,%i2 ! mm++ + inc 4,%i0 ! pp++ + ! fmuld + 10 fitod + 6. f28 ready, mul/add unit available on SS1 + faddd %f12,%f24,%f14 ! f14 = f12 + 2^52 + fmuld %f26,%f28,%f16 ! f16 = fd * fmh + addcc %l7,%i5,%i4 ! pd += carry{in} + ! 1 cycle stall of faddd + st %f15,[%fp-4] ! fmlxd[low] = f15 + ! fmuld + 9. f16 ready on SS1 + faddd %f16,%f24,%f18 ! f18 = f16 + 2^52 + st %f14,[%fp-8] ! fmlxd[high] = f14 + ld [%fp-4],%l7 ! tmp0 = l7 = fmlxd[low] + lduh [%fp-6],%i5 ! i5 = fmlxd[high] & 0xffff + addx %g0,%i5,%i5 ! carry = (fmlxd[high] & 0xffff)+C + addcc %i4,%l7,%l7 ! pd += tmp0 + st %f18,[%fp-16] ! fmhxd = f18 + ld [%fp-16],%o4 ! o4 = fmhxd[high] + st %f19,[%fp-12] ! fmhxd = f18 + ld [%fp-12],%o5 ! o5 = fmhxd[low] + sll %o5,16,%l3 ! l3 = fmhxd[low] << 16 + srl %o5,16,%o5 ! o5 = fmhxd[low] >> 16 + addx %i5,%o5,%i5 ! carry += (fmhxd[low] >> 16) + C + addcc %l7,%l3,%l7 ! pd += fmhxd[low] << 16 + sll %o4,16,%l3 ! l3 = fmlxd[high] << 16 + addx %i5,%l3,%i5 ! carry += fmlxd[high] << 16 + C + deccc %i3 ! ml-- + bne LBMDpxdLoop ! if (ml > 0) + st %l7,[%i0-4] ! goto LBMDpxdLoop; pp[-1] = pd + tst %i5 + be LBMDExit ! if (!carry) + nop ! goto LBMDExit +LBMDacLoop: + deccc %i1 + blt LBMDExit + ld [%i0],%i3 + addcc %i3,%i5,%i3 + addxcc %g0,%g0,%i5 + st %i3,[%i0] + bne LBMDacLoop + inc 4,%i0 +LBMDExit: + ret + restore %g0,%i5,%o0 +LP61 = 64 + .seg "data" ! [internal] + .align 8 +L2pwr32: + .word 0x41f00000 + .word 0 + .align 8 +L2pwr52: + .word 0x43300000 + .word 0 + .seg "text" + .proc 14 + .global _BnnDivideDigit +_BnnDivideDigit: +!#PROLOGUE# 0 +!#PROLOGUE# 1 + save %sp,-112,%sp + call _BnnNumLeadingZeroBitsInDigit,1 + mov %i3,%o0 + mov %o0,%o2 + tst %o2 + be L77225 + st %o2,[%fp-8] + ld [%i0-4],%o4 + st %i2,[%fp-16] + st %o4,[%fp-12] + mov %i2,%o1 + mov %i1,%o0 + call _BnnShiftLeft,3 + sll %i3,%o2,%i3 +L77225: + sub %i2,1,%l2 + sethi %hi(0xffff),%o1 ! [internal] + or %o1,%lo(0xffff),%o1 ! [internal] + sll %i2,2,%l3 + add %i1,%l3,%l3 + dec 4,%l3 + ld [%l3],%i2 + and %i3,%o1,%l1 + sll %l2,2,%l4 + tst %l2 + srl %i3,16,%l6 + mov %o1,%l0 + sll %l1,16,%l7 + add %i0,%l4,%l4 + be L77249 + add %l6,1,%l5 +LY43: ! [internal] + dec 4,%l3 + ld [%l3],%i4 + mov %i2,%i5 + mov %i5,%o0 + call .udiv,2 + mov %l6,%o1 + mov %o0,%i1 + mov %l1,%o0 + call .umul,2 + mov %i1,%o1 + mov %o0,%i2 + mov %l6,%o0 + call .umul,2 + mov %i1,%o1 + srl %i2,16,%i0 + add %o0,%i0,%i0 + cmp %i0,%i5 + dec %l2 + bgu L77232 + sll %i2,16,%i2 + cmp %i0,%i5 + bne LY57 + cmp %i2,%i4 +LY54: ! [internal] + bleu,a LY57 + cmp %i2,%i4 +L77232: + cmp %l7,%i2 +LY55: ! [internal] + bleu L77234 + dec %i1 + sub %i2,%l7,%i2 + b L77228 + sub %i0,%l5,%i0 +LY56: ! [internal] + ld [%fp-4],%o3 + ld [%fp+68],%i0 + ld [%fp+80],%o1 + dec 4,%o0 + ld [%o0],%o0 + sll %o3,32,%o3 + call .udiv,2 + or %o3,%o0,%o0 + dec 4,%i0 + st %o0,[%i0] + ld [%fp+76],%o0 + tst %o0 + bne,a LY56 + ld [%fp+72],%o0 + b L77259 + ld [%fp-4],%i2 +L77234: + sub %i0,%l6,%i0 + sub %i2,%l7,%i2 +L77228: + cmp %i0,%i5 + bgu,a LY55 + cmp %l7,%i2 + cmp %i0,%i5 + be LY54 + cmp %i2,%i4 +LY57: ! [internal] + bleu LY47 + sub %i4,%i2,%i4 + inc %i0 +LY47: ! [internal] + sub %i5,%i0,%i5 + sll %i5,16,%o0 + srl %i4,16,%o7 + sll %i1,16,%i1 + dec 4,%l4 + st %i1,[%l4] + mov %l6,%o1 + or %o0,%o7,%o0 + call .udiv,2 + nop + mov %o0,%i1 + mov %l1,%o0 + call .umul,2 + mov %i1,%o1 + mov %o0,%i2 + mov %l6,%o0 + call .umul,2 + mov %i1,%o1 + mov %o0,%i0 + srl %i2,16,%o0 + add %i0,%o0,%i0 + and %i0,%l0,%o2 + srl %i0,16,%i0 + cmp %i0,%i5 + sll %o2,16,%o2 + and %i2,%l0,%i2 + bgu L77244 + or %i2,%o2,%i2 + cmp %i0,%i5 + bne,a LY53 + ld [%l4],%o1 + cmp %i2,%i4 +LY51: ! [internal] + bleu,a LY53 + ld [%l4],%o1 +L77244: + cmp %i3,%i2 +LY52: ! [internal] + bleu L77246 + dec %i1 + sub %i2,%i3,%i2 + b L77240 + dec %i0 +L77246: + sub %i2,%i3,%i2 +L77240: + cmp %i0,%i5 + bgu,a LY52 + cmp %i3,%i2 + cmp %i0,%i5 + be,a LY51 + cmp %i2,%i4 + ld [%l4],%o1 +LY53: ! [internal] + tst %l2 + or %o1,%i1,%o1 + sub %i4,%i2,%i2 + bne LY43 + st %o1,[%l4] +L77249: + ld [%fp-8],%o2 + tst %o2 + be,a LY50 + ld [%fp-8],%o1 + cmp %l4,%l3 + bleu,a LY49 + cmp %l4,%l3 + ld [%fp-16],%o4 + sll %o4,2,%o4 + add %l3,%o4,%o4 + cmp %l4,%o4 + bcc,a LY49 + cmp %l4,%l3 + sub %l4,%l3,%i0 + sra %i0,2,%i0 + mov %i0,%o1 + call _BnnShiftRight,3 + mov %l3,%o0 + ld [%fp-12],%o4 + dec %i0 + sll %i0,2,%i0 + b L77258 + st %o4,[%l3+%i0] +LY49: ! [internal] + bne,a LY48 + ld [%fp-16],%o1 + ld [%fp-16],%o0 + mov 1,%o1 + dec %o0 + sll %o0,2,%o0 + b LY42 + add %l3,%o0,%o0 +LY48: ! [internal] + mov %l3,%o0 +LY42: ! [internal] + call _BnnShiftRight,3 + ld [%fp-8],%o2 +L77258: + ld [%fp-8],%o1 +LY50: ! [internal] + srl %i2,%o1,%i2 +L77259: + ret + restore %g0,%i2,%o0 + .seg "data" ! [internal] +_copyright: + .half 0x4028 + .half 0x2329 + .half 0x4b65 + .half 0x724e + .half 0x2e63 + .half 0x3a20 + .half 0x636f + .half 0x7079 + .half 0x7269 + .half 0x6768 + .half 0x7420 + .half 0x4469 + .half 0x6769 + .half 0x7461 + .half 0x6c20 + .half 0x4571 + .half 0x7569 + .half 0x706d + .half 0x656e + .half 0x7420 + .half 0x436f + .half 0x7270 + .half 0x6f72 + .half 0x6174 + .half 0x696f + .half 0x6e20 + .half 0x2620 + .half 0x494e + .half 0x5249 + .half 0x4120 + .half 0x3139 + .half 0x3838 + .half 0x2c20 + .half 0x3139 + .half 0x3839 + .half 0xa00 diff --git a/otherlibs/num/bignum/s/supersparcKerN.s b/otherlibs/num/bignum/s/supersparcKerN.s new file mode 100644 index 000000000..27c0b8120 --- /dev/null +++ b/otherlibs/num/bignum/s/supersparcKerN.s @@ -0,0 +1,469 @@ +! Copyright Digital Equipment Corporation 1991 +! Last modified on Fri Mar 1 17:21:25 GMT+1:00 1991 by shand +! +! KerN for SPARC +! Mark Shand +! +! Implementation notes: +! +! Initial implementations of sparc offer very limited support for +! integer multiplication, so BnnMultiplyDigit is based on +! double precision floating point multiplies that compute +! a 16x32->48 bit result without round-off. Performance is +! not great, but is about twice as good as using the integer +! multiply primitives directly. +! +! BnnDivideDigit uses the unmodified assembly code produced +! by cc -O2 KerN.c +! + .seg "text" ! [internal] + .proc 16 + .global _BnnSetToZero +_BnnSetToZero: + deccc %o1 + bneg LBSZ3 ! is zero + andcc 1,%o1,%o2 + be LBSZ2 ! is odd + nop + dec 4,%o0 +LBSZ1: ! [internal] + inc 8,%o0 + st %g0,[%o0-4] +LBSZ2: + deccc 2,%o1 + bpos LBSZ1 + st %g0,[%o0] +LBSZ3: + retl + nop ! [internal] +! +! + .proc 16 + .global _BnnAssign +_BnnAssign: + cmp %o0,%o1 + bgt,a LBAG2 ! if(mm >= nn) goto LBAG2 + tst %o2 + be LBAGX + tst %o2 + be LBAGX ! if(nl==0) return + nop +LBAG1: + ld [%o1],%o3 + inc 4,%o1 + st %o3,[%o0] + deccc %o2 + bgt LBAG1 + inc 4,%o0 +LBAGX: + retl + nop +LBAG2: + be LBAGX ! if(nl==0) return + sll %o2,2,%o3 ! nl <<= 2 + add %o1,%o3,%o1 ! nn += nl + add %o0,%o3,%o0 ! mm += nl +LBAG3: + dec 4,%o1 + ld [%o1],%o3 ! %o3 = *--nn + dec 4,%o0 + deccc %o2 + bgt LBAG3 + st %o3,[%o0] ! *--mm = %o3 + retl + nop +! +! + .proc 16 + .global _BnnSetDigit +_BnnSetDigit: + retl + st %o1,[%o0] +! +! + .proc 14 + .global _BnnGetDigit +_BnnGetDigit: + retl + ld [%o0],%o0 +! +! + .proc 14 + .global _BnnNumDigits +_BnnNumDigits: + tst %o1 + sll %o1,2,%o3 + be LBND2 + add %o0,%o3,%o4 + dec 4,%o4 +LBND1: + ld [%o4],%o2 + tst %o2 + bne LBND2 + deccc %o1 + bne,a LBND1 + dec 4,%o4 +LBND2: + retl + add 1,%o1,%o0 +! +! + .proc 14 + .global _BnnNumLeadingZeroBitsInDigit +_BnnNumLeadingZeroBitsInDigit: + addcc %o0,%g0,%o5 ! %o5 = d + be LBLZX ! if(!d) goto BLZX + sethi %hi(0xffff0000),%o1 ! mask = 0xffff0000 + mov 1,%o0 ! p = 1 + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ1 + sll %o1,8,%o1 + sll %o5,16,%o5 + or 16,%o0,%o0 +LBLZ1: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ2 + sll %o1,4,%o1 + sll %o5,8,%o5 + or 8,%o0,%o0 +LBLZ2: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ3 + sll %o1,2,%o1 + sll %o5,4,%o5 + or 4,%o0,%o0 +LBLZ3: + andcc %o1,%o5,%g0 ! mask & d + bne LBLZ4 + nop + sll %o5,2,%o5 + or 2,%o0,%o0 +LBLZ4: + srl %o5,31,%o5 ! %o5 = (d & 0x80000000) != 0 + retl + xor %o0,%o5,%o0 +LBLZX: + retl + mov 32,%o0 + .proc 4 + .global _BnnDoesDigitFitInWord +_BnnDoesDigitFitInWord: + retl + mov 1,%o0 + .proc 4 + .global _BnnIsDigitZero +_BnnIsDigitZero: + tst %o0 + bne,a LBDZ0 + mov 0,%o1 + mov 1,%o1 +LBDZ0: + retl + add %g0,%o1,%o0 + .proc 4 + .global _BnnIsDigitNormalized +_BnnIsDigitNormalized: + retl + srl %o0,31,%o0 + .proc 4 + .global _BnnIsDigitOdd +_BnnIsDigitOdd: + retl + and %o0,1,%o0 + .proc 4 + .global _BnnCompareDigits +_BnnCompareDigits: + cmp %o0,%o1 + bleu LBCD1 + mov -1,%o0 + retl + mov 1,%o0 +LBCD1: ! [internal] + be,a LBCD2 + mov 0,%o0 +LBCD2: + retl + nop ! [internal] + .proc 16 + .global _BnnComplement +_BnnComplement: + deccc %o1 + bneg LE129 + nop +LY11: ! [internal] + ld [%o0],%o2 + xor %o2,-1,%o2 + st %o2,[%o0] + deccc %o1 + bpos LY11 + inc 4,%o0 +LE129: + retl + nop ! [internal] + .proc 16 + .global _BnnAndDigits +_BnnAndDigits: + ld [%o0],%o2 + and %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 16 + .global _BnnOrDigits +_BnnOrDigits: + ld [%o0],%o2 + or %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 16 + .global _BnnXorDigits +_BnnXorDigits: + ld [%o0],%o2 + xor %o2,%o1,%o2 + retl + st %o2,[%o0] + .proc 14 + .global _BnnShiftLeft +_BnnShiftLeft: + tst %o2 + be L77105 + mov 0,%o4 + deccc %o1 + mov 32,%o3 + bneg L77105 + sub %o3,%o2,%o3 +LY12: ! [internal] + ld [%o0],%o5 + sll %o5,%o2,%g1 + or %g1,%o4,%g1 + st %g1,[%o0] + deccc %o1 + srl %o5,%o3,%o4 + bpos LY12 + inc 4,%o0 +L77105: + retl + add %g0,%o4,%o0 + .proc 14 + .global _BnnShiftRight +_BnnShiftRight: + tst %o2 + be L77114 + mov 0,%o4 + sll %o1,2,%g1 + deccc %o1 + mov 32,%o3 + add %o0,%g1,%o0 + bneg L77114 + sub %o3,%o2,%o3 +LY13: ! [internal] + dec 4,%o0 + ld [%o0],%o5 + srl %o5,%o2,%g2 + or %g2,%o4,%g2 + deccc %o1 + sll %o5,%o3,%o4 + bpos LY13 + st %g2,[%o0] +L77114: + retl + add %g0,%o4,%o0 + .proc 14 + .global _BnnAddCarry ! (mm, ml, car) +_BnnAddCarry: + tst %o2 + be LBACX0 ! if(car == 0) return(0); + tst %o1 + be LBACX1 ! if(nl == 0) return(1); + nop +LBACL: + ld [%o0],%o3 + inccc %o3 + bcc LBACX0 + st %o3,[%o0] + deccc %o1 + bgt LBACL + inc 4,%o0 +LBACX1: + retl + mov 1,%o0 +LBACX0: + retl + mov 0,%o0 + .proc 14 + .global _BnnAdd ! (mm ml nn nl car) +_BnnAdd: + sub %o1,%o3,%o1 ! ml -= nl + tst %o3 + be,a _BnnAddCarry ! if (nl == 0) %o2 = car; goto AddCarry + mov %o4,%o2 +LBAD1: + ld [%o2],%o5 ! o5 = *nn + addcc -1,%o4,%g0 ! set C = carin + ld [%o0],%o4 ! o4 = *mm + inc 4,%o2 + addxcc %o5,%o4,%o5 ! o5 = *mm + *nn, C = carout + addx %g0,%g0,%o4 ! o4 = carout + st %o5,[%o0] + deccc %o3 + bne LBAD1 + inc 4,%o0 + b _BnnAddCarry + mov %o4,%o2 + .proc 14 + .global _BnnSubtractBorrow ! (mm, ml, car) +_BnnSubtractBorrow: + tst %o2 + bne LSBBX1 ! if(car == 1) return(1); + tst %o1 + be LSBBX0 ! if(nl == 0) return(0); + nop +LSBBL: + ld [%o0],%o3 + deccc %o3 + bcc LSBBX1 + st %o3,[%o0] + deccc %o1 + bgt LSBBL + inc 4,%o0 +LSBBX0: + retl + mov 0,%o0 +LSBBX1: + retl + mov 1,%o0 + .proc 14 + .global _BnnSubtract ! (mm ml nn nl car) +_BnnSubtract: + sub %o1,%o3,%o1 ! ml -= nl + tst %o3 + be,a _BnnSubtractBorrow ! if (nl == 0) %o2 = car; goto SubBorrow + mov %o4,%o2 +LSUB1: + ld [%o2],%o5 ! o5 = *nn + deccc %o4 ! set C = carin + ld [%o0],%o4 ! o4 = *mm + inc 4,%o2 + subxcc %o4,%o5,%o5 ! o5 = *mm + *nn, C = carout + mov 1,%o4 + subx %o4,%g0,%o4 ! o4 = carout + st %o5,[%o0] + deccc %o3 + bne LSUB1 + inc 4,%o0 + b _BnnSubtractBorrow + mov %o4,%o2 + .proc 14 + .global _BnnMultiplyDigit +_BnnMultiplyDigit: +!#PROLOGUE# 0 +!#PROLOGUE# 1 + tst %o4 + bne LMDnonzero + cmp %o4,1 + retl + mov 0,%o0 +LMDnonzero: + bne LMD0 + mov 0,%o5 + b _BnnAdd ! shortcut to BnnAdd + mov 0,%o4 ! carry in = 0 +LMD0: + save %sp,-96,%sp + tst %i3 + be L77007 + sub %i1,%i3,%l1 +LMD1: + ld [%i0],%l7 + ld [%i2],%l0 + umul %l0,%i4,%o0 + mov %y,%o1 + addcc %o0,%i5,%i1 + inc 4,%i2 + addx %o1,%g0,%i5 + addcc %l7,%i1,%l7 + addx %g0,%i5,%i5 + st %l7,[%i0] + deccc %i3 + bgt LMD1 + inc 4,%i0 +L77007: + tst %i5 + be LMDexit + deccc %l1 +LY3: ! [internal] + blt LMDexit + inc 4,%i0 + ld [%i0-4],%i1 + addcc %i1,%i5,%i1 + addxcc %g0,%g0,%i5 + st %i1,[%i0-4] + bne,a LY3 + deccc %l1 +LMDexit: + ret + restore %g0,%i5,%o0 + .proc 14 + .global _BnnDivideDigit +_BnnDivideDigit: +! BnnDivideDigit(qq, nn, nl, d) + + save %sp,-96,%sp + mov %i0, %i5 + deccc %i2 ! --%i2; + sll %i2, 2, %i2 + blt bnnout + ld [%i1+%i2], %i0 ! X(hight) = %i1[%i2]; +bnndivloop: + + deccc 4, %i2 ! --%i2; +! condition code remains unchanged until bgt at loop end + ld [%i1+%i2], %i4 ! X(%i4) = %i1[%i2]; + mov %i0, %y + udiv %i4, %i3, %l0 ! %l0 = %i0,%i4 / %i3; + umul %l0, %i3, %l1 ! %l1 = %l0 * %i3; + sub %i4, %l1, %i0 ! %i0 = %i0,%i4 % %i3; + bgt bnndivloop ! if (%i2 > 0) goto divloop; + st %l0,[%i5+%i2] ! %i5[%i2] = %l0; +bnnout: + ret + restore + + .seg "data" ! [internal] +_copyright: + .half 0x4028 + .half 0x2329 + .half 0x4b65 + .half 0x724e + .half 0x2e63 + .half 0x3a20 + .half 0x636f + .half 0x7079 + .half 0x7269 + .half 0x6768 + .half 0x7420 + .half 0x4469 + .half 0x6769 + .half 0x7461 + .half 0x6c20 + .half 0x4571 + .half 0x7569 + .half 0x706d + .half 0x656e + .half 0x7420 + .half 0x436f + .half 0x7270 + .half 0x6f72 + .half 0x6174 + .half 0x696f + .half 0x6e20 + .half 0x2620 + .half 0x494e + .half 0x5249 + .half 0x4120 + .half 0x3139 + .half 0x3838 + .half 0x2c20 + .half 0x3139 + .half 0x3839 + .half 0xa00 + diff --git a/otherlibs/num/bignum/s/unix2vms.sed b/otherlibs/num/bignum/s/unix2vms.sed new file mode 100644 index 000000000..ba273375c --- /dev/null +++ b/otherlibs/num/bignum/s/unix2vms.sed @@ -0,0 +1,28 @@ +s/^# >>> IMPORTANT <<< DO NOT MODIFY THIS LINE$/# >>> IMPORTANT <<< DO NOT MODIFY THIS FILE -- IT IS GENERATED FROM vaxKerN.s/ +s/^\([^#"]*\)#/\1;/ +/^\.set callee_save,~63$/s// callee_save = ^C3/ +{ +: all_at +s/^\([^;"]*\)\*/\1@/ +t all_at +} +{ +: all_d +s/^\([^;"]*\)\$/\1#/ +t all_d +} +s/^0x/^X/ +{ +: all_hex +s/^\([^;"]*[^0-9A-Za-z_;"]\)0x/\1^X/ +t all_hex +} +{ +: all_usB +s/^\([^;"]*\)_B/\1B/ +t all_usB +} +s/\.data[ ][ ]*;\(.*\)$/.psect \1,noexe,quad/ +s/\.text[ ][ ]*;\(.*\)$/.psect \1,exe,shr,pic,nowrt,quad/ +$a\ + .end diff --git a/otherlibs/num/bignum/s/vaxKerN.mar b/otherlibs/num/bignum/s/vaxKerN.mar new file mode 100644 index 000000000..b6d4f95d7 --- /dev/null +++ b/otherlibs/num/bignum/s/vaxKerN.mar @@ -0,0 +1,701 @@ +; Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990 +; +; KerN for the VAX. +; [Bepaul, Shand] +; Last modified_on Mon Apr 2 21:03:05 GMT+2:00 1990 by shand +; modified_on Mon Nov 20 13:51:10 GMT+1:00 1989 by herve +; modified_on 17-OCT-1989 20:37:48 by Jim Lawton +; +; >>> IMPORTANT <<< DO NOT MODIFY THIS FILE -- IT IS GENERATED FROM vaxKerN.s +; +; >>> READ THIS <<< +; +; This file is automatically converted from unix to VAX/VMS assembler format. +; On VMS it is the callee's rsponsiblity to save all modified registers +; other than r0 and r1. On Ultrix r0-r5 are considered saved by caller. +; Specify procedure entry masks that save ALL modified registers (including +; r0 and r1) and "&" them with "callee_save" which is a predefined constant +; that eliminates the saves which are unnecessary under whichever calling +; convention the file is being assembler for. + callee_save = ^C3 + ; WARNING: text after comment used in conversion to VMS format assembler + .psect vaxKerN_data,noexe,quad +_copyright: .ascii "@(#)vaxKerN.s: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\12\0" + ; WARNING: text after comment used in conversion to VMS format assembler + .psect vaxKerN,exe,shr,pic,nowrt,quad + .globl BnnSetToZero + .align 3 +BnnSetToZero: + .word ^X3&callee_save ; mask<r0,r1> + movl 4(ap),r0 ; nn + movl 8(ap),r1 ; nl + sobgeq r1,LSTZ1 ; if(nl--) goto LSTZ1 + ret ; return; +LSTZ1: clrl (r0)+ ; *(nn++) = 0; + sobgeq r1,LSTZ1 ; if(nl--) goto LSTZ1; + ret + + .globl BnnAssign + .align 3 +BnnAssign: + .word ^X7&callee_save ; mask<r0,r1,r2> + movl 4(ap),r0 ; mm + movl 8(ap),r1 ; nn + movl 12(ap),r2 ; nl + cmpl r0,r1 + bgequ LAG2 ; if(mm >= nn) goto LAG2; + sobgeq r2,LAG1 ; if(nl--) goto LAG1; + ret ; return; +LAG1: movl (r1)+,(r0)+ ; *(mm++) = *(nn++); + sobgeq r2,LAG1 ; if(nl--) goto LAG1; +LAG2: blequ LAG4 ; if(mm <= nn) goto LAG4; + moval (r0)[r2],r0 ; mm = &mm[nl]; + moval (r1)[r2],r1 ; nn = &nn[nl]; + sobgeq r2,LAG3 ; if(nl--) goto LAG3; + ret ; return; +LAG3: movl -(r1),-(r0) ; *(--mm) = *(--nn); + sobgeq r2,LAG3 ; if(nl--) goto LAG3; +LAG4: ret ; return; + + .globl BnnSetDigit + .align 3 +BnnSetDigit: + .word ^X0&callee_save ; mask<> + movl 8(ap),@4(ap) ; *nn = d; + ret + + .globl BnnGetDigit + .align 3 +BnnGetDigit: + .word ^X0&callee_save ; mask<> + movl @4(ap),r0 ; return(*nn); + ret + + .globl BnnNumDigits + .align 3 +BnnNumDigits: + .word ^X2&callee_save ; mask<r1> + movl 8(ap),r0 ; nl + moval @4(ap)[r0],r1 ; nn = &nn[nd]; + sobgeq r0,LND1 ; if(nl-- != 0) goto LND1; + movl #1,r0 + ret ; return(1); +LND1: tstl -(r1) + bneq LND3 ; if(*(--n) != 0) goto LND3; + sobgeq r0,LND1 ; if(nl-- != 0) goto LND1; + movl #1,r0 + ret ; return(1); +LND3: incl r0 + ret ; return(nl + 1); + + .globl BnnNumLeadingZeroBitsInDigit + .align 3 +BnnNumLeadingZeroBitsInDigit: + .word ^X2&callee_save ; mask<r1> + movl 4(ap),r1 ; d + movl #31,r0 +LLZ1: bbs r0,r1,LLZ2 + sobgeq r0,LLZ1 +LLZ2: subl3 r0,#31,r0 + ret + + .globl BnnDoesDigitFitInWord + .align 3 +BnnDoesDigitFitInWord: + .word ^X0&callee_save ; mask<> + movl #1,r0 ; C_VERSION + ret + + .globl BnnIsDigitZero + .align 3 +BnnIsDigitZero: + .word ^X2&callee_save ; mask<r1> + tstl 4(ap) ; d + bneq LDZ1 ; if(d) goto LDZ1; + movl #1,r0 + ret ; return(1); +LDZ1: clrl r0 + ret ; return(0); + + .globl BnnIsDigitNormalized +; Boolean BnIsDigitNormalized(n, nd) BigNum n; int nd; { + .align 3 +BnnIsDigitNormalized: + .word ^X0&callee_save ; mask<> + movl 4(ap),r0 ; d + extzv #31,#1,r0,r0 ; return(d >> 31); + ret + + .globl BnnIsDigitOdd + .align 3 +BnnIsDigitOdd: + .word ^X0&callee_save ; mask<> + bicl3 #-2,4(ap),r0 ; return(d || 1); + ret + + .globl BnnCompareDigits + .align 3 +BnnCompareDigits: + .word ^X0&callee_save ; mask<> + cmpl 4(ap),8(ap) ; cmpl d1,d2 + beql LCDeq ; if(d0 == d1) goto LCDeq + blssu LCDinf ; if(d0 < d1) goto LCDinf + movl #1,r0 ; return(1); + ret +LCDeq: clrl r0 ; return(0); + ret +LCDinf: movl #-1,r0 ; return(-1); + ret + + .globl BnnComplement + .align 3 +BnnComplement: + .word ^X2&callee_save ; mask<r1> + movl 4(ap),r0 ; nn + movl 8(ap),r1 ; nl + sobgeq r1,LCM1 ; if(nl-- != 0) goto LCM1; + ret +LCM1: mcoml (r0),(r0)+ ; *(n++) ^= -1; + sobgeq r1,LCM1 ; if(nl-- != 0) goto LCM1; + ret + + .globl BnnAndDigits + .align 3 +BnnAndDigits: + .word ^X0&callee_save ; mask<> + mcoml 8(ap),r0 ; d = ~d; + bicl2 r0,@4(ap) ; *nn &= ~d; + ret + + .globl BnnOrDigits + .align 3 +BnnOrDigits: + .word ^X0&callee_save ; mask<> + bisl2 8(ap),@4(ap) ; *nn |= d; + ret + + .globl BnnXorDigits + .align 3 +BnnXorDigits: + .word ^X0&callee_save ; mask<> + xorl2 8(ap),@4(ap) ; *nn ^= d; + ret + + .globl BnnShiftLeft + .align 3 +BnnShiftLeft: + .word ^X7E&callee_save ; mask<r1,r2,r3,r4,r5,r6> + clrl r0 ; res = 0; + movl 12(ap),r3 ; nbi + bneq LSL0 ; if(nbi) goto LSL0 + ret ; return(res); +LSL0: movl 4(ap),r2 ; mm + movl 8(ap),r1 ; ml + subl3 r3,#32,r4 ; rnbi = BN_DIGIT_SIZE - nbi; + sobgeq r1,LSL1 ; if(ml-- != 0) goto LSL1; + ret ; return(res); +LSL1: movl (r2),r5 ; save = *mm + ashl r3,r5,r6 ; X = save << nbi; + bisl3 r0,r6,(r2)+ ; *(mm++) = X | res; + extzv r4,r3,r5,r0 ; res = save >> rnbits; + sobgeq r1,LSL1 ; if(ml-- != 0) goto LSL1; + ret ; return(res); + + .globl BnnShiftRight + .align 3 +BnnShiftRight: + .word ^X7E&callee_save ; mask<r1,r2,r3,r4,r5,r6> + clrl r0 ; res = 0; + movl 12(ap),r3 ; nbi + bneq LSR0 ; if(nbi) goto LSR0; + ret ; return(res); +LSR0: movl 8(ap),r1 ; ml + moval @4(ap)[r1],r2 ; mm = &mm[ml]; + subl3 r3,#32,r4 ; lnbi = BN_DIGIT_SIZE - nbi; + sobgeq r1,LSR1 ; if(ml-- != 0) goto LSR1; + ret ; return(res); +LSR1: movl -(r2),r5 ; save = *(--mm); + extzv r3,r4,r5,r6 ; X = save >> nbi; + bisl3 r0,r6,(r2) ; *mm = X | res; + ashl r4,r5,r0 ; res = save << lnbi; + sobgeq r1,LSR1 ; if(ml-- != 0) goto LSR1; + ret ; return(res); + + .globl BnnAddCarry + .align 3 +BnnAddCarry: + .word ^X2&callee_save ; mask<r1> + movl 12(ap),r0 ; car + beql LAC3 ; if(car == 0) return(car); + movl 8(ap),r0 ; nl + beql LAC2 ; if(nl == 0) return(1); + movl 4(ap),r1 ; nn +LAC1: incl (r1)+ ; ++(*nn++); + bcc LAC4 ; if(!Carry) goto LAC4 + sobgtr r0,LAC1 ; if(--nl > 0) goto LAC1; +LAC2: movl #1,r0 ; return(1); +LAC3: ret +LAC4: clrl r0 ; return(0); + ret + + .globl BnnAdd + .align 3 +BnnAdd: + .word ^X1E&callee_save ; mask<r1,r2,r3,r4> +LADDEntry: movl 4(ap),r0 ; mm + movl 12(ap),r1 ; nn + movl 16(ap),r3 ; nl + bneq LADD1 ; if(nl) goto LADD1 + subl3 r3,8(ap),r2 ; ml -= nl; + tstl 20(ap) ; car + bneq LADD5 ; if(car) goto LADD5 + clrl r0 + ret ; return(0); +LADD1: subl3 r3,8(ap),r2 ; ml -= nl; + addl3 20(ap),#-1,r4 ; C = car + +LADD2: adwc (r1)+,(r0)+ ; *(m++) += *(n++) + C; +LADD3: sobgtr r3,LADD2 ; if(--nl > 0) goto LADD2; + bcs LADD5 ; if(C) goto LADD5; +LADD4: clrl r0 + ret + +LADD6: incl (r0)+ ; ++(*m++); + bcc LADD4 ; if(!C) goto LADD4; +LADD5: sobgeq r2,LADD6 ; if(--ml >= 0) goto LADD6; +LADD7: movl #1,r0 + ret + + .globl BnnSubtractBorrow + .align 3 +BnnSubtractBorrow: + .word ^X2&callee_save ; mask<r1> + movl 12(ap),r0 ; car + bneq LSB2 ; if(car) return(car); + movl 8(ap),r0 ; nl + beql LSB20 ; if(nl == 0) return(0); + movl 4(ap),r1 ; nn +LSB1: decl (r1)+ ; (*nn++)--; + bcc LSB3 ; if(!Carry) goto LSB3; + sobgtr r0,LSB1 ; if(--nl > 0) goto LSB1; +LSB20: ; assert r0 == 0 return(0); +LSB2: ret +LSB3: movl #1,r0 ; return(1); + ret + + .globl BnnSubtract + .align 3 +BnnSubtract: + .word ^X1E&callee_save ; mask<r1,r2,r3,r4> + movl 4(ap),r2 ; mm + movl 12(ap),r1 ; nn + movl 16(ap),r3 ; nl + bneq LS1 ; if(nl) goto LS1 + subl3 r3,8(ap),r0 ; ml -= nl; + tstl 20(ap) ; car + beql LS5 ; if(car) goto LS5 + movl #1,r0 + ret ; return(1); +LS1: subl3 r3,8(ap),r0 ; ml -= nl; + tstl 20(ap) ; C = 0; Z = (car == 0) + bneq LS2 ; if(!(Z = (car == 0))) goto LS2 + addl3 #1,#-1,r4 ; C = 1; + +LS2: sbwc (r1)+,(r2)+ ; C..*m++ -= *n++ + C + sobgtr r3,LS2 ; if(--nl > 0) goto LS2 + bcs LS5 +LS3: movl #1,r0 + ret +LS4: decl (r2)+ + bcc LS3 +LS5: sobgeq r0,LS4 ; if (--ml >= 0) goto LS4 + clrl r0 + ret + + .globl BnnMultiplyDigit +; note1: (2^32-1)*(2^32-1) = 2^64-1 - 2*(2^32-1) +; thus 64 bits accomodates a*b+c+d for all a,b,c,d < 2^32 +; note2: inner loop is doubled to avoid unnecessary register moves. + .align 3 +BnnMultiplyDigit: + .word ^X1FE&callee_save ; mask<r1,r2,r3,r4,r5,r6,r7,r8> + movl 20(ap),r2 ; r2 = d + blss LMDNeg ; if (d<0) goto LMDNeg + bneq LMD1 ; if (d) goto LMD1; + clrl r0 + ret +LMD1: cmpl #1,r2 + bneq LMD2 ; if (d != 1) goto LMD2 + clrl 20(ap) ; IN BnnAdd: car = 0 + brw LADDEntry ; BnnAdd(pp,pl,mm,ml,0); + +LMD2: movl 4(ap),r3 ; r3 = p + movl 12(ap),r1 ; r1 = m + movl 16(ap),r7 ; r7 = ml + subl3 r7,8(ap),r8 ; r8 = pl-ml + ashl #-1,r7,r0 ; loop counter r0 = (ml+1)/2 + clrl r5 + bitl #1,r7 + bneq LMDPOddLen ; if (ml is odd) goto LMDPOddLen + clrl r7 + brb LMDPEvenLen ; if (ml is even) goto LMDPOddLen +LMDPLoop: emul (r1)+,r2,#0,r4 ; r4:r5 = m[i]*d + bgeq LMDMPos1 ; if (m[i] < 0) + addl2 r2,r5 ; r5 += d +LMDMPos1: addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ ; *p++ += r4 + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2 +LMDPOddLen: emul (r1)+,r2,#0,r6 ; r6:r7 = m[i+1]*d + bgeq LMDMPos2 ; if (m[i+1] < 0) + addl2 r2,r7 ; r7 += d +LMDMPos2: addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ ; *p++ += r6 + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2 +LMDPEvenLen: sobgeq r0,LMDPLoop ; if ((i+=2)/2 < ml/2) repeat loop + addl2 r7,(r3)+ ; *p += (m[ml-1]*d)/2^32 + bcs LMDTail +LMDRet0: clrl r0 + ret + +LMDNeg: movl 4(ap),r3 ; r3 = p + movl 12(ap),r1 ; r1 = m + movl 16(ap),r7 ; r7 = ml + subl3 r7,8(ap),r8 ; r8 = pl-ml + ashl #-1,r7,r0 ; loop counter r0 = (ml+1)/2 + clrl r5 + bitl #1,r7 + bneq LMDNOddLen + clrl r7 + brb LMDNEvenLen +LMDNLoop: movl (r1)+,r6 ; r6 = m[i] + emul r6,r2,#0,r4 ; r4:r5 = m[i]*d + bleq LMDMPos3 ; if (m[i] < 0) + addl2 r2,r5 ; r5 += d +LMDMPos3: addl2 r6,r5 ; r5 += m[i] + addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ ; *p++ += r4 + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2 +LMDNOddLen: movl (r1)+,r4 ; r6 = m[i+1] + emul r4,r2,#0,r6 ; r6:r7 = m[i+1]*d + bleq LMDMPos4 ; if (m[i+1] < 0) + addl2 r2,r7 ; r7 += d +LMDMPos4: addl2 r4,r7 ; r7 += m[i+1] + addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ ; *p++ += r6 + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2 +LMDNEvenLen: sobgeq r0,LMDNLoop ; if ((i+=2)/2 < ml/2) repeat loop + addl2 r7,(r3)+ ; *p += (m[ml-1]*d)/2^32 + bcs LMDTail + clrl r0 ; r0 = carry + ret + +LMDTailLoop: incl (r3)+ + bcc LMDRet0 +LMDTail: sobgtr r8,LMDTailLoop + movl #1,r0 ; r0 = carry + ret + + .globl BnnDivideDigit + .align 3 +BnnDivideDigit: + .word ^X3FE&callee_save ; mask<r1,r2,r3,r4,r5,r6,r7,r8,r9> + movl 12(ap),r2 ; nl + movl 16(ap),r3 ; d + moval @8(ap)[r2],r0 ; nn = &nn[nl]; + decl r2 ; nl--; + moval @4(ap)[r2],r1 ; qq = &qq[nl]; + movl -(r0),r5 ; X(hight) = *(--n); + extzv #1,#31,r3,r7 ; r7 = D' <- D div 2 + tstl r3 + bgeq Lndivc2 + brw Lndiv5 ; D < 0!! + + ; D < 2**31 + brb Lndivc2 ; N < D * 2**32 +Lndivc1: movl -(r0),r4 ; (bdivu dx3 ax1 dx1) + cmpl r5,r7 + blss Lndivc11 + extzv #0,#1,r4,r6 ; r6 <- n0 + ashq #-1,r4,r4 ; N' = r4 = N quo 2 < D * 2**31 + ediv r3,r4,r4,r5 ; r4 <- Q' = N' quo D < 2**31 + ; r5 <- R' = N' rem D < D + ashq #1,r4,r4 ; r4 <- 2 * Q' < 2**32 + ; r5 <- 2 * R' < 2 * D + addl2 r6,r5 ; r5 <- 2 * R' + n0 < 2 * D + cmpl r5,r3 ; r5 < D -> Q = r4, R = r5 + blssu Lndivc12 ; sinon + incl r4 ; Q = r4 + 1 + subl2 r3,r5 ; R = r5 - D + brb Lndivc12 +Lndivc11: ediv r3,r4,r4,r5 ; Q = r4, R = r5 +Lndivc12: movl r4,-(r1) ; range r4 en me'moire +Lndivc2: sobgeq r2,Lndivc1 ; (sobgez dx2 Lndivc1) + movl r5,r0 ; return(X(hight)); + ret + +Lndiv3: movl -(r0),r4 ; r4 poid faible de N + extzv #0,#1,r4,r9 ; r9 <- n0 + extzv #1,#1,r4,r6 ; r6 <- n1 + extzv #2,#1,r4,r8 ; r8 <- n2 + ashq #-3,r4,r4 ; r4 <- N'' = N quo 4 + bicl2 #^XE0000000,r5 ; Le ashq ne le fait pas + ediv r7,r4,r4,r5 ; r4 <- Q' = N''' quo D' + ; r5 <- R' = N''' rem D' + ashl #1,r5,r5 ; r5 <- 2 * R' + addl2 r8,r5 ; r5 <- 2 * R' + n2 + bbc #0,r3,Lndiv4 ; si d0 = 0 + cmpl r5,r4 ; sinon r5 <- 2R' + n1 - Q' + blssu Lndiv30 ; la diff est < 0 + subl2 r4,r5 ; la diff est > 0 + brb Lndiv4 ; voila la diff! +Lndiv30: subl2 r4,r5 ; la diff! + decl r4 ; r4 <- r4 - 1 + addl2 r3,r5 ; r5 <- r5 + D +Lndiv4: ashl #1,r4,r4 ; r4 <- 2Q' + addl2 r5,r5 ; r5 <- 2r5 + bisl2 r6,r5 ; r5 <- r5 + n1 (flag C ok!) + bcs Lndiv40 ; On deborde sur! + cmpl r5,r3 + blssu Lndiv42 ; depasse pas D +Lndiv40: incl r4 ; Q = r4 + 1 + subl2 r3,r5 ; R = r5 - D +Lndiv42: ashl #1,r4,r4 ; r4 <- 2Q' + addl2 r5,r5 ; r5 <- 2r5 + bisl2 r9,r5 ; r5 <- r5 + n0 (flag C ok!) + bcs Lndiv43 ; On deborde sur! + cmpl r5,r3 + blssu Lndiv44 ; depasse pas D +Lndiv43: incl r4 ; Q = r4 + 1 + subl2 r3,r5 ; R = r5 - D +Lndiv44: movl r4,-(r1) ; range le quotient en memoire +Lndiv5: sobgeq r2,Lndiv3 ; On continue! + movl r5,r0 ; return(X(hight)); + ret + +; BigNumCarry BnnMultiply (pp, pl, mm, ml, nn, nl) +; BigNum pp, nn, mm; +; BigNumLength pl, nl, ml; + +.globl BnnMultiply + .align 3 +BnnMultiply: + .word ^XFFE&callee_save ; mask<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11> + movl 24(ap),r9 ; r9 = nl + bneq LMM_nl_pos +LMM_Ret0a: + clrl r0 +LMM_Ret: + ret +LMM_nl_pos: + movl 20(ap),r11 ; nn + cmpl 12(ap),r11 ; if (nn == mm) + beql BMM_Sqr +LMM_NotSqr: + movl 4(ap),r10 ; pp + clrl r8 ; c_hi +LMM_NLoop: + movl 16(ap),r7 ; ml + movl 12(ap),r1 ; mm + moval (r10)+,r3 ; pp + clrl r5 ; c_lo + movl (r11)+,r2 ; digit + bsbw BMM_MultiplyDigit + sobgtr r9,LMM_NLoop + movl r8,r0 + beql LMM_Ret + movl 16(ap),r7 ; r7 = ml + subl3 r7,8(ap),r1 ; r7 = pl-ml + subl2 24(ap),r1 ; r7 = pl-ml-nl + bleq LMM_Ret + moval (r10)[r7],r10 ; pp += ml +LMM_PLoop: + incl (r10)+ + bcc LMM_Ret0a + sobgtr r1,LMM_PLoop + ret +; Special squaring code based on: +; n[0..nl-1]*n[0..nl-1] = sum (i = 0..nl-1): +; B^2i * (n[i]*n[i] + 2*n[i] * n[i+1..nl-1] * B) +; the 2*n[i] is tricky because it may overflow, but ... +; suppose L[i] = 2*n[i]%2^32 +; and H[i] = 2*n[i]/2^32 +; Then: +; sum (i = 0..nl-1): +; B^2i * (n[i]*n[i] + L[i]+H[i-1] * n[i+1..nl-1] * B + H[i-1]*n[i]) +; notice that when i = nl-1 the final term is 2*n[nl-1] * n[nl..nl-1], +; n[nl..nl-1] is zero length -- i.e. we can ignore it! +; lastly we don't have quite enough registers to conveniently remember +; the top bit of n[i-1] we encode it in the PC by duplicating +; the loop--sometimes I love assembler. +LMMS_NNLoop: + ; execute this version of loop if n[i-1] was >= 2^31 + movl (r11)+,r0 ; d = r0 = *nn++ + movl r11,r1 ; r1 = mm + emul r0,r0,#0,r4 ; r4:r5 = d*d + addl2 r0,r4 ; r4 += (2*n[i-1])/2^32*n[i] (= d) + adwc #0,r5 + addl2 r4,(r10)+ ; *pp++ += d*d%2^32 + adwc #0,r5 ; r5 += C + moval (r10)+,r3 ; arg-p = pp++ + movl r9,r7 ; arg-ml = ml + addl3 r0,r0,r2 ; if (d >= 0) + bisl2 #1,r2 + bcc LMMS_DPos ; switch to < 2^31 loop +LMMS_DNeg: + addl2 r0,r5 ; compensate for signed mul + addl2 r0,r5 ; r4:r5 += 2*r2*2^32 + tstl r2 ; set condition codes for entry to subr + ; MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5) + bsbb BMM_MultiplyDigit + sobgeq r9,LMMS_NNLoop + brb LMMS_Post +; >>> ENTRY <<< +BMM_Sqr: + ; r9 = nl, r11 = nn + movl 16(ap),r8 ; r8 = ml + bneq LMMS_ml_pos + clrl r0 + ret ; return 0; +LMMS_ml_pos: + cmpl r8,r9 ; if (ml != nl) + bneq LMM_NotSqr + + ; r8 = 0, r9 = nl, r11 = nn, r10 = sgn(nn[nl-1]) + movl 4(ap),r10 ; r10 = pp + ; r11 = nn + clrl r8 ; r8 = high carry = 0 + decl r9 ; r9 = ml-1 = nl-1 +LMMS_NLoop: + ; execute this version of loop if n[i-1] was < 2^31 + movl (r11)+,r0 ; d = r0 = *nn++ + movl r11,r1 ; r1 = mm + emul r0,r0,#0,r4 ; r4:r5 = d*d + addl2 r4,(r10)+ ; *pp++ += d*d%2^32 + adwc #0,r5 ; r5 += C + moval (r10)+,r3 ; arg-p = pp++ + movl r9,r7 ; arg-ml = ml + addl3 r0,r0,r2 ; if (d < 0) + bcs LMMS_DNeg ; switch to >= 2^31 loop +LMMS_DPos: + tstl r2 ; set condition codes for entry to subr + ; MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5) + bsbb BMM_MultiplyDigit + sobgeq r9,LMMS_NLoop + ; r9 = 0, r10 = pp+2*ml, r2 = 2*nn[nl-1], r8 = carry_hi, r11 = nn+nl +LMMS_Post: + movl r8,r0 + bneq LMMS_CProp ; if (c != 0) +LMMS_ret: + ret ; return +LMMS_CProp: + movl 16(ap),r7 ; r7 = nl + subl3 r7,8(ap),r2 ; r2 = pl-nl (note nl == ml) + subl2 r7,r2 ; r2 = pl-nl-ml + bleq LMMS_ret ; if (pl-nl > ml) + ; ret = BnnAddCarry(pp+ml, pl-ml, c); +LMMS_CPLoop: + incl (r10)+ ; (*pp++)++ + bcc LMMS_Ret0 + sobgtr r2,LMMS_CPLoop + ret +LMMS_Ret0: + clrl r0 + ret + +; Subroutine: MultiplyDigit(pp,mm,ml,d,c_hi,c_lo) +; returns: +; c_hi*base^(ml+1)+ pp[0..ml] = pp[0..ml]+(mm[0..ml-1]*d)+c_hi*base^ml+c_lo +; +; In: +; ml_entry:r7 +; ml/2: r0 +; mm: r1 +; digit: r2 +; pp: r3 +; c_hi: r8 +; c_lo: r5 +; +; multiply scratch: r4,r5 / r6,r7 +; +; Out: +; c_hi: r8 +LMMD_C_hi: + addl2 r8,(r3)[r7] ; p[ml] += c_hi + clrl r8 + adwc #0,r8 + rsb +LMMD_Zero: + tstl r5 ; Too complicated, return to + beql LMMD_ZC_lo ; normal case. + tstl r2 + brb LMMD_Retry +LMMD_ZC_lo: + tstl r8 + bneq LMMD_C_hi + rsb +BMM_MultiplyDigit: + beql LMMD_Zero +LMMD_Retry: + blss LMMD_Neg ; if (d<0) goto LMMD_Neg + ashl #-1,r7,r0 ; loop counter r0 = ml/2 + bitl #1,r7 + bneq LMMD_POddLen ; if (ml is odd) goto LMMD_POddLen + movl r5,r7 + brb LMMD_PEvenLen ; if (ml is even) goto LMMD_POddLen +LMMD_PLoop: emul (r1)+,r2,#0,r4 ; r4:r5 = m[i]*d + bgeq LMMD_MPos1 ; if (m[i] < 0) + addl2 r2,r5 ; r5 += d +LMMD_MPos1: addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ ; *p++ += r4 + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2 +LMMD_POddLen: emul (r1)+,r2,#0,r6 ; r6:r7 = m[i+1]*d + bgeq LMMD_MPos2 ; if (m[i+1] < 0) + addl2 r2,r7 ; r7 += d +LMMD_MPos2: addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ ; *p++ += r6 + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2 +LMMD_PEvenLen: sobgeq r0,LMMD_PLoop ; if ((i+=2)/2 < ml/2) repeat loop + addl2 r8,r7 + clrl r8 + adwc #0,r8 + addl2 r7,(r3) ; *p += (m[ml-1]*d)/2^32 + adwc #0,r8 + rsb +LMMD_Neg: + ashl #-1,r7,r0 ; loop counter r0 = ml/2 + bitl #1,r7 + bneq LMMD_NOddLen + movl r5,r7 + brb LMMD_NEvenLen +LMMD_NLoop: movl (r1)+,r6 ; r6 = m[i] + emul r6,r2,#0,r4 ; r4:r5 = m[i]*d + bleq LMMD_MPos3 ; if (m[i] < 0) + addl2 r2,r5 ; r5 += d +LMMD_MPos3: addl2 r6,r5 ; r5 += m[i] + addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ ; *p++ += r4 + adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2 +LMMD_NOddLen: movl (r1)+,r4 ; r6 = m[i+1] + emul r4,r2,#0,r6 ; r6:r7 = m[i+1]*d + bleq LMMD_MPos4 ; if (m[i+1] < 0) + addl2 r2,r7 ; r7 += d +LMMD_MPos4: addl2 r4,r7 ; r7 += m[i+1] + addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ ; *p++ += r6 + adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2 +LMMD_NEvenLen: sobgeq r0,LMMD_NLoop ; if ((i+=2)/2 < ml/2) repeat loop + addl2 r8,r7 + clrl r8 + adwc #0,r8 + addl2 r7,(r3) ; *p += (m[ml-1]*d)/2^32 + adwc #0,r8 + rsb +.end diff --git a/otherlibs/num/bignum/s/vaxKerN.s b/otherlibs/num/bignum/s/vaxKerN.s new file mode 100644 index 000000000..c9f5d716d --- /dev/null +++ b/otherlibs/num/bignum/s/vaxKerN.s @@ -0,0 +1,700 @@ +# Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990 +# +# KerN for the VAX. +# [Bepaul, Shand] +# Last modified_on Mon Apr 2 21:03:05 GMT+2:00 1990 by shand +# modified_on Mon Nov 20 13:51:10 GMT+1:00 1989 by herve +# modified_on 17-OCT-1989 20:37:48 by Jim Lawton +# +# >>> IMPORTANT <<< DO NOT MODIFY THIS LINE +# +# >>> READ THIS <<< +# +# This file is automatically converted from unix to VAX/VMS assembler format. +# On VMS it is the callee's rsponsiblity to save all modified registers +# other than r0 and r1. On Ultrix r0-r5 are considered saved by caller. +# Specify procedure entry masks that save ALL modified registers (including +# r0 and r1) and "&" them with "callee_save" which is a predefined constant +# that eliminates the saves which are unnecessary under whichever calling +# convention the file is being assembler for. +.set callee_save,~63 + # WARNING: text after comment used in conversion to VMS format assembler + .data # vaxKerN_data +_copyright: .ascii "@(#)vaxKerN.s: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\12\0" + # WARNING: text after comment used in conversion to VMS format assembler + .text # vaxKerN + .globl _BnnSetToZero + .align 3 +_BnnSetToZero: + .word 0x3&callee_save # mask<r0,r1> + movl 4(ap),r0 # nn + movl 8(ap),r1 # nl + sobgeq r1,LSTZ1 # if(nl--) goto LSTZ1 + ret # return; +LSTZ1: clrl (r0)+ # *(nn++) = 0; + sobgeq r1,LSTZ1 # if(nl--) goto LSTZ1; + ret + + .globl _BnnAssign + .align 3 +_BnnAssign: + .word 0x7&callee_save # mask<r0,r1,r2> + movl 4(ap),r0 # mm + movl 8(ap),r1 # nn + movl 12(ap),r2 # nl + cmpl r0,r1 + bgequ LAG2 # if(mm >= nn) goto LAG2; + sobgeq r2,LAG1 # if(nl--) goto LAG1; + ret # return; +LAG1: movl (r1)+,(r0)+ # *(mm++) = *(nn++); + sobgeq r2,LAG1 # if(nl--) goto LAG1; +LAG2: blequ LAG4 # if(mm <= nn) goto LAG4; + moval (r0)[r2],r0 # mm = &mm[nl]; + moval (r1)[r2],r1 # nn = &nn[nl]; + sobgeq r2,LAG3 # if(nl--) goto LAG3; + ret # return; +LAG3: movl -(r1),-(r0) # *(--mm) = *(--nn); + sobgeq r2,LAG3 # if(nl--) goto LAG3; +LAG4: ret # return; + + .globl _BnnSetDigit + .align 3 +_BnnSetDigit: + .word 0x0&callee_save # mask<> + movl 8(ap),*4(ap) # *nn = d; + ret + + .globl _BnnGetDigit + .align 3 +_BnnGetDigit: + .word 0x0&callee_save # mask<> + movl *4(ap),r0 # return(*nn); + ret + + .globl _BnnNumDigits + .align 3 +_BnnNumDigits: + .word 0x2&callee_save # mask<r1> + movl 8(ap),r0 # nl + moval *4(ap)[r0],r1 # nn = &nn[nd]; + sobgeq r0,LND1 # if(nl-- != 0) goto LND1; + movl $1,r0 + ret # return(1); +LND1: tstl -(r1) + bneq LND3 # if(*(--n) != 0) goto LND3; + sobgeq r0,LND1 # if(nl-- != 0) goto LND1; + movl $1,r0 + ret # return(1); +LND3: incl r0 + ret # return(nl + 1); + + .globl _BnnNumLeadingZeroBitsInDigit + .align 3 +_BnnNumLeadingZeroBitsInDigit: + .word 0x2&callee_save # mask<r1> + movl 4(ap),r1 # d + movl $31,r0 +LLZ1: bbs r0,r1,LLZ2 + sobgeq r0,LLZ1 +LLZ2: subl3 r0,$31,r0 + ret + + .globl _BnnDoesDigitFitInWord + .align 3 +_BnnDoesDigitFitInWord: + .word 0x0&callee_save # mask<> + movl $1,r0 # C_VERSION + ret + + .globl _BnnIsDigitZero + .align 3 +_BnnIsDigitZero: + .word 0x2&callee_save # mask<r1> + tstl 4(ap) # d + bneq LDZ1 # if(d) goto LDZ1; + movl $1,r0 + ret # return(1); +LDZ1: clrl r0 + ret # return(0); + + .globl _BnnIsDigitNormalized +# Boolean BnIsDigitNormalized(n, nd) BigNum n; int nd; { + .align 3 +_BnnIsDigitNormalized: + .word 0x0&callee_save # mask<> + movl 4(ap),r0 # d + extzv $31,$1,r0,r0 # return(d >> 31); + ret + + .globl _BnnIsDigitOdd + .align 3 +_BnnIsDigitOdd: + .word 0x0&callee_save # mask<> + bicl3 $-2,4(ap),r0 # return(d || 1); + ret + + .globl _BnnCompareDigits + .align 3 +_BnnCompareDigits: + .word 0x0&callee_save # mask<> + cmpl 4(ap),8(ap) # cmpl d1,d2 + beql LCDeq # if(d0 == d1) goto LCDeq + blssu LCDinf # if(d0 < d1) goto LCDinf + movl $1,r0 # return(1); + ret +LCDeq: clrl r0 # return(0); + ret +LCDinf: movl $-1,r0 # return(-1); + ret + + .globl _BnnComplement + .align 3 +_BnnComplement: + .word 0x2&callee_save # mask<r1> + movl 4(ap),r0 # nn + movl 8(ap),r1 # nl + sobgeq r1,LCM1 # if(nl-- != 0) goto LCM1; + ret +LCM1: mcoml (r0),(r0)+ # *(n++) ^= -1; + sobgeq r1,LCM1 # if(nl-- != 0) goto LCM1; + ret + + .globl _BnnAndDigits + .align 3 +_BnnAndDigits: + .word 0x0&callee_save # mask<> + mcoml 8(ap),r0 # d = ~d; + bicl2 r0,*4(ap) # *nn &= ~d; + ret + + .globl _BnnOrDigits + .align 3 +_BnnOrDigits: + .word 0x0&callee_save # mask<> + bisl2 8(ap),*4(ap) # *nn |= d; + ret + + .globl _BnnXorDigits + .align 3 +_BnnXorDigits: + .word 0x0&callee_save # mask<> + xorl2 8(ap),*4(ap) # *nn ^= d; + ret + + .globl _BnnShiftLeft + .align 3 +_BnnShiftLeft: + .word 0x7E&callee_save # mask<r1,r2,r3,r4,r5,r6> + clrl r0 # res = 0; + movl 12(ap),r3 # nbi + bneq LSL0 # if(nbi) goto LSL0 + ret # return(res); +LSL0: movl 4(ap),r2 # mm + movl 8(ap),r1 # ml + subl3 r3,$32,r4 # rnbi = BN_DIGIT_SIZE - nbi; + sobgeq r1,LSL1 # if(ml-- != 0) goto LSL1; + ret # return(res); +LSL1: movl (r2),r5 # save = *mm + ashl r3,r5,r6 # X = save << nbi; + bisl3 r0,r6,(r2)+ # *(mm++) = X | res; + extzv r4,r3,r5,r0 # res = save >> rnbits; + sobgeq r1,LSL1 # if(ml-- != 0) goto LSL1; + ret # return(res); + + .globl _BnnShiftRight + .align 3 +_BnnShiftRight: + .word 0x7E&callee_save # mask<r1,r2,r3,r4,r5,r6> + clrl r0 # res = 0; + movl 12(ap),r3 # nbi + bneq LSR0 # if(nbi) goto LSR0; + ret # return(res); +LSR0: movl 8(ap),r1 # ml + moval *4(ap)[r1],r2 # mm = &mm[ml]; + subl3 r3,$32,r4 # lnbi = BN_DIGIT_SIZE - nbi; + sobgeq r1,LSR1 # if(ml-- != 0) goto LSR1; + ret # return(res); +LSR1: movl -(r2),r5 # save = *(--mm); + extzv r3,r4,r5,r6 # X = save >> nbi; + bisl3 r0,r6,(r2) # *mm = X | res; + ashl r4,r5,r0 # res = save << lnbi; + sobgeq r1,LSR1 # if(ml-- != 0) goto LSR1; + ret # return(res); + + .globl _BnnAddCarry + .align 3 +_BnnAddCarry: + .word 0x2&callee_save # mask<r1> + movl 12(ap),r0 # car + beql LAC3 # if(car == 0) return(car); + movl 8(ap),r0 # nl + beql LAC2 # if(nl == 0) return(1); + movl 4(ap),r1 # nn +LAC1: incl (r1)+ # ++(*nn++); + bcc LAC4 # if(!Carry) goto LAC4 + sobgtr r0,LAC1 # if(--nl > 0) goto LAC1; +LAC2: movl $1,r0 # return(1); +LAC3: ret +LAC4: clrl r0 # return(0); + ret + + .globl _BnnAdd + .align 3 +_BnnAdd: + .word 0x1E&callee_save # mask<r1,r2,r3,r4> +LADDEntry: movl 4(ap),r0 # mm + movl 12(ap),r1 # nn + movl 16(ap),r3 # nl + bneq LADD1 # if(nl) goto LADD1 + subl3 r3,8(ap),r2 # ml -= nl; + tstl 20(ap) # car + bneq LADD5 # if(car) goto LADD5 + clrl r0 + ret # return(0); +LADD1: subl3 r3,8(ap),r2 # ml -= nl; + addl3 20(ap),$-1,r4 # C = car + +LADD2: adwc (r1)+,(r0)+ # *(m++) += *(n++) + C; +LADD3: sobgtr r3,LADD2 # if(--nl > 0) goto LADD2; + bcs LADD5 # if(C) goto LADD5; +LADD4: clrl r0 + ret + +LADD6: incl (r0)+ # ++(*m++); + bcc LADD4 # if(!C) goto LADD4; +LADD5: sobgeq r2,LADD6 # if(--ml >= 0) goto LADD6; +LADD7: movl $1,r0 + ret + + .globl _BnnSubtractBorrow + .align 3 +_BnnSubtractBorrow: + .word 0x2&callee_save # mask<r1> + movl 12(ap),r0 # car + bneq LSB2 # if(car) return(car); + movl 8(ap),r0 # nl + beql LSB20 # if(nl == 0) return(0); + movl 4(ap),r1 # nn +LSB1: decl (r1)+ # (*nn++)--; + bcc LSB3 # if(!Carry) goto LSB3; + sobgtr r0,LSB1 # if(--nl > 0) goto LSB1; +LSB20: # assert r0 == 0 return(0); +LSB2: ret +LSB3: movl $1,r0 # return(1); + ret + + .globl _BnnSubtract + .align 3 +_BnnSubtract: + .word 0x1E&callee_save # mask<r1,r2,r3,r4> + movl 4(ap),r2 # mm + movl 12(ap),r1 # nn + movl 16(ap),r3 # nl + bneq LS1 # if(nl) goto LS1 + subl3 r3,8(ap),r0 # ml -= nl; + tstl 20(ap) # car + beql LS5 # if(car) goto LS5 + movl $1,r0 + ret # return(1); +LS1: subl3 r3,8(ap),r0 # ml -= nl; + tstl 20(ap) # C = 0; Z = (car == 0) + bneq LS2 # if(!(Z = (car == 0))) goto LS2 + addl3 $1,$-1,r4 # C = 1; + +LS2: sbwc (r1)+,(r2)+ # C..*m++ -= *n++ + C + sobgtr r3,LS2 # if(--nl > 0) goto LS2 + bcs LS5 +LS3: movl $1,r0 + ret +LS4: decl (r2)+ + bcc LS3 +LS5: sobgeq r0,LS4 # if (--ml >= 0) goto LS4 + clrl r0 + ret + + .globl _BnnMultiplyDigit +# note1: (2^32-1)*(2^32-1) = 2^64-1 - 2*(2^32-1) +# thus 64 bits accomodates a*b+c+d for all a,b,c,d < 2^32 +# note2: inner loop is doubled to avoid unnecessary register moves. + .align 3 +_BnnMultiplyDigit: + .word 0x1FE&callee_save # mask<r1,r2,r3,r4,r5,r6,r7,r8> + movl 20(ap),r2 # r2 = d + blss LMDNeg # if (d<0) goto LMDNeg + bneq LMD1 # if (d) goto LMD1; + clrl r0 + ret +LMD1: cmpl $1,r2 + bneq LMD2 # if (d != 1) goto LMD2 + clrl 20(ap) # IN BnnAdd: car = 0 + brw LADDEntry # BnnAdd(pp,pl,mm,ml,0); + +LMD2: movl 4(ap),r3 # r3 = p + movl 12(ap),r1 # r1 = m + movl 16(ap),r7 # r7 = ml + subl3 r7,8(ap),r8 # r8 = pl-ml + ashl $-1,r7,r0 # loop counter r0 = (ml+1)/2 + clrl r5 + bitl $1,r7 + bneq LMDPOddLen # if (ml is odd) goto LMDPOddLen + clrl r7 + brb LMDPEvenLen # if (ml is even) goto LMDPOddLen +LMDPLoop: emul (r1)+,r2,$0,r4 # r4:r5 = m[i]*d + bgeq LMDMPos1 # if (m[i] < 0) + addl2 r2,r5 # r5 += d +LMDMPos1: addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ # *p++ += r4 + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2 +LMDPOddLen: emul (r1)+,r2,$0,r6 # r6:r7 = m[i+1]*d + bgeq LMDMPos2 # if (m[i+1] < 0) + addl2 r2,r7 # r7 += d +LMDMPos2: addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ # *p++ += r6 + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2 +LMDPEvenLen: sobgeq r0,LMDPLoop # if ((i+=2)/2 < ml/2) repeat loop + addl2 r7,(r3)+ # *p += (m[ml-1]*d)/2^32 + bcs LMDTail +LMDRet0: clrl r0 + ret + +LMDNeg: movl 4(ap),r3 # r3 = p + movl 12(ap),r1 # r1 = m + movl 16(ap),r7 # r7 = ml + subl3 r7,8(ap),r8 # r8 = pl-ml + ashl $-1,r7,r0 # loop counter r0 = (ml+1)/2 + clrl r5 + bitl $1,r7 + bneq LMDNOddLen + clrl r7 + brb LMDNEvenLen +LMDNLoop: movl (r1)+,r6 # r6 = m[i] + emul r6,r2,$0,r4 # r4:r5 = m[i]*d + bleq LMDMPos3 # if (m[i] < 0) + addl2 r2,r5 # r5 += d +LMDMPos3: addl2 r6,r5 # r5 += m[i] + addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ # *p++ += r4 + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2 +LMDNOddLen: movl (r1)+,r4 # r6 = m[i+1] + emul r4,r2,$0,r6 # r6:r7 = m[i+1]*d + bleq LMDMPos4 # if (m[i+1] < 0) + addl2 r2,r7 # r7 += d +LMDMPos4: addl2 r4,r7 # r7 += m[i+1] + addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ # *p++ += r6 + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2 +LMDNEvenLen: sobgeq r0,LMDNLoop # if ((i+=2)/2 < ml/2) repeat loop + addl2 r7,(r3)+ # *p += (m[ml-1]*d)/2^32 + bcs LMDTail + clrl r0 # r0 = carry + ret + +LMDTailLoop: incl (r3)+ + bcc LMDRet0 +LMDTail: sobgtr r8,LMDTailLoop + movl $1,r0 # r0 = carry + ret + + .globl _BnnDivideDigit + .align 3 +_BnnDivideDigit: + .word 0x3FE&callee_save # mask<r1,r2,r3,r4,r5,r6,r7,r8,r9> + movl 12(ap),r2 # nl + movl 16(ap),r3 # d + moval *8(ap)[r2],r0 # nn = &nn[nl]; + decl r2 # nl--; + moval *4(ap)[r2],r1 # qq = &qq[nl]; + movl -(r0),r5 # X(hight) = *(--n); + extzv $1,$31,r3,r7 # r7 = D' <- D div 2 + tstl r3 + bgeq Lndivc2 + brw Lndiv5 # D < 0!! + + # D < 2**31 + brb Lndivc2 # N < D * 2**32 +Lndivc1: movl -(r0),r4 # (bdivu dx3 ax1 dx1) + cmpl r5,r7 + blss Lndivc11 + extzv $0,$1,r4,r6 # r6 <- n0 + ashq $-1,r4,r4 # N' = r4 = N quo 2 < D * 2**31 + ediv r3,r4,r4,r5 # r4 <- Q' = N' quo D < 2**31 + # r5 <- R' = N' rem D < D + ashq $1,r4,r4 # r4 <- 2 * Q' < 2**32 + # r5 <- 2 * R' < 2 * D + addl2 r6,r5 # r5 <- 2 * R' + n0 < 2 * D + cmpl r5,r3 # r5 < D -> Q = r4, R = r5 + blssu Lndivc12 # sinon + incl r4 # Q = r4 + 1 + subl2 r3,r5 # R = r5 - D + brb Lndivc12 +Lndivc11: ediv r3,r4,r4,r5 # Q = r4, R = r5 +Lndivc12: movl r4,-(r1) # range r4 en me'moire +Lndivc2: sobgeq r2,Lndivc1 # (sobgez dx2 Lndivc1) + movl r5,r0 # return(X(hight)); + ret + +Lndiv3: movl -(r0),r4 # r4 poid faible de N + extzv $0,$1,r4,r9 # r9 <- n0 + extzv $1,$1,r4,r6 # r6 <- n1 + extzv $2,$1,r4,r8 # r8 <- n2 + ashq $-3,r4,r4 # r4 <- N'' = N quo 4 + bicl2 $0xE0000000,r5 # Le ashq ne le fait pas + ediv r7,r4,r4,r5 # r4 <- Q' = N''' quo D' + # r5 <- R' = N''' rem D' + ashl $1,r5,r5 # r5 <- 2 * R' + addl2 r8,r5 # r5 <- 2 * R' + n2 + bbc $0,r3,Lndiv4 # si d0 = 0 + cmpl r5,r4 # sinon r5 <- 2R' + n1 - Q' + blssu Lndiv30 # la diff est < 0 + subl2 r4,r5 # la diff est > 0 + brb Lndiv4 # voila la diff! +Lndiv30: subl2 r4,r5 # la diff! + decl r4 # r4 <- r4 - 1 + addl2 r3,r5 # r5 <- r5 + D +Lndiv4: ashl $1,r4,r4 # r4 <- 2Q' + addl2 r5,r5 # r5 <- 2r5 + bisl2 r6,r5 # r5 <- r5 + n1 (flag C ok!) + bcs Lndiv40 # On deborde sur! + cmpl r5,r3 + blssu Lndiv42 # depasse pas D +Lndiv40: incl r4 # Q = r4 + 1 + subl2 r3,r5 # R = r5 - D +Lndiv42: ashl $1,r4,r4 # r4 <- 2Q' + addl2 r5,r5 # r5 <- 2r5 + bisl2 r9,r5 # r5 <- r5 + n0 (flag C ok!) + bcs Lndiv43 # On deborde sur! + cmpl r5,r3 + blssu Lndiv44 # depasse pas D +Lndiv43: incl r4 # Q = r4 + 1 + subl2 r3,r5 # R = r5 - D +Lndiv44: movl r4,-(r1) # range le quotient en memoire +Lndiv5: sobgeq r2,Lndiv3 # On continue! + movl r5,r0 # return(X(hight)); + ret + +# BigNumCarry BnnMultiply (pp, pl, mm, ml, nn, nl) +# BigNum pp, nn, mm; +# BigNumLength pl, nl, ml; + +.globl _BnnMultiply + .align 3 +_BnnMultiply: + .word 0xFFE&callee_save # mask<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11> + movl 24(ap),r9 # r9 = nl + bneq LMM_nl_pos +LMM_Ret0a: + clrl r0 +LMM_Ret: + ret +LMM_nl_pos: + movl 20(ap),r11 # nn + cmpl 12(ap),r11 # if (nn == mm) + beql BMM_Sqr +LMM_NotSqr: + movl 4(ap),r10 # pp + clrl r8 # c_hi +LMM_NLoop: + movl 16(ap),r7 # ml + movl 12(ap),r1 # mm + moval (r10)+,r3 # pp + clrl r5 # c_lo + movl (r11)+,r2 # digit + bsbw BMM_MultiplyDigit + sobgtr r9,LMM_NLoop + movl r8,r0 + beql LMM_Ret + movl 16(ap),r7 # r7 = ml + subl3 r7,8(ap),r1 # r7 = pl-ml + subl2 24(ap),r1 # r7 = pl-ml-nl + bleq LMM_Ret + moval (r10)[r7],r10 # pp += ml +LMM_PLoop: + incl (r10)+ + bcc LMM_Ret0a + sobgtr r1,LMM_PLoop + ret +# Special squaring code based on: +# n[0..nl-1]*n[0..nl-1] = sum (i = 0..nl-1): +# B^2i * (n[i]*n[i] + 2*n[i] * n[i+1..nl-1] * B) +# the 2*n[i] is tricky because it may overflow, but ... +# suppose L[i] = 2*n[i]%2^32 +# and H[i] = 2*n[i]/2^32 +# Then: +# sum (i = 0..nl-1): +# B^2i * (n[i]*n[i] + L[i]+H[i-1] * n[i+1..nl-1] * B + H[i-1]*n[i]) +# notice that when i = nl-1 the final term is 2*n[nl-1] * n[nl..nl-1], +# n[nl..nl-1] is zero length -- i.e. we can ignore it! +# lastly we don't have quite enough registers to conveniently remember +# the top bit of n[i-1] we encode it in the PC by duplicating +# the loop--sometimes I love assembler. +LMMS_NNLoop: + # execute this version of loop if n[i-1] was >= 2^31 + movl (r11)+,r0 # d = r0 = *nn++ + movl r11,r1 # r1 = mm + emul r0,r0,$0,r4 # r4:r5 = d*d + addl2 r0,r4 # r4 += (2*n[i-1])/2^32*n[i] (= d) + adwc $0,r5 + addl2 r4,(r10)+ # *pp++ += d*d%2^32 + adwc $0,r5 # r5 += C + moval (r10)+,r3 # arg-p = pp++ + movl r9,r7 # arg-ml = ml + addl3 r0,r0,r2 # if (d >= 0) + bisl2 $1,r2 + bcc LMMS_DPos # switch to < 2^31 loop +LMMS_DNeg: + addl2 r0,r5 # compensate for signed mul + addl2 r0,r5 # r4:r5 += 2*r2*2^32 + tstl r2 # set condition codes for entry to subr + # MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5) + bsbb BMM_MultiplyDigit + sobgeq r9,LMMS_NNLoop + brb LMMS_Post +# >>> ENTRY <<< +BMM_Sqr: + # r9 = nl, r11 = nn + movl 16(ap),r8 # r8 = ml + bneq LMMS_ml_pos + clrl r0 + ret # return 0; +LMMS_ml_pos: + cmpl r8,r9 # if (ml != nl) + bneq LMM_NotSqr + + # r8 = 0, r9 = nl, r11 = nn, r10 = sgn(nn[nl-1]) + movl 4(ap),r10 # r10 = pp + # r11 = nn + clrl r8 # r8 = high carry = 0 + decl r9 # r9 = ml-1 = nl-1 +LMMS_NLoop: + # execute this version of loop if n[i-1] was < 2^31 + movl (r11)+,r0 # d = r0 = *nn++ + movl r11,r1 # r1 = mm + emul r0,r0,$0,r4 # r4:r5 = d*d + addl2 r4,(r10)+ # *pp++ += d*d%2^32 + adwc $0,r5 # r5 += C + moval (r10)+,r3 # arg-p = pp++ + movl r9,r7 # arg-ml = ml + addl3 r0,r0,r2 # if (d < 0) + bcs LMMS_DNeg # switch to >= 2^31 loop +LMMS_DPos: + tstl r2 # set condition codes for entry to subr + # MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5) + bsbb BMM_MultiplyDigit + sobgeq r9,LMMS_NLoop + # r9 = 0, r10 = pp+2*ml, r2 = 2*nn[nl-1], r8 = carry_hi, r11 = nn+nl +LMMS_Post: + movl r8,r0 + bneq LMMS_CProp # if (c != 0) +LMMS_ret: + ret # return +LMMS_CProp: + movl 16(ap),r7 # r7 = nl + subl3 r7,8(ap),r2 # r2 = pl-nl (note nl == ml) + subl2 r7,r2 # r2 = pl-nl-ml + bleq LMMS_ret # if (pl-nl > ml) + # ret = BnnAddCarry(pp+ml, pl-ml, c); +LMMS_CPLoop: + incl (r10)+ # (*pp++)++ + bcc LMMS_Ret0 + sobgtr r2,LMMS_CPLoop + ret +LMMS_Ret0: + clrl r0 + ret + +# Subroutine: MultiplyDigit(pp,mm,ml,d,c_hi,c_lo) +# returns: +# c_hi*base^(ml+1)+ pp[0..ml] = pp[0..ml]+(mm[0..ml-1]*d)+c_hi*base^ml+c_lo +# +# In: +# ml_entry:r7 +# ml/2: r0 +# mm: r1 +# digit: r2 +# pp: r3 +# c_hi: r8 +# c_lo: r5 +# +# multiply scratch: r4,r5 / r6,r7 +# +# Out: +# c_hi: r8 +LMMD_C_hi: + addl2 r8,(r3)[r7] # p[ml] += c_hi + clrl r8 + adwc $0,r8 + rsb +LMMD_Zero: + tstl r5 # Too complicated, return to + beql LMMD_ZC_lo # normal case. + tstl r2 + brb LMMD_Retry +LMMD_ZC_lo: + tstl r8 + bneq LMMD_C_hi + rsb +BMM_MultiplyDigit: + beql LMMD_Zero +LMMD_Retry: + blss LMMD_Neg # if (d<0) goto LMMD_Neg + ashl $-1,r7,r0 # loop counter r0 = ml/2 + bitl $1,r7 + bneq LMMD_POddLen # if (ml is odd) goto LMMD_POddLen + movl r5,r7 + brb LMMD_PEvenLen # if (ml is even) goto LMMD_POddLen +LMMD_PLoop: emul (r1)+,r2,$0,r4 # r4:r5 = m[i]*d + bgeq LMMD_MPos1 # if (m[i] < 0) + addl2 r2,r5 # r5 += d +LMMD_MPos1: addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ # *p++ += r4 + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2 +LMMD_POddLen: emul (r1)+,r2,$0,r6 # r6:r7 = m[i+1]*d + bgeq LMMD_MPos2 # if (m[i+1] < 0) + addl2 r2,r7 # r7 += d +LMMD_MPos2: addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ # *p++ += r6 + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2 +LMMD_PEvenLen: sobgeq r0,LMMD_PLoop # if ((i+=2)/2 < ml/2) repeat loop + addl2 r8,r7 + clrl r8 + adwc $0,r8 + addl2 r7,(r3) # *p += (m[ml-1]*d)/2^32 + adwc $0,r8 + rsb +LMMD_Neg: + ashl $-1,r7,r0 # loop counter r0 = ml/2 + bitl $1,r7 + bneq LMMD_NOddLen + movl r5,r7 + brb LMMD_NEvenLen +LMMD_NLoop: movl (r1)+,r6 # r6 = m[i] + emul r6,r2,$0,r4 # r4:r5 = m[i]*d + bleq LMMD_MPos3 # if (m[i] < 0) + addl2 r2,r5 # r5 += d +LMMD_MPos3: addl2 r6,r5 # r5 += m[i] + addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1 + addl2 r4,(r3)+ # *p++ += r4 + adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2 +LMMD_NOddLen: movl (r1)+,r4 # r6 = m[i+1] + emul r4,r2,$0,r6 # r6:r7 = m[i+1]*d + bleq LMMD_MPos4 # if (m[i+1] < 0) + addl2 r2,r7 # r7 += d +LMMD_MPos4: addl2 r4,r7 # r7 += m[i+1] + addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1 + addl2 r6,(r3)+ # *p++ += r6 + adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2 +LMMD_NEvenLen: sobgeq r0,LMMD_NLoop # if ((i+=2)/2 < ml/2) repeat loop + addl2 r8,r7 + clrl r8 + adwc $0,r8 + addl2 r7,(r3) # *p += (m[ml-1]*d)/2^32 + adwc $0,r8 + rsb diff --git a/otherlibs/num/int_misc.mli b/otherlibs/num/int_misc.mli new file mode 100644 index 000000000..32693f1fe --- /dev/null +++ b/otherlibs/num/int_misc.mli @@ -0,0 +1,23 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Some extra operations on integers *) + +val gcd_int: int -> int -> int +val num_bits_int: int -> int +val compare_int: int -> int -> int +val sign_int: int -> int +val length_of_int: int +val biggest_int: int +val least_int: int +val monster_int: int diff --git a/otherlibs/num/int_misc.mlp b/otherlibs/num/int_misc.mlp new file mode 100644 index 000000000..a6ff5b425 --- /dev/null +++ b/otherlibs/num/int_misc.mlp @@ -0,0 +1,41 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Some extra operations on integers *) + +(* +#include "../../config/m.h" +*) + +let rec gcd_int i1 i2 = + if i2 = 0 then abs i1 else gcd_int i2 (i1 mod i2) +;; + +let rec num_bits_int_aux n = + if n = 0 then 0 else succ(num_bits_int_aux (n lsr 1));; + +let num_bits_int n = num_bits_int_aux (abs n);; + +let sign_int i = if i = 0 then 0 else if i > 0 then 1 else -1;; + +#ifdef SIXTYFOUR +let length_of_int = 62;; +#else +let length_of_int = 30;; +#endif +let monster_int = 1 lsl length_of_int;; +let biggest_int = monster_int - 1;; +let least_int = - biggest_int;; + +let compare_int n1 n2 = + if n1 == n2 then 0 else if n1 > n2 then 1 else -1;; diff --git a/otherlibs/num/nat.mli b/otherlibs/num/nat.mli new file mode 100644 index 000000000..72c971831 --- /dev/null +++ b/otherlibs/num/nat.mli @@ -0,0 +1,70 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Nat]: operations on natural numbers *) + +type nat + +(* Natural numbers (type [nat]) are positive integers of arbitrary size. + All operations on [nat] are performed in-place. *) + +external create_nat: int -> nat = "create_nat" +val make_nat: int -> nat +external set_to_zero_nat: nat -> int -> int -> unit = "set_to_zero_nat" +external blit_nat: nat -> int -> nat -> int -> int -> unit = "blit_nat" +val copy_nat: nat -> int -> int -> nat +external set_digit_nat: nat -> int -> int -> unit = "set_digit_nat" +external nth_digit_nat: nat -> int -> int = "nth_digit_nat" +external length_nat: nat -> int = "%array_length" +val length_nat : nat -> int +external num_digits_nat: nat -> int -> int -> int = "num_digits_nat" +external num_leading_zero_bits_in_digit: nat -> int -> int = "num_leading_zero_bits_in_digit" +external is_digit_int: nat -> int -> bool = "is_digit_int" +external is_digit_zero: nat -> int -> bool = "is_digit_zero" +external is_digit_normalized: nat -> int -> bool = "is_digit_normalized" +external is_digit_odd: nat -> int -> bool = "is_digit_odd" +val is_zero_nat: nat -> int -> int -> bool +val is_nat_int: nat -> int -> int -> bool +val int_of_nat: nat -> int +val nat_of_int: int -> nat +external incr_nat: nat -> int -> int -> int -> int = "incr_nat" +external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "add_nat" "add_nat_native" +external complement_nat: nat -> int -> int -> unit = "complement_nat" +external decr_nat: nat -> int -> int -> int -> int = "decr_nat" +external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "sub_nat" "sub_nat_native" +external mult_digit_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int = "mult_digit_nat" "mult_digit_nat_native" +external mult_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int = "mult_nat" "mult_nat_native" +external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_left_nat" "shift_left_nat_native" +external div_digit_nat: nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit = "div_digit_nat" "div_digit_nat_native" +external div_nat: nat -> int -> int -> nat -> int -> int -> unit = "div_nat" "div_nat_native" +external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_right_nat" "shift_right_nat_native" +external compare_digits_nat: nat -> int -> nat -> int -> int = "compare_digits_nat" +external compare_nat: nat -> int -> int -> nat -> int -> int -> int = "compare_nat" "compare_nat_native" +val eq_nat : nat -> int -> int -> nat -> int -> int -> bool +val le_nat : nat -> int -> int -> nat -> int -> int -> bool +val lt_nat : nat -> int -> int -> nat -> int -> int -> bool +val ge_nat : nat -> int -> int -> nat -> int -> int -> bool +val gt_nat : nat -> int -> int -> nat -> int -> int -> bool +external land_digit_nat: nat -> int -> nat -> int -> unit = "land_digit_nat" +external lor_digit_nat: nat -> int -> nat -> int -> unit = "lor_digit_nat" +external lxor_digit_nat: nat -> int -> nat -> int -> unit = "lxor_digit_nat" +val square_nat : nat -> int -> int -> nat -> int -> int -> int +val gcd_nat : nat -> int -> int -> nat -> int -> int -> int +val sqrt_nat : nat -> int -> int -> nat +val string_of_nat : nat -> string +val nat_of_string : string -> nat +val sys_nat_of_string : int -> string -> int -> int -> nat +val float_of_nat : nat -> float +val make_power_base : int -> nat -> int * int +val power_base_int : int -> int -> nat +val length_of_digit: int diff --git a/otherlibs/num/nat.mlp b/otherlibs/num/nat.mlp new file mode 100644 index 000000000..90877d521 --- /dev/null +++ b/otherlibs/num/nat.mlp @@ -0,0 +1,527 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* +#include "../../config/m.h" +*) + +open Int_misc + +type nat;; + +external create_nat: int -> nat = "create_nat" +external set_to_zero_nat: nat -> int -> int -> unit = "set_to_zero_nat" +external blit_nat: nat -> int -> nat -> int -> int -> unit = "blit_nat" +external set_digit_nat: nat -> int -> int -> unit = "set_digit_nat" +external nth_digit_nat: nat -> int -> int = "nth_digit_nat" +external length_nat: nat -> int = "%array_length" +external num_digits_nat: nat -> int -> int -> int = "num_digits_nat" +external num_leading_zero_bits_in_digit: nat -> int -> int = "num_leading_zero_bits_in_digit" +external is_digit_int: nat -> int -> bool = "is_digit_int" +external is_digit_zero: nat -> int -> bool = "is_digit_zero" +external is_digit_normalized: nat -> int -> bool = "is_digit_normalized" +external is_digit_odd: nat -> int -> bool = "is_digit_odd" +external incr_nat: nat -> int -> int -> int -> int = "incr_nat" +external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "add_nat" "add_nat_native" +external complement_nat: nat -> int -> int -> unit = "complement_nat" +external decr_nat: nat -> int -> int -> int -> int = "decr_nat" +external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "sub_nat" "sub_nat_native" +external mult_digit_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int = "mult_digit_nat" "mult_digit_nat_native" +external mult_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int = "mult_nat" "mult_nat_native" +external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_left_nat" "shift_left_nat_native" +external div_digit_nat: nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit = "div_digit_nat" "div_digit_nat_native" +external div_nat: nat -> int -> int -> nat -> int -> int -> unit = "div_nat" "div_nat_native" +external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_right_nat" "shift_right_nat_native" +external compare_digits_nat: nat -> int -> nat -> int -> int = "compare_digits_nat" +external compare_nat: nat -> int -> int -> nat -> int -> int -> int = "compare_nat" "compare_nat_native" +external land_digit_nat: nat -> int -> nat -> int -> unit = "land_digit_nat" +external lor_digit_nat: nat -> int -> nat -> int -> unit = "lor_digit_nat" +external lxor_digit_nat: nat -> int -> nat -> int -> unit = "lxor_digit_nat" + +#ifdef SIXTYFOUR +let length_of_digit = 64 +#else +let length_of_digit = 32 +#endif + +let make_nat len = + if len < 0 then invalid_arg "make_nat" else + let res = create_nat len in set_to_zero_nat res 0 len; res + +let copy_nat nat off_set length = + let res = create_nat (length) in + blit_nat res 0 nat off_set length; + res + +let is_zero_nat n off len = + compare_nat (make_nat 1) 0 1 n off (num_digits_nat n off len) = 0 + +let is_nat_int nat off len = + num_digits_nat nat off len = 1 & is_digit_int nat off + +let sys_int_of_nat nat off len = + if is_nat_int nat off len + then nth_digit_nat nat off + else failwith "int_of_nat" + +let int_of_nat nat = + sys_int_of_nat nat 0 (length_nat nat) + +let nat_of_int i = + if i < 0 then invalid_arg "nat_of_int" else + let res = make_nat 1 in + if i = 0 then res else begin set_digit_nat res 0 i; res end + +let eq_nat nat1 off1 len1 nat2 off2 len2 = + compare_nat nat1 off1 (num_digits_nat nat1 off1 len1) + nat2 off2 (num_digits_nat nat2 off2 len2) = 0 +and le_nat nat1 off1 len1 nat2 off2 len2 = + compare_nat nat1 off1 (num_digits_nat nat1 off1 len1) + nat2 off2 (num_digits_nat nat2 off2 len2) <= 0 +and lt_nat nat1 off1 len1 nat2 off2 len2 = + compare_nat nat1 off1 (num_digits_nat nat1 off1 len1) + nat2 off2 (num_digits_nat nat2 off2 len2) < 0 +and ge_nat nat1 off1 len1 nat2 off2 len2 = + compare_nat nat1 off1 (num_digits_nat nat1 off1 len1) + nat2 off2 (num_digits_nat nat2 off2 len2) >= 0 +and gt_nat nat1 off1 len1 nat2 off2 len2 = + compare_nat nat1 off1 (num_digits_nat nat1 off1 len1) + nat2 off2 (num_digits_nat nat2 off2 len2) > 0 + +let square_nat nat1 off1 len1 nat2 off2 len2 = + let c = ref 0 + and trash = make_nat 1 in + (* Double product *) + for i = 0 to len2 - 2 do + c := !c + mult_digit_nat + nat1 + (succ (off1 + 2 * i)) + (2 * (pred (len2 - i))) + nat2 + (succ (off2 + i)) + (pred (len2 - i)) + nat2 + (off2 + i) + done; + shift_left_nat nat1 0 len1 trash 0 1; + (* Square of digit *) + for i = 0 to len2 - 1 do + c := !c + mult_digit_nat + nat1 + (off1 + 2 * i) + (len1 - 2 * i) + nat2 + (off2 + i) + 1 + nat2 + (off2 + i) + done; + !c + +let gcd_int_nat i nat off len = + if i = 0 then 1 else + if is_nat_int nat off len then begin + set_digit_nat nat off (gcd_int (nth_digit_nat nat off) i); 0 + end else begin + let len_copy = succ len in + let copy = create_nat len_copy + and quotient = create_nat 1 + and remainder = create_nat 1 in + blit_nat copy 0 nat off len; + set_digit_nat copy len 0; + div_digit_nat quotient 0 remainder 0 copy 0 len_copy (nat_of_int i) 0; + set_digit_nat nat off (gcd_int (nth_digit_nat remainder 0) i); + 0 + end + +let exchange r1 r2 = + let old1 = !r1 in r1 := !r2; r2 := old1 + +let gcd_nat nat1 off1 len1 nat2 off2 len2 = + if is_zero_nat nat1 off1 len1 then begin + blit_nat nat1 off1 nat2 off2 len2; len2 + end else begin + let copy1 = ref (create_nat (succ len1)) + and copy2 = ref (create_nat (succ len2)) in + blit_nat !copy1 0 nat1 off1 len1; + blit_nat !copy2 0 nat2 off2 len2; + set_digit_nat !copy1 len1 0; + set_digit_nat !copy2 len2 0; + if lt_nat !copy1 0 len1 !copy2 0 len2 + then exchange copy1 copy2; + let real_len1 = + ref (num_digits_nat !copy1 0 (length_nat !copy1)) + and real_len2 = + ref (num_digits_nat !copy2 0 (length_nat !copy2)) in + while not (is_zero_nat !copy2 0 !real_len2) do + set_digit_nat !copy1 !real_len1 0; + div_nat !copy1 0 (succ !real_len1) !copy2 0 !real_len2; + exchange copy1 copy2; + real_len1 := !real_len2; + real_len2 := num_digits_nat !copy2 0 !real_len2 + done; + blit_nat nat1 off1 !copy1 0 !real_len1; + !real_len1 + end + +let sqrt_nat nat off len = + let size_copy = succ len in + let size_sqrt = len / 2 + len mod 2 in + let candidate = make_nat (size_sqrt) + and beginning = make_nat (size_sqrt) in + set_digit_nat candidate (size_sqrt - 1) 1; + shift_left_nat candidate (size_sqrt - 1) 1 beginning 0 + (((if len mod 2 = 0 then 31 else 15) - + num_leading_zero_bits_in_digit nat (off + len - 1)) / 2); + let size_aux = size_copy - size_sqrt in + let copy = create_nat size_copy in + let aux = make_nat size_aux in + set_digit_nat copy len 0; + blit_nat copy 0 nat off len; + div_nat copy 0 size_copy candidate 0 size_sqrt; + blit_nat aux 0 copy size_sqrt size_aux; + add_nat aux 0 size_aux candidate 0 (num_digits_nat candidate 0 size_sqrt) 0; + shift_right_nat aux 0 size_aux beginning 0 1; + while not + (eq_nat aux 0 (num_digits_nat aux 0 size_aux) + candidate 0 (num_digits_nat candidate 0 size_sqrt)) + do + blit_nat candidate 0 aux 0 size_aux; + set_digit_nat copy len 0; + blit_nat copy 0 nat off len; + div_nat copy 0 size_copy candidate 0 size_sqrt; + blit_nat aux 0 copy size_sqrt size_aux; + add_nat aux 0 size_aux candidate 0 (num_digits_nat candidate 0 size_sqrt) 0; + shift_right_nat aux 0 size_aux beginning 0 1 + done; + candidate + +let power_base_max = make_nat 2 + +#ifdef SIXTYFOUR +let _ = + set_digit_nat power_base_max 0 1000000000000000000; + mult_digit_nat power_base_max 0 2 + power_base_max 0 1 (nat_of_int 9) 0 +let pmax = 19 +#else +let _ = set_digit_nat power_base_max 0 1000000000 +let pmax = 9 +#endif + +(* Nat temporaries *) +let a_2 = make_nat 2 +and a_1 = make_nat 1 +and b_2 = make_nat 2 + +#ifdef SIXTYFOUR +let max_superscript_10_power_in_int = 18 +let max_power_10_power_in_int = nat_of_int 1000000000000000000 +#else +let max_superscript_10_power_in_int = 9 +let max_power_10_power_in_int = nat_of_int 1000000000 +#endif + +let raw_string_of_digit nat off = + if is_nat_int nat off 1 + then begin string_of_int (nth_digit_nat nat off) end + else begin + blit_nat b_2 0 nat off 1; + div_digit_nat a_2 0 a_1 0 b_2 0 2 max_power_10_power_in_int 0; + let leading_digits = nth_digit_nat a_2 0 + and s1 = string_of_int (nth_digit_nat a_1 0) in + let len = String.length s1 in + if leading_digits < 10 then begin + let result = String.make (max_superscript_10_power_in_int+1) '0' in + String.set result 0 + (Char.chr (48 + leading_digits)); + String.blit s1 0 + result (String.length result - len) len; + result + end else begin + let result = String.make (max_superscript_10_power_in_int+2) '0' in + String.blit (string_of_int leading_digits) 0 result 0 2; + String.blit s1 0 + result (String.length result - len) len; + result + end + end + +(* XL: suppression de string_of_digit et de sys_string_of_digit. + La copie est de toute facon faite dans string_of_nat, qui est le + seul point d'entree public dans ce code. *) + +(****** +let sys_string_of_digit nat off = + let s = raw_string_of_digit nat off in + let result = String.create (String.length s) in + String.blit s 0 result 0 (String.length s); + s + +let string_of_digit nat = + sys_string_of_digit nat 0 + +*******) + +let digits = "0123456789ABCDEF" + +(* + make_power_base affecte power_base des puissances successives de base a + partir de la puissance 1-ieme. + A la fin de la boucle i-1 est la plus grande puissance de la base qui tient + sur un seul digit et j est la plus grande puissance de la base qui tient + sur un int. +*) +let make_power_base base power_base = + let i = ref 0 + and j = ref 0 in + set_digit_nat power_base 0 base; + while incr i; is_digit_zero power_base !i do + mult_digit_nat power_base !i 2 + power_base (pred !i) 1 + power_base 0 + done; + while !j <= !i & is_digit_int power_base !j do incr j done; + (!i - 2, !j) + +(* + int_to_string place la representation de l entier int en base base + dans la chaine s en le rangeant de la fin indiquee par pos vers le + debut, sur times places et affecte a pos sa nouvelle valeur. +*) +let int_to_string int s pos_ref base times = + let i = ref int + and j = ref times in + while ((!i != 0) or (!j != 0)) & (!pos_ref != -1) do + String.set s !pos_ref (String.get digits (!i mod base)); + decr pos_ref; + decr j; + i := !i / base + done + +(* XL: suppression de adjust_string *) + +let power_base_int base i = + if i = 0 then + nat_of_int 1 + else if i < 0 then + invalid_arg "power_base_int" + else begin + let power_base = make_nat (succ length_of_digit) in + let (pmax, pint) = make_power_base base power_base in + let n = i / (succ pmax) + and rem = i mod (succ pmax) in + if n > 0 then begin + let newn = + if i = biggest_int then n else (succ n) in + let res = make_nat newn + and res2 = make_nat newn + and l = num_bits_int n - 2 in + let p = ref (1 lsl l) in + blit_nat res 0 power_base pmax 1; + for i = l downto 0 do + let len = num_digits_nat res 0 newn in + let len2 = min n (2 * len) in + let succ_len2 = succ len2 in + square_nat res2 0 len2 res 0 len; + if n land !p > 0 then begin + set_to_zero_nat res 0 len; + mult_digit_nat res 0 succ_len2 + res2 0 len2 + power_base pmax; + () + end else + blit_nat res 0 res2 0 len2; + set_to_zero_nat res2 0 len2; + p := !p lsr 1 + done; + if rem > 0 then begin + mult_digit_nat res2 0 newn + res 0 n power_base (pred rem); + res2 + end else res + end else + copy_nat power_base (pred rem) 1 + end + +(* the ith element (i >= 2) of num_digits_max_vector is : + | | + | biggest_string_length * log (i) | + | ------------------------------- | + 1 + | length_of_digit * log (2) | + -- -- +*) + +(* XL: ai specialise le code d origine a length_of_digit = 32. *) +(* Puis suppression (inutile?) *) + +(****** +let num_digits_max_vector = + [|0; 0; 1024; 1623; 2048; 2378; 2647; 2875; 3072; 3246; 3402; + 3543; 3671; 3789; 3899; 4001; 4096|] + +let num_digits_max_vector = + match length_of_digit with + 16 -> [|0; 0; 2048; 3246; 4096; 4755; 5294; 5749; 6144; 6492; 6803; + 7085; 7342; 7578; 7797; 8001; 8192|] +(* If really exotic machines !!!! + | 17 -> [|0; 0; 1928; 3055; 3855; 4476; 4983; 5411; 5783; 6110; 6403; + 6668; 6910; 7133; 7339; 7530; 7710|] + | 18 -> [|0; 0; 1821; 2886; 3641; 4227; 4706; 5111; 5461; 5771; 6047; + 6298; 6526; 6736; 6931; 7112; 7282|] + | 19 -> [|0; 0; 1725; 2734; 3449; 4005; 4458; 4842; 5174; 5467; 5729; + 5966; 6183; 6382; 6566; 6738; 6898|] + | 20 -> [|0; 0; 1639; 2597; 3277; 3804; 4235; 4600; 4915; 5194; 5443; + 5668; 5874; 6063; 6238; 6401; 6553|] + | 21 -> [|0; 0; 1561; 2473; 3121; 3623; 4034; 4381; 4681; 4946; 5183; + 5398; 5594; 5774; 5941; 6096; 6241|] + | 22 -> [|0; 0; 1490; 2361; 2979; 3459; 3850; 4182; 4468; 4722; 4948; + 5153; 5340; 5512; 5671; 5819; 5958|] + | 23 -> [|0; 0; 1425; 2258; 2850; 3308; 3683; 4000; 4274; 4516; 4733; + 4929; 5108; 5272; 5424; 5566; 5699|] + | 24 -> [|0; 0; 1366; 2164; 2731; 3170; 3530; 3833; 4096; 4328; 4536; + 4723; 4895; 5052; 5198; 5334; 5461|] + | 25 -> [|0; 0; 1311; 2078; 2622; 3044; 3388; 3680; 3932; 4155; 4354; + 4534; 4699; 4850; 4990; 5121; 5243|] + | 26 -> [|0; 0; 1261; 1998; 2521; 2927; 3258; 3538; 3781; 3995; 4187; + 4360; 4518; 4664; 4798; 4924; 5041|] + | 27 -> [|0; 0; 1214; 1924; 2428; 2818; 3137; 3407; 3641; 3847; 4032; + 4199; 4351; 4491; 4621; 4742; 4855|] + | 28 -> [|0; 0; 1171; 1855; 2341; 2718; 3025; 3286; 3511; 3710; 3888; + 4049; 4196; 4331; 4456; 4572; 4681|] + | 29 -> [|0; 0; 1130; 1791; 2260; 2624; 2921; 3172; 3390; 3582; 3754; + 3909; 4051; 4181; 4302; 4415; 4520|] + | 30 -> [|0; 0; 1093; 1732; 2185; 2536; 2824; 3067; 3277; 3463; 3629; + 3779; 3916; 4042; 4159; 4267; 4369|] + | 31 -> [|0; 0; 1057; 1676; 2114; 2455; 2733; 2968; 3171; 3351; 3512; + 3657; 3790; 3912; 4025; 4130; 4228|] +*) + | 32 -> [|0; 0; 1024; 1623; 2048; 2378; 2647; 2875; 3072; 3246; 3402; + 3543; 3671; 3789; 3899; 4001; 4096|] + | n -> failwith "num_digits_max_vector" +******) + +(* XL: suppression de string_list_of_nat *) + +let unadjusted_string_of_nat nat off len_nat = + let len = num_digits_nat nat off len_nat in + if len = 1 then + raw_string_of_digit nat off + else + let len_copy = ref (succ len) in + let copy1 = create_nat !len_copy + and copy2 = make_nat !len_copy + and rest_digit = make_nat 2 in + if len > biggest_int / (succ pmax) + then failwith "number too long" + else let len_s = (succ pmax) * len in + let s = String.make len_s '0' + and pos_ref = ref len_s in + len_copy := pred !len_copy; + blit_nat copy1 0 nat off len; + set_digit_nat copy1 len 0; + while not (is_zero_nat copy1 0 !len_copy) do + div_digit_nat copy2 0 + rest_digit 0 + copy1 0 (succ !len_copy) + power_base_max 0; + let str = raw_string_of_digit rest_digit 0 in + String.blit str 0 + s (!pos_ref - String.length str) + (String.length str); + (* XL: il y avait pmax a la place de String.length str + mais ca ne marche pas avec le blit de Caml Light, + qui ne verifie pas les debordements *) + pos_ref := !pos_ref - pmax; + len_copy := num_digits_nat copy2 0 !len_copy; + blit_nat copy1 0 copy2 0 !len_copy; + set_digit_nat copy1 !len_copy 0 + done; + s + +let string_of_nat nat = + let s = unadjusted_string_of_nat nat 0 (length_nat nat) + and index = ref 0 in + begin try + for i = 0 to String.length s - 2 do + if String.get s i <> '0' then (index:= i; raise Exit) + done + with Exit -> () + end; + String.sub s !index (String.length s - !index) + +(* XL: suppression de sys_string_of_nat *) + +(* XL: suppression de debug_string_nat *) + +let base_digit_of_char c base = + let n = Char.code c in + if n >= 48 & n <= 47 + min base 10 then n - 48 + else if n >= 65 & n <= 65 + base - 11 then n - 55 + else failwith "invalid digit" + +(* + La sous-chaine (s, off, len) represente un nat en base base que + on determine ici +*) +let sys_nat_of_string base s off len = + let power_base = make_nat (succ length_of_digit) in + let (pmax, pint) = make_power_base base power_base in + let new_len = ref (1 + len / (pmax + 1)) + and current_len = ref 1 in + let possible_len = ref (min 2 !new_len) in + + let nat1 = make_nat !new_len + and nat2 = make_nat !new_len + + and digits_read = ref 0 + and bound = off + len - 1 + and int = ref 0 in + + for i = off to bound do + (* + on lit pint (au maximum) chiffres, on en fait un int + et on l integre au nombre + *) + let c = String.get s i in + begin match c with + ' ' | '\t' | '\n' | '\r' | '\\' -> () + | _ -> int := !int * base + base_digit_of_char c base; + incr digits_read + end; + if (!digits_read = pint or i = bound) & not (!digits_read = 0) then + begin + set_digit_nat nat1 0 !int; + for j = 1 to !current_len do + set_digit_nat nat1 j 0 + done; + mult_digit_nat nat1 0 !possible_len + nat2 0 !current_len + power_base (pred !digits_read); + blit_nat nat2 0 nat1 0 !possible_len; + current_len := num_digits_nat nat1 0 !possible_len; + possible_len := min !new_len (succ !current_len); + int := 0; + digits_read := 0 + end + done; + (* + On recadre le nat + *) + let nat = create_nat !current_len in + blit_nat nat 0 nat1 0 !current_len; + nat + +let nat_of_string s = sys_nat_of_string 10 s 0 (String.length s) + +let float_of_nat nat = float_of_string(string_of_nat nat) diff --git a/otherlibs/num/num.ml b/otherlibs/num/num.ml new file mode 100644 index 000000000..be61ff055 --- /dev/null +++ b/otherlibs/num/num.ml @@ -0,0 +1,398 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +open Int_misc +open Nat +open Big_int +open Arith_flags +open Ratio + +type num = Int of int | Big_int of big_int | Ratio of ratio + (* The type of numbers. *) + +let biggest_INT = big_int_of_int biggest_int +and least_INT = big_int_of_int least_int + +(* Coercion big_int -> num *) +let num_of_big_int bi = + if le_big_int bi biggest_INT & ge_big_int bi least_INT + then Int (int_of_big_int bi) + else Big_int bi + +let numerator_num = function + Ratio r -> normalize_ratio r; num_of_big_int (numerator_ratio r) +| n -> n + +let denominator_num = function + Ratio r -> normalize_ratio r; num_of_big_int (denominator_ratio r) +| n -> Int 1 + +let normalize_num = function + Int i -> Int i +| Big_int bi -> num_of_big_int bi +| Ratio r -> if is_integer_ratio r + then num_of_big_int (numerator_ratio r) + else Ratio r + +let cautious_normalize_num_when_printing n = + if (!normalize_ratio_when_printing_flag) then (normalize_num n) else n + +(* Operations on num *) + +let add_num a b = match (a,b) with + ((Int int1), (Int int2)) -> + let r = int1 + int2 in + if (int1 lxor int2) lor (int1 lxor (r lxor (-1))) < 0 + then Int r (* No overflow *) + else Big_int(add_big_int (big_int_of_int int1) (big_int_of_int int2)) + | ((Int i), (Big_int bi)) -> + num_of_big_int (add_int_big_int i bi) + | ((Big_int bi), (Int i)) -> + num_of_big_int (add_int_big_int i bi) + + | ((Int i), (Ratio r)) -> + Ratio (add_int_ratio i r) + | ((Ratio r), (Int i)) -> + Ratio (add_int_ratio i r) + + | ((Big_int bi1), (Big_int bi2)) -> num_of_big_int (add_big_int bi1 bi2) + + | ((Big_int bi), (Ratio r)) -> + Ratio (add_big_int_ratio bi r) + | ((Ratio r), (Big_int bi)) -> + Ratio (add_big_int_ratio bi r) + + | ((Ratio r1), (Ratio r2)) -> Ratio (add_ratio r1 r2) + +let ( +/ ) = add_num + +let minus_num = function + Int i -> if i = monster_int + then Big_int (minus_big_int (big_int_of_int i)) + else Int (-i) +| Big_int bi -> Big_int (minus_big_int bi) +| Ratio r -> Ratio (minus_ratio r) + +let sub_num n1 n2 = add_num n1 (minus_num n2) + +let ( -/ ) = sub_num + +let mult_num a b = match (a,b) with + ((Int int1), (Int int2)) -> + if num_bits_int int1 + num_bits_int int2 < length_of_int + then Int (int1 * int2) + else num_of_big_int (mult_big_int (big_int_of_int int1) + (big_int_of_int int2)) + + | ((Int i), (Big_int bi)) -> + num_of_big_int (mult_int_big_int i bi) + | ((Big_int bi), (Int i)) -> + num_of_big_int (mult_int_big_int i bi) + + | ((Int i), (Ratio r)) -> + Ratio (mult_int_ratio i r) + | ((Ratio r), (Int i)) -> + Ratio (mult_int_ratio i r) + + | ((Big_int bi1), (Big_int bi2)) -> + num_of_big_int (mult_big_int bi1 bi2) + + | ((Big_int bi), (Ratio r)) -> + Ratio (mult_big_int_ratio bi r) + | ((Ratio r), (Big_int bi)) -> + Ratio (mult_big_int_ratio bi r) + + | ((Ratio r1), (Ratio r2)) -> + Ratio (mult_ratio r1 r2) + +let ( */ ) = mult_num + +let square_num = function + Int i -> if 2 * num_bits_int i < length_of_int + then Int (i * i) + else num_of_big_int (square_big_int (big_int_of_int i)) + | Big_int bi -> Big_int (square_big_int bi) + | Ratio r -> Ratio (square_ratio r) + +let div_num a b = match (a,b) with + ((Int int1), (Int int2)) -> + Ratio (create_ratio (big_int_of_int int1) (big_int_of_int int2)) + + | ((Int i), (Big_int bi)) -> + Ratio (create_ratio (big_int_of_int i) bi) + + | ((Big_int bi), (Int i)) -> + Ratio (create_ratio bi (big_int_of_int i)) + + | ((Int i), (Ratio r)) -> + Ratio (div_int_ratio i r) + | ((Ratio r), (Int i)) -> + Ratio (div_ratio_int r i) + + | ((Big_int bi1), (Big_int bi2)) -> + Ratio (create_ratio bi1 bi2) + + | ((Big_int bi), (Ratio r)) -> + Ratio (div_big_int_ratio bi r) + | ((Ratio r), (Big_int bi)) -> + Ratio (div_ratio_big_int r bi) + + | ((Ratio r1), (Ratio r2)) -> + Ratio (div_ratio r1 r2) + +let ( // ) = div_num + +let floor_num = function + Int i as n -> n +| Big_int bi as n -> n +| Ratio r -> num_of_big_int (floor_ratio r) + +let quo_num x y = floor_num (div_num x y) + +let mod_num x y = sub_num x (mult_num y (quo_num x y)) + +let power_num_int a b = match (a,b) with + ((Int i), n) -> + (match sign_int n with + 0 -> Int 1 + | 1 -> num_of_big_int (power_int_positive_int i n) + | _ -> Ratio (create_normalized_ratio + unit_big_int (power_int_positive_int i (-n)))) +| ((Big_int bi), n) -> + (match sign_int n with + 0 -> Int 1 + | 1 -> num_of_big_int (power_big_int_positive_int bi n) + | _ -> Ratio (create_normalized_ratio + unit_big_int (power_big_int_positive_int bi (-n)))) +| ((Ratio r), n) -> + (match sign_int n with + 0 -> Int 1 + | 1 -> Ratio (power_ratio_positive_int r n) + | _ -> Ratio (power_ratio_positive_int + (inverse_ratio r) (-n))) + +let power_num_big_int a b = match (a,b) with + ((Int i), n) -> + (match sign_big_int n with + 0 -> Int 1 + | 1 -> num_of_big_int (power_int_positive_big_int i n) + | _ -> Ratio (create_normalized_ratio + unit_big_int + (power_int_positive_big_int i (minus_big_int n)))) +| ((Big_int bi), n) -> + (match sign_big_int n with + 0 -> Int 1 + | 1 -> num_of_big_int (power_big_int_positive_big_int bi n) + | _ -> Ratio (create_normalized_ratio + unit_big_int + (power_big_int_positive_big_int bi (minus_big_int n)))) +| ((Ratio r), n) -> + (match sign_big_int n with + 0 -> Int 1 + | 1 -> Ratio (power_ratio_positive_big_int r n) + | _ -> Ratio (power_ratio_positive_big_int + (inverse_ratio r) (minus_big_int n))) + +let power_num a b = match (a,b) with + (n, (Int i)) -> power_num_int n i +| (n, (Big_int bi)) -> power_num_big_int n bi +| _ -> invalid_arg "power_num" + +let ( **/ ) = power_num + +let is_integer_num = function + Int _ -> true +| Big_int _ -> true +| Ratio r -> is_integer_ratio r + +(* integer_num, floor_num, round_num, ceiling_num rendent des nums *) +let integer_num = function + Int i as n -> n +| Big_int bi as n -> n +| Ratio r -> num_of_big_int (integer_ratio r) + +and round_num = function + Int i as n -> n +| Big_int bi as n -> n +| Ratio r -> num_of_big_int (round_ratio r) + +and ceiling_num = function + Int i as n -> n +| Big_int bi as n -> n +| Ratio r -> num_of_big_int (ceiling_ratio r) + +(* Comparisons on nums *) + +let sign_num = function + Int i -> sign_int i +| Big_int bi -> sign_big_int bi +| Ratio r -> sign_ratio r + +let eq_num a b = match (a,b) with + ((Int int1), (Int int2)) -> int1 = int2 + +| ((Int i), (Big_int bi)) -> eq_big_int (big_int_of_int i) bi +| ((Big_int bi), (Int i)) -> eq_big_int (big_int_of_int i) bi + +| ((Int i), (Ratio r)) -> eq_big_int_ratio (big_int_of_int i) r +| ((Ratio r), (Int i)) -> eq_big_int_ratio (big_int_of_int i) r + +| ((Big_int bi1), (Big_int bi2)) -> eq_big_int bi1 bi2 + +| ((Big_int bi), (Ratio r)) -> eq_big_int_ratio bi r +| ((Ratio r), (Big_int bi)) -> eq_big_int_ratio bi r + +| ((Ratio r1), (Ratio r2)) -> eq_ratio r1 r2 + +let ( =/ ) = eq_num + +let ( <>/ ) a b = not(eq_num a b) + +let compare_num a b = match (a,b) with + ((Int int1), (Int int2)) -> compare_int int1 int2 + +| ((Int i), (Big_int bi)) -> compare_big_int (big_int_of_int i) bi +| ((Big_int bi), (Int i)) -> compare_big_int bi (big_int_of_int i) + +| ((Int i), (Ratio r)) -> compare_big_int_ratio (big_int_of_int i) r +| ((Ratio r), (Int i)) -> -(compare_big_int_ratio (big_int_of_int i) r) + +| ((Big_int bi1), (Big_int bi2)) -> compare_big_int bi1 bi2 + +| ((Big_int bi), (Ratio r)) -> compare_big_int_ratio bi r +| ((Ratio r), (Big_int bi)) -> -(compare_big_int_ratio bi r) + +| ((Ratio r1), (Ratio r2)) -> compare_ratio r1 r2 + +let lt_num num1 num2 = compare_num num1 num2 < 0 +and le_num num1 num2 = compare_num num1 num2 <= 0 +and gt_num num1 num2 = compare_num num1 num2 > 0 +and ge_num num1 num2 = compare_num num1 num2 >= 0 + +let ( </ ) = lt_num +and ( <=/ ) = le_num +and ( >/ ) = gt_num +and ( >=/ ) = ge_num + +let max_num num1 num2 = if lt_num num1 num2 then num2 else num1 +and min_num num1 num2 = if gt_num num1 num2 then num2 else num1 + +(* Coercions with basic types *) + +(* Coercion with int type *) +let int_of_num = function + Int i -> i +| Big_int bi -> int_of_big_int bi +| Ratio r -> int_of_ratio r + +and num_of_int i = + if i = monster_int + then Big_int (big_int_of_int i) + else Int i + +(* Coercion with nat type *) +let nat_of_num = function + Int i -> nat_of_int i +| Big_int bi -> nat_of_big_int bi +| Ratio r -> nat_of_ratio r + +and num_of_nat nat = + if (is_nat_int nat 0 (length_nat nat)) + then Int (nth_digit_nat nat 0) + else Big_int (big_int_of_nat nat) + +(* Coercion with big_int type *) +let big_int_of_num = function + Int i -> big_int_of_int i +| Big_int bi -> bi +| Ratio r -> big_int_of_ratio r + +(* Coercion with ratio type *) +let ratio_of_num = function + Int i -> ratio_of_int i +| Big_int bi -> ratio_of_big_int bi +| Ratio r -> r + +and num_of_ratio r = + normalize_ratio r; + if not (is_integer_ratio r) then Ratio r + else if is_int_big_int (numerator_ratio r) then + Int (int_of_big_int (numerator_ratio r)) + else Big_int (numerator_ratio r) + +let string_of_big_int_for_num bi = + if !approx_printing_flag + then approx_big_int !floating_precision bi + else string_of_big_int bi + +(* Coercion with string type *) + +(* XL: suppression de sys_string_of_num *) + +let string_of_normalized_num = function + Int i -> string_of_int i +| Big_int bi -> string_of_big_int_for_num bi +| Ratio r -> string_of_ratio r +let string_of_num n = + string_of_normalized_num (cautious_normalize_num_when_printing n) +let num_of_string s = + try + let flag = !normalize_ratio_flag in + normalize_ratio_flag := true; + let r = ratio_of_string s in + normalize_ratio_flag := flag; + if eq_big_int (denominator_ratio r) unit_big_int + then num_of_big_int (numerator_ratio r) + else Ratio r + with Failure _ -> + failwith "num_of_string" + +(* Coercion with float type *) +let float_of_num = function + Int i -> float i +| Big_int bi -> float_of_big_int bi +| Ratio r -> float_of_ratio r + +(* XL: suppression de num_of_float, float_num *) + +let succ_num = function + Int i -> if i = biggest_int + then Big_int (succ_big_int (big_int_of_int i)) + else Int (succ i) +| Big_int bi -> num_of_big_int (succ_big_int bi) +| Ratio r -> Ratio (add_int_ratio 1 r) + +and pred_num = function + Int i -> if i = monster_int + then Big_int (pred_big_int (big_int_of_int i)) + else Int (pred i) +| Big_int bi -> num_of_big_int (pred_big_int bi) +| Ratio r -> Ratio (add_int_ratio (-1) r) + +let abs_num = function + Int i -> if i = monster_int + then Big_int (minus_big_int (big_int_of_int i)) + else Int (abs i) + | Big_int bi -> Big_int (abs_big_int bi) + | Ratio r -> Ratio (abs_ratio r) + +let approx_num_fix n num = approx_ratio_fix n (ratio_of_num num) +and approx_num_exp n num = approx_ratio_exp n (ratio_of_num num) + +let incr_num r = r := succ_num !r +and decr_num r = r := pred_num !r + + + + + diff --git a/otherlibs/num/num.mli b/otherlibs/num/num.mli new file mode 100644 index 000000000..77a82d728 --- /dev/null +++ b/otherlibs/num/num.mli @@ -0,0 +1,120 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Num]: operation on arbitrary-precision numbers *) + +open Nat +open Big_int +open Ratio + +(* Numbers (type [num]) are arbitrary-precision rational numbers, + plus the special elements [1/0] (infinity) and [0/0] (undefined). *) + +type num = Int of int | Big_int of big_int | Ratio of ratio + (* The type of numbers. *) + +(* Arithmetic operations *) + +val (+/) : num -> num -> num +val add_num : num -> num -> num + (* Addition *) +val minus_num : num -> num + (* Unary negation. *) +val (-/) : num -> num -> num +val sub_num : num -> num -> num + (* Subtraction *) +val ( */ ) : num -> num -> num +val mult_num : num -> num -> num + (* Multiplication *) +val square_num : num -> num + (* Squaring *) +val (//) : num -> num -> num +val div_num : num -> num -> num + (* Division *) +val quo_num : num -> num -> num +val mod_num : num -> num -> num + (* Euclidean division: quotient and remainder *) +val ( **/ ) : num -> num -> num +val power_num : num -> num -> num + (* Exponentiation *) +val is_integer_num : num -> bool + (* Test if a number is an integer *) +val integer_num : num -> num +val floor_num : num -> num +val round_num : num -> num +val ceiling_num : num -> num + (* Approximate a number by an integer. + [floor_num n] returns the largest integer smaller or equal to [n]. + [ceiling_num n] returns the smallest integer bigger or equal to [n]. + [integer_num n] returns the integer closest to [n]. In case of ties, + rounds towards zero. + [round_num n] returns the integer closest to [n]. In case of ties, + rounds off zero. *) +val sign_num : num -> int + (* Return [-1], [0] or [1] according to the sign of the argument. *) +val (=/) : num -> num -> bool +val (</) : num -> num -> bool +val (>/) : num -> num -> bool +val (<=/) : num -> num -> bool +val (>=/) : num -> num -> bool +val (<>/) : num -> num -> bool +val eq_num : num -> num -> bool +val lt_num : num -> num -> bool +val le_num : num -> num -> bool +val gt_num : num -> num -> bool +val ge_num : num -> num -> bool + (* Usual comparisons between numbers *) +val compare_num : num -> num -> int + (* Return [-1], [0] or [1] if the first argument is less than, + equal to, or greater than the second argument. *) +val max_num : num -> num -> num +val min_num : num -> num -> num + (* Return the greater (resp. the smaller) of the two arguments. *) +val abs_num : num -> num + (* Absolute value. *) +val succ_num: num -> num + (* [succ n] is [n+1] *) +val pred_num: num -> num + (* [pred n] is [n-1] *) +val incr_num: num ref -> unit + (* [incr r] is [r:=!r+1], where [r] is a reference to a number. *) +val decr_num: num ref -> unit + (* [decr r] is [r:=!r-1], where [r] is a reference to a number. *) + +(* Coercions with strings *) + +val string_of_num : num -> string + (* Convert a number to a string, using fractional notation. *) +val approx_num_fix : int -> num -> string +val approx_num_exp : int -> num -> string + (* Approximate a number by a decimal. The first argument is the + required precision. The second argument is the number to + approximate. [approx_fix] uses decimal notation; the first + argument is the number of digits after the decimal point. + [approx_exp] uses scientific (exponential) notation; the + first argument is the number of digits in the mantissa. *) +val num_of_string : string -> num + (* Convert a string to a number. *) + +(* Coercions between numerical types *) + +val int_of_num : num -> int +val num_of_int : int -> num +val nat_of_num : num -> nat +val num_of_nat : nat -> num +val num_of_big_int : big_int -> num +val big_int_of_num : num -> big_int +val ratio_of_num : num -> ratio +val num_of_ratio : ratio -> num +val float_of_num : num -> float + diff --git a/otherlibs/num/ratio.ml b/otherlibs/num/ratio.ml new file mode 100644 index 000000000..d3168b239 --- /dev/null +++ b/otherlibs/num/ratio.ml @@ -0,0 +1,567 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +open Int_misc +open String_misc +open Nat +open Big_int +open Arith_flags + +(* Definition of the type ratio : + Conventions : + - the denominator is always a positive number + - the sign of n/0 is the sign of n +These convention is automatically respected when a ratio is created with +the create_ratio primitive +*) + +type ratio = { mutable numerator : big_int; + mutable denominator : big_int; + mutable normalized : bool} + +let failwith_zero name = + let s = "infinite or undefined rational number" in + failwith (if String.length name = 0 then s else name ^ " " ^ s) + +let numerator_ratio r = r.numerator +and denominator_ratio r = r.denominator + +let null_denominator r = sign_big_int r.denominator = 0 + +let verify_null_denominator r = + if sign_big_int r.denominator = 0 + then (if !error_when_null_denominator_flag + then (failwith_zero "") + else true) + else false + +let sign_ratio r = sign_big_int r.numerator + +(* Physical normalization of rational numbers *) +(* 1/0, 0/0 and -1/0 are the normalized forms for n/0 numbers *) +let normalize_ratio r = + if r.normalized then r + else if verify_null_denominator r then begin + r.numerator <- big_int_of_int (sign_big_int r.numerator); + r.normalized <- true; + r + end else begin + let p = gcd_big_int r.numerator r.denominator in + if eq_big_int p unit_big_int + then begin + r.normalized <- true; r + end else begin + r.numerator <- div_big_int (r.numerator) p; + r.denominator <- div_big_int (r.denominator) p; + r.normalized <- true; r + end + end + +let cautious_normalize_ratio r = + if (!normalize_ratio_flag) then (normalize_ratio r) else r + +let cautious_normalize_ratio_when_printing r = + if (!normalize_ratio_when_printing_flag) then (normalize_ratio r) else r + +let create_ratio bi1 bi2 = + match sign_big_int bi2 with + -1 -> cautious_normalize_ratio + { numerator = minus_big_int bi1; + denominator = minus_big_int bi2; + normalized = false } + | 0 -> if !error_when_null_denominator_flag + then (failwith_zero "create_ratio") + else cautious_normalize_ratio + { numerator = bi1; denominator = bi2; normalized = false } + | _ -> cautious_normalize_ratio + { numerator = bi1; denominator = bi2; normalized = false } + +let create_normalized_ratio bi1 bi2 = + match sign_big_int bi2 with + -1 -> { numerator = minus_big_int bi1; + denominator = minus_big_int bi2; + normalized = true } +| 0 -> if !error_when_null_denominator_flag + then failwith_zero "create_normalized_ratio" + else { numerator = bi1; denominator = bi2; normalized = true } +| _ -> { numerator = bi1; denominator = bi2; normalized = true } + +let is_normalized_ratio r = r.normalized + +let report_sign_ratio r bi = + if sign_ratio r = -1 + then minus_big_int bi + else bi + +let abs_ratio r = + { numerator = abs_big_int r.numerator; + denominator = r.denominator; + normalized = r.normalized } + +let is_integer_ratio r = + eq_big_int ((normalize_ratio r).denominator) unit_big_int + +(* Operations on rational numbers *) + +let add_ratio r1 r2 = + if !normalize_ratio_flag then begin + let p = gcd_big_int ((normalize_ratio r1).denominator) + ((normalize_ratio r2).denominator) in + if eq_big_int p unit_big_int then + {numerator = add_big_int (mult_big_int (r1.numerator) r2.denominator) + (mult_big_int (r2.numerator) r1.denominator); + denominator = mult_big_int (r1.denominator) r2.denominator; + normalized = true} + else begin + let d1 = div_big_int (r1.denominator) p + and d2 = div_big_int (r2.denominator) p in + let n = add_big_int (mult_big_int (r1.numerator) d2) + (mult_big_int d1 r2.numerator) in + let p' = gcd_big_int n p in + { numerator = div_big_int n p'; + denominator = mult_big_int d1 (div_big_int (r2.denominator) p'); + normalized = true } + end + end else + { numerator = add_big_int (mult_big_int (r1.numerator) r2.denominator) + (mult_big_int (r1.denominator) r2.numerator); + denominator = mult_big_int (r1.denominator) r2.denominator; + normalized = false } + +let minus_ratio r = + { numerator = minus_big_int (r.numerator); + denominator = r.denominator; + normalized = r.normalized } + +let add_int_ratio i r = + cautious_normalize_ratio r; + { numerator = add_big_int (mult_int_big_int i r.denominator) r.numerator; + denominator = r.denominator; + normalized = r.normalized } + +let add_big_int_ratio bi r = + cautious_normalize_ratio r; + { numerator = add_big_int (mult_big_int bi r.denominator) r.numerator ; + denominator = r.denominator; + normalized = r.normalized } + +let sub_ratio r1 r2 = add_ratio r1 (minus_ratio r2) + +let mult_ratio r1 r2 = + if !normalize_ratio_flag then begin + let p1 = gcd_big_int ((normalize_ratio r1).numerator) + ((normalize_ratio r2).denominator) + and p2 = gcd_big_int (r2.numerator) r1.denominator in + let (n1, d2) = + if eq_big_int p1 unit_big_int + then (r1.numerator, r2.denominator) + else (div_big_int (r1.numerator) p1, div_big_int (r2.denominator) p1) + and (n2, d1) = + if eq_big_int p2 unit_big_int + then (r2.numerator, r1.denominator) + else (div_big_int r2.numerator p2, div_big_int r1.denominator p2) in + { numerator = mult_big_int n1 n2; + denominator = mult_big_int d1 d2; + normalized = true } + end else + { numerator = mult_big_int (r1.numerator) r2.numerator; + denominator = mult_big_int (r1.denominator) r2.denominator; + normalized = false } + +let mult_int_ratio i r = + if !normalize_ratio_flag then + begin + let p = gcd_big_int ((normalize_ratio r).denominator) (big_int_of_int i) in + if eq_big_int p unit_big_int + then { numerator = mult_big_int (big_int_of_int i) r.numerator; + denominator = r.denominator; + normalized = true } + else { numerator = mult_big_int (div_big_int (big_int_of_int i) p) + r.numerator; + denominator = div_big_int (r.denominator) p; + normalized = true } + end + else + { numerator = mult_int_big_int i r.numerator; + denominator = r.denominator; + normalized = false } + +let mult_big_int_ratio bi r = + if !normalize_ratio_flag then + begin + let p = gcd_big_int ((normalize_ratio r).denominator) bi in + if eq_big_int p unit_big_int + then { numerator = mult_big_int bi r.numerator; + denominator = r.denominator; + normalized = true } + else { numerator = mult_big_int (div_big_int bi p) r.numerator; + denominator = div_big_int (r.denominator) p; + normalized = true } + end + else + { numerator = mult_big_int bi r.numerator; + denominator = r.denominator; + normalized = false } + +let square_ratio r = + cautious_normalize_ratio r; + { numerator = square_big_int r.numerator; + denominator = square_big_int r.denominator; + normalized = r.normalized } + +let inverse_ratio r = + if !error_when_null_denominator_flag & (sign_big_int r.numerator) = 0 + then failwith_zero "inverse_ratio" + else {numerator = report_sign_ratio r r.denominator; + denominator = abs_big_int r.numerator; + normalized = r.normalized} + +let div_ratio r1 r2 = + mult_ratio r1 (inverse_ratio r2) + +(* Integer part of a rational number *) +(* Odd function *) +let integer_ratio r = + if null_denominator r then failwith_zero "integer_ratio" + else if sign_ratio r = 0 then zero_big_int + else report_sign_ratio r (div_big_int (abs_big_int r.numerator) + (abs_big_int r.denominator)) + +(* Floor of a rational number *) +(* Always less or equal to r *) +let floor_ratio r = + verify_null_denominator r; + div_big_int (r.numerator) r.denominator + +(* Round of a rational number *) +(* Odd function, 1/2 -> 1 *) +let round_ratio r = + verify_null_denominator r; + let abs_num = abs_big_int r.numerator in + let bi = div_big_int abs_num r.denominator in + report_sign_ratio r + (if sign_big_int + (sub_big_int + (mult_int_big_int + 2 + (sub_big_int abs_num (mult_big_int (r.denominator) bi))) + r.denominator) = -1 + then bi + else succ_big_int bi) + +let ceiling_ratio r = + if (is_integer_ratio r) + then r.numerator + else succ_big_int (floor_ratio r) + + +(* Comparison operators on rational numbers *) +let eq_ratio r1 r2 = + normalize_ratio r1; + normalize_ratio r2; + eq_big_int (r1.numerator) r2.numerator & + eq_big_int (r1.denominator) r2.denominator + +let compare_ratio r1 r2 = + if verify_null_denominator r1 then + let sign_num_r1 = sign_big_int r1.numerator in + if (verify_null_denominator r2) + then + let sign_num_r2 = sign_big_int r2.numerator in + if sign_num_r1 = 1 & sign_num_r2 = -1 then 1 + else if sign_num_r1 = -1 & sign_num_r2 = 1 then -1 + else 0 + else sign_num_r1 + else if verify_null_denominator r2 then + -(sign_big_int r2.numerator) + else match compare_int (sign_big_int r1.numerator) + (sign_big_int r2.numerator) with + 1 -> 1 + | -1 -> -1 + | _ -> if eq_big_int (r1.denominator) r2.denominator + then compare_big_int (r1.numerator) r2.numerator + else compare_big_int + (mult_big_int (r1.numerator) r2.denominator) + (mult_big_int (r1.denominator) r2.numerator) + + +let lt_ratio r1 r2 = compare_ratio r1 r2 < 0 +and le_ratio r1 r2 = compare_ratio r1 r2 <= 0 +and gt_ratio r1 r2 = compare_ratio r1 r2 > 0 +and ge_ratio r1 r2 = compare_ratio r1 r2 >= 0 + +let max_ratio r1 r2 = if lt_ratio r1 r2 then r2 else r1 +and min_ratio r1 r2 = if gt_ratio r1 r2 then r2 else r1 + +let eq_big_int_ratio bi r = + (is_integer_ratio r) & eq_big_int bi r.numerator + +let compare_big_int_ratio bi r = + normalize_ratio r; + if (verify_null_denominator r) + then -(sign_big_int r.numerator) + else compare_big_int (mult_big_int bi r.denominator) r.numerator + +let lt_big_int_ratio bi r = compare_big_int_ratio bi r < 0 +and le_big_int_ratio bi r = compare_big_int_ratio bi r <= 0 +and gt_big_int_ratio bi r = compare_big_int_ratio bi r > 0 +and ge_big_int_ratio bi r = compare_big_int_ratio bi r >= 0 + +(* Coercions *) + +(* Coercions with type int *) +let int_of_ratio r = + if ((is_integer_ratio r) & (is_int_big_int r.numerator)) + then (int_of_big_int r.numerator) + else failwith "integer argument required" + +and ratio_of_int i = + { numerator = big_int_of_int i; + denominator = unit_big_int; + normalized = true } + +(* Coercions with type nat *) +let ratio_of_nat nat = + { numerator = big_int_of_nat nat; + denominator = unit_big_int; + normalized = true } + +and nat_of_ratio r = + normalize_ratio r; + if not (is_integer_ratio r) then + failwith "nat_of_ratio" + else if sign_big_int r.numerator > -1 then + nat_of_big_int (r.numerator) + else failwith "nat_of_ratio" + +(* Coercions with type big_int *) +let ratio_of_big_int bi = + { numerator = bi; denominator = unit_big_int; normalized = true } + +and big_int_of_ratio r = + normalize_ratio r; + if is_integer_ratio r + then r.numerator + else failwith "big_int_of_ratio" + +let div_int_ratio i r = + verify_null_denominator r; + mult_int_ratio i (inverse_ratio r) + +let div_ratio_int r i = + div_ratio r (ratio_of_int i) + +let div_big_int_ratio bi r = + verify_null_denominator r; + mult_big_int_ratio bi (inverse_ratio r) + +let div_ratio_big_int r bi = + div_ratio r (ratio_of_big_int bi) + +(* Functions on type string *) +(* giving floating point approximations of rational numbers *) + +let only_zeros s i l = + let res = ref true in + for j = i to i + l - 1 do + if s.[j] <> '0' then res := false + done; + !res + +(* Position of the leading digit of the decimal expansion *) +(* of a strictly positive rational number *) +(* if the decimal expansion of a non null rational r is equal to *) +(* sigma for k=-P to N of r_k*10^k then msd_ratio r = N *) +(* Nota : for a big_int we have msd_ratio = nums_digits_big_int -1 *) +let msd_ratio r = + cautious_normalize_ratio r; + if null_denominator r then failwith_zero "msd_ratio" + else if sign_big_int r.numerator = 0 then 0 + else begin + let str_num = string_of_big_int r.numerator + and str_den = string_of_big_int r.denominator in + let size_num = String.length str_num + and size_den = String.length str_den in + let rec msd_rec str_num nnum str_den nden i m = + if i > nnum then + if i > nden or only_zeros str_den i (nden - i) + then m else pred m + else if i > nden then m + else match compare_int (Char.code (String.get str_num i)) + (Char.code (String.get str_den i)) with + 0 -> msd_rec str_num nnum str_den nden (succ i) m + | 1 -> m + | _ -> pred m + in msd_rec str_num (pred size_num) str_den (pred size_den) + 0 (size_num - size_den) + end + +(* Decimal approximations of rational numbers *) + +(* Approximation with fix decimal point *) +(* This is an odd function and the last digit is round off *) +(* Format integer_part . decimal_part_with_n_digits *) +let approx_ratio_fix n r = + (* Don't need to normalize *) + if (null_denominator r) then failwith_zero "approx_ratio_fix" + else + let sign_r = sign_ratio r in + if sign_r = 0 + then "+0" (* r = 0 *) + else (* r.numerator and r.denominator are not null numbers + s contains one more digit than desired for the round off operation + and to have enough room in s when including the decimal point *) + if n >= 0 then + let s = + let nat = + (nat_of_big_int + (div_big_int + (base_power_big_int + 10 (succ n) (abs_big_int r.numerator)) + r.denominator)) + in (if sign_r = -1 then "-" else "+") ^ string_of_nat nat in + let l = String.length s in + if round_futur_last_digit s 1 (pred l) + then begin (* if one more char is needed in s *) + let str = (String.make (succ l) '0') in + String.set str 0 (if sign_r = -1 then '-' else '+'); + String.set str 1 '1'; + String.set str (l - n) '.'; + str + end else (* s can contain the final result *) + if l > n + 2 + then begin (* |r| >= 1, set decimal point *) + let l2 = (pred l) - n in + String.blit s l2 s (succ l2) n; + String.set s l2 '.'; s + end else begin (* |r| < 1, there must be 0-characters *) + (* before the significant development, *) + (* with care to the sign of the number *) + let size = n + 3 in + let m = size - l + 2 + and str = String.make size '0' in + + (String.blit (if sign_r = 1 then "+0." else "-0.") 0 str 0 3); + (String.blit s 1 str m (l - 2)); + str + end + else begin + let s = string_of_big_int + (div_big_int + (abs_big_int r.numerator) + (base_power_big_int + 10 (-n) r.denominator)) in + let len = succ (String.length s) in + let s' = String.make len '0' in + String.set s' 0 (if sign_r = -1 then '-' else '+'); + String.blit s 0 s' 1 (pred len); + s' + end + +(* Number of digits of the decimal representation of an int *) +let num_decimal_digits_int n = + String.length (string_of_int n) + +(* Approximation with floating decimal point *) +(* This is an odd function and the last digit is round off *) +(* Format (+/-)(0. n_first_digits e msd)/(1. n_zeros e (msd+1) *) +let approx_ratio_exp n r = + (* Don't need to normalize *) + if (null_denominator r) then failwith_zero "approx_ratio_exp" + else if n <= 0 then invalid_arg "approx_ratio_exp" + else + let sign_r = sign_ratio r + and i = ref (n + 3) in + if sign_r = 0 + then + let s = String.make (n + 5) '0' in + (String.blit "+0." 0 s 0 3); + (String.blit "e0" 0 s !i 2); s + else + let msd = msd_ratio (abs_ratio r) in + let k = n - msd in + let s = + (let nat = nat_of_big_int + (if k < 0 + then + div_big_int (abs_big_int r.numerator) + (base_power_big_int 10 (-k) + r.denominator) + else + div_big_int (base_power_big_int + 10 k (abs_big_int r.numerator)) + r.denominator) in + string_of_nat nat) in + if (round_futur_last_digit s 0 (String.length s)) + then + let m = num_decimal_digits_int (succ msd) in + let str = String.make (n + m + 4) '0' in + (String.blit (if sign_r = -1 then "-1." else "+1.") 0 str 0 3); + String.set str !i ('e'); + incr i; + (if m = 0 + then String.set str !i '0' + else String.blit (string_of_int (succ msd)) 0 str !i m); + str + else + let m = num_decimal_digits_int (succ msd) + and p = n + 3 in + let str = String.make (succ (m + p)) '0' in + (String.blit (if sign_r = -1 then "-0." else "+0.") 0 str 0 3); + (String.blit s 0 str 3 n); + String.set str p 'e'; + (if m = 0 + then String.set str (succ p) '0' + else (String.blit (string_of_int (succ msd)) 0 str (succ p) m)); + str + +(* String approximation of a rational with a fixed number of significant *) +(* digits printed *) +let float_of_rational_string r = + let s = approx_ratio_exp !floating_precision r in + if String.get s 0 = '+' + then (String.sub s 1 (pred (String.length s))) + else s + +(* Coercions with type string *) +let string_of_ratio r = + cautious_normalize_ratio_when_printing r; + if !approx_printing_flag + then float_of_rational_string r + else string_of_big_int r.numerator ^ "/" ^ string_of_big_int r.denominator + +(* XL: j'ai puissamment simplifie "ratio_of_string" en virant la notation + scientifique. *) + +let ratio_of_string s = + let n = index_char s '/' 0 in + if n = -1 then + { numerator = big_int_of_string s; + denominator = unit_big_int; + normalized = true } + else + create_ratio (sys_big_int_of_string s 0 n) + (sys_big_int_of_string s (n+1) (String.length s - n - 1)) + +(* Coercion with type float *) + +let float_of_ratio r = + float_of_string (float_of_rational_string r) + +(* XL: suppression de ratio_of_float *) + +let power_ratio_positive_int r n = + create_ratio (power_big_int_positive_int (r.numerator) n) + (power_big_int_positive_int (r.denominator) n) + +let power_ratio_positive_big_int r bi = + create_ratio (power_big_int_positive_big_int (r.numerator) bi) + (power_big_int_positive_big_int (r.denominator) bi) diff --git a/otherlibs/num/ratio.mli b/otherlibs/num/ratio.mli new file mode 100644 index 000000000..524b7b48a --- /dev/null +++ b/otherlibs/num/ratio.mli @@ -0,0 +1,86 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Ratio]: operations on rational numbers *) + +open Nat +open Big_int + +(* Rationals (type [ratio]) are arbitrary-precision rational numbers, + plus the special elements [1/0] (infinity) and [0/0] (undefined). + In constrast with numbers (type [num]), the special cases of + small integers and big integers are not optimized specially. *) + +type ratio + +val null_denominator : ratio -> bool +val numerator_ratio : ratio -> big_int +val denominator_ratio : ratio -> big_int +val sign_ratio : ratio -> int +val normalize_ratio : ratio -> ratio +val cautious_normalize_ratio : ratio -> ratio +val cautious_normalize_ratio_when_printing : ratio -> ratio +val create_ratio : big_int -> big_int -> ratio +val create_normalized_ratio : big_int -> big_int -> ratio +val is_normalized_ratio : ratio -> bool +val report_sign_ratio : ratio -> big_int -> big_int +val abs_ratio : ratio -> ratio +val is_integer_ratio : ratio -> bool +val add_ratio : ratio -> ratio -> ratio +val minus_ratio : ratio -> ratio +val add_int_ratio : int -> ratio -> ratio +val add_big_int_ratio : big_int -> ratio -> ratio +val sub_ratio : ratio -> ratio -> ratio +val mult_ratio : ratio -> ratio -> ratio +val mult_int_ratio : int -> ratio -> ratio +val mult_big_int_ratio : big_int -> ratio -> ratio +val square_ratio : ratio -> ratio +val inverse_ratio : ratio -> ratio +val div_ratio : ratio -> ratio -> ratio +val integer_ratio : ratio -> big_int +val floor_ratio : ratio -> big_int +val round_ratio : ratio -> big_int +val ceiling_ratio : ratio -> big_int +val eq_ratio : ratio -> ratio -> bool +val compare_ratio : ratio -> ratio -> int +val lt_ratio : ratio -> ratio -> bool +val le_ratio : ratio -> ratio -> bool +val gt_ratio : ratio -> ratio -> bool +val ge_ratio : ratio -> ratio -> bool +val max_ratio : ratio -> ratio -> ratio +val min_ratio : ratio -> ratio -> ratio +val eq_big_int_ratio : big_int -> ratio -> bool +val compare_big_int_ratio : big_int -> ratio -> int +val lt_big_int_ratio : big_int -> ratio -> bool +val le_big_int_ratio : big_int -> ratio -> bool +val gt_big_int_ratio : big_int -> ratio -> bool +val ge_big_int_ratio : big_int -> ratio -> bool +val int_of_ratio : ratio -> int +val ratio_of_int : int -> ratio +val ratio_of_nat : nat -> ratio +val nat_of_ratio : ratio -> nat +val ratio_of_big_int : big_int -> ratio +val big_int_of_ratio : ratio -> big_int +val div_int_ratio : int -> ratio -> ratio +val div_ratio_int : ratio -> int -> ratio +val div_big_int_ratio : big_int -> ratio -> ratio +val div_ratio_big_int : ratio -> big_int -> ratio +val approx_ratio_fix : int -> ratio -> string +val approx_ratio_exp : int -> ratio -> string +val float_of_rational_string : ratio -> string +val string_of_ratio : ratio -> string +val ratio_of_string : string -> ratio +val float_of_ratio : ratio -> float +val power_ratio_positive_int : ratio -> int -> ratio +val power_ratio_positive_big_int : ratio -> big_int -> ratio + diff --git a/otherlibs/num/string_misc.ml b/otherlibs/num/string_misc.ml new file mode 100644 index 000000000..ba86407d8 --- /dev/null +++ b/otherlibs/num/string_misc.ml @@ -0,0 +1,18 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +let rec index_char str chr pos = + if pos >= String.length str then -1 + else if String.get str pos = chr then pos + else index_char str chr (pos + 1) +;; diff --git a/otherlibs/num/string_misc.mli b/otherlibs/num/string_misc.mli new file mode 100644 index 000000000..cffd4729e --- /dev/null +++ b/otherlibs/num/string_misc.mli @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +val index_char: string -> char -> int -> int diff --git a/otherlibs/num/test/Makefile b/otherlibs/num/test/Makefile new file mode 100644 index 000000000..b6723b5cd --- /dev/null +++ b/otherlibs/num/test/Makefile @@ -0,0 +1,36 @@ +CAMLC=../../../boot/cslrun ../../../cslc -I ../../../stdlib +CAMLOPT=../../../boot/cslrun ../../../cslopt -I ../../../stdlib + +test: test.byt test.opt + ./test.byt + ./test.opt + +TESTFILES=test.cmo \ + test_nats.cmo test_big_ints.cmo test_ratios.cmo test_nums.cmo end_test.cmo + +TESTOPTFILES=$(TESTFILES:.cmo=.cmx) + +test.byt: $(TESTFILES) ../nums.cma ../libnums.a + $(CAMLC) -o test.byt -custom ../nums.cma $(TESTFILES) ../libnums.a + +test.opt: $(TESTOPTFILES) ../nums.cmxa ../libnums.a + $(CAMLOPT) -o test.opt ../nums.cmxa $(TESTOPTFILES) ../libnums.a + +.SUFFIXES: .ml .cmo .cmx + +.ml.cmo: + $(CAMLC) -I .. -c $< + +.ml.cmx: + $(CAMLOPT) -I .. -c $< + +csltopnum: + cslmktop -o csltopnum -custom ../nums.cma ../libnums.a + +clean: + rm -f test.byt test.opt *.o *.cm? csltopnum + +depend: + csldep *.ml > .depend + +include .depend diff --git a/otherlibs/num/test/end_test.ml b/otherlibs/num/test/end_test.ml new file mode 100644 index 000000000..40aceb959 --- /dev/null +++ b/otherlibs/num/test/end_test.ml @@ -0,0 +1,8 @@ +open Test + +let _ = + print_newline(); + if !error_occurred then begin + prerr_endline "************* TEST FAILED ****************"; exit 2 + end else + exit 0 diff --git a/otherlibs/num/test/test.ml b/otherlibs/num/test/test.ml new file mode 100644 index 000000000..8ad93204a --- /dev/null +++ b/otherlibs/num/test/test.ml @@ -0,0 +1,60 @@ +open Printf + +let error_occurred = ref false + +let function_tested = ref "" + +let testing_function s = + function_tested := s; + print_newline(); + print_string s; + print_newline() + +let test test_number eq_fun (answer, correct_answer) = + flush stdout; + flush stderr; + if not (eq_fun answer correct_answer) then begin + fprintf stderr ">>> Bad result (%s, test %d)\n" !function_tested test_number; + error_occurred := true; + false + end else begin + printf " %d..." test_number; + true + end + +let failure_test test_number fun_to_test arg = + flush stdout; + flush stderr; + try + fun_to_test arg; + fprintf stderr ">>> Failure expected (%s, test %d)\n" + !function_tested test_number; + error_occurred := true; + false + with _ -> + printf " %d..." test_number; + true + +let failwith_test test_number fun_to_test arg correct_failure = + try + fun_to_test arg; + fprintf stderr ">>> Failure expected (%s, test %d)\n" + !function_tested test_number; + error_occurred := true; + false + with x -> + if x = correct_failure then begin + printf " %d..." test_number; + true + end else begin + fprintf stderr ">>> Bad failure (%s, test %d)\n" + !function_tested test_number; + error_occurred := true; + false + end + +let eq = (==) +let eq_int = (==) +let eq_string = (=) + +let sixtyfour = (1 lsl 32) <> 0 diff --git a/otherlibs/num/test/test_big_ints.ml b/otherlibs/num/test/test_big_ints.ml new file mode 100644 index 000000000..b7553044d --- /dev/null +++ b/otherlibs/num/test/test_big_ints.ml @@ -0,0 +1,365 @@ +open Test;; +open Nat;; +open Big_int;; +open Int_misc;; + +testing_function "compare_big_int";; + +test 1 +eq_int (compare_big_int zero_big_int zero_big_int, 0);; +test 2 +eq_int (compare_big_int zero_big_int (big_int_of_int 1), (-1));; +test 3 +eq_int (compare_big_int zero_big_int (big_int_of_int (-1)), 1);; +test 4 +eq_int (compare_big_int (big_int_of_int 1) zero_big_int, 1);; +test 5 +eq_int (compare_big_int (big_int_of_int (-1)) zero_big_int, (-1));; +test 6 +eq_int (compare_big_int (big_int_of_int 1) (big_int_of_int 1), 0);; +test 7 +eq_int (compare_big_int (big_int_of_int (-1)) (big_int_of_int (-1)), 0);; +test 8 +eq_int (compare_big_int (big_int_of_int 1) (big_int_of_int (-1)), 1);; +test 9 +eq_int (compare_big_int (big_int_of_int (-1)) (big_int_of_int 1), (-1));; +test 10 +eq_int (compare_big_int (big_int_of_int 1) (big_int_of_int 2), (-1));; +test 11 +eq_int (compare_big_int (big_int_of_int 2) (big_int_of_int 1), 1);; +test 12 +eq_int (compare_big_int (big_int_of_int (-1)) (big_int_of_int (-2)), 1);; +test 13 +eq_int (compare_big_int (big_int_of_int (-2)) (big_int_of_int (-1)), (-1));; + + +testing_function "pred_big_int";; + +test 1 +eq_big_int (pred_big_int zero_big_int, big_int_of_int (-1));; +test 2 +eq_big_int (pred_big_int unit_big_int, zero_big_int);; +test 3 +eq_big_int (pred_big_int (big_int_of_int (-1)), big_int_of_int (-2));; + +testing_function "succ_big_int";; + +test 1 +eq_big_int (succ_big_int zero_big_int, unit_big_int);; +test 2 +eq_big_int (succ_big_int unit_big_int, big_int_of_int 2);; +test 3 +eq_big_int (succ_big_int (big_int_of_int (-1)), zero_big_int);; + +testing_function "add_big_int";; + +test 1 +eq_big_int (add_big_int zero_big_int zero_big_int, zero_big_int);; +test 2 +eq_big_int (add_big_int zero_big_int (big_int_of_int 1), + big_int_of_int 1);; +test 3 +eq_big_int (add_big_int (big_int_of_int 1) zero_big_int, + big_int_of_int 1);; +test 4 +eq_big_int (add_big_int zero_big_int (big_int_of_int (-1)), + big_int_of_int (-1));; +test 5 +eq_big_int (add_big_int (big_int_of_int (-1)) zero_big_int, + big_int_of_int (-1));; +test 6 +eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 1), + big_int_of_int 2);; +test 7 +eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 2), + big_int_of_int 3);; +test 8 +eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int 1), + big_int_of_int 3);; +test 9 +eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-1)), + big_int_of_int (-2));; +test 10 +eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-2)), + big_int_of_int (-3));; +test 11 +eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int (-1)), + big_int_of_int (-3));; +test 12 +eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-1)), + zero_big_int);; +test 13 +eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 1), + zero_big_int);; +test 14 +eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-2)), + big_int_of_int (-1));; +test 15 +eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int 1), + big_int_of_int (-1));; +test 16 +eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 2), + big_int_of_int 1);; +test 17 +eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int (-1)), + big_int_of_int 1);; + + +testing_function "sub_big_int";; + +test 1 +eq_big_int (sub_big_int zero_big_int zero_big_int, zero_big_int);; +test 2 +eq_big_int (sub_big_int zero_big_int (big_int_of_int 1), + big_int_of_int (-1));; +test 3 +eq_big_int (sub_big_int (big_int_of_int 1) zero_big_int, + big_int_of_int 1);; +test 4 +eq_big_int (sub_big_int zero_big_int (big_int_of_int (-1)), + big_int_of_int 1);; +test 5 +eq_big_int (sub_big_int (big_int_of_int (-1)) zero_big_int, + big_int_of_int (-1));; +test 6 +eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 1), + zero_big_int);; +test 7 +eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 2), + big_int_of_int (-1));; +test 8 +eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int 1), + big_int_of_int 1);; +test 9 +eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-1)), + zero_big_int);; +test 10 +eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-2)), + big_int_of_int 1);; +test 11 +eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int (-1)), + big_int_of_int (-1));; +test 12 +eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-1)), + big_int_of_int 2);; +test 13 +eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 1), + big_int_of_int (-2));; +test 14 +eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-2)), + big_int_of_int 3);; +test 15 +eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int 1), + big_int_of_int (-3));; +test 16 +eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 2), + big_int_of_int (-3));; +test 17 +eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int (-1)), + big_int_of_int 3);; + +testing_function "mult_int_big_int";; + +test 1 +eq_big_int (mult_int_big_int 0 (big_int_of_int 3), zero_big_int);; +test 2 +eq_big_int (mult_int_big_int 1 (big_int_of_int 3), big_int_of_int 3);; +test 3 +eq_big_int (mult_int_big_int 1 zero_big_int, zero_big_int);; +test 4 +eq_big_int (mult_int_big_int 2 (big_int_of_int 3), big_int_of_int 6);; + +testing_function "mult_big_int";; + +test 1 +eq_big_int (mult_big_int zero_big_int zero_big_int, + zero_big_int);; +test 2 +eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int 3), + big_int_of_int 6);; +test 3 +eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int (-3)), + big_int_of_int (-6));; +test 4 +eq_big_int (mult_big_int (big_int_of_string "12724951") + (big_int_of_string "81749606400"), + big_int_of_string "1040259735709286400");; +test 5 +eq_big_int (mult_big_int (big_int_of_string "26542080") + (big_int_of_string "81749606400"), + big_int_of_string "2169804593037312000");; + +testing_function "quomod_big_int";; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int 1) (big_int_of_int 1) in + test 1 eq_big_int (quotient, big_int_of_int 1) & + test 2 eq_big_int (modulo, zero_big_int);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int 1) (big_int_of_int (-1)) in + test 3 eq_big_int (quotient, big_int_of_int (-1)) & + test 4 eq_big_int (modulo, zero_big_int);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int (-1)) (big_int_of_int 1) in + test 5 eq_big_int (quotient, big_int_of_int (-1)) & + test 6 eq_big_int (modulo, zero_big_int);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int 3) (big_int_of_int 2) in + test 7 eq_big_int (quotient, big_int_of_int 1) & + test 8 eq_big_int (modulo, big_int_of_int 1);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int 5) (big_int_of_int 3) in + test 9 eq_big_int (quotient, big_int_of_int 1) & + test 10 eq_big_int (modulo, big_int_of_int 2);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int (-5)) (big_int_of_int 3) in + test 11 eq_big_int (quotient, big_int_of_int (-2)) & + test 12 eq_big_int (modulo, big_int_of_int 1);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int 1) (big_int_of_int 2) in + test 13 eq_big_int (quotient, zero_big_int) & + test 14 eq_big_int (modulo, big_int_of_int 1);; + +let (quotient, modulo) = + quomod_big_int (big_int_of_int (-1)) (big_int_of_int 3) in + test 15 eq_big_int (quotient, minus_big_int unit_big_int) & + test 16 eq_big_int (modulo, big_int_of_int 2);; + +failwith_test 17 +(quomod_big_int (big_int_of_int 1)) zero_big_int +Division_by_zero +;; + +testing_function "gcd_big_int";; + +test 1 +eq_big_int (gcd_big_int zero_big_int zero_big_int, + zero_big_int);; +test 2 +eq_big_int (gcd_big_int zero_big_int (big_int_of_int 1), + big_int_of_int 1);; +test 3 +eq_big_int (gcd_big_int (big_int_of_int 1) zero_big_int, + big_int_of_int 1);; +test 4 +eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 2), + big_int_of_int 1);; +test 5 +eq_big_int (gcd_big_int (big_int_of_int 2) (big_int_of_int 1), + big_int_of_int 1);; +test 6 +eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 1), + big_int_of_int 1);; +test 7 +eq_big_int (gcd_big_int (big_int_of_int 9) (big_int_of_int 16), + big_int_of_int 1);; +test 8 +eq_big_int (gcd_big_int (big_int_of_int 12) (big_int_of_int 16), + big_int_of_int 4);; + +for i = 9 to 28 do + let n1 = Random.int 1000000000 + and n2 = Random.int 100000 in + test i eq + (int_of_big_int (gcd_big_int (big_int_of_int n1) (big_int_of_int n2)), + gcd_int n1 n2) +done;; + +testing_function "int_of_big_int";; + +test 1 +eq_int (int_of_big_int (big_int_of_int 1), 1);; +test 2 +eq (is_int_big_int (big_int_of_int 1), true);; +test 3 +eq (is_int_big_int (succ_big_int (big_int_of_int biggest_int)),false);; + +testing_function "sys_string_of_big_int";; + +test 1 +eq_string (string_of_big_int (big_int_of_int 1), "1");; + + +testing_function "big_int_of_string";; + +test 1 +eq_big_int (big_int_of_string "1", big_int_of_int 1);; +test 2 +eq_big_int (big_int_of_string "-1", big_int_of_int (-1));; +test 4 +eq_big_int (big_int_of_string "0", zero_big_int);; + +failwith_test 5 big_int_of_string "sdjdkfighdgf" + (Failure "invalid digit");; + +test 6 +eq_big_int (big_int_of_string "123", big_int_of_int 123);; +test 7 +eq_big_int (big_int_of_string "3456", big_int_of_int 3456);; + +test 9 +eq_big_int (big_int_of_string "-3456", big_int_of_int (-3456));; + + +let implode = List.fold_left (^) "";; (* Au diable l'efficacite *) + +let l = List.rev [ +"174679877494298468451661416292903906557638850173895426081611831060970135303"; +"044177587617233125776581034213405720474892937404345377707655788096850784519"; +"539374048533324740018513057210881137248587265169064879918339714405948322501"; +"445922724181830422326068913963858377101914542266807281471620827145038901025"; +"322784396182858865537924078131032036927586614781817695777639491934361211399"; +"888524140253852859555118862284235219972858420374290985423899099648066366558"; +"238523612660414395240146528009203942793935957539186742012316630755300111472"; +"852707974927265572257203394961525316215198438466177260614187266288417996647"; +"132974072337956513457924431633191471716899014677585762010115338540738783163"; +"739223806648361958204720897858193606022290696766988489073354139289154127309"; +"916985231051926209439373780384293513938376175026016587144157313996556653811"; +"793187841050456120649717382553450099049321059330947779485538381272648295449"; +"847188233356805715432460040567660999184007627415398722991790542115164516290"; +"619821378529926683447345857832940144982437162642295073360087284113248737998"; +"046564369129742074737760485635495880623324782103052289938185453627547195245"; +"688272436219215066430533447287305048225780425168823659431607654712261368560"; +"702129351210471250717394128044019490336608558608922841794819375031757643448"; +"32" +] in + +let bi1=big_int_of_string (implode (List.rev l)) in + +let bi2=big_int_of_string (implode (List.rev ("3" :: List.tl l))) in + +test 10 +eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "10")) + (big_int_of_string "2")));; + +testing_function "power_base_int";; + +test 1 +eq_big_int (big_int_of_nat (power_base_int 10 0), unit_big_int) +;; +test 2 +eq_big_int (big_int_of_nat (power_base_int 10 8), big_int_of_int 100000000) +;; +test 3 +eq_big_int (big_int_of_nat (power_base_int 2 (if sixtyfour then 64 else 32)), + big_int_of_nat (let nat = make_nat 2 in + set_digit_nat nat 1 1; + nat)) +;; + +testing_function "base_power_big_int";; + +test 1 +eq_big_int (base_power_big_int 10 0 (big_int_of_int 2), big_int_of_int 2);; +test 2 +eq_big_int (base_power_big_int 10 2 (big_int_of_int 2), big_int_of_int 200);; +test 3 +eq_big_int (base_power_big_int 10 1 (big_int_of_int 123), big_int_of_int 1230) +;; + diff --git a/otherlibs/num/test/test_nats.ml b/otherlibs/num/test/test_nats.ml new file mode 100644 index 000000000..ca4562fee --- /dev/null +++ b/otherlibs/num/test/test_nats.ml @@ -0,0 +1,127 @@ +open Test;; +open Nat;; + +(* Can compare nats less than 2**32 *) +let equal_nat n1 n2 = + eq_nat n1 0 (num_digits_nat n1 0 1) + n2 0 (num_digits_nat n2 0 1);; + +testing_function "num_digits_nat";; + +test (-1) eq (false,not true);; +test 0 eq (true,not false);; + +test 1 +eq_int +(let r = make_nat 2 in + set_digit_nat r 1 1; + num_digits_nat r 0 1,1);; + +testing_function "length_nat";; + +test 1 +eq_int +(let r = make_nat 2 in + set_digit_nat r 0 1; + length_nat r,2);; + +testing_function "equal_nat";; + +let zero_nat = make_nat 1 in + +test 1 +equal_nat (zero_nat,zero_nat);; +test 2 +equal_nat (nat_of_int 1,nat_of_int 1);; + +test 3 +equal_nat (nat_of_string "2",nat_of_string "2");; +test 4 +eq (equal_nat (nat_of_string "2")(nat_of_string "3"),false);; + +testing_function "incr_nat";; + +let zero = nat_of_int 0 in +let res = incr_nat zero 0 1 1 in + test 1 + equal_nat (zero, nat_of_int 1) & + test 2 + eq (res,0);; + +let n = nat_of_int 1 in +let res = incr_nat n 0 1 1 in + test 3 + equal_nat (n, nat_of_int 2) & + test 4 + eq (res,0);; + + +testing_function "decr_nat";; + +let n = nat_of_int 1 in +let res = decr_nat n 0 1 0 in + test 1 + equal_nat (n, nat_of_int 0) & + test 2 + eq (res,1);; + +let n = nat_of_int 2 in +let res = decr_nat n 0 1 0 in + test 3 + equal_nat (n, nat_of_int 1) & + test 4 + eq (res,1);; + +testing_function "is_zero_nat";; + +let n = nat_of_int 1 in +test 1 eq (is_zero_nat n 0 1,false) & +test 2 eq (is_zero_nat (make_nat 1) 0 1, true) & +test 3 eq (is_zero_nat (make_nat 2) 0 2, true) & +(let r = make_nat 2 in + set_digit_nat r 1 1; + test 4 eq (is_zero_nat r 0 1, true)) +;; + +testing_function "string_of_nat";; + +let n = make_nat 4;; + +test 1 eq_string (string_of_nat n, "0");; + +complement_nat n 0 (if sixtyfour then 2 else 4);; + +test 2 eq_string (string_of_nat n, "340282366920938463463374607431768211455");; + +testing_function "string_of_nat & nat_of_string";; + +for i = 1 to 20 do + let s = String.make i '0' in + String.set s 0 '1'; + test i eq_string (string_of_nat (nat_of_string s), s) +done;; + +let s = "3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333" in +test 21 equal_nat ( +nat_of_string s, +(let nat = make_nat 15 in + set_digit_nat nat 0 3; + mult_digit_nat nat 0 15 + (nat_of_string (String.sub s 0 135)) 0 14 + (nat_of_int 10) 0; + nat)) +;; + +test 22 eq_string (string_of_nat(nat_of_string "1073741824"), "1073741824");; + +testing_function "gcd_nat";; + +for i = 1 to 20 do + let n1 = Random.int 1000000000 + and n2 = Random.int 100000 in + let nat1 = nat_of_int n1 + and nat2 = nat_of_int n2 in + gcd_nat nat1 0 1 nat2 0 1; + test i eq (int_of_nat nat1, Int_misc.gcd_int n1 n2) +done +;; diff --git a/otherlibs/num/test/test_nums.ml b/otherlibs/num/test/test_nums.ml new file mode 100644 index 000000000..424285808 --- /dev/null +++ b/otherlibs/num/test/test_nums.ml @@ -0,0 +1,220 @@ +open Test;; +open Nat;; +open Big_int;; +open Ratio;; +open Int_misc;; +open Num;; +open Arith_status;; + +testing_function "add_num";; + +test 1 +eq_num (add_num (Int 1) (Int 3), Int 4);; +test 2 +eq_num (add_num (Int 1) (Big_int (big_int_of_int 3)), Int 4);; +test 3 +eq_num (add_num (Int 1) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "7/4"));; +test 4 +eq_num (add_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "7/4"));; +test 5 +eq_num (add_num (Big_int (big_int_of_int 1)) (Big_int (big_int_of_int 3)), + Int 4);; +test 6 +eq_num (add_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "7/4"));; +test 7 +eq_num (add_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "17/12"));; +test 8 +eq_num (add_num (Int least_int) (Int 1), + Int (- (pred biggest_int)));; +test 9 +eq_num (add_num (Int biggest_int) (Int 1), + Big_int (minus_big_int (pred_big_int (big_int_of_int least_int))));; + +testing_function "sub_num";; + +test 1 +eq_num (sub_num (Int 1) (Int 3), Int (-2));; +test 2 +eq_num (sub_num (Int 1) (Big_int (big_int_of_int 3)), Int (-2));; +test 3 +eq_num (sub_num (Int 1) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "1/4"));; +test 4 +eq_num (sub_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "1/4"));; +test 5 +eq_num (sub_num (Big_int (big_int_of_int 1)) (Big_int (big_int_of_int 3)), + Int (-2));; +test 7 +eq_num (sub_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "1/4"));; +test 8 +eq_num (sub_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "-1/12"));; +test 9 +eq_num (sub_num (Int least_int) (Int (-1)), + Int (- (pred biggest_int)));; +test 10 +eq_num (sub_num (Int (-1)) (Int biggest_int), pred_num (Int least_int));; + +testing_function "mult_num";; + +test 1 +eq_num (mult_num (Int 2) (Int 3), Int 6);; +test 2 +eq_num (mult_num (Int 127) (Int (int_of_string "257")), + Int (int_of_string "32639"));; +test 3 +eq_num (mult_num (Int 257) (Int (int_of_string "260")), + Big_int (big_int_of_string "66820"));; +test 4 +eq_num (mult_num (Int 2) (Big_int (big_int_of_int 3)), Int 6);; +test 5 +eq_num (mult_num (Int 10) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "15/2"));; +test 6 +eq_num (mult_num (Big_int (big_int_of_int 10)) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "15/2"));; +test 7 +eq_num (mult_num (Big_int (big_int_of_int 2)) (Big_int (big_int_of_int 3)), + Int 6);; +test 8 +eq_num (mult_num (Big_int (big_int_of_int 10)) (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "15/2"));; +test 9 +eq_num (mult_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")) + , Ratio (ratio_of_string "1/2"));; + +testing_function "div_num";; + +test 1 +eq_num (div_num (Int 6) (Int 3), Int 2);; +test 2 +eq_num (div_num (Int (int_of_string "32639")) + (Int (int_of_string "257")), Int 127);; +test 3 +eq_num (div_num (Big_int (big_int_of_string "66820")) + (Int (int_of_string "257")), + Int 260);; +test 4 +eq_num (div_num (Int 6) (Big_int (big_int_of_int 3)), Int 2);; +test 5 +eq_num (div_num (Ratio (ratio_of_string "15/2")) + (Int 10), + Ratio (ratio_of_string "3/4"));; +test 6 +eq_num (div_num (Big_int (big_int_of_int 6)) (Big_int (big_int_of_int 3)), + Int 2);; +test 7 +eq_num (div_num (Ratio (ratio_of_string "15/2")) + (Big_int (big_int_of_int 10)), + Ratio (ratio_of_string "3/4"));; +test 8 +eq_num (div_num (Ratio (ratio_of_string "15/2")) + (Ratio (ratio_of_string "3/4")), + Big_int (big_int_of_int 10));; +test 9 +eq_num (div_num (Ratio (ratio_of_string "1/2")) + (Ratio (ratio_of_string "3/4")), + Ratio (ratio_of_string "2/3"));; + +testing_function "is_integer_num";; + +test 1 +eq (is_integer_num (Int 3),true);; +test 2 +eq (is_integer_num (Big_int (big_int_of_string "1234567890")),true);; +test 3 +eq (not (is_integer_num (Ratio (ratio_of_string "1/2"))),true);; +test 4 +eq (is_integer_num (Ratio (ratio_of_string "1073774590/32770")),true);; + +testing_function "num_of_ratio";; + +test 1 +eq_num (num_of_ratio (ratio_of_string "4/2"), Int 2);; +test 2 +eq_num (num_of_ratio (ratio_of_string "11811160075/11"), + Big_int (big_int_of_string "1073741825"));; +test 3 +eq_num (num_of_ratio (ratio_of_string "123456789012/1234"), + Ratio (ratio_of_string "61728394506/617"));; + +testing_function "num_of_string";; + +test 1 +eq_num (num_of_string "123/3456", Ratio (ratio_of_string "123/3456"));; +(********* +test 2 +eq_num (num_of_string "12.3/34.56", Ratio (ratio_of_string "1230/3456"));; +test 3 +eq_num (num_of_string "1.23/325.6", Ratio (ratio_of_string "123/32560"));; +test 4 +eq_num (num_of_string "12.3/345.6", Ratio (ratio_of_string "123/3456"));; +set_error_when_null_denominator false;; +test 5 +eq_num (num_of_string "12.3/0.0", Ratio (ratio_of_string "123/0"));; +test 6 +eq_num (num_of_string "0/0", Ratio (ratio_of_string "0/0"));; +set_error_when_null_denominator true;; +*********) +test 7 +eq_num (num_of_string "1234567890", + Big_int (big_int_of_string "1234567890"));; +test 8 +eq_num (num_of_string "12345", Int (int_of_string "12345"));; +(********* +test 9 +eq_num (num_of_string "0.23", Ratio (ratio_of_string "23/100"));; +test 10 +eq_num (num_of_string "0.23", Ratio (ratio_of_string "0.23/1"));; +********) + +failwith_test 11 +num_of_string ("frlshjkurty") (Failure "num_of_string");; + +(******* + +testing_function "immediate numbers";; + +standard arith false;; + +let x = (1/2) in +test 0 eq_string (string_of_num x, "1/2");; + +let y = 12345678901 in +test 1 eq_string (string_of_num y, "12345678901");; +testing_function "immediate numbers";; + +let x = (1/2) in +test 0 eq_string (string_of_num x, "1/2");; + +let y = 12345678901 in +test 1 eq_string (string_of_num y, "12345678901");; + +testing_function "pattern_matching on nums";; + +let f1 = function 0 -> true | _ -> false;; + +test 1 eq (f1 0, true);; + +test 2 eq (f1 1, false);; + +test 3 eq (f1 (0/1), true);; + +test 4 eq (f1 (let n = num_of_string "2000000000000000000000000" in n-n) , + true);; + +test 5 eq (f1 (let n = num_of_string "2000000000000000000000000" in n/n-1) , + true);; + +test 6 eq (f1 (let n = num_of_string "2000000000000000000000000" in n+1) , + false);; + +test 7 eq (f1 (1/2), false);; + +**************) diff --git a/otherlibs/num/test/test_ratios.ml b/otherlibs/num/test/test_ratios.ml new file mode 100644 index 000000000..692713c67 --- /dev/null +++ b/otherlibs/num/test/test_ratios.ml @@ -0,0 +1,928 @@ +open Test;; +open Nat;; +open Big_int;; +open Ratio;; +open Int_misc;; +open Arith_status;; + +set_error_when_null_denominator false;; + +let infinite_failure = "infinite or undefined rational number";; + +testing_function "create_ratio";; + +let r = create_ratio (big_int_of_int 1) (big_int_of_int (-2)) in +test 1 eq_big_int (numerator_ratio r, big_int_of_int (-1)) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 2);; + +let r = create_ratio (big_int_of_int 2) (big_int_of_int 3) in +test 3 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 4 eq_big_int (denominator_ratio r, big_int_of_int 3);; + +set_normalize_ratio true;; + +let r = create_ratio (big_int_of_int 12) (big_int_of_int (-16)) in +test 5 eq_big_int (numerator_ratio r, big_int_of_int (-3)) & +test 6 eq_big_int (denominator_ratio r, big_int_of_int 4);; + +set_normalize_ratio false;; + +let r = create_ratio (big_int_of_int 0) (big_int_of_int 0) in +test 7 eq_big_int (numerator_ratio r, big_int_of_int 0) & +test 8 eq_big_int (denominator_ratio r, big_int_of_int 0);; + +testing_function "create_normalized_ratio";; + +let r = create_normalized_ratio (big_int_of_int 1) (big_int_of_int (-2)) in +test 1 eq_big_int (numerator_ratio r, big_int_of_int (-1)) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 2);; + +let r = create_normalized_ratio (big_int_of_int 2) (big_int_of_int 3) in +test 3 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 4 eq_big_int (denominator_ratio r, big_int_of_int 3);; + +set_normalize_ratio true;; + +let r = create_normalized_ratio (big_int_of_int 12) (big_int_of_int (-16)) in +test 5 eq_big_int (numerator_ratio r, big_int_of_int (-12)) & +test 6 eq_big_int (denominator_ratio r, big_int_of_int 16);; + +set_normalize_ratio false;; + +let r = create_normalized_ratio (big_int_of_int 1) (big_int_of_int 0) in +test 7 eq_big_int (numerator_ratio r, big_int_of_int 1) & +test 8 eq_big_int (denominator_ratio r, big_int_of_int 0);; + +let r = create_normalized_ratio (big_int_of_int 0) (big_int_of_int 0) in +test 9 eq_big_int (numerator_ratio r, big_int_of_int 0) & +test 10 eq_big_int (denominator_ratio r, big_int_of_int 0);; + +testing_function "null_denominator";; + +test 1 + eq (null_denominator (create_ratio (big_int_of_int 1) (big_int_of_int (-2))), + false);; +test 2 eq + (null_denominator (create_ratio (big_int_of_int 1) zero_big_int),true);; + +(***** +testing_function "verify_null_denominator";; + +test 1 + eq (verify_null_denominator (ratio_of_string "0/1"), false);; +test 2 + eq (verify_null_denominator (ratio_of_string "0/0"), true);; +*****) + +testing_function "sign_ratio";; + +test 1 +eq_int (sign_ratio (create_ratio (big_int_of_int (-2)) (big_int_of_int (-3))), + 1);; +test 2 +eq_int (sign_ratio (create_ratio (big_int_of_int 2) (big_int_of_int (-3))), + (-1));; +test 3 +eq_int (sign_ratio (create_ratio zero_big_int (big_int_of_int (-3))), 0);; + +testing_function "normalize_ratio";; + +let r = create_ratio (big_int_of_int 12) (big_int_of_int (-16)) in +normalize_ratio r; +test 1 eq_big_int (numerator_ratio r, big_int_of_int (-3)) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 4);; + +let r = create_ratio (big_int_of_int (-1)) zero_big_int in +normalize_ratio r; +test 3 eq_big_int (numerator_ratio r, big_int_of_int (-1)) & +test 4 eq_big_int (denominator_ratio r, zero_big_int);; + +testing_function "report_sign_ratio";; + +test 1 +eq_big_int (report_sign_ratio + (create_ratio (big_int_of_int 2) (big_int_of_int (-3))) + (big_int_of_int 1), + big_int_of_int (-1));; +test 2 +eq_big_int (report_sign_ratio + (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (big_int_of_int 1), + big_int_of_int 1);; + +testing_function "is_integer_ratio";; + +test 1 eq + (is_integer_ratio (create_ratio (big_int_of_int 2) (big_int_of_int (-1))), + true);; +test 2 eq + (is_integer_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)), + false);; + +testing_function "add_ratio";; + +let r = add_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 2)) + (create_ratio (big_int_of_int 2) (big_int_of_int 3)) in +test 1 eq_big_int (numerator_ratio r, big_int_of_int 7) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 6);; + +let r = add_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in +test 3 eq_big_int (numerator_ratio r, big_int_of_int 1) & +test 4 eq_big_int (denominator_ratio r, big_int_of_int 6);; + +let r = add_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in +test 5 eq_big_int (numerator_ratio r, big_int_of_int 4) & +test 6 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = add_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 7 eq_big_int (numerator_ratio r, big_int_of_int 3) & +test 8 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = add_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 9 eq_big_int (numerator_ratio r, zero_big_int) & +test 10 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = add_ratio (create_ratio (big_int_of_string "12724951") + (big_int_of_string "26542080")) + (create_ratio (big_int_of_string "-1") + (big_int_of_string "81749606400")) in +test 11 eq_big_int (numerator_ratio r, + big_int_of_string "1040259735682744320") & +test 12 eq_big_int (denominator_ratio r, + big_int_of_string "2169804593037312000");; + +let r1,r2 = + (create_ratio (big_int_of_string "12724951") + (big_int_of_string "26542080"), + create_ratio (big_int_of_string "-1") + (big_int_of_string "81749606400")) in + +let bi1 = mult_big_int (numerator_ratio r1) (denominator_ratio r2) +and bi2 = mult_big_int (numerator_ratio r2) (denominator_ratio r1) +in +test 1 +eq_big_int (bi1, + big_int_of_string "1040259735709286400") +& +test 2 +eq_big_int (bi2, + big_int_of_string "-26542080") +& test 3 +eq_big_int (mult_big_int (denominator_ratio r1) (denominator_ratio r2), + big_int_of_string "2169804593037312000") +& test 4 +eq_big_int (add_big_int bi1 bi2, + big_int_of_string "1040259735682744320") +;; + +testing_function "sub_ratio";; + +let r = sub_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) (big_int_of_int 2)) in +test 1 eq_big_int (numerator_ratio r, big_int_of_int 1) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 6);; + +let r = sub_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in +test 3 eq_big_int (numerator_ratio r, big_int_of_int 4) & +test 4 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = sub_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 5 eq_big_int (numerator_ratio r, big_int_of_int (-3)) & +test 6 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = sub_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 7 eq_big_int (numerator_ratio r, zero_big_int) & +test 8 eq_big_int (denominator_ratio r, zero_big_int);; + +testing_function "mult_ratio";; + +let r = mult_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 7) (big_int_of_int 5)) in +test 1 eq_big_int (numerator_ratio r, big_int_of_int 14) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 15);; + +let r = mult_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in +test 3 eq_big_int (numerator_ratio r, big_int_of_int (-2)) & +test 4 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = mult_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 5 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 6 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = mult_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 7 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 8 eq_big_int (denominator_ratio r, zero_big_int);; + +testing_function "div_ratio";; + +let r = div_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 5) (big_int_of_int 7)) in +test 1 eq_big_int (numerator_ratio r, big_int_of_int 14) & +test 2 eq_big_int (denominator_ratio r, big_int_of_int 15);; + +let r = div_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in +test 3 eq_big_int (numerator_ratio r, big_int_of_int (-4)) & +test 4 eq_big_int (denominator_ratio r, zero_big_int);; + +let r = div_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 5 eq_big_int (numerator_ratio r, zero_big_int) & +test 6 eq_big_int (denominator_ratio r, big_int_of_int 3);; + +let r = div_ratio (create_ratio (big_int_of_int 2) zero_big_int) + (create_ratio (big_int_of_int 1) zero_big_int) in +test 7 eq_big_int (numerator_ratio r, zero_big_int) & +test 8 eq_big_int (denominator_ratio r, zero_big_int);; + +testing_function "integer_ratio";; + +test 1 +eq_big_int (integer_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + big_int_of_int 1);; +test 2 +eq_big_int (integer_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int (-3))), + big_int_of_int (-1));; +test 3 +eq_big_int (integer_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int 2)), + big_int_of_int 1);; +test 4 +eq_big_int (integer_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int (-2))), + big_int_of_int (-1));; + +failwith_test 5 +integer_ratio (create_ratio (big_int_of_int 3) zero_big_int) +(Failure("integer_ratio "^infinite_failure));; + +testing_function "floor_ratio";; + +test 1 +eq_big_int (floor_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + big_int_of_int 1);; +test 2 +eq_big_int (floor_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int (-3))), + big_int_of_int (-2));; +test 3 +eq_big_int (floor_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int 2)), + big_int_of_int 1);; +test 4 +eq_big_int (floor_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int (-2))), + big_int_of_int (-2));; + +failwith_test 5 floor_ratio (create_ratio (big_int_of_int 3) zero_big_int) +Division_by_zero;; + + +testing_function "round_ratio";; + +test 1 +eq_big_int (round_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + big_int_of_int 2);; +test 2 +eq_big_int (round_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int (-3))), + big_int_of_int (-2));; +test 3 +eq_big_int (round_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int 2)), + big_int_of_int 2);; +test 4 +eq_big_int (round_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int (-2))), + big_int_of_int (-2));; + +failwith_test 5 +round_ratio (create_ratio (big_int_of_int 3) zero_big_int) +Division_by_zero;; + + +testing_function "ceiling_ratio";; + +test 1 +eq_big_int (ceiling_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + big_int_of_int 2);; +test 2 +eq_big_int (ceiling_ratio + (create_ratio (big_int_of_int 5) (big_int_of_int (-3))), + big_int_of_int (-1));; +test 3 +eq_big_int (ceiling_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int 2)), + big_int_of_int 2);; +test 4 +eq_big_int (ceiling_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int (-2))), + big_int_of_int (-1));; +test 5 +eq_big_int (ceiling_ratio + (create_ratio (big_int_of_int 4) (big_int_of_int 2)), + big_int_of_int 2);; +failwith_test 6 +ceiling_ratio (create_ratio (big_int_of_int 3) zero_big_int) +Division_by_zero;; + +testing_function "eq_ratio";; + +test 1 +eq_ratio (create_ratio (big_int_of_int 5) (big_int_of_int 3), + create_ratio (big_int_of_int (-20)) (big_int_of_int (-12)));; +test 2 +eq_ratio (create_ratio (big_int_of_int 1) zero_big_int, + create_ratio (big_int_of_int 2) zero_big_int);; + +let neq_ratio x y = not (eq_ratio x y);; + +test 3 +neq_ratio (create_ratio (big_int_of_int 1) zero_big_int, + create_ratio (big_int_of_int (-1)) zero_big_int);; +test 4 +neq_ratio (create_ratio (big_int_of_int 1) zero_big_int, + create_ratio zero_big_int zero_big_int);; +test 5 +eq_ratio (create_ratio zero_big_int zero_big_int, + create_ratio zero_big_int zero_big_int);; + +testing_function "compare_ratio";; + +test 1 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), + 0);; +test 2 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) + (create_ratio (big_int_of_int 1) (big_int_of_int 0)), + 0);; +test 3 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)), + 0);; +test 4 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), + 0);; +test 5 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), + 0);; +test 6 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + 0);; +test 7 +eq_int (compare_ratio (create_ratio (big_int_of_int 5) (big_int_of_int 3)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), + 0);; +test 8 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)), + 0);; +test 9 +eq_int (compare_ratio (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), + 0);; +test 10 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) + (create_ratio (big_int_of_int 0) (big_int_of_int 1)), + 0);; +test 11 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 1)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), + 0);; +test 12 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int 1) (big_int_of_int 0)), + 0);; +test 13 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int 2) (big_int_of_int 0)), + 0);; +test 14 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)), + 1);; +test 15 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int 1) (big_int_of_int 0)), + (-1));; +test 16 +eq_int (compare_ratio (create_ratio (big_int_of_int 5) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) (big_int_of_int 0)), + (-1));; +test 17 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + 1);; +test 18 +eq_int (compare_ratio (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)) + (create_ratio (big_int_of_int 1) (big_int_of_int 0)), + (-1));; +test 19 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)), + 1);; +test 20 +eq_int (compare_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) + (create_ratio (big_int_of_int 0) (big_int_of_int 3)), + 1);; +test 21 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)), + 0);; +test 22 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-2)) (big_int_of_int 0)), + 0);; +test 23 +eq_int (compare_ratio (create_ratio (big_int_of_int 5) (big_int_of_int 3)) + (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)), + 1);; +test 24 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + (-1));; +test 25 +eq_int (compare_ratio (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)) + (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)), + 1);; +test 26 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)), + (-1));; +test 27 +eq_int (compare_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) + (create_ratio (big_int_of_int 0) (big_int_of_int 3)), + (-1));; +test 28 +eq_int (compare_ratio (create_ratio (big_int_of_int 5) (big_int_of_int 3)) + (create_ratio (big_int_of_int 3) (big_int_of_int 2)), + 1);; +test 29 +eq_int (compare_ratio (create_ratio (big_int_of_int 3) (big_int_of_int 2)) + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + (-1));; +test 30 +eq_int (compare_ratio (create_ratio (big_int_of_int 5) (big_int_of_int 3)) + (create_ratio (big_int_of_int (-3)) (big_int_of_int 2)), + 1);; +test 31 +eq_int (compare_ratio (create_ratio (big_int_of_int (-3)) (big_int_of_int 2)) + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + (-1));; +test 32 +eq_int (compare_ratio (create_ratio (big_int_of_int 3) (big_int_of_int 2)) + (create_ratio (big_int_of_int 0) (big_int_of_int 3)), + 1);; +test 33 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 2)) + (create_ratio (big_int_of_int 5) (big_int_of_int 3)), + (-1));; +test 34 +eq_int (compare_ratio (create_ratio (big_int_of_int (-3)) (big_int_of_int 2)) + (create_ratio (big_int_of_int 0) (big_int_of_int 3)), + (-1));; +test 35 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 2)) + (create_ratio (big_int_of_int (-5)) (big_int_of_int 3)), + 1);; +test 36 +eq_int (compare_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 2)) + (create_ratio (big_int_of_int 0) (big_int_of_int 3)), + 0);; + +testing_function "eq_big_int_ratio";; + +test 1 +eq_big_int_ratio (big_int_of_int 3, + (create_ratio (big_int_of_int 3) (big_int_of_int 1)));; +test 2 +eq +(not (eq_big_int_ratio (big_int_of_int 1) + (create_ratio (big_int_of_int 3) (big_int_of_int 1))), +true);; + +test 3 +eq +(not (eq_big_int_ratio (big_int_of_int 1) + (create_ratio (big_int_of_int 3) (big_int_of_int 2))), + true);; + +test 4 +eq +(not (eq_big_int_ratio (big_int_of_int 1) + (create_ratio (big_int_of_int 3) (big_int_of_int 0))), + true);; + +test 5 +eq +(not (eq_big_int_ratio (big_int_of_int 1) + (create_ratio (big_int_of_int (-3)) (big_int_of_int 2))), + true);; + +testing_function "compare_big_int_ratio";; + +test 1 +eq_int (compare_big_int_ratio + (big_int_of_int 1) + (create_ratio (big_int_of_int 3) (big_int_of_int 0)), (-1));; +test 2 +eq_int (compare_big_int_ratio + (big_int_of_int 1) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), 0);; +test 3 +eq_int (compare_big_int_ratio + (big_int_of_int 1) + (create_ratio (big_int_of_int (-3)) (big_int_of_int 0)), 1);; +test 4 +eq_int (compare_big_int_ratio + (big_int_of_int (-1)) + (create_ratio (big_int_of_int 3) (big_int_of_int 0)), (-1));; +test 5 +eq_int (compare_big_int_ratio + (big_int_of_int (-1)) + (create_ratio (big_int_of_int 0) (big_int_of_int 0)), 0);; +test 6 +eq_int (compare_big_int_ratio + (big_int_of_int (-1)) + (create_ratio (big_int_of_int (-3)) (big_int_of_int 0)), 1);; +test 7 +eq_int (compare_big_int_ratio + (big_int_of_int 1) + (create_ratio (big_int_of_int 1) (big_int_of_int 1)), 0);; +test 8 +eq_int (compare_big_int_ratio + (big_int_of_int 1) + (create_ratio (big_int_of_int 3) (big_int_of_int 2)), (-1));; +test 9 +eq_int (compare_big_int_ratio + (big_int_of_int 1) + (create_ratio (big_int_of_int 2) (big_int_of_int 3)), 1);; + + + +testing_function "int_of_ratio";; + +test 1 +eq_int (int_of_ratio (create_ratio (big_int_of_int 4) (big_int_of_int 2)), + 2);; + +test 2 +eq_int (int_of_ratio + (create_ratio (big_int_of_int biggest_int) (big_int_of_int 1)), + biggest_int);; + +failwith_test 3 +int_of_ratio (create_ratio (big_int_of_int 4) (big_int_of_int 0)) +(Failure "integer argument required");; + +failwith_test 4 +int_of_ratio (create_ratio (succ_big_int (big_int_of_int biggest_int)) + (big_int_of_int 1)) +(Failure "integer argument required");; + +failwith_test 5 +int_of_ratio (create_ratio (big_int_of_int 4) (big_int_of_int 3)) +(Failure "integer argument required");; + +testing_function "ratio_of_int";; + +test 1 +eq_ratio (ratio_of_int 3, + create_ratio (big_int_of_int 3) (big_int_of_int 1));; + +test 2 +eq_ratio (ratio_of_nat (nat_of_int 2), + create_ratio (big_int_of_int 2) (big_int_of_int 1));; + +testing_function "nat_of_ratio";; + +let nat1 = nat_of_ratio (create_ratio (big_int_of_int 3) (big_int_of_int 1)) +and nat2 = nat_of_int 3 in +test 1 +eq (eq_nat nat1 0 (length_nat nat1) nat2 0 (length_nat nat2), true) +;; + +failwith_test 2 +nat_of_ratio (create_ratio (big_int_of_int 3) (big_int_of_int 0)) +(Failure "nat_of_ratio");; + +failwith_test 3 +nat_of_ratio (create_ratio (big_int_of_int (-3)) (big_int_of_int 1)) +(Failure "nat_of_ratio");; + +failwith_test 4 +nat_of_ratio (create_ratio (big_int_of_int 3) (big_int_of_int 2)) +(Failure "nat_of_ratio");; + +testing_function "ratio_of_big_int";; + +test 1 +eq_ratio (ratio_of_big_int (big_int_of_int 3), + create_ratio (big_int_of_int 3) (big_int_of_int 1));; + +testing_function "big_int_of_ratio";; + +test 1 +eq_big_int (big_int_of_ratio + (create_ratio (big_int_of_int 3) (big_int_of_int 1)), + big_int_of_int 3);; +test 2 +eq_big_int (big_int_of_ratio + (create_ratio (big_int_of_int (-3)) (big_int_of_int 1)), + big_int_of_int (-3));; + +failwith_test 3 +big_int_of_ratio (create_ratio (big_int_of_int 3) (big_int_of_int 0)) +(Failure "big_int_of_ratio");; + +testing_function "string_of_ratio";; + +test 1 +eq_string (string_of_ratio + (create_ratio (big_int_of_int 43) (big_int_of_int 35)), + "43/35");; +test 2 +eq_string (string_of_ratio + (create_ratio (big_int_of_int 42) (big_int_of_int 0)), + "1/0");; + +set_normalize_ratio_when_printing false;; + +test 3 +eq_string (string_of_ratio + (create_ratio (big_int_of_int 42) (big_int_of_int 35)), + "42/35");; + +set_normalize_ratio_when_printing true;; + +test 4 +eq_string (string_of_ratio + (create_ratio (big_int_of_int 42) (big_int_of_int 35)), + "6/5");; + +testing_function "ratio_of_string";; + +test 1 +eq_ratio (ratio_of_string ("123/3456"), + create_ratio (big_int_of_int 123) (big_int_of_int 3456));; + +(*********** +test 2 +eq_ratio (ratio_of_string ("12.3/34.56"), + create_ratio (big_int_of_int 1230) (big_int_of_int 3456));; +test 3 +eq_ratio (ratio_of_string ("1.23/325.6"), + create_ratio (big_int_of_int 123) (big_int_of_int 32560));; +test 4 +eq_ratio (ratio_of_string ("12.3/345.6"), + create_ratio (big_int_of_int 123) (big_int_of_int 3456));; +test 5 +eq_ratio (ratio_of_string ("12.3/0.0"), + create_ratio (big_int_of_int 123) (big_int_of_int 0));; +***********) +test 6 +eq_ratio (ratio_of_string ("0/0"), + create_ratio (big_int_of_int 0) (big_int_of_int 0));; + +test 7 +eq_ratio (ratio_of_string "1234567890", + create_ratio (big_int_of_string "1234567890") unit_big_int);; +failwith_test 8 +ratio_of_string "frlshjkurty" (Failure "invalid digit");; + +(*********** +testing_function "msd_ratio";; + +test 1 +eq_int (msd_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 1)), + 0);; +test 2 +eq_int (msd_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 12)), + (-2));; +test 3 +eq_int (msd_ratio (create_ratio (big_int_of_int 12) (big_int_of_int 1)), + 1);; +test 4 +eq_int (msd_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 2)), + (-1));; +test 5 +eq_int (msd_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 1)), + 0);; +test 6 +eq_int (msd_ratio (create_ratio (big_int_of_int 25) (big_int_of_int 21)), + 0);; +test 7 +eq_int (msd_ratio (create_ratio (big_int_of_int 35) (big_int_of_int 21)), + 0);; +test 8 +eq_int (msd_ratio (create_ratio (big_int_of_int 215) (big_int_of_int 31)), + 0);; +test 9 +eq_int (msd_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 30)), + (-2));; +test 10 +eq_int (msd_ratio (create_ratio (big_int_of_int 2345) + (big_int_of_int 23456)), + (-2));; +test 11 +eq_int (msd_ratio (create_ratio (big_int_of_int 2345) + (big_int_of_int 2346)), + (-1));; +test 12 +eq_int (msd_ratio (create_ratio (big_int_of_int 2345) + (big_int_of_int 2344)), + 0);; +test 13 +eq_int (msd_ratio (create_ratio (big_int_of_int 23456) + (big_int_of_int 2345)), + 1);; +test 14 +eq_int (msd_ratio (create_ratio (big_int_of_int 23467) + (big_int_of_int 2345)), + 1);; +failwith_test 15 +msd_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 0)) +("msd_ratio "^infinite_failure);; +failwith_test 16 +msd_ratio (create_ratio (big_int_of_int (-1)) (big_int_of_int 0)) +("msd_ratio "^infinite_failure);; +failwith_test 17 +msd_ratio (create_ratio (big_int_of_int 0) (big_int_of_int 0)) +("msd_ratio "^infinite_failure);; +*************************) + +testing_function "round_futur_last_digit";; + +let s = "+123456" in +test 1 eq (round_futur_last_digit s 1 (pred (String.length s)), + false) & +test 2 eq_string (s, "+123466");; + +let s = "123456" in +test 3 eq (round_futur_last_digit s 0 (String.length s), false) & +test 4 eq_string (s, "123466");; + +let s = "-123456" in +test 5 eq (round_futur_last_digit s 1 (pred (String.length s)), + false) & +test 6 eq_string (s, "-123466");; + +let s = "+123496" in +test 7 eq (round_futur_last_digit s 1 (pred (String.length s)), + false) & +test 8 eq_string (s, "+123506");; + +let s = "123496" in +test 9 eq (round_futur_last_digit s 0 (String.length s), false) & +test 10 eq_string (s, "123506");; + +let s = "-123496" in +test 11 eq (round_futur_last_digit s 1 (pred (String.length s)), + false) & +test 12 eq_string (s, "-123506");; + +let s = "+996" in +test 13 eq (round_futur_last_digit s 1 (pred (String.length s)), + true) & +test 14 eq_string (s, "+006");; + +let s = "996" in +test 15 eq (round_futur_last_digit s 0 (String.length s), true) & +test 16 eq_string (s, "006");; + +let s = "-996" in +test 17 eq (round_futur_last_digit s 1 (pred (String.length s)), + true) & +test 18 eq_string (s, "-006");; + +let s = "+6666666" in +test 19 eq (round_futur_last_digit s 1 (pred (String.length s)), + false) & +test 20 eq_string (s, "+6666676") ;; + +let s = "6666666" in +test 21 eq (round_futur_last_digit s 0 (String.length s), false) & +test 22 eq_string (s, "6666676") ;; + +let s = "-6666666" in +test 23 eq (round_futur_last_digit s 1 (pred (String.length s)), + false) & +test 24 eq_string (s, "-6666676") ;; + +testing_function "approx_ratio_fix";; + +let s = approx_ratio_fix 5 + (create_ratio (big_int_of_int 2) + (big_int_of_int 3)) in +test 1 +eq_string (s, "+0.66667");; + +test 2 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_int 20) + (big_int_of_int 3)), + "+6.66667");; +test 3 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_int 2) + (big_int_of_int 30)), + "+0.06667");; +test 4 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_string "999996") + (big_int_of_string "1000000")), + "+1.00000");; +test 5 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_string "299996") + (big_int_of_string "100000")), + "+2.99996");; +test 6 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_string "2999996") + (big_int_of_string "1000000")), + "+3.00000");; +test 7 +eq_string (approx_ratio_fix 4 + (create_ratio (big_int_of_string "299996") + (big_int_of_string "100000")), + "+3.0000");; +test 8 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_int 29996) + (big_int_of_string "100000")), + "+0.29996");; +test 9 +eq_string (approx_ratio_fix 5 + (create_ratio (big_int_of_int 0) + (big_int_of_int 1)), + "+0");; +failwith_test 10 +(approx_ratio_fix 5) (create_ratio (big_int_of_int 1) (big_int_of_int 0)) +(Failure "approx_ratio_fix infinite or undefined rational number");; +failwith_test 11 +(approx_ratio_fix 5) (create_ratio (big_int_of_int 0) (big_int_of_int 0)) +(Failure "approx_ratio_fix infinite or undefined rational number");; + +testing_function "approx_ratio_exp";; + +test 1 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_int 2) + (big_int_of_int 3)), + "+0.66667e0");; +test 2 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_int 20) + (big_int_of_int 3)), + "+0.66667e1");; +test 3 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_int 2) + (big_int_of_int 30)), + "+0.66667e-1");; +test 4 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_string "999996") + (big_int_of_string "1000000")), + "+1.00000e0");; +test 5 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_string "299996") + (big_int_of_string "100000")), + "+0.30000e1");; +test 6 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_int 29996) + (big_int_of_string "100000")), + "+0.29996e0");; +test 7 +eq_string (approx_ratio_exp 5 + (create_ratio (big_int_of_int 0) + (big_int_of_int 1)), + "+0.00000e0");; +failwith_test 8 +(approx_ratio_exp 5) (create_ratio (big_int_of_int 1) (big_int_of_int 0)) +(Failure "approx_ratio_exp infinite or undefined rational number");; +failwith_test 9 +(approx_ratio_exp 5) (create_ratio (big_int_of_int 0) (big_int_of_int 0)) +(Failure "approx_ratio_exp infinite or undefined rational number");; |