From: Sven Luther Date: Tue, 18 Nov 2003 19:10:46 +0000 (+0000) Subject: Imported Upstream version 3.07.2a X-Git-Tag: archive/raspbian/4.08.1-4+rpi1~3^2~63^2~47 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=0fa70661362e255f8720ce97ececa612f816dd9a;p=ocaml.git Imported Upstream version 3.07.2a --- diff --git a/configure b/configure index d3981084..624689a2 100755 --- a/configure +++ b/configure @@ -754,7 +754,7 @@ fi # Configuration for the libraries -otherlibraries="unix str num dynlink bigarray" +otherlibraries="unix str dynlink bigarray" # For the Unix library diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index f50234b8..6c182faf 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -60,7 +60,6 @@ INCLUDES_NODEP= -I $(OCAMLSRCDIR)/stdlib \ -I $(OCAMLSRCDIR)/otherlibs/str \ -I $(OCAMLSRCDIR)/otherlibs/dynlink \ -I $(OCAMLSRCDIR)/otherlibs/unix \ - -I $(OCAMLSRCDIR)/otherlibs/num \ -I $(OCAMLSRCDIR)/otherlibs/graph INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP) @@ -180,7 +179,6 @@ STDLIB_MLIS=../stdlib/*.mli \ ../otherlibs/unix/unix.mli \ ../otherlibs/str/str.mli \ ../otherlibs/bigarray/bigarray.mli \ - ../otherlibs/num/num.mli all: exe lib manpages exe: $(OCAMLDOC) @@ -206,11 +204,11 @@ manpages: stdlib_man/Pervasives.o odoc_crc.ml: $(CMIFILES) $(EXTRAC_CRC) $(INCLUDES) \ - Arg Arith_status Array Big_int Buffer Callback Char Digest Dynlink \ + Arg Array Buffer Callback Char Digest Dynlink \ Filename Format Gc Genlex Hashtbl \ - Lazy Lexing List Map Marshal Nat Nativeint \ - Num Obj CamlinternalOO Outcometree Parsing Pervasives Printexc \ - Printf Profiling Queue Random Ratio \ + Lazy Lexing List Map Marshal Nativeint \ + Obj CamlinternalOO Outcometree Parsing Pervasives Printexc \ + Printf Profiling Queue Random \ Set Sort Stack Std_exit Str Stream \ String Sys Topdirs Toploop Unix Weak \ Printast Ident Tbl Misc Config Clflags Warnings Ccomp \ diff --git a/otherlibs/num/.cvsignore b/otherlibs/num/.cvsignore deleted file mode 100644 index 7786c62f..00000000 --- a/otherlibs/num/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -libnums.x -*.c.x -so_locations diff --git a/otherlibs/num/.depend b/otherlibs/num/.depend deleted file mode 100644 index edc2107e..00000000 --- a/otherlibs/num/.depend +++ /dev/null @@ -1,28 +0,0 @@ -nat_stubs.o: nat_stubs.c ../../byterun/alloc.h ../../byterun/misc.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/mlvalues.h ../../byterun/custom.h ../../byterun/intext.h \ - ../../byterun/io.h ../../byterun/fix_code.h ../../byterun/fail.h \ - ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ - ../../byterun/freelist.h ../../byterun/minor_gc.h nat.h \ - bignum/h/BigNum.h bignum/h/BntoBnn.h -big_int.cmi: nat.cmi -num.cmi: big_int.cmi nat.cmi ratio.cmi -ratio.cmi: big_int.cmi nat.cmi -arith_flags.cmo: arith_flags.cmi -arith_flags.cmx: arith_flags.cmi -arith_status.cmo: arith_flags.cmi arith_status.cmi -arith_status.cmx: arith_flags.cmx arith_status.cmi -big_int.cmo: int_misc.cmi nat.cmi big_int.cmi -big_int.cmx: int_misc.cmx nat.cmx big_int.cmi -int_misc.cmo: int_misc.cmi -int_misc.cmx: int_misc.cmi -nat.cmo: int_misc.cmi nat.cmi -nat.cmx: int_misc.cmx nat.cmi -num.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi ratio.cmi num.cmi -num.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx ratio.cmx num.cmi -ratio.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi string_misc.cmi \ - ratio.cmi -ratio.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx string_misc.cmx \ - ratio.cmi -string_misc.cmo: string_misc.cmi -string_misc.cmx: string_misc.cmi diff --git a/otherlibs/num/.depend.nt b/otherlibs/num/.depend.nt deleted file mode 100644 index 0d604eab..00000000 --- a/otherlibs/num/.depend.nt +++ /dev/null @@ -1,56 +0,0 @@ -nat_stubs.dobj: nat_stubs.c ../../byterun/alloc.h ../../byterun/misc.h \ - ../../byterun/config.h ../../byterun/../config/m.h \ - ../../byterun/../config/s.h ../../byterun/mlvalues.h \ - ../../byterun/custom.h ../../byterun/intext.h ../../byterun/io.h \ - ../../byterun/fix_code.h ../../byterun/fail.h ../../byterun/memory.h \ - ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ - ../../byterun/minor_gc.h nat.h bignum/h/BigNum.h bignum/h/BntoBnn.h -big_int.cmi: nat.cmi -num.cmi: big_int.cmi nat.cmi ratio.cmi -ratio.cmi: big_int.cmi nat.cmi -arith_flags.cmo: arith_flags.cmi -arith_flags.cmx: arith_flags.cmi -arith_status.cmo: arith_flags.cmi arith_status.cmi -arith_status.cmx: arith_flags.cmx arith_status.cmi -big_int.cmo: int_misc.cmi nat.cmi big_int.cmi -big_int.cmx: int_misc.cmx nat.cmx big_int.cmi -int_misc.cmo: int_misc.cmi -int_misc.cmx: int_misc.cmi -nat.cmo: int_misc.cmi nat.cmi -nat.cmx: int_misc.cmx nat.cmi -num.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi ratio.cmi num.cmi -num.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx ratio.cmx num.cmi -ratio.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi string_misc.cmi \ - ratio.cmi -ratio.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx string_misc.cmx \ - ratio.cmi -string_misc.cmo: string_misc.cmi -string_misc.cmx: string_misc.cmi -nat_stubs.sobj: nat_stubs.c ../../byterun/alloc.h ../../byterun/misc.h \ - ../../byterun/config.h ../../byterun/../config/m.h \ - ../../byterun/../config/s.h ../../byterun/mlvalues.h \ - ../../byterun/custom.h ../../byterun/intext.h ../../byterun/io.h \ - ../../byterun/fix_code.h ../../byterun/fail.h ../../byterun/memory.h \ - ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ - ../../byterun/minor_gc.h nat.h bignum/h/BigNum.h bignum/h/BntoBnn.h -big_int.cmi: nat.cmi -num.cmi: big_int.cmi nat.cmi ratio.cmi -ratio.cmi: big_int.cmi nat.cmi -arith_flags.cmo: arith_flags.cmi -arith_flags.cmx: arith_flags.cmi -arith_status.cmo: arith_flags.cmi arith_status.cmi -arith_status.cmx: arith_flags.cmx arith_status.cmi -big_int.cmo: int_misc.cmi nat.cmi big_int.cmi -big_int.cmx: int_misc.cmx nat.cmx big_int.cmi -int_misc.cmo: int_misc.cmi -int_misc.cmx: int_misc.cmi -nat.cmo: int_misc.cmi nat.cmi -nat.cmx: int_misc.cmx nat.cmi -num.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi ratio.cmi num.cmi -num.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx ratio.cmx num.cmi -ratio.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi string_misc.cmi \ - ratio.cmi -ratio.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx string_misc.cmx \ - ratio.cmi -string_misc.cmo: string_misc.cmi -string_misc.cmx: string_misc.cmi diff --git a/otherlibs/num/Makefile b/otherlibs/num/Makefile deleted file mode 100644 index a7ae36b1..00000000 --- a/otherlibs/num/Makefile +++ /dev/null @@ -1,90 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Xavier Leroy, projet Cristal, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../LICENSE. # -# # -######################################################################### - -# $Id: Makefile,v 1.29 2002/06/27 11:36:01 xleroy Exp $ - -# Makefile for the "num" (exact rational arithmetic) library - -include ../../config/Makefile - -# Compilation options -CC=$(BYTECC) -CFLAGS=-O -I./bignum/h -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -CAMLC=../../ocamlcomp.sh -w s -CAMLOPT=../../ocamlcompopt.sh -w s -MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib -COMPFLAGS=-warn-error A - -CAMLOBJS=int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo \ - ratio.cmo num.cmo arith_status.cmo - -CMIFILES=big_int.cmi nat.cmi num.cmi ratio.cmi arith_status.cmi - -COBJS=nat_stubs.o -BIGNUM_OBJS=bignum/o/KerN.o bignum/o/bnInit.o bignum/o/bnMult.o \ - bignum/o/bnDivide.o bignum/o/bnCmp.o bignum/o/bzf.o bignum/o/bz.o - -all: libnums.a nums.cma $(CMIFILES) - -allopt: libnums.a nums.cmxa $(CMIFILES) - -nums.cma: $(CAMLOBJS) - $(MKLIB) -ocamlc '$(CAMLC)' -o nums $(CAMLOBJS) - -nums.cmxa: $(CAMLOBJS:.cmo=.cmx) - $(MKLIB) -ocamlopt '$(CAMLOPT)' -o nums $(CAMLOBJS:.cmo=.cmx) - -libnums.a: $(BIGNUM_OBJS) $(COBJS) - $(MKLIB) -o nums $(BIGNUM_OBJS) $(COBJS) - -$(BIGNUM_OBJS): - cd bignum; $(MAKE) $(BIGNUM_ARCH) CC="$(CC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)" - -$(CAMLOBJS:.cmo=.cmx): ../../ocamlopt - -install: - if test -f dllnums.so; then cp dllnums.so $(STUBLIBDIR)/dllnums.so; fi - cp libnums.a $(LIBDIR)/libnums.a - cd $(LIBDIR); $(RANLIB) libnums.a - cp nums.cma $(CMIFILES) $(CMIFILES:.cmi=.mli) $(LIBDIR) - -installopt: - cp $(CAMLOBJS:.cmo=.cmx) nums.cmxa nums.a $(LIBDIR) - cd $(LIBDIR); $(RANLIB) nums.a - -partialclean: - rm -f *.cm* - -clean: partialclean - rm -f *.a *.o *.so - cd bignum; $(MAKE) scratch - cd test; $(MAKE) clean - -.SUFFIXES: .ml .mli .cmi .cmo .cmx - -.mli.cmi: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmo: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmx: - $(CAMLOPT) -c $(COMPFLAGS) $< - -nat_stubs.o: nat.h - -depend: - gcc -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend - -include .depend diff --git a/otherlibs/num/Makefile.Mac b/otherlibs/num/Makefile.Mac deleted file mode 100644 index 5487101c..00000000 --- a/otherlibs/num/Makefile.Mac +++ /dev/null @@ -1,64 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Damien Doligez, projet Para, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../LICENSE. # -# # -######################################################################### - -# $Id: Makefile.Mac,v 1.13 2002/07/23 14:12:00 doligez Exp $ - -# Makefile for the "num" (exact rational arithmetic) library - -# Compilation options -PPCC = mrc -PPCCOptions = -i :bignum:h:,:::byterun:,:::config: -w 35 {cdbgflag} - -CAMLC = :::boot:ocamlrun :::ocamlc -I :::stdlib: -w s -CAMLOPT = :::boot:ocamlrun :::ocamlopt: -I :::stdlib: -w s - -CAMLOBJS = int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo ¶ - ratio.cmo num.cmo arith_status.cmo - -CMIFILES = big_int.cmi nat.cmi num.cmi ratio.cmi arith_status.cmi - -PPCCOBJS = nat_stubs.c.x - -all Ä libnums.x nums.cma {CMIFILES} - -nums.cma Ä {CAMLOBJS} - {CAMLC} -a -o nums.cma {CAMLOBJS} - -libnums.x Ä :bignum:libbignum.x {PPCCOBJS} - ppclink {ldbgflag} -xm library -o libnums.x :bignum:libbignum.x {PPCCOBJS} - -:bignum:libbignum.x Ä :bignum:libbignum.o - directory :bignum; domake C; directory :: - -install Ä - duplicate -y libnums.x nums.cma {CMIFILES} "{LIBDIR}" - -partialclean Ä - delete -i Å.cm[aio] || set status 0 - -clean Ä partialclean - delete -i Å.x || set status 0 - directory :bignum; domake scratch; directory :: - directory :test; domake clean; directory :: - -.cmi Ä .mli - {CAMLC} -c {COMPFLAGS} {default}.mli - -.cmo Ä .ml - {CAMLC} -c {COMPFLAGS} {default}.ml - -depend Ä - begin - MakeDepend -w -objext .x Å.c - :::boot:ocamlrun :::tools:ocamldep Å.mli Å.ml - end | streamedit -e "/¶t/ replace // ' ' -c °" > Makefile.Mac.depend diff --git a/otherlibs/num/Makefile.Mac.depend b/otherlibs/num/Makefile.Mac.depend deleted file mode 100644 index c36b2671..00000000 --- a/otherlibs/num/Makefile.Mac.depend +++ /dev/null @@ -1,33 +0,0 @@ -#*** Dependencies: Cut here *** -# These dependencies were produced at 20:33:19 on Tue, Aug 21, 2001 by MakeDepend - -:nat_stubs.c.x Ä ¶ - :nat_stubs.c ¶ - "{CIncludes}"memory.h ¶ - :nat.h ¶ - "{CIncludes}"ConditionalMacros.h ¶ - "{CIncludes}"MacMemory.h ¶ - "{CIncludes}"MacTypes.h ¶ - "{CIncludes}"MixedMode.h - -big_int.cmiÄ nat.cmi -num.cmiÄ big_int.cmi nat.cmi ratio.cmi -ratio.cmiÄ big_int.cmi nat.cmi -arith_flags.cmoÄ arith_flags.cmi -arith_flags.cmxÄ arith_flags.cmi -arith_status.cmoÄ arith_flags.cmi arith_status.cmi -arith_status.cmxÄ arith_flags.cmx arith_status.cmi -big_int.cmoÄ int_misc.cmi nat.cmi big_int.cmi -big_int.cmxÄ int_misc.cmx nat.cmx big_int.cmi -int_misc.cmoÄ int_misc.cmi -int_misc.cmxÄ int_misc.cmi -nat.cmoÄ int_misc.cmi nat.cmi -nat.cmxÄ int_misc.cmx nat.cmi -num.cmoÄ arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi ratio.cmi num.cmi -num.cmxÄ arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx ratio.cmx num.cmi -ratio.cmoÄ arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi string_misc.cmi ¶ - ratio.cmi -ratio.cmxÄ arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx string_misc.cmx ¶ - ratio.cmi -string_misc.cmoÄ string_misc.cmi -string_misc.cmxÄ string_misc.cmi diff --git a/otherlibs/num/Makefile.nt b/otherlibs/num/Makefile.nt deleted file mode 100644 index e3bb3e5f..00000000 --- a/otherlibs/num/Makefile.nt +++ /dev/null @@ -1,101 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Xavier Leroy, projet Cristal, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../LICENSE. # -# # -######################################################################### - -# $Id: Makefile.nt,v 1.16 2002/06/27 11:36:02 xleroy Exp $ - -# Makefile for the "num" (exact rational arithmetic) library - -include ../../config/Makefile - -# Compilation options -CC=$(BYTECC) -CFLAGS=-O -I./bignum/h -I../../byterun -CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../boot -w s -CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -w s - -CAMLOBJS=int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo \ - ratio.cmo num.cmo arith_status.cmo - -CMIFILES=big_int.cmi nat.cmi num.cmi ratio.cmi arith_status.cmi - -DCOBJS=nat_stubs.$(DO) -SCOBJS=nat_stubs.$(SO) -BIGNUM_SOBJS=bignum/o/KerN.$(SO) bignum/o/bnInit.$(SO) \ - bignum/o/bnMult.$(SO) bignum/o/bnDivide.$(SO) \ - bignum/o/bnCmp.$(SO) bignum/o/bzf.$(SO) bignum/o/bz.$(SO) - -all: dllnums.dll libnums.$(A) nums.cma $(CMIFILES) - -allopt: libnums.$(A) nums.cmxa $(CMIFILES) - -nums.cma: $(CAMLOBJS) - $(CAMLC) -a -o nums.cma $(CAMLOBJS) -dllib -lnums -cclib -lnums - -nums.cmxa: $(CAMLOBJS:.cmo=.cmx) - $(CAMLOPT) -a -o nums.cmxa $(CAMLOBJS:.cmo=.cmx) -cclib -lnums - -dllnums.dll: bignum/dbignum.$(A) $(DCOBJS) - $(call MKDLL,dllnums.dll,tmp.$(A),\ - $(DCOBJS) bignum/dbignum.$(A) ../../byterun/ocamlrun.$(A)) - rm tmp.* - -libnums.$(A): bignum/sbignum.$(A) $(SCOBJS) - $(call MKLIB,libnums.$(A),$(SCOBJS) $(BIGNUM_SOBJS)) - -bignum/dbignum.$(A) bignum/sbignum.$(A): - cd bignum ; $(MAKEREC) - -$(CAMLOBJS:.cmo=.cmx): ../../ocamlopt - -install: - cp dllnums.dll $(STUBLIBDIR)/dllnums.dll - cp libnums.$(A) $(LIBDIR)/libnums.$(A) - cp nums.cma $(CMIFILES) $(LIBDIR) - -installopt: - cp $(CAMLOBJS:.cmo=.cmx) nums.cmxa nums.$(A) $(LIBDIR) - -partialclean: - rm -f *.cm* - -clean: partialclean - rm -f *.dll *.$(A) *.$(O) - cd bignum ; $(MAKEREC) scratch - cd test ; $(MAKEREC) clean - -.SUFFIXES: .ml .mli .cmi .cmo .cmx .$(DO) .$(SO) - -.mli.cmi: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmo: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmx: - $(CAMLOPT) -c $(COMPFLAGS) $< - -.c.$(DO): - $(BYTECC) $(DLLCCCOMPOPTS) $(CFLAGS) -c $< - mv $*.$(O) $*.$(DO) - -.c.$(SO): - $(BYTECC) $(BYTECCCOMPOPTS) $(CFLAGS) -c $< - mv $*.$(O) $*.$(SO) - -nat_stubs.$(O): nat.h - -depend: - sed -e 's/\.o/.$(DO)/g' .depend > .depend.nt - sed -e 's/\.o/.$(SO)/g' .depend >> .depend.nt - -include .depend.nt diff --git a/otherlibs/num/README b/otherlibs/num/README deleted file mode 100644 index 193f0695..00000000 --- a/otherlibs/num/README +++ /dev/null @@ -1,64 +0,0 @@ -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 - - ocamlc -custom nums.cma <.cmo and .ml files> -cclib -lnums - -for the linking phase. - -If you'd like to have the bignum functions available at toplevel, do - - ocamlmktop -o ocamltopnum -custom nums.cma <.cmo and .ml files> -cclib -lnums - ./ocamltopnum - -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 deleted file mode 100644 index 19103ed9..00000000 --- a/otherlibs/num/arith_flags.ml +++ /dev/null @@ -1,25 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: arith_flags.ml,v 1.4 2001/12/07 13:40:14 xleroy Exp $ *) - -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 deleted file mode 100644 index 30e5300c..00000000 --- a/otherlibs/num/arith_flags.mli +++ /dev/null @@ -1,20 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: arith_flags.mli,v 1.5 2001/12/07 13:40:14 xleroy Exp $ *) - -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 deleted file mode 100644 index a15b5816..00000000 --- a/otherlibs/num/arith_status.ml +++ /dev/null @@ -1,100 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: arith_status.ml,v 1.4 2001/12/07 13:40:14 xleroy Exp $ *) - -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 )"; - 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 )"; - 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 )"; - 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 )"; - 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 )"; - print_newline () -;; diff --git a/otherlibs/num/arith_status.mli b/otherlibs/num/arith_status.mli deleted file mode 100644 index 76300eb8..00000000 --- a/otherlibs/num/arith_status.mli +++ /dev/null @@ -1,60 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: arith_status.mli,v 1.6 2001/12/07 13:40:14 xleroy Exp $ *) - -(** 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 - (** See {!Arith_status.set_error_when_null_denominator}.*) -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 - (** See {!Arith_status.set_normalize_ratio}.*) -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 - (** See {!Arith_status.set_normalize_ratio_when_printing}.*) -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 - (** See {!Arith_status.set_approx_printing}.*) -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 - (** See {!Arith_status.set_floating_precision}.*) -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 deleted file mode 100644 index 6718f5d0..00000000 --- a/otherlibs/num/big_int.ml +++ /dev/null @@ -1,603 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: big_int.ml,v 1.17 2002/05/27 12:06:48 weis Exp $ *) - -open Int_misc -open Nat - -type big_int = - { sign : int; - abs_value : nat } - -let create_big_int sign nat = - if sign = 1 || sign = -1 || - (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 monster_big_int = big_int_of_int monster_int;; - -let monster_nat = monster_big_int.abs_value;; - -let is_int_big_int bi = - num_digits_big_int bi == 1 && - match compare_nat bi.abs_value 0 1 monster_nat 0 1 with - | 0 -> bi.sign == -1 - | -1 -> true - | _ -> false;; - -let int_of_big_int bi = - try let n = int_of_nat bi.abs_value in - if bi.sign = -1 then - n else n - with Failure _ -> - if eq_big_int bi monster_big_int then monster_int - else failwith "int_of_big_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 - - -let sys_big_int_of_string_aux s ofs len sgn = - if len < 1 then failwith "sys_big_int_of_string"; - let n = sys_nat_of_string 10 s ofs len in - if is_zero_nat n 0 (length_nat n) then zero_big_int - else {sign = sgn; abs_value = n} -;; - -let sys_big_int_of_string s ofs len = - match s.[ofs] with - | '-' -> sys_big_int_of_string_aux s (ofs+1) (len-1) (-1) - | '+' -> sys_big_int_of_string_aux s (ofs+1) (len-1) 1 - | _ -> sys_big_int_of_string_aux s ofs len 1 -;; - -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 (succ 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 (succ 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 = copy_nat bi2.abs_value 0 len_bi2 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 - | 0 -> zero_big_int - | -1 -> invalid_arg "sqrt_big_int" - | _ -> {sign = 1; - abs_value = sqrt_nat (bi.abs_value) 0 (num_digits_big_int bi)} - -let square_big_int bi = - if bi.sign == 0 then zero_big_int else - 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 = 1; 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 deleted file mode 100644 index 7fd13692..00000000 --- a/otherlibs/num/big_int.mli +++ /dev/null @@ -1,143 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: big_int.mli,v 1.10 2002/03/14 20:12:54 xleroy Exp $ *) - -(** Operations on arbitrary-precision integers. - - Big integers (type [big_int]) are signed integers of arbitrary size. -*) - -open Nat - -type big_int - (** The type of big integers. *) - -val zero_big_int : big_int - (** The big integer [0]. *) -val unit_big_int : big_int - (** The big integer [1]. *) - -(** {6 Arithmetic operations} *) - -val minus_big_int : big_int -> big_int - (** Unary negation. *) -val abs_big_int : big_int -> big_int - (** Absolute value. *) -val add_big_int : big_int -> big_int -> big_int - (** Addition. *) -val succ_big_int : big_int -> big_int - (** Successor (add 1). *) -val add_int_big_int : int -> big_int -> big_int - (** Addition of a small integer to a big integer. *) -val sub_big_int : big_int -> big_int -> big_int - (** Subtraction. *) -val pred_big_int : big_int -> big_int - (** Predecessor (subtract 1). *) -val mult_big_int : big_int -> big_int -> big_int - (** Multiplication of two big integers. *) -val mult_int_big_int : int -> big_int -> big_int - (** Multiplication of a big integer by a small integer *) -val square_big_int: big_int -> big_int - (** Return the square of the given big integer *) -val sqrt_big_int: big_int -> big_int - (** [sqrt_big_int a] returns the integer square root of [a], - that is, the largest big integer [r] such that [r * r <= a]. - Raise [Invalid_argument] if [a] is negative. *) -val quomod_big_int : big_int -> big_int -> big_int * big_int - (** Euclidean division of two big integers. - The first part of the result is the quotient, - the second part is the remainder. - Writing [(q,r) = quomod_big_int a b], we have - [a = q * b + r] and [0 <= r < |b|]. - Raise [Division_by_zero] if the divisor is zero. *) -val div_big_int : big_int -> big_int -> big_int - (** Euclidean quotient of two big integers. - This is the first result [q] of [quomod_big_int] (see above). *) -val mod_big_int : big_int -> big_int -> big_int - (** Euclidean modulus of two big integers. - This is the second result [r] of [quomod_big_int] (see above). *) -val gcd_big_int : big_int -> big_int -> big_int - (** Greatest common divisor of two big integers. *) -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 - (** Exponentiation functions. Return the big integer - representing the first argument [a] raised to the power [b] - (the second argument). Depending - on the function, [a] and [b] can be either small integers - or big integers. Raise [Invalid_argument] if [b] is negative. *) - -(** {6 Comparisons and tests} *) - -val sign_big_int : big_int -> int - (** Return [0] if the given big integer is zero, - [1] if it is positive, and [-1] if it is negative. *) -val compare_big_int : big_int -> big_int -> int - (** [compare_big_int a b] returns [0] if [a] and [b] are equal, - [1] if [a] is greater than [b], and [-1] if [a] is smaller - than [b]. *) -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 - (** Usual boolean comparisons between two big integers. *) -val max_big_int : big_int -> big_int -> big_int - (** Return the greater of its two arguments. *) -val min_big_int : big_int -> big_int -> big_int - (** Return the smaller of its two arguments. *) -val num_digits_big_int : big_int -> int - (** Return the number of machine words used to store the - given big integer. *) - -(** {6 Conversions to and from strings} *) - -val string_of_big_int : big_int -> string - (** Return the string representation of the given big integer, - in decimal (base 10). *) -val big_int_of_string : string -> big_int - (** Convert a string to a big integer, in decimal. - The string consists of an optional [-] or [+] sign, - followed by one or several decimal digits. *) - -(** {6 Conversions to and from other numerical types} *) - -val big_int_of_int : int -> big_int - (** Convert a small integer to a big integer. *) -val is_int_big_int : big_int -> bool - (** Test whether the given big integer is small enough to - be representable as a small integer (type [int]) - without loss of precision. On a 32-bit platform, - [is_int_big_int a] returns [true] if and only if - [a] is between 2{^30} and 2{^30}-1. On a 64-bit platform, - [is_int_big_int a] returns [true] if and only if - [a] is between -2{^62} and 2{^62}-1. *) -val int_of_big_int : big_int -> int - (** Convert a big integer to a small integer (type [int]). - Raises [Failure "int_of_big_int"] if the big integer - is not representable as a small integer. *) -val float_of_big_int : big_int -> float - (** Returns a floating-point number approximating the - given big integer. *) - -(**/**) - -(** {6 For internal use} *) -val nat_of_big_int : big_int -> nat -val big_int_of_nat : nat -> 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 round_futur_last_digit : string -> int -> int -> bool -val approx_big_int: int -> big_int -> string diff --git a/otherlibs/num/bignum/.cvsignore b/otherlibs/num/bignum/.cvsignore deleted file mode 100644 index c76baffd..00000000 --- a/otherlibs/num/bignum/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -libbignum.x diff --git a/otherlibs/num/bignum/Makefile b/otherlibs/num/bignum/Makefile deleted file mode 100644 index aeb250a3..00000000 --- a/otherlibs/num/bignum/Makefile +++ /dev/null @@ -1,343 +0,0 @@ -# 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 " - @echo "see README for valid versions." - @sh -c 'exit 1' - -#all: testKerN bztest -# @echo All is done - -#all: $(LIB) -# @echo All is done - -all: $(OBJECT) - @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 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 -K pic s/KerN.s -o o/KerN.o - rm -f s/KerN.s - $(MAKE) CC="$(CC)" CFLAGS="$(CFLAGS)" \ - OBJECT="$(OBJECT)" all - -x86: scratch - as s/x86KerN.s -o o/KerN.o - $(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" \ - 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) 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; \ - echo "# Remove all text above and including this line." >>tosend; \ - sed -e "s/modified_on/modified_on/g" <$$i >>tosend; \ - $(SENDMAIL) $(SENDMAILFLAGS) $(USER) " - echo "see README for valid versions." - -#all Ä testKerN bztest -# echo All is done - -all Ä {PPCLIB} - echo - -scratch Ä - delete -i :o:Å.x || set status 0 - delete -i libbignum.x - delete -i bztest testKerN - -# build the BigNum library -{PPCLIB} Ä {PPCOBJECT} - ppclink {ldbgflag} -xm library -o {PPCLIB} {PPCOBJECT} - -# How to choose the machine dependent version. All produce KerN.o -:o:KerN.x Ä :c:KerN.c - echo "The Default is KerN written in C with digits on long" - domake C -d C="{PPCC}" -d COptions="{PPCCOptions}" - -C Ä scratch - {PPCC} {PPCCOptions} :c:KerN.c -o :o:KerN.x - domake all - -.x Ä .c {KERNH} - {PPCC} {PPCCOptions} {depdir}{default}.c -o {targdir}{default}.x - -:o: Ä :c: :c:bn: - -# Level N -:o:bnInit.x Ä {KERNH} -:o:bnMult.x Ä {KERNH} -:o:bnDivide.x Ä {KERNH} -:o:bnCmp.x Ä {KERNH} - -# Level Z -:o:bz.x Ä :h:BigZ.h {KERNH} - -# Some functions built with BigZ -:o:bzf.x Ä :h:BigZ.h {KERNH} - -# Tests Of KerN -testKerN ÄÄ :o:testKerN.x {PPCLIB} - ppclink -c 'MPS ' -t MPST :o:testKerN.x {PPCLIB} {PPCLinkOptions} ¶ - -o testKerN {PPCLibs} - -:o:testKerN.o :o:testKerN.x Ä {KERNH} - -# Tests Of BigZ -bztest ÄÄ :o:bztest.x {PPCLIB} - ppclink -c 'MPS ' -t MPST :o:bztest.x {PPCLIB} {PPCLinkOptions} ¶ - -o bztest {PPCLibs} - -:o:bztest.x Ä :h:BigZ.h {KERNH} diff --git a/otherlibs/num/bignum/Makefile.nt b/otherlibs/num/bignum/Makefile.nt deleted file mode 100644 index 10e67b82..00000000 --- a/otherlibs/num/bignum/Makefile.nt +++ /dev/null @@ -1,87 +0,0 @@ -include ../../../config/Makefile - -CC = $(BYTECC) -CFLAGS = -c -I./h -DCAML_LIGHT -KERNH = h/BigNum.h -OBJS = o/KerN.$(O) o/bnInit.$(O) o/bnMult.$(O) o/bnDivide.$(O) \ - o/bnCmp.$(O) o/bzf.$(O) o/bz.$(O) - -all: dbignum.$(A) sbignum.$(A) - -scratch: - rm -f *.$(A) o/*.$(O) - -# DLL - -dbignum.$(A): $(OBJS:.$(O)=.$(DO)) - $(call MKLIB,dbignum.$(A),$(OBJS:.$(O)=.$(DO))) - -o/KerN.$(DO): c/KerN.c - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/KerN.c - mv KerN.$(O) o/KerN.$(DO) - -o/bnInit.$(DO): c/bn/bnInit.c $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/bn/bnInit.c - mv bnInit.$(O) o/bnInit.$(DO) - -o/bnMult.$(DO): c/bn/bnMult.c $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/bn/bnMult.c - mv bnMult.$(O) o/bnMult.$(DO) - -o/bnDivide.$(DO): c/bn/bnDivide.c $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/bn/bnDivide.c - mv bnDivide.$(O) o/bnDivide.$(DO) - -o/bnCmp.$(DO): c/bn/bnCmp.c $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/bn/bnCmp.c - mv bnCmp.$(O) o/bnCmp.$(DO) - -o/bz.$(DO): c/bz.c h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/bz.c - mv bz.$(O) o/bz.$(DO) - -o/br.$(DO): c/br.c h/BigR.h h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/br.c - mv br.$(O) o/br.$(DO) - -o/bzf.$(DO): c/bzf.c h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c/bzf.c - mv bzf.$(O) o/bzf.$(DO) - -# Static - -sbignum.$(A): $(OBJS:.$(O)=.$(SO)) - $(call MKLIB,sbignum.$(A),$(OBJS:.$(O)=.$(SO))) - -o/KerN.$(SO): c/KerN.c - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/KerN.c - mv KerN.$(O) o/KerN.$(SO) - -o/bnInit.$(SO): c/bn/bnInit.c $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/bn/bnInit.c - mv bnInit.$(O) o/bnInit.$(SO) - -o/bnMult.$(SO): c/bn/bnMult.c $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/bn/bnMult.c - mv bnMult.$(O) o/bnMult.$(SO) - -o/bnDivide.$(SO): c/bn/bnDivide.c $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/bn/bnDivide.c - mv bnDivide.$(O) o/bnDivide.$(SO) - -o/bnCmp.$(SO): c/bn/bnCmp.c $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/bn/bnCmp.c - mv bnCmp.$(O) o/bnCmp.$(SO) - -o/bz.$(SO): c/bz.c h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/bz.c - mv bz.$(O) o/bz.$(SO) - -o/br.$(SO): c/br.c h/BigR.h h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/br.c - mv br.$(O) o/br.$(SO) - -o/bzf.$(SO): c/bzf.c h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c/bzf.c - mv bzf.$(O) o/bzf.$(SO) - diff --git a/otherlibs/num/bignum/README b/otherlibs/num/bignum/README deleted file mode 100644 index d2ff1ef0..00000000 --- a/otherlibs/num/bignum/README +++ /dev/null @@ -1,97 +0,0 @@ - -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 deleted file mode 100644 index 54fc12e1..00000000 --- a/otherlibs/num/bignum/c/KerN.c +++ /dev/null @@ -1,860 +0,0 @@ -/* 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; - register BigNumProduct save; - - - ml -= nl; - - 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; - register BigNumProduct save; - - - ml -= nl; - - 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; - - { -/* 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. - */ - -{ - { - 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 deleted file mode 100644 index b678124d..00000000 --- a/otherlibs/num/bignum/c/bn/bnCmp.c +++ /dev/null @@ -1,77 +0,0 @@ -/* 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 deleted file mode 100644 index e25938bb..00000000 --- a/otherlibs/num/bignum/c/bn/bnDivide.c +++ /dev/null @@ -1,156 +0,0 @@ -/* 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 deleted file mode 100644 index d0230150..00000000 --- a/otherlibs/num/bignum/c/bn/bnInit.c +++ /dev/null @@ -1,74 +0,0 @@ -/* 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 deleted file mode 100644 index f4ecf833..00000000 --- a/otherlibs/num/bignum/c/bn/bnMult.c +++ /dev/null @@ -1,84 +0,0 @@ -/* 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 deleted file mode 100644 index 10d0c224..00000000 --- a/otherlibs/num/bignum/c/bz.c +++ /dev/null @@ -1,833 +0,0 @@ -/* 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 -#include -#include -#include -#include -*/ - -#define NULL 0 -#define max(a,b) (a=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 deleted file mode 100644 index 7186452a..00000000 --- a/otherlibs/num/bignum/c/bzf.c +++ /dev/null @@ -1,50 +0,0 @@ -/* 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 deleted file mode 100644 index 2d06b184..00000000 --- a/otherlibs/num/bignum/c/bztest.c +++ /dev/null @@ -1,167 +0,0 @@ -/* 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 -#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 deleted file mode 100644 index 22faa322..00000000 --- a/otherlibs/num/bignum/c/testKerN.c +++ /dev/null @@ -1,1085 +0,0 @@ -/* 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 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; idepend = "(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; idepend = "(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 deleted file mode 100644 index 604a9c0a..00000000 --- a/otherlibs/num/bignum/h/BigNum.h +++ /dev/null @@ -1,144 +0,0 @@ -/* 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 deleted file mode 100644 index aaab0a2b..00000000 --- a/otherlibs/num/bignum/h/BigZ.h +++ /dev/null @@ -1,97 +0,0 @@ -/* 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 deleted file mode 100644 index edec7e2e..00000000 --- a/otherlibs/num/bignum/h/BntoBnn.h +++ /dev/null @@ -1,105 +0,0 @@ -/* 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 */ - - -#include - - /* 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/o/.cvsignore b/otherlibs/num/bignum/o/.cvsignore deleted file mode 100644 index 37a28a8c..00000000 --- a/otherlibs/num/bignum/o/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -*.x diff --git a/otherlibs/num/bignum/o/EMPTY b/otherlibs/num/bignum/o/EMPTY deleted file mode 100644 index e69de29b..00000000 diff --git a/otherlibs/num/bignum/s/68KerN.s b/otherlibs/num/bignum/s/68KerN.s deleted file mode 100644 index 1b84ae0f..00000000 --- a/otherlibs/num/bignum/s/68KerN.s +++ /dev/null @@ -1,403 +0,0 @@ -| 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 deleted file mode 100644 index 6baa4380..00000000 --- a/otherlibs/num/bignum/s/68KerN_mot.s +++ /dev/null @@ -1,410 +0,0 @@ -| 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 deleted file mode 100644 index ef5ae6aa..00000000 --- a/otherlibs/num/bignum/s/68KerN_sony.s +++ /dev/null @@ -1,426 +0,0 @@ -/* 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 deleted file mode 100644 index e7a63b65..00000000 --- a/otherlibs/num/bignum/s/RS6000KerN.s +++ /dev/null @@ -1,468 +0,0 @@ -# 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 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 deleted file mode 100644 index f9785794..00000000 --- a/otherlibs/num/bignum/s/alphaKerN.s +++ /dev/null @@ -1,2511 +0,0 @@ - .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 deleted file mode 100644 index f6d53f37..00000000 --- a/otherlibs/num/bignum/s/hpKerN.s +++ /dev/null @@ -1,814 +0,0 @@ -; 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 - 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<=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>=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 deleted file mode 100644 index 2a23b648..00000000 --- a/otherlibs/num/bignum/s/i960KerN.s +++ /dev/null @@ -1,928 +0,0 @@ -/* -** (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 deleted file mode 100644 index 672312ff..00000000 --- a/otherlibs/num/bignum/s/mipsKerN.s +++ /dev/null @@ -1,1382 +0,0 @@ - # 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 deleted file mode 100644 index 7df2f9eb..00000000 --- a/otherlibs/num/bignum/s/nsKerN.s +++ /dev/null @@ -1,427 +0,0 @@ -# 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 deleted file mode 100644 index 51198b80..00000000 --- a/otherlibs/num/bignum/s/pyramidKerN.s +++ /dev/null @@ -1,454 +0,0 @@ -# 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 deleted file mode 100644 index 2626d70c..00000000 --- a/otherlibs/num/bignum/s/sparcKerN.s +++ /dev/null @@ -1,643 +0,0 @@ -! 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 deleted file mode 100644 index 5e0a6dfd..00000000 --- a/otherlibs/num/bignum/s/sparcfpuKerN.s +++ /dev/null @@ -1,741 +0,0 @@ -! 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 deleted file mode 100644 index 4fca4c08..00000000 --- a/otherlibs/num/bignum/s/supersparcKerN.s +++ /dev/null @@ -1,472 +0,0 @@ -! 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: -LBAddCarry: - 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: -LBAdd: - sub %o1,%o3,%o1 ! ml -= nl - tst %o3 - be,a LBAddCarry ! 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 LBAddCarry - mov %o4,%o2 - .proc 14 - .global _BnnSubtractBorrow ! (mm, ml, car) -_BnnSubtractBorrow: -LBSubtractBorrow: - 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 LBSubtractBorrow ! 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 LBSubtractBorrow - 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 LBAdd ! 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 deleted file mode 100644 index ba273375..00000000 --- a/otherlibs/num/bignum/s/unix2vms.sed +++ /dev/null @@ -1,28 +0,0 @@ -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 deleted file mode 100644 index b6d4f95d..00000000 --- a/otherlibs/num/bignum/s/vaxKerN.mar +++ /dev/null @@ -1,701 +0,0 @@ -; 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 -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 - 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 - 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 - 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 - 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 - 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 deleted file mode 100644 index c9f5d716..00000000 --- a/otherlibs/num/bignum/s/vaxKerN.s +++ /dev/null @@ -1,700 +0,0 @@ -# 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 -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 - 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 - 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 - 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 - 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 - 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/bignum/s/x86KerN.s b/otherlibs/num/bignum/s/x86KerN.s deleted file mode 100644 index 191c33a9..00000000 --- a/otherlibs/num/bignum/s/x86KerN.s +++ /dev/null @@ -1,520 +0,0 @@ -# Copyright Digital Equipment Corporation & INRIA 1988, 1989 -# -# KerN for the 80386 -# [Bepaul] -# - .data - .type copyright,@object - .size copyright,72 -copyright: .string "@(#)KerN.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\n" - - .text - .align 16 - .globl BnnSetToZero -BnnSetToZero: movl 4(%esp),%edx # nn - movl 8(%esp),%eax # nl - testl %eax,%eax - je BSTZ2 # if(nl==0) return - .align 16 -BSTZ1: movl $0,(%edx) # *nn = 0 - decl %eax # nl-- - leal 4(%edx),%edx # nn += 1 - jne BSTZ1 # if(nl) BSTZ1 -BSTZ2: ret - - .align 16 - .globl BnnAssign -BnnAssign: pushl %ebx - movl 8(%esp),%edx # mm - movl 12(%esp),%ebx # nn - movl 16(%esp),%eax # nl - testl %eax,%eax # if(nl<=0) return - je BAG4 - sall $2,%eax - leal (%eax,%ebx),%ecx # nnlim=nn+nl - cmpl %ebx,%edx - jb BAG1 # if(mm>= rnbi - bswap %ecx - decl %ebx # ml-- - jne BSL1 # if(ml) BSL1 -BSL2: popl %ebx - popl %esi - popl %edi - popl %ebp - ret - - .align 16 - .globl BnnShiftRight -BnnShiftRight: pushl %ebp - pushl %edi - pushl %esi - pushl %ebx - movl 20(%esp),%ebp # mm - movl 24(%esp),%ebx # ml - movl 28(%esp),%ecx # nbi - xorl %eax,%eax # res = 0 - testl %ecx,%ecx # if(nbi == 0) return(res) - je BSR2 - testl %ebx,%ebx # if(ml == 0) return(res) - je BSR2 - leal (%ebp,%ebx,4),%ebp # mm += ml - movl $32,%edx # rnbi = 32 - subl %ecx,%edx # rnbi -= nbi - bswap %edx # Same as rnbi << 24.. - orl %edx,%ecx # C = rnbi .. nbi - .align 16 -BSR1: - addl $-4,%ebp # mm-- - movl (%ebp),%esi # save = *mm - movl (%ebp),%edi # X = save - shrl %cl,%edi # X >>= nbi - orl %eax,%edi # X |= res - movl %edi,(%ebp) # *mm = X - movl %esi,%eax # res = save - bswap %ecx - sall %cl,%eax # res <<= rnbi - bswap %ecx - decl %ebx # ml-- - jne BSR1 # if(ml) BSR1 -BSR2: popl %ebx - popl %esi - popl %edi - popl %ebp - ret - - .align 16 - .globl BnnAddCarry -BnnAddCarry: movl 4(%esp),%edx # nn - movl 8(%esp),%ecx # nl - cmpl $0,12(%esp) # if(carryin==0) return(0); - je BAC4 -BAC1: testl %ecx,%ecx # if(nl==0) return(1); - je BAC3 - .align 16 -BAC2: movl (%edx),%eax # X = *nn - addl $1,%eax # X++ - movl %eax,(%edx) # *nn = X - jnc BAC4 # if !CF return(0); - leal 4(%edx),%edx # nn += 1; - decl %ecx # nl-- - jnz BAC2 # if(nl!=0) BAC2 -BAC3: movl $1,%eax # return(1); - ret -BAC4: xorl %eax,%eax # return(0); - ret - - .align 16 - .globl BnnAdd -BnnAdd: pushl %edi - pushl %esi - pushl %ebx - movl 16(%esp),%edx # mm - movl 20(%esp),%ecx # ml - movl 24(%esp),%ebx # nn - movl 28(%esp),%esi # nl - movl 32(%esp),%eax # c - subl %esi,%ecx # ml -= nl - testl %esi,%esi # if(nl == 0) BADD2 - je BADD2 - neg %eax # CF = c - .align 16 -BADD1: - movl (%ebx),%eax # c = *nn - movl (%edx),%edi # X = *mm - adc %eax,%edi # X += c + CF - movl %edi,(%edx) # *mm = X - decl %esi # nl-- - leal 4(%ebx),%ebx # nn += 1; - leal 4(%edx),%edx # mm += 1; - jne BADD1 # if(nl != 0) BADD1 - setc %al # c = CF - andl $255,%eax -BADD2: testl %eax,%eax # if(c == 0) return(0); - je BADD5 - testl %ecx,%ecx # if(ml==0) return(1); - je BADD4 - .align 16 -BADD3: incl (%edx) # (*mm)++ - jnz BADD5 # if !ZF return(0); - addl $4,%edx # mm++ - decl %ecx # ml-- - jnz BADD3 # if(ml!=0) BADD3 -BADD4: movl $1,%eax # return(1); - popl %ebx - popl %esi - popl %edi - ret -BADD5: xorl %eax,%eax # return(0); - popl %ebx - popl %esi - popl %edi - ret - - .align 16 - .globl BnnSubtractBorrow -BnnSubtractBorrow: - movl 4(%esp),%edx # nn - movl 8(%esp),%ecx # nl - cmpl $0,12(%esp) # if(carryin==1) return(1); - jne BSB4 -BSB1: testl %ecx,%ecx # if(nl==0) return(0); - je BSB3 - .align 16 -BSB2: subl $1,(%edx) # (*nn)-- - jnc BSB4 # if !CF return(1); - addl $4,%edx # nn++ - decl %ecx # nl-- - jnz BSB2 # if(nl!=0) BSB2 -BSB3: xorl %eax,%eax # return(0); - ret -BSB4: movl $1,%eax # return(1); - ret - - .align 16 - .globl BnnSubtract -BnnSubtract: pushl %edi - pushl %esi - pushl %ebx - movl 16(%esp),%edx # mm - movl 20(%esp),%ecx # ml - movl 24(%esp),%ebx # nn - movl 28(%esp),%esi # nl - movl 32(%esp),%eax # c - subl %esi,%ecx # ml -= nl - testl %esi,%esi # if(nl) BS2 - je BS2 - xorl $1,%eax # c = !c; - neg %eax # CF = c - .align 16 -BS1: movl (%edx),%edi # X = *mm - movl (%ebx),%eax # c = *nn - sbb %eax,%edi # X -= c + CF - movl %edi,(%edx) # *mm = X - leal 4(%ebx),%ebx # nn += 1; - leal 4(%edx),%edx # mm += 1; - decl %esi # nl-- - jne BS1 # if(nl != 0) BS1 - setc %al # c = CF - andl $255,%eax - xorl $1,%eax # c = !c; -BS2: testl %eax,%eax # if(c == 1) return(1); - jne BS5 - testl %ecx,%ecx # if(ml==0) return(0); - je BS4 - .align 16 -BS3: subl $1,(%edx) # (*mm)-- - jnc BS5 # if !CF return(1); - addl $4,%edx # mm++ - decl %ecx # ml-- - jnz BS3 # if(ml!=0) BS3 -BS4: xorl %eax,%eax # return(0); - popl %ebx - popl %esi - popl %edi - ret -BS5: movl $1,%eax # return(1); - popl %ebx - popl %esi - popl %edi - ret - - .align 16 - .globl BnnMultiplyDigit -BnnMultiplyDigit: - movl 20(%esp),%ecx # d - testl %ecx,%ecx # if(d!=0) BM1 - jne BMD1 - xorl %eax,%eax # return(0); - ret -BMD1: cmpl $1,%ecx # if(d!=1) BM2 - jne BMD2 - movl $0,20(%esp) - jmp BnnAdd # return(BnnAdd(pp,pl,mm,ml,0) -BMD2: pushl %ebp - pushl %edi - pushl %esi - pushl %ebx - movl 20(%esp),%edi # pp - movl 28(%esp),%esi # mm - movl 32(%esp),%ebp # ml - subl %ebp,24(%esp) # pl -= ml - xorl %ebx,%ebx # low = 0 - testl %ebp,%ebp - je BMD7 # if(ml == 0) return(0); - .align 16 -BMD3: movl (%esi),%eax # XL = *mm - addl $4,%esi # mm++ - mul %ecx # XH:XL = D*XL - addl %ebx,%eax # XL += low - adc $0,%edx # XH += CF - addl (%edi),%eax # XL += *pp (reverse ?!) - adc $0,%edx # XH += CF - movl %eax,(%edi) # *pp = XL - addl $4,%edi # pp++ - movl %edx,%ebx # low = XH -BMD4: decl %ebp # ml-- - jne BMD3 # if(ml) BMD3 - movl 24(%esp),%edx # pl - addl %ebx,(%edi) # *pp += low - jnc BMD7 # if !CF return(0) - decl %edx # pl-- - je BMD6 # if(pl == 0) return(1) - addl $4,%edi # pp++ - .align 16 -BMD5: addl $1,(%edi) # (*pp)++ - jnc BMD7 # if !CF return(0); - addl $4,%edi # pp++ - decl %edx # pl-- - jnz BMD5 # if(pl!=0) BMD5 -BMD6: movl $1,%eax # return(1); - popl %ebx - popl %esi - popl %edi - popl %ebp - ret -BMD7: xorl %eax,%eax # return(0); - popl %ebx - popl %esi - popl %edi - popl %ebp - ret - - .align 16 - .globl BnnDivideDigit -BnnDivideDigit: pushl %edi - pushl %esi - pushl %ebx - movl 16(%esp),%edi # qq - movl 20(%esp),%esi # nn - movl 24(%esp),%ecx # nl - movl 28(%esp),%ebx # d - leal (%esi,%ecx,4),%esi # nn+=nl - decl %ecx # nl--; - leal (%edi,%ecx,4),%edi # qq += ql - addl $-4,%esi # nn-- - movl (%esi),%edx # XH = *nn; - testl %ecx,%ecx - je BDD2 # if(nl==0) return(XH) - .align 16 -BDD1: addl $-4,%esi # nn-- - movl (%esi),%eax # XL = *nn - div %ebx # XL = XH:XL / d; - # XH = XH:XL % d; - addl $-4,%edi # qq-- - movl %eax,(%edi) # *qq = XL; - decl %ecx # nl-- - jnz BDD1 # if(nl!=0) BDD1 -BDD2: movl %edx,%eax # return(XH); - popl %ebx - popl %esi - popl %edi - ret diff --git a/otherlibs/num/int_misc.ml b/otherlibs/num/int_misc.ml deleted file mode 100644 index 1c6f1b74..00000000 --- a/otherlibs/num/int_misc.ml +++ /dev/null @@ -1,36 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: int_misc.ml,v 1.6 2002/05/27 12:06:49 weis Exp $ *) - -(* Some extra operations on integers *) - -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;; - -let length_of_int = Sys.word_size - 2;; - -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/int_misc.mli b/otherlibs/num/int_misc.mli deleted file mode 100644 index a7b4e10a..00000000 --- a/otherlibs/num/int_misc.mli +++ /dev/null @@ -1,25 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: int_misc.mli,v 1.4 2001/12/07 13:40:15 xleroy Exp $ *) - -(* 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/nat.h b/otherlibs/num/nat.h deleted file mode 100644 index 559ecca8..00000000 --- a/otherlibs/num/nat.h +++ /dev/null @@ -1,19 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1999 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: nat.h,v 1.5 2001/12/07 13:40:15 xleroy Exp $ */ - -/* Nats are represented as unstructured blocks with tag Custom_tag. */ - -#define Bignum_val(nat) ((BigNum) Data_custom_val(nat)) - diff --git a/otherlibs/num/nat.ml b/otherlibs/num/nat.ml deleted file mode 100644 index 3543165a..00000000 --- a/otherlibs/num/nat.ml +++ /dev/null @@ -1,564 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: nat.ml,v 1.12 2002/03/14 20:12:54 xleroy Exp $ *) - -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 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" - -external initialize_nat: unit -> unit = "initialize_nat" -let _ = initialize_nat() - -let length_nat (n : nat) = Obj.size (Obj.repr n) - 1 - -let length_of_digit = Sys.word_size;; - -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 - -(* Nat temporaries *) -let a_2 = make_nat 2 -and a_1 = make_nat 1 -and b_2 = make_nat 2 - -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 - -(* Racine carrée entière par la méthode de Newton (entière par défaut). *) - -(* Théorème: la suite xn+1 = (xn + a/xn) / 2 converge vers la racine *) -(* carrée entière de a par défaut, si on part d'une valeur x0 *) -(* strictement plus grande que la racine de a, sauf quand a est un *) -(* carré - 1, cas auquel la suite alterne entre la racine par défaut *) -(* et par excès. Dans tous les cas, le dernier terme de la partie *) -(* strictement décroissante de la suite est le résultat cherché. *) - -let sqrt_nat rad off len = - let len = num_digits_nat rad off len in - (* Copie de travail du radicande *) - let len_parity = len mod 2 in - let rad_len = len + 1 + len_parity in - let rad = - let res = create_nat rad_len in - blit_nat res 0 rad off len; - set_digit_nat res len 0; - set_digit_nat res (rad_len - 1) 0; - res in - let cand_len = (len + 1) / 2 in (* ceiling len / 2 *) - let cand_rest = rad_len - cand_len in - (* Racine carrée supposée cand = "|FFFF .... |" *) - let cand = make_nat cand_len in - (* Amélioration de la racine de départ: - on calcule nbb le nombre de bits significatifs du premier digit du candidat - (la moitié du nombre de bits significatifs dans les deux premiers - digits du radicande étendu à une longueur paire). - shift_cand est word_size - nbb *) - let shift_cand = - ((num_leading_zero_bits_in_digit rad (len-1)) + - Sys.word_size * len_parity) / 2 in - (* Tous les bits du radicande sont à 0, on rend 0. *) - if shift_cand = Sys.word_size then cand else - begin - complement_nat cand 0 cand_len; - shift_right_nat cand 0 1 a_1 0 shift_cand; - let next_cand = create_nat rad_len in - (* Repeat until *) - let rec loop () = - (* next_cand := rad *) - blit_nat next_cand 0 rad 0 rad_len; - (* next_cand <- next_cand / cand *) - div_nat next_cand 0 rad_len cand 0 cand_len; - (* next_cand (poids fort) <- next_cand (poids fort) + cand, - i.e. next_cand <- cand + rad / cand *) - add_nat next_cand cand_len cand_rest cand 0 cand_len 0; - (* next_cand <- next_cand / 2 *) - shift_right_nat next_cand cand_len cand_rest a_1 0 1; - if lt_nat next_cand cand_len cand_rest cand 0 cand_len then - begin (* cand <- next_cand *) - blit_nat cand 0 next_cand cand_len cand_len; loop () - end - else cand in - loop () - end;; - -let power_base_max = make_nat 2;; - -match length_of_digit with - | 64 -> - 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; - () - | 32 -> set_digit_nat power_base_max 0 1000000000 - | _ -> failwith "Nat.power_base_max: unknown word size" -;; - -let pmax = - match length_of_digit with - | 64 -> 19 - | 32 -> 9 - | _ -> failwith "Nat.pmax: unknown word size" -;; - -let max_superscript_10_power_in_int = - match length_of_digit with - | 64 -> 18 - | 32 -> 9 - | _ -> failwith "Nat.max_superscript_10_power_in_int: unknown word size" -;; -let max_power_10_power_in_int = - match length_of_digit with - | 64 -> nat_of_int 1000000000000000000 - | 32 -> nat_of_int 1000000000 - | _ -> failwith "Nat.max_power_10_power_in_int: unknown word size" -;; - -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) || (!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 || i = bound) && not (!digits_read = 0) then - begin - set_digit_nat nat1 0 !int; - let erase_len = if !new_len = !current_len then !current_len - 1 - else !current_len in - for j = 1 to erase_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/nat.mli b/otherlibs/num/nat.mli deleted file mode 100644 index 78dc8f1a..00000000 --- a/otherlibs/num/nat.mli +++ /dev/null @@ -1,71 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: nat.mli,v 1.10 2002/03/14 20:12:54 xleroy Exp $ *) - -(* 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" -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_stubs.c b/otherlibs/num/nat_stubs.c deleted file mode 100644 index 36d004ff..00000000 --- a/otherlibs/num/nat_stubs.c +++ /dev/null @@ -1,334 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: nat_stubs.c,v 1.12 2001/12/07 13:40:16 xleroy Exp $ */ - -#define CAML_LIGHT -#include "alloc.h" -#include "custom.h" -#include "intext.h" -#include "fail.h" -#include "memory.h" -#include "mlvalues.h" -#include "nat.h" - -#include "BigNum.h" -#include "BntoBnn.h" - -/* Stub code for the BigNum package. */ - -static void serialize_nat(value, unsigned long *, unsigned long *); -static unsigned long deserialize_nat(void * dst); - -static struct custom_operations nat_operations = { - "_nat", - custom_finalize_default, - custom_compare_default, - custom_hash_default, - serialize_nat, - deserialize_nat -}; - -CAMLprim value initialize_nat(value unit) -{ - register_custom_operations(&nat_operations); - return Val_unit; -} - -CAMLprim value create_nat(value size) -{ - mlsize_t sz = Long_val(size); - - return alloc_custom(&nat_operations, sz * sizeof(value), 0, 1); -} - -CAMLprim value length_nat(value nat) -{ - return Val_long(Wosize_val(nat) - 1); -} - -CAMLprim value set_to_zero_nat(value nat, value ofs, value len) -{ - BnSetToZero(Bignum_val(nat), Long_val(ofs), Long_val(len)); - return Val_unit; -} - -CAMLprim value blit_nat(value nat1, value ofs1, value nat2, value ofs2, value len) -{ - BnAssign(Bignum_val(nat1), Long_val(ofs1), - Bignum_val(nat2), Long_val(ofs2), - Long_val(len)); - return Val_unit; -} - -CAMLprim value set_digit_nat(value nat, value ofs, value digit) -{ - BnSetDigit(Bignum_val(nat), Long_val(ofs), Long_val(digit)); - return Val_unit; -} - -CAMLprim value nth_digit_nat(value nat, value ofs) -{ - return Val_long(BnGetDigit(Bignum_val(nat), Long_val(ofs))); -} - -CAMLprim value num_digits_nat(value nat, value ofs, value len) -{ - return Val_long(BnNumDigits(Bignum_val(nat), Long_val(ofs), Long_val(len))); -} - -CAMLprim value num_leading_zero_bits_in_digit(value nat, value ofs) -{ - return - Val_long(BnNumLeadingZeroBitsInDigit(Bignum_val(nat), Long_val(ofs))); -} - -CAMLprim value is_digit_int(value nat, value ofs) -{ - return Val_bool(BnDoesDigitFitInWord(Bignum_val(nat), Long_val(ofs))); -} - -CAMLprim value is_digit_zero(value nat, value ofs) -{ - return Val_bool(BnIsDigitZero(Bignum_val(nat), Long_val(ofs))); -} - -CAMLprim value is_digit_normalized(value nat, value ofs) -{ - return Val_bool(BnIsDigitNormalized(Bignum_val(nat), Long_val(ofs))); -} - -CAMLprim value is_digit_odd(value nat, value ofs) -{ - return Val_bool(BnIsDigitOdd(Bignum_val(nat), Long_val(ofs))); -} - -CAMLprim value incr_nat(value nat, value ofs, value len, value carry_in) -{ - return Val_long(BnAddCarry(Bignum_val(nat), Long_val(ofs), - Long_val(len), Long_val(carry_in))); -} - -value add_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value carry_in) -{ - return Val_long(BnAdd(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(len2), - Long_val(carry_in))); -} - -CAMLprim value add_nat(value *argv, int argn) -{ - return add_nat_native(argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6]); -} - -CAMLprim value complement_nat(value nat, value ofs, value len) -{ - BnComplement(Bignum_val(nat), Long_val(ofs), Long_val(len)); - return Val_unit; -} - -CAMLprim value decr_nat(value nat, value ofs, value len, value carry_in) -{ - return Val_long(BnSubtractBorrow(Bignum_val(nat), Long_val(ofs), - Long_val(len), Long_val(carry_in))); -} - -value sub_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value carry_in) -{ - return Val_long(BnSubtract(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(len2), - Long_val(carry_in))); -} - -CAMLprim value sub_nat(value *argv, int argn) -{ - return sub_nat_native(argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6]); -} - -value mult_digit_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value nat3, value ofs3) -{ - return - Val_long(BnMultiplyDigit(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(len2), - Bignum_val(nat3), Long_val(ofs3))); -} - -CAMLprim value mult_digit_nat(value *argv, int argn) -{ - return mult_digit_nat_native(argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6], argv[7]); -} - -value mult_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value nat3, value ofs3, value len3) -{ - return - Val_long(BnMultiply(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(len2), - Bignum_val(nat3), Long_val(ofs3), Long_val(len3))); -} - -CAMLprim value mult_nat(value *argv, int argn) -{ - return mult_nat_native(argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6], argv[7], argv[8]); -} - -value shift_left_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value nbits) -{ - BnShiftLeft(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(nbits)); - return Val_unit; -} - -CAMLprim value shift_left_nat(value *argv, int argn) -{ - return shift_left_nat_native(argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5]); -} - -value div_digit_nat_native(value natq, value ofsq, value natr, value ofsr, value nat1, value ofs1, value len1, value nat2, value ofs2) -{ - BnDivideDigit(Bignum_val(natq), Long_val(ofsq), - Bignum_val(natr), Long_val(ofsr), - Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2)); - return Val_unit; -} - -CAMLprim value div_digit_nat(value *argv, int argn) -{ - return div_digit_nat_native(argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6], argv[7], argv[8]); -} - -value div_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2) -{ - BnDivide(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(len2)); - return Val_unit; -} - -CAMLprim value div_nat(value *argv, int argn) -{ - return div_nat_native(argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5]); -} - -value shift_right_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value nbits) -{ - BnShiftRight(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(nbits)); - return Val_unit; -} - -CAMLprim value shift_right_nat(value *argv, int argn) -{ - return shift_right_nat_native(argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5]); -} - -CAMLprim value compare_digits_nat(value nat1, value ofs1, value nat2, value ofs2) -{ - return Val_long(BnCompareDigits(Bignum_val(nat1), Long_val(ofs1), - Bignum_val(nat2), Long_val(ofs2))); -} - -value compare_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2) -{ - return Val_long(BnCompare(Bignum_val(nat1), Long_val(ofs1), Long_val(len1), - Bignum_val(nat2), Long_val(ofs2), Long_val(len2))); -} - -CAMLprim value compare_nat(value *argv, int argn) -{ - return compare_nat_native(argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5]); -} - -CAMLprim value land_digit_nat(value nat1, value ofs1, value nat2, value ofs2) -{ - BnAndDigits(Bignum_val(nat1), Long_val(ofs1), - Bignum_val(nat2), Long_val(ofs2)); - return Val_unit; -} - -CAMLprim value lor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) -{ - BnOrDigits(Bignum_val(nat1), Long_val(ofs1), - Bignum_val(nat2), Long_val(ofs2)); - return Val_unit; -} - -CAMLprim value lxor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) -{ - BnXorDigits(Bignum_val(nat1), Long_val(ofs1), - Bignum_val(nat2), Long_val(ofs2)); - return Val_unit; -} - -/* The wire format for a nat is: - - 32-bit word: number of 32-bit words in nat - - N 32-bit words (big-endian format) - For little-endian platforms, the memory layout between 32-bit and 64-bit - machines is identical, so we can write the nat using serialize_block_4. - For big-endian 64-bit platforms, we need to swap the two 32-bit halves - of 64-bit words to obtain the correct behavior. */ - -static void serialize_nat(value nat, - unsigned long * wsize_32, - unsigned long * wsize_64) -{ - mlsize_t len = Wosize_val(nat) - 1; - -#ifdef ARCH_SIXTYFOUR - len = len * 2; /* two 32-bit words per 64-bit digit */ - if (len >= (1L << 32)) - failwith("output_value: nat too big"); -#endif - serialize_int_4((int32) len); -#if defined(ARCH_SIXTYFOUR) && defined(ARCH_BIG_ENDIAN) - { int32 * p; - mlsize_t i; - for (i = len, p = Data_custom_val(nat); i > 0; i -= 2, p += 2) { - serialize_int_4(p[1]); /* low 32 bits of 64-bit digit */ - serialize_int_4(p[0]); /* high 32 bits of 64-bit digit */ - } - } -#else - serialize_block_4(Data_custom_val(nat), len); -#endif - *wsize_32 = len * 4; - *wsize_64 = len * 4; -} - -static unsigned long deserialize_nat(void * dst) -{ - mlsize_t len; - - len = deserialize_uint_4(); -#if defined(ARCH_SIXTYFOUR) && defined(ARCH_BIG_ENDIAN) - { uint32 * p; - mlsize_t i; - for (i = len, p = dst; i > 0; i -= 2, p += 2) { - p[1] = deserialize_uint_4(); /* low 32 bits of 64-bit digit */ - p[0] = deserialize_uint_4(); /* high 32 bits of 64-bit digit */ - } - } -#else - deserialize_block_4(dst, len); -#endif - return len * 4; -} - diff --git a/otherlibs/num/num.ml b/otherlibs/num/num.ml deleted file mode 100644 index cdbeb07d..00000000 --- a/otherlibs/num/num.ml +++ /dev/null @@ -1,396 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: num.ml,v 1.6 2001/12/07 13:40:16 xleroy Exp $ *) - -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 - -let 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) - -(* 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)) -> num_of_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)) -> - num_of_ratio (mult_int_ratio i r) - | ((Ratio r), (Int i)) -> - num_of_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)) -> - num_of_ratio (mult_big_int_ratio bi r) - | ((Ratio r), (Big_int bi)) -> - num_of_ratio (mult_big_int_ratio bi r) - - | ((Ratio r1), (Ratio r2)) -> - num_of_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 n1 n2 = - match n1 with - | Int i1 -> - begin match n2 with - | Int i2 -> - num_of_ratio (create_ratio (big_int_of_int i1) (big_int_of_int i2)) - | Big_int bi2 -> num_of_ratio (create_ratio (big_int_of_int i1) bi2) - | Ratio r2 -> num_of_ratio (div_int_ratio i1 r2) end - - | Big_int bi1 -> - begin match n2 with - | Int i2 -> num_of_ratio (create_ratio bi1 (big_int_of_int i2)) - | Big_int bi2 -> num_of_ratio (create_ratio bi1 bi2) - | Ratio r2 -> num_of_ratio (div_big_int_ratio bi1 r2) end - - | Ratio r1 -> - begin match n2 with - | Int i2 -> num_of_ratio (div_ratio_int r1 i2) - | Big_int bi2 -> num_of_ratio (div_ratio_big_int r1 bi2) - | Ratio r2 -> num_of_ratio (div_ratio r1 r2) end -;; - -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 ( / ) = 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;; - -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 deleted file mode 100644 index cd4d8ea2..00000000 --- a/otherlibs/num/num.mli +++ /dev/null @@ -1,171 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: num.mli,v 1.8 2001/12/28 23:15:23 guesdon Exp $ *) - -(** Operation on arbitrary-precision numbers. - - Numbers (type [num]) are arbitrary-precision rational numbers, - plus the special elements [1/0] (infinity) and [0/0] (undefined). -*) - -open Nat -open Big_int -open Ratio - -(** The type of numbers. *) -type num = - Int of int - | Big_int of big_int - | Ratio of ratio - - -(** {6 Arithmetic operations} *) - - -val ( +/ ) : num -> num -> num -(** Same as {!Num.add_num}.*) - -val add_num : num -> num -> num -(** Addition *) - -val minus_num : num -> num -(** Unary negation. *) - -val ( -/ ) : num -> num -> num -(** Same as {!Num.sub_num}.*) - -val sub_num : num -> num -> num -(** Subtraction *) - -val ( */ ) : num -> num -> num -(** Same as {!Num.mult_num}.*) - -val mult_num : num -> num -> num -(** Multiplication *) - -val square_num : num -> num -(** Squaring *) - -val ( // ) : num -> num -> num -(** Same as {!Num.div_num}.*) - -val div_num : num -> num -> num -(** Division *) - -val quo_num : num -> num -> num -(** Euclidean division: quotient. *) - -val mod_num : num -> num -> num -(** Euclidean division: remainder. *) - -val ( **/ ) : num -> num -> num -(** Same as {!Num.power_num}. *) - -val power_num : num -> num -> num -(** Exponentiation *) - -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. *) - -val is_integer_num : num -> bool -(** Test if a number is an integer *) - -(** The four following functions approximate a number by an integer : *) - -val integer_num : num -> num -(** [integer_num n] returns the integer closest to [n]. In case of ties, - rounds towards zero. *) - -val floor_num : num -> num -(** [floor_num n] returns the largest integer smaller or equal to [n]. *) - -val round_num : num -> num -(** [round_num n] returns the integer closest to [n]. In case of ties, - rounds off zero. *) - -val ceiling_num : num -> num -(** [ceiling_num n] returns the smallest integer bigger or equal to [n]. *) - - -val sign_num : num -> int -(** Return [-1], [0] or [1] according to the sign of the argument. *) - -(** {7 Comparisons between numbers} *) - -val ( =/ ) : num -> num -> bool -val ( 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 - -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 -(** Return the greater of the two arguments. *) - -val min_num : num -> num -> num -(** Return the smaller of the two arguments. *) - - -(** {6 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 -(** See {!Num.approx_num_exp}.*) - -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. {!Num.approx_num_fix} uses decimal notation; the first - argument is the number of digits after the decimal point. - [approx_num_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. *) - -(** {6 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 deleted file mode 100644 index 50023642..00000000 --- a/otherlibs/num/ratio.ml +++ /dev/null @@ -1,577 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -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 *) - -(* Compares strings that contains only digits, have the same length, - from index i to index i + l *) -let rec compare_num_string s1 s2 i len = - if i >= len then 0 else - let c1 = int_of_char s1.[i] - and c2 = int_of_char s2.[i] in - match compare_int c1 c2 with - | 0 -> compare_num_string s1 s2 (succ i) len - | c -> c;; - -(* 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 *) - -(* Tests if s has only zeros characters from index i to index lim *) -let rec only_zeros s i lim = - i >= lim || s.[i] == '0' && only_zeros s (succ i) lim;; - -(* 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 size_min = min size_num size_den in - let m = size_num - size_den in - let cmp = compare_num_string str_num str_den 0 size_min in - match cmp with - | 1 -> m - | -1 -> pred m - | _ -> - if m >= 0 then m else - if only_zeros str_den size_min size_den then m - else pred m - 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 deleted file mode 100644 index d6c2aff2..00000000 --- a/otherlibs/num/ratio.mli +++ /dev/null @@ -1,88 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: ratio.mli,v 1.4 2001/12/07 13:40:16 xleroy Exp $ *) - -(* 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 deleted file mode 100644 index e19e46eb..00000000 --- a/otherlibs/num/string_misc.ml +++ /dev/null @@ -1,20 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: string_misc.ml,v 1.4 2001/12/07 13:40:16 xleroy Exp $ *) - -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 deleted file mode 100644 index 079c951e..00000000 --- a/otherlibs/num/string_misc.mli +++ /dev/null @@ -1,16 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id: string_misc.mli,v 1.4 2001/12/07 13:40:17 xleroy Exp $ *) - -val index_char: string -> char -> int -> int diff --git a/otherlibs/num/test/.depend b/otherlibs/num/test/.depend deleted file mode 100644 index 28fea1f5..00000000 --- a/otherlibs/num/test/.depend +++ /dev/null @@ -1,10 +0,0 @@ -end_test.cmo: test.cmo -end_test.cmx: test.cmx -test_big_ints.cmo: test.cmo -test_big_ints.cmx: test.cmx -test_nats.cmo: test.cmo -test_nats.cmx: test.cmx -test_nums.cmo: test.cmo -test_nums.cmx: test.cmx -test_ratios.cmo: test.cmo -test_ratios.cmx: test.cmx diff --git a/otherlibs/num/test/Makefile b/otherlibs/num/test/Makefile deleted file mode 100644 index 0d188b4d..00000000 --- a/otherlibs/num/test/Makefile +++ /dev/null @@ -1,56 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Xavier Leroy, projet Cristal, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../../LICENSE.# -# # -######################################################################### - -# $Id: Makefile,v 1.8 2001/12/07 13:40:17 xleroy Exp $ - -include ../../../config/Makefile - -CAMLC=../../../boot/ocamlrun ../../../ocamlc -I ../../../stdlib -CAMLOPT=../../../boot/ocamlrun ../../../ocamlopt -I ../../../stdlib - -test: test.byt test.opt - if $(SUPPORTS_SHARED_LIBRARIES); then ../../../byterun/ocamlrun -I .. ./test.byt; else ./test.byt; fi - ./test.opt - -TESTFILES=test.cmo \ - test_nats.cmo test_big_ints.cmo test_ratios.cmo test_nums.cmo \ - test_io.cmo end_test.cmo - -TESTOPTFILES=$(TESTFILES:.cmo=.cmx) - -test.byt: $(TESTFILES) ../nums.cma ../libnums.a - $(CAMLC) -ccopt -L.. -o test.byt ../nums.cma $(TESTFILES) - -test.opt: $(TESTOPTFILES) ../nums.cmxa ../libnums.a - $(CAMLOPT) -ccopt -L.. -o test.opt ../nums.cmxa $(TESTOPTFILES) - -$(TESTOPTFILES): ../../../ocamlopt - -.SUFFIXES: .ml .cmo .cmx - -.ml.cmo: - $(CAMLC) -I .. -c $< - -.ml.cmx: - $(CAMLOPT) -I .. -c $< - -ocamlnum: - ocamlmktop -o ocamlnum -custom ../nums.cma ../libnums.a - -clean: - rm -f test.byt test.opt *.o *.cm? ocamlnum - -depend: - ocamldep *.ml > .depend - -include .depend diff --git a/otherlibs/num/test/Makefile.Mac b/otherlibs/num/test/Makefile.Mac deleted file mode 100644 index c9111c9f..00000000 --- a/otherlibs/num/test/Makefile.Mac +++ /dev/null @@ -1,40 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Damien Doligez, projet Para, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../../LICENSE.# -# # -######################################################################### - -# $Id: Makefile.Mac,v 1.6 2001/12/07 13:40:17 xleroy Exp $ - -CAMLC = ::::boot:ocamlrun ::::ocamlc -I ::::stdlib: -CAMLOPT = ::::boot:ocamlrun ::::ocamlopt -I ::::stdlib: - -test Ä test.byt - :test.byt - -TESTFILES = test.cmo test_nats.cmo test_big_ints.cmo ¶ - test_ratios.cmo test_nums.cmo test_io.cmo end_test.cmo - -test.byt Ä {TESTFILES} ::nums.cma ::libnums.o - alias ocamlc "{CAMLC}" - ::::tools:ocamlc-custom -o test.byt ::nums.cma {TESTFILES} ::libnums.[ox] - -.cmo Ä .ml - {CAMLC} -I :: -c {default}.ml - -ocamlnum Ä - ocamlmktop -o ocamlnum -custom ::nums.cma ::libnums.[ox] - -clean Ä - delete -i test.byt ocamlnum - delete -i Å.cm[io] || set status 0 - -depend Ä - ocamldep Å.ml > Makefile.Mac.depend diff --git a/otherlibs/num/test/Makefile.Mac.depend b/otherlibs/num/test/Makefile.Mac.depend deleted file mode 100644 index bda141c0..00000000 --- a/otherlibs/num/test/Makefile.Mac.depend +++ /dev/null @@ -1,10 +0,0 @@ -end_test.cmoÄ test.cmo -end_test.cmxÄ test.cmx -test_big_ints.cmoÄ test.cmo -test_big_ints.cmxÄ test.cmx -test_nats.cmoÄ test.cmo -test_nats.cmxÄ test.cmx -test_nums.cmoÄ test.cmo -test_nums.cmxÄ test.cmx -test_ratios.cmoÄ test.cmo -test_ratios.cmxÄ test.cmx diff --git a/otherlibs/num/test/Makefile.nt b/otherlibs/num/test/Makefile.nt deleted file mode 100644 index a0a9fda4..00000000 --- a/otherlibs/num/test/Makefile.nt +++ /dev/null @@ -1,54 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Xavier Leroy, projet Cristal, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../../LICENSE.# -# # -######################################################################### - -# $Id: Makefile.nt,v 1.7 2002/06/07 13:31:21 xleroy Exp $ - -CAMLC=../../../boot/ocamlrun ../../../ocamlc -I ../../../stdlib -I .. -CAMLOPT=../../../boot/ocamlrun ../../../ocamlopt -I ../../../stdlib -I .. - -test: test.byt test.opt - ../../../byterun/ocamlrun -I .. ./test.byt - ./test.opt - -TESTFILES=test.cmo \ - test_nats.cmo test_big_ints.cmo test_ratios.cmo test_nums.cmo \ - test_io.cmo end_test.cmo - -TESTOPTFILES=$(TESTFILES:.cmo=.cmx) - -test.byt: $(TESTFILES) ../nums.cma ../libnums.lib - $(CAMLC) -o test.byt nums.cma $(TESTFILES) - -test.opt: $(TESTOPTFILES) ../nums.cmxa ../libnums.lib - $(CAMLOPT) -o test.opt nums.cmxa $(TESTOPTFILES) - -$(TESTOPTFILES): ../../../ocamlopt - -.SUFFIXES: .ml .cmo .cmx - -.ml.cmo: - $(CAMLC) -c $< - -.ml.cmx: - $(CAMLOPT) -c $< - -ocamltopnum.exe: - ocamlmktop -o ocamltopnum.exe -custom ../nums.cma ../libnums.$(A) - -clean: - rm -f test.byt test.opt *.$(O) *.cm? ocamltopnum.exe - -depend: - ocamldep *.ml > .depend - -include .depend diff --git a/otherlibs/num/test/end_test.ml b/otherlibs/num/test/end_test.ml deleted file mode 100644 index 57e099ed..00000000 --- a/otherlibs/num/test/end_test.ml +++ /dev/null @@ -1 +0,0 @@ -Test.end_tests ();; diff --git a/otherlibs/num/test/test.ml b/otherlibs/num/test/test.ml deleted file mode 100644 index 8426e0ae..00000000 --- a/otherlibs/num/test/test.ml +++ /dev/null @@ -1,77 +0,0 @@ -open Printf;; - -let flush_all () = flush stdout; flush stderr;; - -let message s = print_string s; print_newline ();; - -let error_occurred = ref false;; -let immediate_failure = ref true;; - -let error () = - if !immediate_failure then exit 2 else begin - error_occurred := true; flush_all (); false - end;; - -let success () = flush_all (); true;; - -let function_tested = ref "";; - -let testing_function s = - flush_all (); - function_tested := s; - print_newline(); - message s;; - -let test test_number eq_fun (answer, correct_answer) = - flush_all (); - if not (eq_fun answer correct_answer) then begin - fprintf stderr ">>> Bad result (%s, test %d)\n" !function_tested test_number; - error () - end else begin - printf " %d..." test_number; - success () - end;; - -let failure_test test_number fun_to_test arg = - flush_all (); - try - fun_to_test arg; - fprintf stderr ">>> Failure expected (%s, test %d)\n" - !function_tested test_number; - error () - with _ -> - printf " %d..." test_number; - success ();; - -let failwith_test test_number fun_to_test arg correct_failure = - flush_all (); - try - fun_to_test arg; - fprintf stderr ">>> Failure expected (%s, test %d)\n" - !function_tested test_number; - error () - with x -> - if x = correct_failure then begin - printf " %d..." test_number; - success () - end else begin - fprintf stderr ">>> Bad failure (%s, test %d)\n" - !function_tested test_number; - error () - end;; - -let end_tests () = - flush_all (); - print_newline (); - if !error_occurred then begin - prerr_endline "************* TESTS FAILED ****************"; exit 2 - end else begin - prerr_endline "************* TESTS COMPLETED SUCCESSFULLY ****************"; - exit 0 - end;; - -let eq = (==);; -let eq_int = (==);; -let eq_string = (=);; - -let sixtyfour = (1 lsl 31) <> 0;; diff --git a/otherlibs/num/test/test_big_ints.ml b/otherlibs/num/test/test_big_ints.ml deleted file mode 100644 index 61e9ae4d..00000000 --- a/otherlibs/num/test/test_big_ints.ml +++ /dev/null @@ -1,468 +0,0 @@ -open Test;; -open Nat;; -open Big_int;; -open Int_misc;; -open List;; - -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 - let _ = - test i eq - (int_of_big_int (gcd_big_int (big_int_of_int n1) (big_int_of_int n2)), - gcd_int n1 n2) in - () -done;; - -testing_function "int_of_big_int";; - -test 1 -eq_int (int_of_big_int (big_int_of_int 1), 1);; - - -testing_function "is_int_big_int";; - -test 1 -eq (is_int_big_int (big_int_of_int 1), true);; -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);; -test 4 -eq (int_of_big_int (big_int_of_int monster_int), monster_int);; -(* Should be true *) -test 5 -eq (is_int_big_int (big_int_of_string (string_of_int biggest_int)), true);; -test 6 -eq (is_int_big_int (big_int_of_string (string_of_int least_int)), true);; -test 7 -eq (is_int_big_int (big_int_of_string (string_of_int monster_int)), true);; - -(* Should be false *) -(* Successor of biggest_int is not an int *) -test 8 -eq (is_int_big_int (succ_big_int (big_int_of_int (biggest_int))), false);; -test 9 -eq (is_int_big_int - (succ_big_int (succ_big_int (big_int_of_int (biggest_int)))), false);; -(* Negation of monster_int (as a big_int) is not an int *) -test 10 -eq (is_int_big_int - (minus_big_int (big_int_of_string (string_of_int monster_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 = 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 (rev l)) in - -let bi2 = big_int_of_string (implode (rev ("3" :: 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"))) -(* test 11 - && -eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "10e0")) - (big_int_of_string "20e-1"))) && -test 12 -eq_big_int (minus_big_int bi1, - (add_big_int (mult_big_int bi2 (big_int_of_string "-10e0")) - (big_int_of_string "-20e-1"))) && -test 13 -eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "+10e0")) - (big_int_of_string "+20e-1"))) && -test 14 -eq_big_int (minus_big_int bi1, - (add_big_int (mult_big_int bi2 (big_int_of_string "-10e+0")) - (big_int_of_string "-20e-1"))) && -test 15 -eq_big_int (minus_big_int bi1, - (add_big_int (mult_big_int bi2 (big_int_of_string "-1e+1")) - (big_int_of_string "-2e-0"))) && -test 16 -eq_big_int (minus_big_int bi1, - (add_big_int (mult_big_int bi2 (big_int_of_string "-0.1e+2")) - (big_int_of_string "-2.0e-0"))) && -test 17 -eq_big_int (minus_big_int bi1, - (add_big_int (mult_big_int bi2 (big_int_of_string "-1.000e+1")) - (big_int_of_string "-0.02e2")))*) -;; - -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 (length_of_int + 2)), - 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) -;; - -testing_function "power_int_positive_big_int";; - -test 1 -eq_big_int (power_int_positive_big_int 2 (big_int_of_int 10), - big_int_of_int 1024);; -test 2 -eq_big_int - (power_int_positive_big_int 2 (big_int_of_int 65), - big_int_of_string "36893488147419103232");; - -test 3 -eq_big_int - (power_int_positive_big_int 3 (big_int_of_string "47"), - big_int_of_string "26588814358957503287787");; - - -testing_function "power_big_int_positive_big_int";; - -test 1 -eq_big_int - (power_big_int_positive_big_int (big_int_of_int 2) (big_int_of_int 10), - big_int_of_int 1024);; - -test 2 -eq_big_int - (power_big_int_positive_big_int (big_int_of_int 2) (big_int_of_int 65), - big_int_of_string "36893488147419103232");; - -test 3 -eq_big_int - (power_big_int_positive_big_int - (big_int_of_string "3") (big_int_of_string "47"), - big_int_of_string "26588814358957503287787");; - -testing_function "square_big_int";; - -test 1 eq_big_int - (square_big_int (big_int_of_string "0"), big_int_of_string "0");; -test 2 eq_big_int - (square_big_int (big_int_of_string "1"), big_int_of_string "1");; -test 3 eq_big_int - (square_big_int (big_int_of_string "-1"), big_int_of_string "1");; -test 4 eq_big_int - (square_big_int (big_int_of_string "-7"), big_int_of_string "49");; diff --git a/otherlibs/num/test/test_io.ml b/otherlibs/num/test/test_io.ml deleted file mode 100644 index 1df11a5f..00000000 --- a/otherlibs/num/test/test_io.ml +++ /dev/null @@ -1,64 +0,0 @@ -open Test -open Nat -open Big_int -open Num - -let intern_extern obj = - let f = Filename.temp_file "testnum" ".data" in - let oc = open_out_bin f in - output_value oc obj; - close_out oc; - let ic = open_in_bin f in - let res = input_value ic in - close_in ic; - Sys.remove f; - res -;; - -testing_function "output_value/input_value on nats";; - -let equal_nat n1 n2 = - eq_nat n1 0 (length_nat n1) n2 0 (length_nat n2) -;; - -List.iter - (fun (i, s) -> - let n = nat_of_string s in - ignore(test i equal_nat (n, intern_extern n))) - [1, "0"; - 2, "1234"; - 3, "8589934592"; - 4, "340282366920938463463374607431768211455"; - 5, String.make 100 '3'; - 6, String.make 1000 '9'; - 7, String.make 20000 '8'] -;; - -testing_function "output_value/input_value on big ints";; - -List.iter - (fun (i, s) -> - let b = big_int_of_string s in - ignore(test i eq_big_int (b, intern_extern b))) - [1, "0"; - 2, "1234"; - 3, "-1234"; - 4, "1040259735709286400"; - 5, "-" ^ String.make 20000 '7'] -;; - -testing_function "output_value/input_value on nums";; - -List.iter - (fun (i, s) -> - let n = num_of_string s in - ignore(test i eq_num (n, intern_extern n))) - [1, "0"; - 2, "1234"; - 3, "-1234"; - 4, "159873568791325097646845892426782"; - 5, "1/4"; - 6, "-15/2"; - 7, "159873568791325097646845892426782/24098772507410987265987"; - 8, String.make 10000 '3' ^ "/" ^ String.make 5000 '7'] -;; diff --git a/otherlibs/num/test/test_nats.ml b/otherlibs/num/test/test_nats.ml deleted file mode 100644 index bfb26f10..00000000 --- a/otherlibs/num/test/test_nats.ml +++ /dev/null @@ -1,142 +0,0 @@ -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 -;; - -testing_function "sqrt_nat";; - -test 1 equal_nat (sqrt_nat (nat_of_int 1) 0 1, nat_of_int 1);; -test 2 equal_nat (let n = nat_of_string "8589934592" in - sqrt_nat n 0 (length_nat n), - nat_of_string "92681");; -test 3 equal_nat (let n = nat_of_string "4294967295" in - sqrt_nat n 0 (length_nat n), - nat_of_string "65535");; -test 4 equal_nat (let n = nat_of_string "18446744065119617025" in - sqrt_nat n 0 (length_nat n), - nat_of_string "4294967295");; -test 5 equal_nat (sqrt_nat (nat_of_int 15) 0 1, - nat_of_int 3);; diff --git a/otherlibs/num/test/test_nums.ml b/otherlibs/num/test/test_nums.ml deleted file mode 100644 index 42428580..00000000 --- a/otherlibs/num/test/test_nums.ml +++ /dev/null @@ -1,220 +0,0 @@ -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 deleted file mode 100644 index 45fdce8b..00000000 --- a/otherlibs/num/test/test_ratios.ml +++ /dev/null @@ -1,928 +0,0 @@ -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");;