# Configuration for the libraries
-otherlibraries="unix str num dynlink bigarray"
+otherlibraries="unix str dynlink bigarray"
# For the Unix library
-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)
../otherlibs/unix/unix.mli \
../otherlibs/str/str.mli \
../otherlibs/bigarray/bigarray.mli \
- ../otherlibs/num/num.mli
all: exe lib manpages
exe: $(OCAMLDOC)
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 \
+++ /dev/null
-libnums.x
-*.c.x
-so_locations
+++ /dev/null
-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
+++ /dev/null
-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
+++ /dev/null
-#########################################################################
-# #
-# 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
+++ /dev/null
-#########################################################################
-# #
-# 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
+++ /dev/null
-#*** 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
+++ /dev/null
-#########################################################################
-# #
-# 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
+++ /dev/null
-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 <options> 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 <options> 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.
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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;;
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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 <your choice>)";
- print_newline ();
- print_newline ();
-
- arith_print_string
- "Normalization when printing";
- arith_print_bool (get_normalize_ratio_when_printing ());
- print_newline ();
- print_string
- " (returned by get_normalize_ratio_when_printing ())";
- print_newline ();
- print_string
- " (modifiable with set_normalize_ratio_when_printing <your choice>)";
- print_newline ();
- print_newline ();
-
- arith_print_string
- "Floating point approximation when printing rational numbers";
- arith_print_bool (get_approx_printing ());
- print_newline ();
- print_string
- " (returned by get_approx_printing ())";
- print_newline ();
- print_string
- " (modifiable with set_approx_printing <your choice>)";
- print_newline ();
- (if (get_approx_printing ())
- then (print_string " Default precision = ";
- print_int (get_floating_precision ());
- print_newline ();
- print_string " (returned by get_floating_precision ())";
- print_newline ();
- print_string
- " (modifiable with set_floating_precision <your choice>)";
- print_newline ();
- print_newline ())
- else print_newline());
-
- arith_print_string
- "Error when a rational denominator is null";
- arith_print_bool (get_error_when_null_denominator ());
- print_newline ();
- print_string " (returned by get_error_when_null_denominator ())";
- print_newline ();
- print_string
- " (modifiable with set_error_when_null_denominator <your choice>)";
- print_newline ()
-;;
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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. *)
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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)))
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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
+++ /dev/null
-libbignum.x
+++ /dev/null
-# Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1992
-# Last modified_on Tue Nov 3 13:44:57 1992 by shand
-# modified_on Fri May 31 18:26:52 GMT+2:00 1991 by herve
-# modified_on Thu Nov 2 14:23:14 GMT+1:00 1989 by gangnet
-# modified_on Wed Jul 5 10:23:54 GMT+2:00 1989 by bertin
-
-CC = cc
-AR = ar
-RANLIB = ranlib
-RANLIBTEST=test -f /usr/bin/ranlib -o -f /bin/ranlib
-LIB = libbignum.a
-OBJECT = o/KerN.o o/bnInit.o o/bnMult.o o/bnDivide.o o/bnCmp.o o/bzf.o o/bz.o
-KERNH = h/BigNum.h
-CFLAGS = -c -I./h -O -DCAML_LIGHT
-LDFLAGS =
-
-# extra entries:
-# all - make all the stuff
-# tidy - cleanup directories
-# scratch - start from scratch
-
-default:
- @echo "Usage: make <version>"
- @echo "see README for valid versions."
- @sh -c 'exit 1'
-
-#all: testKerN bztest
-# @echo All is done
-
-#all: $(LIB)
-# @echo All is done
-
-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" \
- <introtobn > bignum.00.shar
- rm -f introtobn _flist[1-9]
-
-# build shell archives of the beta version
-
-# If you modify the list of files in the package betakit, don't forget
-# to update betaREADME.
-
-BETAKIT= $(KIT) c/br.c c/brtest.c h/BigR.h
-
-# note we replace README by betaREADME and doc/intro by doc/betaintro
-# such that the filename will be README and doc/intro in the archive,
-betabignum01: $(BETAKIT) betaREADME doc/betaintro
- mv README README.cur
- cp betaREADME README
- mv doc/intro doc/intro.cur
- cp doc/betaintro doc/intro
- makekit -s$(PACKET_SIZE)k -n$(PREFIX) -t"Now do 'make'" $(DIRS) $(BETAKIT)
- mv README.cur README
- mv doc/intro.cur doc/intro
-
-
-# send shell archives
-SENDMAIL=/usr/lib/sendmail
-SENDMAILFLAGS=
-USER=nil
-FULLNAME=nil
-COPY=librarian@prl.dec.com
-VERSION= # the version you want to mail, could be empty (current release) or "beta"
-
-
-mail: $(VERSION)bignum.01.shar bignum.00.shar # do bignum00 AFTER !!
- @sh -c "if [ x$(USER) = xnil -o 'x$(FULLNAME)' = xnil ]; \
- then echo must specify USER and FULLNAME; \
- echo EG make USER=herve@prl FULLNAME="'\"'"J-C Herve, Digital PRL"'\"'" mail; exit 1; \
- else :; fi"
- @touch Recipients
- @echo '' >> Recipients
- @date >> Recipients
- @echo "$(FULLNAME)" >> Recipients
- @echo '<'"$(USER)"'>' >> Recipients
- @echo "To: $(COPY)" >tosend
- @echo "Subject: BIGNUM DAEMON" >>tosend
- @echo "Jean-Christophe, I have sent the package bignum to:" >>tosend
- @echo >>tosend
- @echo " $(FULLNAME)" >>tosend
- @echo " $(USER)" >>tosend
- @echo >>tosend
- @echo "Thanks to register this address in your distribution list." >>tosend
- @$(SENDMAIL) $(SENDMAILFLAGS) $(COPY) <tosend
- echo To: $(USER) > sendmail_header
- cp sendmail_header tosend
- echo "Subject: BigNum package from Digital PRL" >>tosend
- cat bignum.00.shar >>tosend
- rm -f bignum.00.shar
- $(SENDMAIL) $(SENDMAILFLAGS) $(USER) <tosend
- for i in `ls bignum.[0-9][0-9].shar`; \
- do cp sendmail_header tosend; \
- echo $$i | sed -e "s/^bignum0*/Subject: BigNum - Part /" >>tosend; \
- echo "# Remove all text above and including this line." >>tosend; \
- sed -e "s/modified_on/modified_on/g" <$$i >>tosend; \
- $(SENDMAIL) $(SENDMAILFLAGS) $(USER) <tosend; \
- done
- rm -f sendmail_header tosend bignum.[0-9][0-9].shar
-
+++ /dev/null
-# Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1992
-
-PPCC = mrc
-PPCCOptions = -i :h: -d CAML_LIGHT -w 30 {cdbgflag}
-PPCLinkOptions = {ldbgflag}
-PPCLibs = "{sharedlibraries}MathLib" "{ppclibraries}PPCCRuntime.o" ¶
- "{ppclibraries}PPCToolLibs.o" "{sharedlibraries}StdCLib" ¶
- "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib"
-
-PPCLIB = libbignum.x
-PPCOBJECT = :o:KerN.x :o:bnInit.x :o:bnMult.x :o:bnDivide.x :o:bnCmp.x ¶
- :o:bzf.x :o:bz.x
-
-KERNH = :h:BigNum.h
-
-# extra entries:
-# all - make all the stuff
-# tidy - cleanup directories
-# scratch - start from scratch
-
-default Ä
- echo "Usage: make <version>"
- echo "see README for valid versions."
-
-#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}
+++ /dev/null
-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)
-
+++ /dev/null
-
-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.
+++ /dev/null
-/* 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.
- *
- */
-
-
-/*\f*/
-
-#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);
- }
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
- /************** 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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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;
-}
-
- /***************************************/
-/*\f*/
-
- /****************** 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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
- /******************* 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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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));
-}
-
- /***************************************/
-/*\f*/
-
- /****************** 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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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)); }
-
-
- /***************************************/
-/*\f */
-
- /***************** 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 */
-
-
- /***************************************/
-/*\f*/
-
- /********************** 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);
- }
-}
-
- /***************************************/
-
-
+++ /dev/null
-/* 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)));
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-******/
-}
+++ /dev/null
-/* 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);
-}
-
-
- /***************************************/
-/*\f*/
-
-
-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) */
- }
-}
+++ /dev/null
-/* 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
-
-
-
- /***************************************/
+++ /dev/null
-/* 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;
-}
-
+++ /dev/null
-/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */
-/* Last modified_on Thu Apr 4 20:01:18 GMT+2:00 1991 by herve */
-/* modified_on Thu Mar 22 20:45:38 GMT+1:00 1990 by shand */
-
-
-/* bz.c: provides an implementation of "unlimited-precision"
- * arithmetic for signed integers.
- *
- * Several conventions are used in the commentary:
- * A "BigZ" is the name for an arbitrary-precision signed integer.
- * Capital letters (e.g., "Z") are used to refer to the value of BigZs.
- */
-
-
-#include "BigZ.h"
-
-
- /***************************************/
-/*
-#include <stdio.h>
-#include <macros.h>
-#include <math.h>
-#include <malloc.h>
-#include <values.h>
-*/
-
-#define NULL 0
-#define max(a,b) (a<b ? b : a)
-#define abs(x) (x>=0 ? x : -(x))
-#define M_LN2 0.69314718055994530942
-#define M_LN10 2.30258509299404568402
-#define BITSPERBYTE 8
-#define BITS(type) (BITSPERBYTE * (int)sizeof(type))
-#define HIBITI (1 << BITS(int) - 1)
-#define MAXINT (~HIBITI)
-
- /***************************************/
-
-#define BzToBn(z) ((z)->Digits)
-#define CTOI(c) (c >= '0' && c <= '9' ? c - '0' :\
- c >= 'a' && c <= 'f' ? c - 'a' + 10:\
- c >= 'A' && c <= 'F' ? c - 'A' + 10:\
- 0)
-
-extern char *malloc();
-
- /*** copyright ***/
-
-static char copyright[]="@(#)bz.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\n";
-
-
- /***************************************/
-
-static int Initialized = FALSE;
-
-/* constants used by BzToString() and BzFromString() */
-static double BzLog [] =
-{
- 0,
- 0, /* log (1) */
- M_LN2, /* log (2) */
- 1.098612, /* log (3) */
- 1.386294, /* log (4) */
- 1.609438, /* log (5) */
- 1.791759, /* log (6) */
- 1.945910, /* log (7) */
- 2.079442, /* log (8) */
- 2.197225, /* log (9) */
- M_LN10, /* log (10) */
- 2.397895, /* log (11) */
- 2.484907, /* log (12) */
- 2.564949, /* log (13) */
- 2.639057, /* log (14) */
- 2.708050, /* log (15) */
- 2.772588, /* log (16) */
-};
-
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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;
- }
- }
-/*\f*/
-
-
- 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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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;
- }
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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);
-}
-
- /***************************************/
-/*\f*/
-
-
-#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;
-}
-
- /***************************************/
-/*\f*/
-
-
-#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;
- }
-}
-
- /***************************************/
+++ /dev/null
-/* 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);
-}
-
+++ /dev/null
-/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */
-/* Last modified_on Tue Feb 25 1:27:57 GMT+1:00 1992 by shand */
-/* modified_on Mon Apr 15 18:44:14 GMT+2:00 1991 by herve */
-
-#include <stdio.h>
-#include "BigZ.h"
-
-#ifndef MSDOS
-#define S(A,B) strcmp(A,B)
-#define P(A) fprintf(stderr,"%d...",A)
-#define E(A,B,C) fprintf(stderr,"\nError in test #%d:\nComputed: %s\nCorrect: %s\n",A,C,B)
-#define T(A,B,C) S(B,C)?E(A,B,C):P(A)
-#else
-void T(A,B,C)
-int A;
-char *B, *C;
-{
- if (strcmp (B, C))
- fprintf (stderr, "\nError in test #%d:\nComputed: %s\nCorrect: %s\n",A,C,B);
- else
- fprintf (stderr,"%2d...",A);
-}
-#endif
-#define NEWLINE fprintf(stderr,"\n")
-#define To(A) BzToString(A,10)
-#define From(A) BzFromString(A,10)
-#define Abs(A) BzAbs(A)
-#define Neg(A) BzNegate(A)
-#define Add(A,B) BzAdd(A,B)
-#define Sub(A,B) BzSubtract(A,B)
-#define Mul(A,B) BzMultiply(A,B)
-#define Div(A,B) BzDiv(A,B)
-#define Mod(A,B) BzMod(A,B)
-#define Fac(A) BzFactorial(A)
-#define FromI(I) BzFromInteger(I)
-#define Cmp(A,B) BzCompare(A,B)
-#define Sqa(A) Mul(A,A)
-
-#define zero FromI(0)
-#define one FromI(1)
-#define two FromI(2)
-#define minusone FromI(-1)
-
-#ifdef DIGITonUSHORT
-#define two31m1 Sub(Mul(From("65536"),From("32768")),one)
-#else
-#define two31m1 FromI(0x7FFFFFFF)
-#endif
-
-main()
-{
- BigZ a,b;
-
- T(1,"12", To(From("12"))) ;
- T(2,"12345678910", To(From("12345678910"))) ;
- T(3,"123", To(From("00000123"))) ;
- T(4,"-123", To(From("-123"))) ;
- T(5,"-32768", To(From("-32768"))) ;
- T(6,"-32768", To(Neg(From("32768")))) ;
- T(7,"-32768", To(Add(From("-16384"),From("-16384")))) ;
- T(8,"-32768", To(Add(From("-16383"),From("-16385")))) ;
- T(9,"-32768", To(Mul(From("2"),From("-16384")))) ;
- T(10,"-16384", To(Div(From("-32768"),From("2")))) ;
- NEWLINE;
- T(11,"100000", To(Add(From("1"),From("99999")))) ;
- T(12,"12343994",To(Add(From("-1684"),From("12345678"))));
- T(13,"-12329294",To(Sub(From("16384"),From("12345678"))));
- T(14,"135801",To(Add(From("12345"),From("123456"))));
- T(15,"123456135801",To(Add(From("12345"),From("123456123456"))));
- T(16,"135801",To(Add(From("123456"),From("12345"))));
- T(17,"123456135801",To(Add(From("123456123456"),From("12345"))));
- T(18,"135801",To(Sub(From("12345"),From("-123456"))));
- T(19,"123456135801",To(Sub(From("12345"),From("-123456123456"))));
- T(20,"135801",To(Sub(From("123456"),From("-12345"))));
- NEWLINE;
- T(21,"123456135801",To(Sub(From("123456123456"),From("-12345"))));
- T(22,"-111111",To(Sub(From("12345"),From("123456"))));
- T(23,"111111",To(Sub(From("123456"),From("12345"))));
- T(24,"-123456111111",To(Sub(From("12345"),From("123456123456"))));
- T(25,"123456111111",To(Sub(From("123456123456"),From("12345"))));
- T(26,"-111111",To(Add(From("12345"),From("-123456"))));
- T(27,"111111",To(Add(From("123456"),From("-12345"))));
- T(28,"-123456111111",To(Add(From("12345"),From("-123456123456"))));
- T(29,"123456111111",To(Add(From("123456123456"),From("-12345"))));
- T(30,"2", To(Div(From("264195"),From("97200")))) ;
- NEWLINE;
- T(31,"27405", To(Mod(From("97200"),From("69795")))) ;
- T(32,"4294967295", To(Div(From("22685491128062564230891640495451214097"),From("5281877500950955845296219748")))) ;
- T(33,"99997",To(Add(From("-3"),From("100000"))));
- T(34,"-100003",To(Add(From("-3"),From("-100000"))));
- T(35,"999999",To(Sub(From("1000000"),From("1"))));
- T(36,"999999999",To(Mul(From("12345679"),From("81"))));
- a = From("1234567");
- b = From("123456");
- T(37,"1234567",To(Add(Mul(Div(a,b),b),Mod(a,b))));
- T(38,"-1234567",To(Add(Mul(Div(Neg(a),Neg(b)),Neg(b)),Mod(Neg(a),Neg(b)))));
- T(39,"1234567",To(Add(Mul(Div(a,Neg(b)),Neg(b)),Mod(a,Neg(b)))));
- T(40,"10000000000000000000000",To(Mul(From("-100000000000"),From("-100000000000"))));
- NEWLINE;
- T(41,"-10000000000000000000000",To(Mul(From("-100000000000"),From("100000000000"))));
- T(42,"-10000000000000000000000",To(Mul(From("100000000000"),From("-100000000000"))));
- T(43,"10000000000000000000000",To(Mul(From("100000000000"),From("100000000000"))));
- a = Sub(From("10000000000000"),From("10000000000000"));
- T(44,"0",To(Mod(a,From("1000000000000"))));
- T(45,"0",To(Div(a,From("1000000000000"))));
- T(46,"0",To(Mod(Neg(a),From("10000000000000"))));
- T(47,"0",To(Div(Neg(a),From("10000000000000"))));
- T(48,"2",To(Div(From("3000"),Sub(From("1234567891234"),From("1234567890000")))));
- T(49,"532",To(Mod(From("3000"),Sub(From("1234567891234"),From("1234567890000")))));
- T(50,"9",To(Mod(From("-1234567890"),From("1234567899"))));
- NEWLINE;
- T(51,"2",To(Mod(Sub(From("12345678900000"),From("12345678926887")),From("3"))));
- T(52,"40830949904677684825316369628906250000000000000",To(Mul(From("48270948888581289062500000000"),From("845870049062500000"))));
- T(53,"22666179639240748063923391983020279316955515",To(Mul(From("6956883693"),From("3258093801689886619170103176686855"))));
- T(54,"1405006117752879898543142606244511569936384000000000",To(Fac(From("42"))));
- T(55,"0",To(Mod(Fac(From("13")),Fac(From("9")))));
- T(56,"0",To(Mod(Fac(From("34")),Fac(From("13")))));
- T(57,"0",To(Mod(Fac(From("57")),Fac(From("21")))));
- T(58,"0",To(Mod(Fac(From("40")),Fac(From("39")))));
- T(59,"59",To(Div(Fac(From("59")),Fac(From("58")))));
- T(60,"2",To(Div(From("5"),From("2"))));
- NEWLINE;
- T(61,"1",To(Mod(From("5"),From("2"))));
- T(62,"-3",To(Div(From("-5"),From("2"))));
- T(63,"1",To(Mod(From("-5"),From("2"))));
- T(64,"3",To(Div(From("-5"),From("-2"))));
- T(65,"1",To(Mod(From("-5"),From("-2"))));
- T(66,"-2",To(Div(From("5"),From("-2"))));
- T(67,"1",To(Mod(From("5"),From("-2"))));
- T(68,"3",To(Div(From("6"),From("2"))));
- T(69,"0",To(Mod(From("6"),From("2"))));
- T(70,"-3",To(Div(From("-6"),From("2"))));
- NEWLINE;
- T(71,"0",To(Mod(From("-6"),From("2"))));
- T(72,"3",To(Div(From("-6"),From("-2"))));
- T(73,"0",To(Mod(From("-6"),From("-2"))));
- T(74,"-3",To(Div(From("6"),From("-2"))));
- T(75,"0",To(Mod(From("6"),From("-2"))));
- T(76,"0",To(Abs(From("0"))));
- T(77,"1234567890",To(Abs(From("1234567890"))));
- T(78,"1234567890",To(Abs(From("-1234567890"))));
- T(79,"1",BzCompare(From("-1234567890"),From("12345"))<0?"1":"0");
- T(80,"1",BzGetSign(From("-1234567890"))<0?"1":"0");
- NEWLINE;
- T(81,"0", To(Add(From("-1"),Mul(From("-1"),From("-1")))));
- T(82,"-1",To(Add(From("-1"),Mul(From("0"), From("-1")))));
- T(83,"-3",To(Add(From("-1"),Mul(From("-2"),From("1" )))));
- T(84,"1", To(Add(From("-1"),Mul(From("-2"),From("-1")))));
- T(85,"-1",To(Add(From("1"), Mul(From("-2"),From("1" )))));
- T(86,"18446744065119617025",To(Mul(From("4294967295"),From("4294967295"))));
- /* (-2^64 + 2^32 - 1) / 2^32 */
- T(87,"-4294967296",To(Div(
- Sub(Mul(Mul(Add(Mul(two31m1,two),one),Mul(Add(two31m1,one), two)),minusone),one),
- Mul(Add (two31m1,one),two))));
- T(88,"Equal",(Cmp(Mod(FromI(10),FromI(5)),zero) == BZ_EQ)?"Equal":"Not equal");
- T(89,"Equal",(Cmp(Div(FromI(4),FromI(5)),zero) == BZ_EQ)?"Equal":"Not equal");
- a = From ("100000000000000000000000000000000000000");
- T(90,To (a),To(Div (Sqa (a),a)));
- /* 90: tests the MIPS & turbo C optimizer bugs. If the special */
- /* purpose squaring code is enabled and the optimizer */
- /* messes up, this test will fail */
- NEWLINE;
- b = Sqa (a);
- T(91,To (b),To(Div (Sqa (b),b)));
- T(92,"-1",To(Div(From("13"),From("-13"))));
- NEWLINE;
-}
+++ /dev/null
-/* Copyright Digital Equipment Corporation & INRIA 1988, 1989 */
-/* testKerN.c: tests des primitives de KerN */
-/* Last modified_on Thu Feb 20 17:26:13 GMT+1:00 1992 by shand */
-/* modified_on Wed Feb 14 16:14:04 GMT+1:00 1990 by herve */
-/* modified_on 17-OCT-1989 20:35:55.91 by Jim Lawton */
-
-/* You can comment the line below if you want to test the C macro Package
- instead of C or Assembly functions. */
-
-#define BNNMACROS_OFF 1
-
-
-#include "BigNum.h"
- /* old types of Bn */
-
-typedef BigNumDigit BigNumType; /* A BigNum's type */
-
-struct BigNumHeader /* The header of a BigNum */
-{
- BigNumType type;
- BigNumLength length;
-};
-
- /* old functions of Bn */
-
-/*
- * Creation and access to type and length fields.
- */
-extern char *malloc();
-/* Allocates a BigNum structure and returns a pointer to it */
-BigNum BnAlloc(size) int size; {
- register BigNum n;
-
- n = (BigNum) (malloc(sizeof(struct BigNumHeader) +
- size * sizeof(BigNumDigit))
- + sizeof(struct BigNumHeader));
- (((struct BigNumHeader *) n) - 1)->length = size;
- return(n);
-}
-
-/* Allocates a BigNum, inserts its Type, and returns a pointer to it */
-BigNum BnCreate(type, size) BigNumType type; int size; {
- register BigNum n;
-
- n = BnAlloc(size);
- (((struct BigNumHeader *) n) - 1)->type = type;
- BnnSetToZero ((n+ 0), size);
- return(n);
-}
-
-/* Frees a BigNum structure */
-BnFree(n) BigNum n; {
- free(((struct BigNumHeader *) n) - 1);
- return 1;
-}
-
-/* Returns the BigNum's Type */
-BigNumType BnGetType(n) BigNum n; {
- return((((struct BigNumHeader *) n) - 1)->type);
-}
-
-/* Sets the BigNum's Type */
-BnSetType(n, type) BigNum n; BigNumType type; {
- (((struct BigNumHeader *) n) - 1)->type = type;
-}
-
-/* Returns the number of digits allocated for the BigNum */
-BnGetSize(n) BigNum n; {
- return((((struct BigNumHeader *) n) - 1)->length);
-}
-
-
-
- /* structure d'un test */
-
-struct testenv {
- char *name; /* Le nom de la fonction teste'e. */
- int flag; /* Pour savoir si l'on continue le Test. */
- char hist[2048]; /* L'expression qui provoque l'erreur. */
- char *depend; /* De quoi depend le Test. */
-};
-
-
- /* Les nombres pre'de'finies. */
-
-static BigNum NumbVect[5][2];
-static BigNum NumbProto, Ntmp2, NtmpBig;
-
-#define RN(n) NumbVect[n][0]
-#define SN(n) NumbVect[n][1]
-
- /* Taille des nombres utilise's. */
- /* de la forme 4(n + 1) */
-#define TESTLENGTH 16
-#define DTL TESTLENGTH/2
-#define QTL TESTLENGTH/4
-
-/* Nombre de test. */
-int TestCount, CallDummy = 0;
-
-int dummy()
-{
- /* a simple way to get control after <n> steps in the debugger */
- printf("TestCount = %d\n", TestCount);
-}
-
-int TestCountInc()
-{
- TestCount++;
- if (TestCount == CallDummy)
- dummy();
-}
-
-ResetTest(n) int n; {
- /* Remet le nieme nombre a` la valeur prototype. */
- BnnAssign ((RN(n)+ 0), ( NumbProto+ 0), TESTLENGTH);
- BnnAssign ((SN(n)+ 0), ( NumbProto+ 0), TESTLENGTH);
-}
-
-Check(n) int n; {
- int i;
- /* Verifie que les n nombres calcules correspondent aux simule's. */
- for(i = 0; i < n; i++)
- if(CheckSubRange(i, 0, TESTLENGTH)) return(1);
- return(FALSE);
-}
-
-CheckSubRange(x, nd, nl) int x, nd, nl; {
- /* Verifie l'e'galite' des sous-nombres
- (RN(x), nd, nl) et (SN(x), nd, nl) */
- while(nl) {
- nl--;
- if(BnnCompareDigits (*(RN(x)+ nd), *( SN(x)+ nd))) return(nd + 1);
- nd++;
- }
- return(FALSE);
-}
-
-ShowDiff0(e, r1, r2) struct testenv *e; int r1,r2; {
- ErrorPrint(e);
- if(r1 != r2)
- printf("---- Result is %d and should be %d----\n", r1, r2);
- return(e->flag);
-}
-
-ShowDiff1(e, r1, r2, n, nd, nl)
- struct testenv *e; char *n; int r1, r2, nd, nl; {
- ErrorPrint(e);
- if(r1 != r2)
- printf("---- Result is %d and should be %d----\n", r1, r2);
- ShowOutRange(0, n, nd, nl);
- ShowSubNumber(0, n, nd, nl);
- return(e->flag);
-}
-
-ShowDiff2(e, r1, r2, n, nd, nl, m, md, ml)
- struct testenv *e; char *n, *m; int r1, r2, nd, nl, md, ml; {
- ErrorPrint(e);
- if(r1 != r2)
- printf("---- Result is %d and should be %d----\n", r1, r2);
- ShowOutRange(0, n, nd, nl);
- ShowOutRange(1, m, md, ml);
- ShowSubNumber(0, n, nd, nl);
- ShowSubNumber(1, m, md, ml);
- return(e->flag);
-}
-
-ShowDiff3(e, r1, r2, n, nd, nl, m, md, ml, o, od, ol)
- struct testenv *e; char *n, *m, *o;
- int r1, r2, nd, nl, md, ml, od, ol; {
- ErrorPrint(e);
- if(r1 != r2)
- printf("---- Result is %d and should be %d----\n", r1, r2);
- ShowOutRange(0, n, nd, nl);
- ShowOutRange(1, m, md, ml);
- ShowOutRange(2, o, od, ol);
- ShowSubNumber(0, n, nd, nl);
- ShowSubNumber(1, m, md, ml);
- ShowSubNumber(2, o, od, ol);
- return(e->flag);
-}
-
-ShowDiff4(e, r1, r2, n, nd, nl, m, md, ml, o, od, ol, p, pd, pl)
- struct testenv *e; char *n, *m, *o, *p;
- int r1, r2, nd, nl, md, ml, od, ol, pd, pl; {
- ErrorPrint(e);
- if(r1 != r2)
- printf("---- Result is %d and should be %d----\n", r1, r2);
- ShowOutRange(0, n, nd, nl);
- ShowOutRange(1, m, md, ml);
- ShowOutRange(2, o, od, ol);
- ShowOutRange(3, p, pd, pl);
- ShowSubNumber(0, n, nd, nl);
- ShowSubNumber(1, m, md, ml);
- ShowSubNumber(2, o, od, ol);
- ShowSubNumber(3, p, pd, pl);
- return(e->flag);
-}
-
-ShowSubNumber(x, n, nd, nl) char *n; int x, nd, nl; {
- printf("[%s, %d, %d] = ", n, nd, nl);
- RangeNumberPrint("", RN(x), nd, nl);
- if(CheckSubRange(x, nd, nl)) {
- RangeNumberPrint(" Before: ", NumbProto, nd, nl);
- RangeNumberPrint(" Simulated: ", SN(x), nd, nl);
-} }
-
-RangeNumberPrint(s, n, nd, nl) char *s; BigNum n; int nd, nl; {
- int first = 1;
-
- /* Ne marche que si BnGetDigit est garanti!!! */
- printf("%s {", s);
- while(nl) {
- nl--;
- if(!first) printf(", "); else first = 0;
- if(BN_DIGIT_SIZE <= 16)
- printf("%.4X", BnnGetDigit ((n+ nd + nl)));
- else if(BN_DIGIT_SIZE <= 32)
- printf("%.8X", BnnGetDigit ((n+ nd + nl)));
- else printf("%.16lX", BnnGetDigit ((n+ nd + nl)));
- }
- printf("}\n");
-}
-
-char *msg = "---- Modification Out of Range of number ";
-ShowOutRange(x, n, nd, nl) char *n; int x, nd, nl; {
- int i = 0, bol = 0;
-
- while(i = CheckSubRange(x, i, TESTLENGTH - i)) {
- if((i <= nd) || (i > nd + nl)) {
- if(!bol) {
- bol = 1;
- printf("%s %s at index: (%d", msg, n, i - 1);
- } else {
- printf(" %d", i - 1);
- } } }
- if(bol) printf(").\n");
-}
-
-ErrorPrint(e) struct testenv *e; {
- printf("*** Error in compute : %s\n", e->hist);
- printf(" Depends on %s\n", e->depend);
-}
-
-/*
- * Tests des fonctions non redefinisables
- */
-
-int genlengthvec[] = {9, 8, 1, 0, 2000, 32000,};
-BigNumType gentypevec[] = {0, 1, 2, 3, 4, 5,};
-
-Generique(e) struct testenv *e; {
- int i;
- int length, length2;
- BigNumType type, type2;
- int fix;
- BigNum n;
-
-
- for(i=0; i < 6; i++) {
- type = gentypevec[i];
- length = genlengthvec[i];
- n = BnCreate(type, length);
- if((type2 = BnGetType(n)) != type) {
- sprintf(e->hist,"BnGetType(BnCreate(%d, %d));", type, length);
- if(ShowDiff0(e, type, type2)) return(TRUE);
- }
- if((length2 = BnGetSize(n)) != length) {
- sprintf(e->hist,"BnGetSize(BnCreate(%d, %d));", type, length);
- if(ShowDiff0(e, length, length2)) return(TRUE);
- }
- if(BnFree(n) == 0) {
- sprintf(e->hist, "BnFree(BnCreate(%d, %d));", type, length);
- if(ShowDiff0(e, 1, 0)) return(TRUE);
- }
- BnSetType((n = BnAlloc(length)), type);
- if((type2 = BnGetType(n)) != type) {
- sprintf(e->hist,"BnGetType(BnAlloc(%d, %d));", type, length);
- if(ShowDiff0(e, type, type2)) return(TRUE);
- }
- if((length2 = BnGetSize(n)) != length) {
- sprintf(e->hist,"BnGetSize(BnAlloc(%d, %d));", type, length);
- if(ShowDiff0(e, length, length2)) return(TRUE);
- }
- if(BnFree(n) == 0) {
- sprintf(e->hist, "BnFree(BnAlloc(%d, %d));", type, length);
- if(ShowDiff0(e, 1, 0)) return(TRUE);
- }
- }
- return(FALSE);
-}
-
-/*
- * BnSetToZero
- */
-___BnSetToZero___(n, nd, nl) register BigNum n; register int nd, nl; {
- register int i;
- for(i=0; i<nl; i++)
- BnnSetDigit ((n+ nd + i), 0);
-}
-
-TestBnSetToZero(e) struct testenv *e; {
- int nd, nl;
-
- e->depend = "(BnSetDigit)";
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++) {
- TestCountInc();
- ResetTest(0);
- BnnSetToZero ((RN(0)+ nd), nl);
- ___BnSetToZero___(SN(0), nd, nl);
- if(Check(1)) {
- sprintf(e->hist, "%s(n, %d, %d)", e->name, nd, nl);
- if(ShowDiff1(e, 0, 0, "n", nd, nl)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnAssign
- */
-___BnAssign___(m, md, n, nd, nl) BigNum m, n; int md, nd, nl; {
- register int i;
- for(i=0; i<nl; i++)
- BnnSetDigit ((NtmpBig+ i), BnnGetDigit ((n+ nd + i)));
- for(i=0; i<nl; i++)
- BnnSetDigit ((m+ md + i), BnnGetDigit ((NtmpBig+ i)));
-}
-
-TestBnAssign(e) struct testenv *e; {
- int md, nd, nl;
-
- e->depend = "(BnGetDigit, BnSetDigit)";
- for(md = 0; md <= TESTLENGTH; md++)
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl=0; ((nl<=TESTLENGTH-nd) && (nl<=TESTLENGTH-md)); nl++) {
- TestCountInc();
- ResetTest(0);
- BnnAssign ((RN(0)+ md), ( RN(0)+ nd), nl);
- ___BnAssign___(SN(0), md, SN(0), nd, nl);
- if(Check(1)) {
- sprintf(e->hist, "%s(m, %d, n, %d, %d)", e->name,
- md, nd, nl);
- if(ShowDiff1(e, 0, 0, "n", md, nl)) return(1);
- } }
- return(FALSE);
-}
-
-
-/*
- * BnNumDigits
- */
-___BnNumDigits___(n, nd, nl) register BigNum n; register int nd, nl; {
-
- while(nl != 0) {
- nl--;
- if(!BnnIsDigitZero (*(n+ nd + nl))) break;
- }
- return(nl + 1);
-}
-
-TestBnNumDigits(e) struct testenv *e; {
- int nd0, nl0, nd, nl, l1, l2;
-
- e->depend = "(BnIsDigitZero)";
- for(nd0 = 0; nd0 <= TESTLENGTH; nd0++)
- for(nl0 = 0; nl0 <= TESTLENGTH - nd0; nl0++)
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++) {
- TestCountInc();
- ResetTest(0);
- BnnSetToZero ((RN(0)+ nd0), nl0);
- BnnSetToZero ((SN(0)+ nd0), nl0);
- l1 = BnnNumDigits ((RN(0)+ nd), nl);
- l2 = ___BnNumDigits___(SN(0), nd, nl);
- if(Check(1) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d, %d)", e->name, nd, nl);
- if(ShowDiff1(e, l1, l2, "n", nd, nl)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnNumLeadingZeroBitsInDigit
- */
-__BnNumLeadingZeroBitsInDigit__(n, nd) BigNum n; int nd; {
- int p = 0;
-
- if(BnnIsDigitZero (*(n+ nd))) return(BN_DIGIT_SIZE);
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- *( Ntmp2+ 1) = BnnShiftLeft ((Ntmp2+ 0), 1, 1);
- while(BnnIsDigitZero (*(Ntmp2+ 1))) {
- *( Ntmp2+ 1) = BnnShiftLeft ((Ntmp2+ 0), 1, 1);
- p++;
- }
- return(p);
-}
-
-TestBnNumLeadingZeroBitsInDigit(e) struct testenv *e; {
- int nd; int l1, l2;
-
-
- e->depend = "(BnShiftLeft, BnIsDigitZero)";
- ResetTest(0);
- for(nd = 0; nd < TESTLENGTH; nd++) {
- TestCountInc();
- l1 = BnnNumLeadingZeroBitsInDigit (*(RN(0)+ nd));
- l2 = __BnNumLeadingZeroBitsInDigit__(SN(0), nd);
- if(Check(1) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d)", e->name, nd);
- if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnIsDigitZero
- */
-___BnIsDigitZero___(n, nd) BigNum n; int nd; {
- if(BnnGetDigit ((n+ nd)) == 0) return(1);
- return(0);
-}
-
-TestBnIsDigitZero(e) struct testenv *e; {
- int nd; int l1, l2;
-
- e->depend = "()";
- ResetTest(0);
- for(nd = 0; nd < TESTLENGTH; nd++) {
- TestCountInc();
- l1 = BnnIsDigitZero (*(RN(0)+ nd));
- l2 = ___BnIsDigitZero___(SN(0), nd);
- if(Check(1) || ((l1 == 0) && (l2 != 0)) ||
- ((l1 != 0) && (l2 == 0))) {
- sprintf(e->hist, "%s(n, %d)", e->name, nd);
- if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnIsDigitNormalized
- */
-___BnIsDigitNormalized___(n, nd) BigNum n; int nd; {
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- *( Ntmp2+ 1) = BnnShiftLeft ((Ntmp2+ 0), 1, 1);
- if(BnnIsDigitZero (*(Ntmp2+ 1))) return(0);
- return(1);
-}
-
-TestBnIsDigitNormalized(e) struct testenv *e; {
- int nd; int l1, l2;
-
- e->depend = "(BnShiftLeft, BnIsDigitZero)";
- ResetTest(0);
- for(nd = 0; nd < TESTLENGTH; nd++) {
- TestCountInc();
- l1 = BnnIsDigitNormalized (*(RN(0)+ nd));
- l2 = ___BnIsDigitNormalized___(SN(0), nd);
- if(Check(1) || ((l1 == 0) && (l2 != 0)) ||
- ((l1 != 0) && (l2 == 0))) {
- sprintf(e->hist, "%s(n, %d)", e->name, nd);
- if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnIsDigitOdd
- */
-___BnIsDigitOdd___(n, nd) BigNum n; int nd; {
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- *( Ntmp2+ 1) = BnnShiftRight ((Ntmp2+ 0), 1, 1);
- if(BnnIsDigitZero (*(Ntmp2+ 1))) return(0);
- return(1);
-}
-
-TestBnIsDigitOdd(e) struct testenv *e; {
- int nd; int l1, l2;
-
- e->depend = "(BnShiftRight, BnIsDigitZero)";
- ResetTest(0);
- for(nd = 0; nd < TESTLENGTH; nd++) {
- TestCountInc();
- l1 = BnnIsDigitOdd (*(RN(0)+ nd));
- l2 = ___BnIsDigitOdd___(SN(0), nd);
- if(Check(1) || ((l1 == 0) && (l2 != 0)) ||
- ((l1 != 0) && (l2 == 0))) {
- sprintf(e->hist, "%s(n, %d)", e->name, nd);
- if(ShowDiff1(e, l1, l2, "n", nd, 1)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnCompareDigits
- */
-___BnCompareDigits___(n, nd, m, md) BigNum n, m; int nd, md; {
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- BnnComplement ((Ntmp2+ 0), 1);
- if(BnnAdd ((Ntmp2+ 0), 1, ( m+ md), 1, (BigNumCarry) 0)) return(-1);
- BnnComplement ((Ntmp2+ 0), 1);
- if(BnnIsDigitZero (*(Ntmp2+ 0))) return(0);
- return(1);
-}
-
-TestBnCompareDigits(e) struct testenv *e; {
- int nd, md; int l1, l2;
-
- e->depend = "(BnComplement, BnAdd, BnIsDigitZero)";
- ResetTest(0);
- ResetTest(1);
- for(nd = 0; nd < TESTLENGTH; nd++)
- for(md = 0; md < TESTLENGTH; md++) {
- TestCountInc();
- l1 = BnnCompareDigits (*(RN(0)+ nd), *( RN(1)+ md));
- l2 = ___BnCompareDigits___(SN(0), nd, SN(1), md);
- if(Check(2) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md);
- if(ShowDiff2(e, l1, l2, "n", nd, 1, "m", md, 1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnComplement
- */
-___BnComplement___(n, nd, nl) BigNum n; int nd, nl; {
- int i;
-
- BnnSetDigit ((Ntmp2+ 0), 0);
- BnnSubtractBorrow ((Ntmp2+ 0), 1, 0);
- for(i = 0; i < nl; i++)
- BnnXorDigits ((n+ nd + i), *( Ntmp2+ 0));
-}
-
-TestBnComplement(e) struct testenv *e; {
- int nd, nl;
-
- e->depend = "(BnSubtractBorrow, BnXorDigits)";
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++) {
- TestCountInc();
- ResetTest(0);
- BnnComplement ((RN(0)+ nd), nl);
- ___BnComplement___(SN(0), nd, nl);
- if(Check(1)) {
- sprintf(e->hist, "%s(n, %d, %d)", e->name, nd, nl);
- if(ShowDiff1(e, 0, 0, "n", nd, nl)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnAndDigits
- */
-___BnAndDigits___(n, nd, m, md) BigNum n, m; int nd, md; {
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- BnnOrDigits ((Ntmp2+ 0), *( m+ md));
- BnnXorDigits ((Ntmp2+ 0), *( m+ md));
- BnnXorDigits ((n+ nd), *( Ntmp2+ 0));
-}
-
-TestBnAndDigits(e) struct testenv *e; {
- int nd, md;
-
- e->depend = "(BnOrDigits, BnXorDigits)";
- ResetTest(1);
- for(nd = 0; nd < TESTLENGTH; nd++)
- for(md = 0; md < TESTLENGTH; md++) {
- TestCountInc();
- ResetTest(0);
- BnnAndDigits ((RN(0)+ nd), *( RN(1)+ md));
- ___BnAndDigits___(SN(0), nd, SN(1), md);
- if(Check(2)) {
- sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md);
- if(ShowDiff2(e, 0, 0, "n", nd, 1, "m", md, 1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnOrDigits
- */
-___BnOrDigits___(n, nd, m, md) BigNum n, m; int nd, md; {
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- BnnAndDigits ((Ntmp2+ 0), *( m+ md));
- BnnXorDigits ((Ntmp2+ 0), *( m+ md));
- BnnXorDigits ((n+ nd), *( Ntmp2+ 0));
-}
-
-TestBnOrDigits(e) struct testenv *e; {
- int nd, md;
-
- e->depend = "(BnAndDigits, BnXorDigits)";
- ResetTest(1);
- for(nd = 0; nd < TESTLENGTH; nd++)
- for(md = 0; md < TESTLENGTH; md++) {
- TestCountInc();
- ResetTest(0);
- BnnOrDigits ((RN(0)+ nd), *( RN(1)+ md));
- ___BnOrDigits___(SN(0), nd, SN(1), md);
- if(Check(2)) {
- sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md);
- if(ShowDiff2(e, 0, 0, "n", nd, 1, "m", md, 1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnXorDigits
- */
-___BnXorDigits___(n, nd, m, md) BigNum n, m; int nd, md; {
- BnnAssign ((Ntmp2+ 0), ( n+ nd), 1);
- BnnAndDigits ((Ntmp2+ 0), *( m+ md));
- BnnComplement ((Ntmp2+ 0), 1);
- BnnOrDigits ((n+ nd), *( m+ md));
- BnnAndDigits ((n+ nd), *( Ntmp2+ 0));
-}
-
-TestBnXorDigits(e) struct testenv *e; {
- int nd, md;
-
- e->depend = "(BnAndDigits, BnComplement, BnOrDigits)";
- ResetTest(1);
- for(nd = 0; nd < TESTLENGTH; nd++)
- for(md = 0; md < TESTLENGTH; md++) {
- TestCountInc();
- ResetTest(0);
- BnnXorDigits ((RN(0)+ nd), *( RN(1)+ md));
- ___BnXorDigits___(SN(0), nd, SN(1), md);
- if(Check(2)) {
- sprintf(e->hist, "%s(n, %d, m, %d)", e->name, nd, md);
- if(ShowDiff2(e, 0, 0, "n", nd, 1, "m", md, 1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnShiftLeft
- */
-___BnShiftLeft___(n, nd, nl, m, md, s) BigNum n, m; int nd, nl, md; int s; {
- BnnSetDigit ((m+ md), 2);
- BnnSetDigit ((Ntmp2+ 0), 1);
- while(s--) {
- BnnSetToZero ((NtmpBig+ 0), 2);
- BnnMultiplyDigit ((NtmpBig+ 0), 2, ( Ntmp2+ 0), 1, *( m+ md));
- BnnAssign ((Ntmp2+ 0), ( NtmpBig+ 0), 1);
- }
- BnnSetToZero ((NtmpBig+ 0), nl + 1);
- BnnMultiplyDigit ((NtmpBig+ 0), nl + 1, ( n+ nd), nl, *( Ntmp2+ 0));
- BnnAssign ((n+ nd), ( NtmpBig+ 0), nl);
- BnnAssign ((m+ md), ( NtmpBig+ nl), 1);
-}
-
-TestBnShiftLeft(e) struct testenv *e; {
- int nd, nl, md; int s;
-
- e->depend = "(BnSetToZero, BnMultiplyDigit)";
- ResetTest(1);
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++)
- for(md = 0; md < 2; md++)
- for(s = 0; s < BN_DIGIT_SIZE; s++) {
- TestCountInc();
- ResetTest(0);
- *( RN(1)+ md) = BnnShiftLeft ((RN(0)+ nd), nl, s);
- ___BnShiftLeft___(SN(0), nd, nl, SN(1), md, s);
- if(Check(2)) {
- sprintf(e->hist, "%s(n, %d, %d, m, %d, %d)",
- e->name, nd, nl, md, s);
- if(ShowDiff2(e, 0, 0, "n", nd, nl, "m", md, 1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnShiftRight
- */
-___BnShiftRight___(n, nd, nl, m, md, s) BigNum n, m; int nd, nl, md; int s; {
- if((nl == 0) || (s == 0)) {
- BnnSetDigit ((m+ md), 0);
- return;
- }
- BnnAssign ((NtmpBig+ 0), ( n+ nd), nl);
- *( NtmpBig+ nl) = BnnShiftLeft ((NtmpBig+ 0), nl, BN_DIGIT_SIZE - s);
- BnnAssign ((n+ nd), ( NtmpBig+ 1), nl);
- BnnAssign ((m+ md), ( NtmpBig+ 0), 1);
-}
-
-TestBnShiftRight(e) struct testenv *e; {
- int nd, nl, md; int s;
-
- e->depend = "(BnShiftLeft)";
- ResetTest(1);
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++)
- for(md = 0; md < 2; md++)
- for(s = 0; s < BN_DIGIT_SIZE; s++) {
- TestCountInc();
- ResetTest(0);
- *( RN(1)+ md) = BnnShiftRight ((RN(0)+ nd), nl, s);
- ___BnShiftRight___(SN(0), nd, nl, SN(1), md, s);
- if(Check(2)) {
- sprintf(e->hist, "%s(n, %d, %d, m, %d, %d)",
- e->name, nd, nl, md, s);
- if(ShowDiff2(e, 0, 0, "n", nd, nl, "m", md, 1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnAddCarry
- */
-BigNumCarry
-___BnAddCarry___(n, nd, nl, r) BigNum n; int nd, nl; int r;{
- if(r == 0) return(0);
- BnnComplement ((n+ nd), nl);
- r = BnnSubtractBorrow ((n+ nd), nl, 0);
- BnnComplement ((n+ nd), nl);
- if(r == 0) return(1);
- return(0);
-}
-
-TestBnAddCarry(e) struct testenv *e; {
- int nd, nl; int r, l1, l2;
-
- e->depend = "(BnComplement, BnSubtractBorrow)";
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++)
- for(r = 0; r < 2; r++) {
- TestCountInc();
- ResetTest(0);
- l1 = BnnAddCarry ((RN(0)+ nd), nl, r);
- l2 = ___BnAddCarry___(SN(0), nd, nl, r);
- if(Check(1) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d, %d, %d)",
- e->name, nd, nl, r);
- if(ShowDiff1(e, l1, l2, "n", nd, nl)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnAdd
- */
-BigNumCarry
-___BnAdd___(n, nd, nl, m, md, ml, r) BigNum n, m; int nd, nl, md, ml; BigNumCarry r;{
- BnnComplement ((m+ md), ml);
- r = BnnSubtract ((n+ nd), ml, ( m+ md), ml, r);
- BnnComplement ((m+ md), ml);
- return(BnnAddCarry ((n+ nd + ml), nl - ml, r));
-}
-
-TestBnAdd(e) struct testenv *e; {
- int nd, nl, md, ml; int l1, l2; BigNumCarry r;
-
- e->depend = "(BnComplement, BnSubtract, BnAddCarry)";
- ResetTest(1);
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++)
- for(md = 0; md <= TESTLENGTH - nl; md++)
- for(ml = 0; ml <= nl ; ml++)
- for(r = 0; r < 2; r++) {
- TestCountInc();
- ResetTest(0);
- l1 = BnnAdd ((RN(0)+ nd), nl, ( RN(1)+ md), ml, r);
- l2 = ___BnAdd___(SN(0), nd, nl, SN(1), md, ml, r);
- if(Check(2) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d, %d, m, %d, %d, %d)",
- e->name, nd, nl, md, ml, r);
- if(ShowDiff2(e, l1, l2, "n", nd, nl, "m", md, ml))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnSubtractBorrow
- */
-BigNumCarry
-___BnSubtractBorrow___(n, nd, nl, r) BigNum n; int nd, nl; BigNumCarry r;{
- if(r == 1) return(1);
- BnnComplement ((n+ nd), nl);
- r = BnnAddCarry ((n+ nd), nl, (BigNumCarry) 1);
- BnnComplement ((n+ nd), nl);
- if(r == 0) return(1);
- return(0);
-}
-
-TestBnSubtractBorrow(e) struct testenv *e; {
- int nd, nl; int l1, l2; BigNumCarry r;
-
- e->depend = "(BnComplement, BnAddCarry)";
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++)
- for(r = 0; r < 2; r++) {
- TestCountInc();
- ResetTest(0);
- l1 = BnnSubtractBorrow ((RN(0)+ nd), nl, r);
- l2 = ___BnSubtractBorrow___(SN(0), nd, nl, r);
- if(Check(1) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d, %d, %d)",
- e->name, nd, nl, r);
- if(ShowDiff1(e, l1, l2, "n", nd, nl)) return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnSubtract
- */
-BigNumCarry
-___BnSubtract___(n, nd, nl, m, md, ml, r) BigNum n, m; int nd, nl, md, ml; BigNumCarry r;{
- BnnComplement ((m+ md), ml);
- r = BnnAdd ((n+ nd), ml, ( m+ md), ml, r);
- BnnComplement ((m+ md), ml);
- return(BnnSubtractBorrow ((n+ nd + ml), nl - ml, r));
-}
-
-TestBnSubtract(e) struct testenv *e; {
- int nd, nl, md, ml; int l1, l2; BigNumCarry r;
-
- e->depend = "(BnComplement, BnAdd, BnSubtractBorrow)";
- ResetTest(1);
- for(nd = 0; nd <= TESTLENGTH; nd++)
- for(nl = 0; nl <= TESTLENGTH - nd; nl++)
- for(md = 0; md <= TESTLENGTH - nl; md++)
- for(ml = 0; ml <= nl ; ml++)
- for(r = 0; r < 2; r++) {
- TestCountInc();
- ResetTest(0);
- l1 = BnnSubtract ((RN(0)+ nd), nl, ( RN(1)+ md), ml, r);
- l2 = ___BnSubtract___(SN(0), nd, nl, SN(1), md, ml, r);
- if(Check(2) || l1 != l2) {
- sprintf(e->hist, "%s(n, %d, %d, m, %d, %d, %d)",
- e->name, nd, nl, md, ml, r);
- if(ShowDiff2(e, l1, l2, "n", nd, nl, "m", md, ml))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnMultiplyDigit
- */
-BigNumCarry
-___BnMultiplyDigit___(p, pd, pl, n, nd, nl, m, md) BigNum p, n, m; int pd, pl, nd, nl, md; {
- BigNumCarry r = 0, ret = 0;
-
- BnnAssign ((Ntmp2+ 0), ( m+ md), 1);
- BnnAssign ((NtmpBig+ 0), ( n+ nd), nl);
- BnnSetToZero ((NtmpBig+ nl), 1);
- while(!BnnIsDigitZero (*(Ntmp2+ 0))) {
- if(BnnIsDigitOdd (*(Ntmp2+ 0))) {
- r = BnnAdd ((p+ pd), pl, ( NtmpBig+ 0), nl + 1, (BigNumCarry) 0);
- if((ret == 0) && (r == 1)) ret = 1;
- else if((ret == 1) && (r == 1)) ret = 2;
- }
- *( Ntmp2+ 1) = BnnShiftRight ((Ntmp2+ 0), 1, 1);
- *( Ntmp2+ 1) = BnnShiftLeft ((NtmpBig+ 0), nl + 1, 1);
- if(!BnnIsDigitZero (*(Ntmp2+ 1))) ret = 3;
- }
- return(ret);
-}
-
-TestBnMultiplyDigit(e) struct testenv *e; {
- int pd, pl, nd, nl, md; int l1, l2;
-
- e->depend = "(BnSetToZero, BnIsDigitZero, BnIsDigitOdd, BnAdd, BnShiftRight, BnShiftLeft)";
- ResetTest(1);
- ResetTest(2);
- for(pd = 0; pd <= TESTLENGTH; pd++)
- for(pl = 0; pl <= TESTLENGTH - pd; pl++)
- for(nd = 0; nd <= TESTLENGTH - pl; nd++)
- for(nl = 0; nl < pl ; nl++)
- for(md = 0; md < TESTLENGTH; md++) {
- TestCountInc();
- ResetTest(0);
- l1 = BnnMultiplyDigit ((RN(0)+pd), pl, (RN(1)+nd), nl, *(RN(2)+md));
- l2 = ___BnMultiplyDigit___(SN(0),pd,pl,SN(1),nd,nl,SN(2),md);
- if(Check(3) || l1 != l2) {
- sprintf(e->hist,
- "BnMultiplyDigit(p, %d, %d, n, %d, %d, m, %d)",
- pd, pl, nd, nl, md);
- if(ShowDiff3(e,l1,l2,"p",pd,pl,"n",nd,nl,"m",md,1))
- return(1);
- } }
- return(FALSE);
-}
-
-/*
- * BnDivideDigit
- */
-TestBnDivideDigit(e) struct testenv *e; {
- int nd, nl, md, qd, rd, l2;
-
- e->depend = "(BnSetToZero, BnMultiplyDigit, BnCompareDigits)";
- ResetTest(2);
- ResetTest(3);
- for(nd = 0; nd <= TESTLENGTH - 2; nd++)
- for(nl = 2; nl <= TESTLENGTH - nd; nl++)
- for(md = 0; md < TESTLENGTH; md++)
- for(qd = 0; qd < TESTLENGTH - nl + 1 ; qd++)
- for(rd = 0; rd < 2; rd++)
- if((!BnnIsDigitZero (*(RN(3)+ md))) &&
- (BnnCompareDigits (*(RN(2)+ nd+nl-1), *( RN(3)+ md)) == -1)) {
- TestCountInc();
- ResetTest(0);
- ResetTest(1);
- *( RN(1)+ rd) = BnnDivideDigit ((RN(0)+ qd), ( RN(2)+ nd), nl, *( RN(3)+ md));
- BnnAssign ((SN(0)+ qd), ( RN(0)+ qd), nl - 1);
- BnnAssign ((SN(1)+ rd), ( RN(1)+ rd), 1);
- BnnSetToZero ((SN(2)+ nd), nl);
- BnnAssign ((SN(2)+ nd), ( SN(1)+ rd), 1);
- l2 = BnnMultiplyDigit ((SN(2)+nd), nl, ( SN(0)+qd), nl - 1, *( SN(3)+ md));
- if(Check(4) || l2 != 0) {
- sprintf(e->hist,
- "BnDivideDigit(q, %d, r, %d, n, %d, %d, m, %d)",
- qd, rd, nd, nl, md);
- if(ShowDiff4(e, 0, l2, "q", qd, nl - 1, "r", rd, 1,
- "n", nd, nl, "m", md, 1))
- return(TRUE);
- } }
- return(FALSE);
-}
-
-/*
- * BnMultiply
- */
-___BnMultiply___(p, pd, pl, m, md, ml, n, nd, nl) BigNum p, m, n; int pd, pl, md, ml, nd, nl; {
- int ret;
-
- for (ret = 0; nl-- > 0; pd++, nd++, pl--)
- ret += BnnMultiplyDigit ((p+ pd), pl, ( m+ md), ml, *( n+ nd));
- return(ret);
-}
-
-TestBnMultiply(e) struct testenv *e; {
- BigNumLength pd, pl, nd, nl, md, ml; int l1, l2;
-
- e->depend = "(BnSetToZero, BnMultiplyDigit)";
- ResetTest(1);
- ResetTest(2);
- for(pd = 0; pd <= TESTLENGTH; pd++)
- for(pl = 0; pl <= TESTLENGTH - pd && pl <= TESTLENGTH/2; pl++)
- for(nd = 0; nd <= TESTLENGTH - pl; nd++)
- for(nl = 0; nl < pl && nl <= TESTLENGTH/3; nl++)
- {
- if (nl <= pl-nl)
- {
- /* Test squaring */
- TestCountInc();
- ResetTest(0);
- l1 = BnnMultiply ((RN(0)+pd), pl, (RN(1)+nd), nl, (RN(1)+nd), nl);
- l2 = ___BnMultiply___(SN(0),pd,pl,SN(1),nd,nl,SN(1),nd,nl);
- if(Check(3) || l1 != l2) {
- sprintf(e->hist,
- "BnMultiply(p, %d, %d, n, %d, %d, n, %d, %d)",
- pd, pl, nd, nl, nd, nl);
- if(ShowDiff3(e,l1,l2,"p",pd,pl,"n",nd,nl,"n",nd,nl))
- return(1);
- }
-
- }
- for(md = 0; md <= TESTLENGTH; md++)
- for (ml = 0; ml <= pl-nl && ml <= TESTLENGTH/3 && md+ml <= TESTLENGTH; ml++) {
- TestCountInc();
- ResetTest(0);
- l1 = BnnMultiply ((RN(0)+pd), pl, (RN(1)+nd), nl, (RN(2)+md), ml);
- l2 = ___BnMultiply___(SN(0),pd,pl,SN(1),nd,nl,SN(2),md,ml);
- if(Check(3) || l1 != l2) {
- sprintf(e->hist,
- "BnMultiply(p, %d, %d, n, %d, %d, m, %d, %d)",
- pd, pl, nd, nl, md, ml);
- if(ShowDiff3(e,l1,l2,"p",pd,pl,"n",nd,nl,"m",md,ml))
- return(1);
- } } }
- return(FALSE);
-}
-
-/*
- * Main
- */
-typedef struct {
- int (*TestFnt)();
- char *NameFnt;
-} TESTONE;
-TESTONE AllTest[] = {
- Generique, "Generic Functions",
- TestBnSetToZero, "BnSetToZero",
- TestBnAssign, "BnAssign",
- TestBnNumDigits, "BnNumDigits",
- TestBnNumLeadingZeroBitsInDigit, "BnNumLeadingZeroBitsInDigit",
- TestBnIsDigitZero, "BnIsDigitZero",
- TestBnIsDigitNormalized, "BnIsDigitNormalized",
- TestBnIsDigitOdd, "BnIsDigitOdd",
- TestBnCompareDigits, "BnCompareDigits",
- TestBnComplement, "BnComplement",
- TestBnAndDigits, "BnAndDigits",
- TestBnOrDigits, "BnOrDigits",
- TestBnXorDigits, "BnXorDigits",
- TestBnShiftLeft, "BnShiftLeft",
- TestBnShiftRight, "BnShiftRight",
- TestBnAddCarry, "BnAddCarry",
- TestBnAdd, "BnAdd",
- TestBnSubtractBorrow, "BnSubtractBorrow",
- TestBnSubtract, "BnSubtract",
- TestBnMultiplyDigit, "BnMultiplyDigit",
- TestBnDivideDigit, "BnDivideDigit",
- TestBnMultiply, "BnMultiply",
-};
-
-main(n, s) int n; char **s; {
- struct testenv realenv, *e = &realenv;
- int i, j, nbtest, SizeAllTest;
-
- /* Initialisations de l'environnement de test. */
- e->flag = 1;
- e->depend = "()";
- /* Allocation des 2 nombres globaux. */
- Ntmp2 = BnAlloc(2);
- NtmpBig = BnAlloc(2 * TESTLENGTH);
- NumbProto = BnAlloc(TESTLENGTH);
- /* Creation du nombre prototype. */
- BnnSetDigit ((NumbProto+ 0), 0); /* Les 2 premiers a` ze'ro. */
- BnnSetDigit ((NumbProto+ 1), 0);
- for(i=0; i < TESTLENGTH/4 - 1; i++) /* Le premier quart est la */
- BnnSetDigit ((NumbProto+ i + 2), i + 1); /* suite 1, 2, 3, ... */
- /* Le 2nd quart est le 1er shifte de BN_DIGIT_SIZE - 2. 0x4000 0x8000 ...*/
- BnnAssign ((NumbProto+ QTL + 1), ( NumbProto+ 2), QTL - 1);
- *( NumbProto+ 0) = BnnShiftLeft ((NumbProto+ QTL + 1), QTL - 1, BN_DIGIT_SIZE - 2);
- /* La 2nd moitie est l'inverse logique de la 1ere */
- BnnAssign ((NumbProto+ DTL), ( NumbProto+ 0), DTL);
- BnnComplement ((NumbProto+ DTL), DTL);
- /* Allocation des nombres utilise's */
- for(i=0; i < 5; i++) {
- RN(i) = BnAlloc(TESTLENGTH);
- SN(i) = BnAlloc(TESTLENGTH);
- }
- if(n > 1 && s[1][0] == '-') {
- CallDummy = atoi(s[1]+1);
- n--;
- s++;
- }
- if(n == 1) {
- printf("%s [-CallDummy#] v|a|TestNum\n", s[0]);
- }
- /* On y va */
- SizeAllTest = (sizeof(AllTest)/sizeof(AllTest[0]));
- for(i = 1; i < n; i++) {
- if(s[i][0] == 'm') {
- /* 0 = No skip; 1 = skip to next; else STOP */
- e->flag = atoi(&s[i][1]);
- } else if(s[i][0] == 'a') {
- for(i = 0; i < SizeAllTest; i++)
- dotest(e, i);
- } else if(s[i][0] == 'v') {
- for(j = 0; j < SizeAllTest; j++)
- seetest(j);
- } else {
- nbtest = atoi(s[i]);
- if((nbtest < 0) || (nbtest >= SizeAllTest))
- printf("Test %d is invalid\n", nbtest);
- else dotest(e, nbtest);
-} } }
-
-dotest(e, n) struct testenv *e; int n; {
- seetest(n);
- TestCount = 0;
- e->name = AllTest[n].NameFnt;
- if(((*(AllTest[n].TestFnt)) (e)) && e->flag > 1) exit(0);
- printf("%d tests were performed\n", TestCount);
-}
-
-seetest(n) int n; {
- printf("%d. Testing %s\n", n, AllTest[n].NameFnt);
-}
-
+++ /dev/null
-/* 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 */
-
-/*\f*/
-
-
- /************ 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));
-
-/*\f*/
-
- /* 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
+++ /dev/null
-/* 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;
-
-/*\f*/
-
-
- /*********** 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));
+++ /dev/null
-/* 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 <stdlib.h>
-
- /* 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));
-}
-
+++ /dev/null
-| 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
+++ /dev/null
-| 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
+++ /dev/null
-/* 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
+++ /dev/null
-# Copyright Digital Equipment Corporation & INRIA 1988, 1989
-#
-# KerN for the RS6000
-# [Bepaul]
-#
-# La plupart du code est celui ge'ne're' par le compilo C (Cha^peau!)
-#
- .set RES,3
- .set CA1,3
- .set CA2,4
- .set CA3,5
- .set CA4,6
- .set CA5,7
- .set X4,7
- .set X3,8
- .set X2,9
- .set X1,10
-
- .set NN1,CA1
- .set MM1,CA1
- .set D1,CA1
- .set NN2,CA2
- .set NL2,CA2
- .set ML2,CA2
- .set D2,CA2
- .set NN3,CA3
- .set NL3,CA3
- .set NL4,CA4
-
- .toc
-T.bignum_dat: .tc bignum_dat[TC],bignum_dat[RW]
- .csect bignum_dat[RW]
- .csect bignum_txt[PR]
-
- .globl .BnnSetToZero # BnnSetToZero(nn, nl)
-.BnnSetToZero: cmpi 0,NL2,0 # if(nl <= 0) return;
- bler
- mtctr NL2 # ctr = nl;
- lil X1,0 # cte = 0;
- ai NN1,NN1,-4 # nn--;
-BSTZ1: stu X1,4(NN1) # *(++nn) = cte;
- bdn BSTZ1 # if(--ctr != 0) goto BSTZ1;
- br # return;
-
- .globl .BnnAssign # BnnAssign(mm, nn, nl)
-.BnnAssign: cmpi 0,NL3,0 # if(nl <= 0) return;
- bler
- mtctr NL3 # ctr = nl;
- cmpl 0,MM1,NN2 # if(mm >= nn) goto BAG2;
- bge BAG2
- ai MM1,MM1,-4 # mm--;
- ai NN2,NN2,-4 # nn--;
-BAG1: lu X1,4(NN2) # X = *(++nn);
- stu X1,4(MM1) # *(++mm) = X;
- bdn BAG1 # if(--ctr != 0) goto BAG1;
- br
-BAG2: beqr # if(mm == nn) return;
- sli X1,NL3,2
- a NN2,NN2,X1 # nn += nl;
- a MM1,MM1,X1 # mm += nl;
-BAG3: lu X1,-4(NN2) # X = *(--nn);
- stu X1,-4(MM1) # *(--mm) = X;
- bdn BAG3 # (if(--ctr != 0) goto BAG3;
- br # return;
-
- .globl .BnnSetDigit # BnnSetDigit(nn, d)
-.BnnSetDigit: st D2,0(NN1)
- br
-
- .globl .BnnGetDigit # BnnGetDigit(nn)
-.BnnGetDigit: l RES,0(NN1)
- br
-
- .globl .BnnNumDigits # BnnNumDigits(nn, nl)
-.BnnNumDigits: cmpi 0,NL2,0 # if(nl <= 0) return(1);
- ble BND2
- sli X1,NL2,2
- a NN1,NN1,X1 # nn += nl;
- mtctr NL2 # ctr = nl;
-BND1: lu X1,-4(NN1) # X = *(--nn);
- cmpi 0,X1,0 # if(X != 0) goto BND3
- bne BND3
- bdn BND1 # if(--ctr != 0) goto BND1;
-BND2: lil RES,1 # return(1);
- br
-BND3: mfctr RES # return(ctr);
- br
-
- .globl .BnnNumLeadingZeroBitsInDigit # (d)
-.BnnNumLeadingZeroBitsInDigit:
- cntlz RES,D1 # Yeah!
- br
-
- .globl .BnnDoesDigitFitInWord # (d)
-.BnnDoesDigitFitInWord:
- lil RES,1 # return(1);
- br
-
- .globl .BnnIsDigitZero # BnnIsDigitZero(d)
-.BnnIsDigitZero: # Use the fact that nabs(d) >=0 <=> d == 0
- nabs RES,D1
- rlinm RES,RES,1,31,31 # sign in the lowest bit.
- xoril RES,RES,1 # get the inverse.
- br
-
- .globl .BnnIsDigitNormalized # (d)
-.BnnIsDigitNormalized:
- rlinm RES,D1,1,31,31 # sign in the lowest bit.
- br
-
- .globl .BnnIsDigitOdd # BnnIsDigitOdd(d)
-.BnnIsDigitOdd: rlinm RES,D1,0,31,31 # only the lowest bit.
- br
-
- .globl .BnnCompareDigits # BnnCompareDigits(d1, d2)
-.BnnCompareDigits:
- cmpl 0,D1,D2 # if(d1 == d2) return(0);
- beq BSD0
- bgt BCDsup # if(d1 > d2) return(1);
- lil RES,-1 # return(-1);
-BSDret: br
-BCDsup: lil RES,1 # return(1);
- br
-BSD0: lil RES,0 # return(0);
- br
-
- .globl .BnnComplement #.BnnComplement(nn, nl)
-.BnnComplement: cmpi 0,NL2,0 # if(nl <= 0) return;
- bler
- ai NN1,NN1,-4 # nn--;
- mtctr NL2 # ctr = nl;
-BCM1: l X1,4(NN1) # X = nn[1];
- sfi X1,X1,-1 # X ^= -1;
- stu X1,4(NN1) # *++nn = X;
- bdn BCM1 # if(--ctr > 0) goto BCM1
- br # return;
-
- .globl .BnnAndDigits # BnnAndDigits(nn, d)
-.BnnAndDigits: l X1,0(NN1) # X = *nn;
- and X1,X1,D2 # X &= d;
- st X1,0(NN1) # *nn = X;
- br
-
- .globl .BnnOrDigits # BnnOrDigits(nn, d)
-.BnnOrDigits: l X1,0(NN1) # X = *nn;
- or X1,X1,D2 # X |= d;
- st X1,0(NN1) # *nn = X;
- br
-
- .globl .BnnXorDigits # BnnXorDigits(nn, d)
-.BnnXorDigits: l X1,0(NN1) # X = *nn;
- xor X1,X1,D2 # X ^= d;
- st X1,0(NN1) # *nn = X;
- br
-
- .globl .BnnShiftLeft # BnnShiftLeft(mm, ml, nbits)
-# here and in the next funxtion we use the fact that MM1 == RES.
- .set NBI,CA3; .set SMM,X1; .set RNB,X2; .set SX,X3; .set SY,ML2
-.BnnShiftLeft: oril SMM,MM1,0
- lil RES,0 # res = 0;
- cmpi 0,NBI,0 # if(nbits == 0) return(res);
- beqr
- cmpi 0,ML2,0 # if(ml <= 0) return(res);
- bler
- sfi RNB,NBI,32 # rnbits = 32 - nbits;
- ai SMM,SMM,-4 # mm--;
- mtctr ML2 # ctr = ml;
-BSL1: l SX,4(SMM) # X = mm[1];
- sl SY,SX,NBI # Y = X << nbits;
- or SY,SY,RES # Y |= res;
- stu SY,4(SMM) # *(++mm) = Y;
- sr RES,SX,RNB # res = X >> rnbits;
- bdn BSL1 # if(--ctr > 0) goto BSL1
- br # return(res);
-
- .globl .BnnShiftRight # BnnShiftRight(mm, ml, nbits)
-.BnnShiftRight: sli X1,ML2,2 # mm += ml;
- a SMM,MM1,X1
- lil RES,0 # res = 0;
- cmpi 0,NBI,0 # if(nbits == 0) return(res);
- beqr
- cmpi 0,ML2,0 # if(ml <= 0) return(res);
- bler
- sfi RNB,NBI,32 # rnbits = 32 - nbits;
- mtctr ML2 # ctr = ml;
-BSR1: lu SX,-4(SMM) # X = *(--mm);
- sr SY,SX,NBI # Y = X >> nbits;
- or SY,SY,RES # Y |= res;
- st SY,0(SMM) # *(mm) = Y;
- sl RES,SX,RNB # res = X << rnbits;
- bdn BSR1 # if(--ctr > 0) goto BSR1
- br # return(res);
-
- .globl .BnnAddCarry # BnnAddCarry(nn, nl, carryin)
- .set CARRY,CA3 # also for BnnSubtractBorrow
-.BnnAddCarry: cmpi 0,CARRY,0 # if(carryin == 0) return(0);
- beq BAC3
- cmpi 0,NL2,0 # if(nl == 0) return(1);
- beq BAC2
- ai NN1,NN1,-4 # nn--;
- mtctr NL2 # ctr = nl;
-BAC1: l X1,4(NN1) # X = nn[1];
- ai. X1,X1,1 # X++;
- stu X1,4(NN1) # *(++nn) = X;
- bne BAC3 # if(X != 0) return(0);
- bdn BAC1 # if(--ctr > 0) goto BAC1
-BAC2: lil RES,1 # return(1);
- br
-BAC3: lil RES,0 # return(0);
- br
-
- .globl .BnnAdd # BnnAdd(mm, ml, nn, nl, carryin)
- .set CARRYIN,CA5 # also for BnnSubtract.
-.BnnAdd: sf ML2,NL4,ML2 # ml -= nl;
- ai NN3,NN3,-4 # nn--;
- ai MM1,MM1,-4 # mm--; carry = 1;
- cmpi 0,NL4,0 # if(nl == 0) goto BADD2;
- beq BADD2
- mtctr NL4 # ctr = nl;
- cmpi 0,CARRYIN,0 # if(carryin) goto BADD1;
- bne BADD1
- ai X1,X1,0 # carry = 0;
-BADD1: lu X2,4(NN3) # Y = *(++nn);
- l X1,4(MM1) # X = mm[1];
- ae X1,X1,X2 # X = X + Y + carry; carry = ??
- stu X1,4(MM1) # *(++mm) = X;
- bdn BADD1 # if(--ctr > 0) goto BADD1
- lil X2,0
- ae CARRYIN,X2,X2 # carryin = carry;
-BADD2: cmpi 0,CARRYIN,0 # if(carryin == 0) return(0);
- beq BADD5
- cmpi 0,ML2,0 # if(ml == 0) return(1);
- beq BADD4
- mtctr ML2 # ctr = ml;
-BADD3: l X1,4(MM1) # X = mm[1];
- ai. X1,X1,1 # X++;
- stu X1,4(MM1) # *(++mm) = X;
- bne BADD5 # if(X != 0) return(0);
- bdn BADD3 # if(--ctr > 0) goto BADD3;
-BADD4: lil RES,1 # return(1);
- br
-BADD5: lil RES,0 # return(0);
- br
-
- .globl .BnnSubtractBorrow # (nn, nl, carryin)
-.BnnSubtractBorrow:
- cmpi 0,CARRY,1 # if(carryin == 1) return(1);
- beq BSB3
- cmpi 0,NL2,0 # if(nl == 0) return(0);
- beq BSB2
- ai NN1,NN1,-4 # nn--;
- mtctr NL2 # ctr = nl;
-BSB1: l X1,4(NN1) # X = nn[1];
- si X2,X1,1 # Y= X-1;
- stu X2,4(NN1) # *(++nn) = Y;
- cmpi 0,X1,0
- bne BSB3 # if(X != 0) return(1);
- bdn BSB1 # if(--ctr > 0) goto BSB1
-BSB2: lil RES,0 # return(0);
- br
-BSB3: lil RES,1 # return(1);
- br
-
- .globl .BnnSubtract # BnnSubtract(mm, ml, nn, nl, carryin)
-.BnnSubtract: sf ML2,NL4,ML2 # ml -= nl;
- ai NN3,NN3,-4 # nn--;
- ai MM1,MM1,-4 # mm--; carry = 1;
- cmpi 0,NL4,0 # if(nl == 0) goto BS2
- beq BS2
- mtctr NL4 # ctr = nl;
- cmpi 0,CARRYIN,0 # if(carryin) goto BS1
- bne BS1
- ai X1,X1,0 # carry = 0;
-BS1: lu X2,4(NN3) # Y = *(++nn);
- l X1,4(MM1) # X = mm[1];
- sfe X1,X2,X1 # X = X - (Y + carry); carry = ??
- stu X1,4(MM1) # *(++mm) = X;
- bdn BS1 # if(--ctr > 0) goto BS1
- lil CA5,0
- ae CA5,CA5,CA5 # carryin = carry;
-BS2: cmpi 0,CA5,1 # if(carryin == 0) return(1);
- beq BS5
- cmpi 0,ML2,0 # if(ml == 0) return(0);
- beq BS4
- mtctr ML2 # ctr = ml;
-BS3: l X1,4(MM1) # X = mm[1];
- si X2,X1,1 # Y= X-1;
- stu X2,4(MM1) # *(++mm) = Y;
- cmpi 0,X1,0 # if(X != 0) return(1);
- bne BS5
- bdn BS3 # if(--ctr > 0) goto BS3
-BS4: lil RES,0 # return(0);
- br
-BS5: lil RES,1 # return(1);
- br
-
- .globl .BnnMultiplyDigit # BnnMultiplyDigit(pp, pl, mm, ml, d)
- .set PP,CA1; .set PL,CA2; .set MM,CA3; .set ML,CA4; .set D,CA5
- .set LOW,X1; .set HIGHT,X2; .set OHIGHT,X3
-.BnnMultiplyDigit:
- cmpi 0,D,0 # if(d == 0) return(0);
- beq BMD7
-BMD1: cmpi 0,D,1 # if(d != 1) goto BMD2;
- bne BMD2
- lil CA5,0 # return(BnnAdd(pp, pl, mm, ml, 0));
- b .BnnAdd
-BMD2: sf PL,ML,PL # pl -= ml;
- ai MM,MM,-4 # mm--;
- ai PP,PP,-4 # pp--;
- cmpi 0,ML,0 # if(ml == 0) return(0);
- beq BMD7
- mtctr ML # ctr = ml;
- lil OHIGHT,0 # OldHight = 0;
- cmpi 0,D,0 # if(D < 0) goto BMD8;
- blt BMD8
-BMD3: lu LOW,4(MM) # Low = mm[1];
- mul HIGHT,LOW,D # Hight:MQ = Low*d
- cmpi 0,LOW,0 # if(Low>=0) pas de correction.
- bge BMD4
- a HIGHT,HIGHT,D # Correction multiplication signe'.
-BMD4: mfmq LOW # Low = MQ;
- a LOW,LOW,OHIGHT # Low += OldHight;
- aze HIGHT,HIGHT # Hight += carry;
- l OHIGHT,4(PP) # *++pp += Low;
- a LOW,LOW,OHIGHT
- stu LOW,4(PP)
- aze OHIGHT,HIGHT # OldHight = Hight + carry;
- bdn BMD3 # if(--ctr > 0) goto BMD3;
-BMD40: l LOW,4(PP) # *(++pp) += OldHight;
- a LOW,LOW,OHIGHT
- stu LOW,4(PP)
- lil LOW,0 # if(carry == 0) return(0);
- aze. LOW,LOW
- beq BMD7
- si. PL,PL,1 # pl--;
- ble BMD6 # if(pl <= 0) return(1);
- mtctr PL # ctr = pl;
-BMD5: l X1,4(PP) # X = pp[1];
- ai. X1,X1,1 # X++;
- stu X1,4(PP) # *(++pp) = X;
- bne BMD7 # if(X != 0) return(0);
- bdn BMD5 # if(--ctr > 0) goto BMD5;
-BMD6: lil RES,1 # return(1);
- br
-BMD7: lil RES,0 # return(0);
- br
-
-BMD8: lu LOW,4(MM) # Low = mm[1];
- mul HIGHT,LOW,D # Hight:MQ = Low*d
- a HIGHT,HIGHT,LOW # Correction pour d<0...
- cmpi 0,LOW,0 # if(Low>=0) pas de correction.
- bge BMD9
- a HIGHT,HIGHT,D # Correction multiplication signe'.
-BMD9: mfmq LOW # Low = MQ;
- a LOW,LOW,OHIGHT # Low += OldHight;
- aze HIGHT,HIGHT # Hight += carry;
- l OHIGHT,4(PP) # *pp += Low;
- a LOW,LOW,OHIGHT
- stu LOW,4(PP)
- aze OHIGHT,HIGHT # OldHight = Hight + carry;
- bdn BMD8 # if(--ctr > 0) goto BMD8;
- b BMD40 # goto BMD40;
-
- .globl .BnnDivideDigit # BnnDivideDigit(qq, nn, nl, d)
- .set QQ,CA1; .set NN,CA2; .set NL,CA3; .set DD,CA4
- .set SQQ,X1; .set R,CA1; .set Q,X2; .set NLOW,X2; .set DQ,X3
- .set BITS,X4; .set AUX,CA3
-.BnnDivideDigit:
- sli X1,NL,2
- a NN,NN,X1 # nn = &nn[nl];
- a SQQ,QQ,X1 # qq = &qq[nl];
- si SQQ,SQQ,4 # qq--;
- lu R,-4(NN) # R = *(--nn);
- si. NL,NL,1 # nl--;
- bler # if(nl <= 0) return(R);
- mtctr NL # ctr = nl;
- sri DQ,DD,1 # D'= D / 2;
- cmpi 0,DD,0 # if(D<0) goto BDDinf;
- blt BDDinf
-# D > 0
-BDDsup: lu NLOW,-4(NN) # Low = *(--nn);
- cmpl 0,R,DQ # if (R < D') goto BDDsupinf;
- blt BDDsupinf
- andil. BITS,NLOW,1 # bits = Low & 1;
- sri NLOW,NLOW,1 # Low >>= 1;
- andil. AUX,R,1 # aux = R & 1;
- sri R,R,1 # R >>= 1;
- sli AUX,AUX,31 # Low |= aux << 31;
- or NLOW,NLOW,AUX
- mtmq NLOW # MQ = Low;
- div Q,R,DD # Q=R:MQ/D; MQ=R:MQ%D;
- mfmq R # R=MQ;
- sli R,R,1 # R <<= 1;
- sli Q,Q,1 # Q <<= 1;
- a R,R,BITS # R+=bits;
- cmpl 0,R,DD # si R<D => ok
- blt BDDsup1
- ai Q,Q,1 # Q++;
- sf R,DD,R # R-=D;
-BDDsup1: stu Q,-4(SQQ) # *(--qq)=Q;
- bdn BDDsup # if(--ctr > 0) goto BDDsup;
- br # return(R);
-BDDsupinf: mtmq NLOW # MQ = XL;
- div Q,R,DD # Q=R:MQ/D; MQ=R:MQ%D;
- mfmq R # R=MQ;
- stu Q,-4(SQQ) # *(--qq)=Q;
- bdn BDDsup # if(--ctr > 0) goto BDDsup;
- br # return(R);
-
-# D < 0
-BDDinf: lu NLOW,-4(NN) # Low = *(--nn);
- andil. BITS,NLOW,7 # bits = Low & 7;
- sri NLOW,NLOW,3 # Low >>= 3;
- andil. AUX,R,7 # aux = R & 7;
- sri R,R,3 # R >>= 3;
- sli AUX,AUX,29 # Low |= aux << 29;
- or NLOW,NLOW,AUX
- mtmq NLOW # MQ = Low;
- div Q,R,DQ # Q=R:MQ/D'; MQ=R:MQ%D';
- mfmq R # R=MQ
- sli R,R,1 # R *= 2;
- andil. AUX,DD,1 # if((D & 1) == 0) rien a retrancher;
- cmpli 0,AUX,0
- beq BDDi4
-# R <- R - Q
- cmpl 0,R,Q # On teste avant de faire la diff.
- blt BDDi3 # la diff est < 0
- sf R,Q,R # la diff est > 0
- b BDDi4
-BDDi3: sf R,Q,R # On met a` jour
- si Q,Q,1 # Q--;
- a R,R,DD # R += D;
-# R <- 2R; Q <- 2Q;
-BDDi4: cmpl 0,R,DQ # On teste avant de faire la mult.
- blt BDDi41 # Ca va passer..
- bne BDDi40 # Ca va casser...
- cmpli 0,AUX,0 # d0 = 1 ca passe...
- bne BDDi41
-BDDi40: sli Q,Q,1 # Q *= 2;
- sli R,R,1 # R *= 2;
- ai Q,Q,1 # Q++;
- sf R,DD,R # R -= D;
- b BDDi5
-BDDi41: sli Q,Q,1 # Q *= 2;
- sli R,R,1 # R *= 2;
-# R <- 2R; Q <- 2Q;
-BDDi5: cmpl 0,R,DQ # On teste avant de faire la mult.
- blt BDDi51 # Ca va passer..
- bne BDDi50 # Ca va casser...
- cmpli 0,AUX,0 # d0 = 1 ca passe...
- bne BDDi51
-BDDi50: sli Q,Q,1 # Q *= 2;
- sli R,R,1 # R *= 2;
- ai Q,Q,1 # Q++;
- sf R,DD,R # R -= D;
- b BDDi6
-BDDi51: sli Q,Q,1 # Q *= 2;
- sli R,R,1 # R *= 2;
-# R += bits;
-BDDi6: sf AUX,BITS,DD # pour tester sans de'bordement..
- cmpl 0,R,AUX
- blt BDDi61 # Ca va passer..
- ai Q,Q,1 # Q++;
- sf R,DD,R # R -= D;
-BDDi61: a R,R,BITS # R += bits;
- stu Q,-4(SQQ) # *(--qq)=Q;
- bdn BDDinf # if(--ctr > 0) goto BDDinf;
- br
+++ /dev/null
- .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
+++ /dev/null
-; Copyright Digital Equipment Corporation & INRIA 1988, 1989
-;
-; KerN for the HP 9000 600/700/800 (PA-RISC 1.1 only)
-; LERCIER Reynald (april 1993)
-;
-
-
-
- .SPACE $TEXT, SORT=8
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnSetToZero
- .PROC
- .CALLINFO
- .ENTRY ; (nn, nl)
- comb,<= %arg1, %r0, L$BSTZ0 ; if (nl <= 0) goto L$BSTZ0
- nop
-L$BSTZ1 addibf,<= -1, %arg1, L$BSTZ1 ; while (nl-->0)
- stwm %r0, 4(0, %arg0) ; { *(nn++)=0 }
-L$BSTZ0 bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnAssign
- .PROC
- .CALLINFO
- .ENTRY ; (mm, nn, nl)
- comb,<= %arg2, %r0, L$BAG0 ; if (nl <= 0) goto L$BAG0
- nop
- comb,>>=,n %arg0, %arg1, L$BAG1 ; if (mm>=nn) goto L$BAG1
-L$BAG2 ldwm 4(%arg1), %r19 ; X=*(nn++)
- addibf,<= -1, %arg2, L$BAG2 ; if ((nl--)>=0) goto L$BAG2
- stwm %r19, 4(%arg0) ; *(mm++)=X
- bv,n %r0(%r2) ; return
-L$BAG1 comb,=,n %arg0, %arg1, L$BAG0 ; if (mm==nn) goto L$BAG0
- shd %arg2, %r0, 30, %r19 ; X = nl <<2
- add %arg0, %r19, %arg0 ; mm+=X
- add %arg1, %r19, %arg1 ; nn+=X
-L$BAG3 ldwm -4(%arg1), %r19 ; X=*(--nn)
- addibf,<= -1, %arg2, L$BAG3 ; if (--nl>=0) goto L$BAG3
- stwm %r19, -4(%arg0) ; *(--mm)=X
-L$BAG0 bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnSetDigit
- .PROC
- .CALLINFO
- .ENTRY ; (nn, d)
- bv %r0(%r2) ; return
- .EXIT
- stws %arg1, 0(0, %arg0) ; *nn = d
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnGetDigit
- .PROC
- .CALLINFO
- .ENTRY ; (nn)
- bv %r0(%r2)
- .EXIT
- ldws 0(0, %arg0), %ret0 ; return (*nn)
- .PROCEND
-
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnNumDigits
- .PROC
- .CALLINFO
- .ENTRY ; (nn, nl)
- comb,<=,n %arg1, %r0, L$BND0 ; if (nl <= 0) goto L$BND0
- shd %arg1, %r0, 30, %r19 ; X = nl<<2
- add %arg0, %r19, %arg0 ; nn+=nl
- ldwm -4(%arg0), %r19 ; X=*(--nn)
-L$BND2 comb,<> %r19, %r0, L$BND1 ; if (X != 0) goto L$BND1
- nop
- addibf,<= -1, %arg1, L$BND2 ; if ((--nl)>0) goto L$BND2
- ldwm -4(%arg0), %r19 ; X=*(--nn)
-L$BND0 bv %r0(%r2) ; return(1)
- ldi 1, %ret0
-L$BND1 bv %r0(%r2) ; return(nl)
- copy %arg1, %ret0
- .EXIT
- .PROCEND
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnNumLeadingZeroBitsInDigit
- .PROC
- .CALLINFO
- .ENTRY ; (d)
- ldi 0, %ret0 ; p=0
- comb,<>,n %r0, %arg0, L$BLZ1 ; if (d<>0) goto L$BLZ1
- bv %r0(%r2) ; return(32)
- ldi 32, %ret0
-L$BLZ2 addi 1, %ret0, %ret0 ; p++
-L$BLZ1 comib,< 0, %arg0, L$BLZ2 ; if (d>0) goto L$BLZ2;
- shd %arg0, %r0, 31, %arg0 ; d<<=1
- bv,n %r0(%r2) ; return(p)
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnDoesDigitFitInWord
- .PROC
- .CALLINFO
- .ENTRY
- bv %r0(%r2) ; return
- ldi 1, %ret0
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnIsDigitZero
- .PROC
- .CALLINFO
- .ENTRY ; (d)
- ldi 1, %ret0
- or,= %r0, %arg0, %r0 ; if (d==0) return(1)
- ldi 0, %ret0 ; return(0)
- bv,n %r0(%r2)
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnIsDigitNormalized
- .PROC
- .CALLINFO
- .ENTRY
- bv %r0(%r2) ; return
- extru %arg0, 0, 1, %ret0 ; the leftmost bit
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnIsDigitOdd
- .PROC
- .CALLINFO
- .ENTRY
- bv %r0(%r2) ; return
- extru %arg0, 31, 1, %ret0 ; the rightmost bit
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnCompareDigits
- .PROC
- .CALLINFO
- .ENTRY ; (d1, d2)
- comb,= %arg0, %arg1, L$BCD0 ; if (d1==d2) goto L$BCD0
- ldi 0, %ret0 ; return(0)
- comb,>> %arg0, %arg1, L$BCD0 ; if (d1>d2) goto L$BCD0
- ldi 1, %ret0 ; return(1)
- ldi -1, %ret0 ; return(-1)
-L$BCD0 bv,n %r0(%r2)
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnComplement
- .PROC
- .CALLINFO
- .ENTRY ; (nn, nl)
- comb,<=,n %arg1, %r0, L$BCM0 ; if (nl <= 0) goto L$BCM0
- ldi -1, %ret0 ; cste=-1
-L$BCM1 ldw (%arg0), %r19 ; X=*(nn)
- xor %r19, %ret0, %r19 ; X ^= cste
- addibf,<= -1, %arg1, L$BCM1 ; if ((--nl)>=0) goto L$BCM1
- stwm %r19, 4(%arg0) ; *(nn++)=X
-L$BCM0 bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnAndDigits
- .PROC
- .CALLINFO
- .ENTRY ; (nn, d)
- ldw (%arg0), %r19 ; X=*nn
- and %r19, %arg1, %r19 ; X &= d
- stw %r19, (%arg0) ; *nn=X
- bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnOrDigits
- .PROC
- .CALLINFO
- .ENTRY ; (nn, d)
- ldw (%arg0), %r19 ; X=*nn
- or %r19, %arg1, %r19 ; X &= d
- stw %r19, (%arg0) ; *nn=X
- bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnXorDigits
- .PROC
- .CALLINFO
- .ENTRY ; (nn, d)
- ldw (%arg0), %r19 ; X=*nn
- xor %r19, %arg1, %r19 ; X &= d
- stw %r19, (%arg0) ; *nn=X
- bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
-; convention for BnnShiftLeft, BnnShiftRight
-nn1 .REG %arg0
-nl1 .REG %arg1
-nbits .REG %arg2
-res .REG %ret0
-X .REG %r19
-Y .REG %r20
-Z .REG %r21
-W .REG %r22
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnShiftLeft
- .PROC
- .CALLINFO
- .ENTRY ; (nn1, nl1, nbits)
- ldi 0, res ; res=0
- comb,= nbits, %r0, L$BSL0 ; if (nbits = 0) goto L$BSL0
- nop
- comb,<= nl1, %r0, L$BSL0 ; if (nl1 <= 0) goto L$BSL0
- nop
- subi 32, nbits, nbits ; nbits-=32
- mtsar nbits
-L$BSL1 ldw (nn1), X ; X=*(nn1)
- vshd X, %r0, Y ; Y= X<<nbits
- or Y, res, Y ; Y|=res
- vshd %r0, X, res ; res= X>>nbits
- addibf,<= -1, nl1, L$BSL1 ; if ((nl1--)>=0) goto L$BSL1
- stwm Y, 4(nn1) ; *(nn1++)=Y
-L$BSL0 bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnShiftRight
- .PROC
- .CALLINFO
- .ENTRY ; (nn1, nl1, nbits)
- ldi 0, res ; res=0
- comb,= nbits, %r0, L$BSR0 ; if (nbits = 0) goto L$BSR0
- nop
- comb,<=,n nl1, %r0, L$BSR0 ; if (nl1 <= 0) goto L$BSR0
- mtsar nbits
- shd nl1, %r0, 30, Y ; Y=nl1<<2
- add Y, nn1, nn1 ; nn1+=Y
-L$BSR1 ldwm -4(nn1), X ; X=*(--nn1)
- vshd %r0, X, Y ; Y= X>>nbits
- or Y, res, Y ; Y|=res
- vshd X, %r0, res ; res= X<<rnbits
- addibf,<= -1, nl1, L$BSR1 ; if ((nl1--)>=0) goto L$BSR1
- stw Y, (nn1) ; *(nn1)=Y
-L$BSR0 bv,n %r0(%r2) ; return
- .EXIT
- .PROCEND
-
-; convention for BnnAddCarry, BnnSubtractBorrow
-carryin .REG %arg2
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnAddCarry
- .PROC
- .CALLINFO
- .ENTRY ; (nn1, nl1, carryin)
- comb,= carryin, %r0, L$BAC0 ; if (carryin == 0) goto L$BAC0
- nop
- comb,<=,n nl1, %r0, L$BAC1 ; if (nl1<= 0) goto L$BAC1
- ldw (nn1), X ; X=*(nn1)
-L$BAC2 addi,UV 1, X, X ; X++
- b L$BAC0 ; if (X<2^32) goto L$BAC0
- stwm X, 4(nn1) ; *(nn1++)=X
- addibf,<=,n -1, nl1, L$BAC2 ; if ((nl1--)>=0) goto L$BAC2
- ldw (nn1), X ; X=*(nn1)
-L$BAC1 bv %r0(%r2) ; return(1)
- ldi 1, res
-L$BAC0 bv %r0(%r2) ; return(0)
- ldi 0, res
- .EXIT
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnSubtractBorrow
- .PROC
- .CALLINFO
- .ENTRY ; (nn1, nl1, d)
- comib,= 1, carryin, L$BSB1 ; if (carryin == 1) goto L$BSB1
- nop
- comb,<=,n nl1, %r0, L$BSB0 ; if (nl1<= 0) goto L$BSB0
- ldw (nn1), X ; X=*(nn1)
-L$BSB2 addi,nuv -1, X, X ; X--
- b L$BSB1 ; if (X!=-1) goto L$BSB1
- stwm X, 4(nn1) ; *(nn1++)=X
- addibf,<=,n -1, nl1, L$BSB2 ; if ((nl1--)>=0) goto L$BSB2
- ldw (nn1), X ; X=*(nn1)
-L$BSB0 bv %r0(%r2) ; return(0)
- ldi 0, res
-L$BSB1 bv %r0(%r2) ; return(1)
- ldi 1, res
- .EXIT
- .PROCEND
-
-; convention for BnnAdd, BnnSubtract
-mm2 .REG %arg0
-ml2 .REG %arg1
-nn2 .REG %arg2
-nl2 .REG %arg3
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnAdd
- .PROC
- .CALLINFO
- .ENTER ; (mm2, ml2, nn2, nl2, carryin)
- sub ml2, nl2, ml2 ; ml2 -= nl2
- ldw -52(0, %r30), res ; res=carryin
- comb,=,n nl2, %r0, L$BADD2 ; if (nl2==0) goto L$BADD2
-L$BADD1 ldwm 4(nn2), X ; X = *(nn2++)
- ldw (mm2), Y ; Y = *(mm2)
- copy res, Z ; Z=res
- ldi 0, res ; res=0
- add,nuv Y, Z, Y ; Y+=Z;
- ldi 1, res ; if (Y>=2^32) res=1 Y-=2^32
- add,nuv Y, X, Y ; Y+=X
- ldi 1, res ; if (Y>=2^32) res=1 Y-=2^32
- addibf,<= -1, nl2, L$BADD1 ; if ((nl2--)>=0) goto L$BADD1
- stwm Y, 4(mm2) ; *(mm2++)=Y
-L$BADD2 comclr,<> res, %r0, %r0 ; if (res<>0) skip next operation
- b,n L$BADD4 ; return(0)
- comclr,<> ml2, %r0, %r0 ; if (ml2<>0) skip next operation
- b L$BADD5 ; return(1)
- ldw (mm2), X ; X=*mm2
-L$BADD3 addi,uv 1, X, X ; X++
- b L$BADD4 ; if (X<2^32) goto L$BADD4
- stwm X, 4(mm2) ; *(mm2++)=X
- addibf,<= -1, ml2, L$BADD3 ; if ((ml2--)>=0) goto L$BADD3
- ldw (mm2), X ; X=*mm2
- b,n L$BADD5 ; return(1)
-L$BADD4 ldi 0, res
-L$BADD5 .LEAVE
- .PROCEND
-
-
- .SPACE $TEXT
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnSubtract
- .PROC
- .CALLINFO
- .ENTRY ; (mm2, ml2, nn2, nl2, carryin)
- sub ml2, nl2, ml2 ; ml2 -= nl2
- ldw -52(0, %r30), res ; res=carryin
- subi 1, res, res ; res=1-res
- comb,=,n nl2, %r0, L$BS2 ; if (nl2==0) goto L$BS2
-L$BS1 ldwm 4(nn2), X ; X = *(nn2++)
- ldw (mm2), Y ; Y = *(mm2)
- copy res, Z ; Z=res
- ldi 0, res ; res=0
- sub,>>= Y, Z, Y ; Y-=Z;
- ldi 1, res ; if (Y<=0) res=1 Y+=2^32
- sub,>>= Y, X, Y ; Y-=X
- ldi 1, res ; if (Y<=0) res=1 Y+=2^32
- addibf,<= -1, nl2, L$BS1 ; if ((nl2--)>=0) goto L$BS1
- stwm Y, 4(mm2) ; *(mm2++)=Y
-L$BS2 comb,= res, %r0, L$BS4 ; if (res==0) goto L$BS4
- nop
- comb,=,n ml2, %r0, L$BS5 ; if (ml2==0) goto L$BS5
- ldw (mm2), X ; X=*mm2
-L$BS3 addi,nuv -1, X, X ; X--
- b L$BS4 ; if (X!=-1) goto L$BS4
- stwm X, 4(mm2) ; *(mm2++)=X
- addibf,<=,n -1, ml2, L$BS3 ; if ((ml2--)>=0) goto L$BS3
- ldw (mm2), X ; X=*mm2
-L$BS5 bv %r0(%r2) ; return(0)
- ldi 0, res
-L$BS4 bv %r0(%r2) ; return(1)
- ldi 1,res
-
- .EXIT
- .PROCEND
-
-
-; conventions for BnnMultiplyDigit
-pp .REG %arg0
-pl1 .REG %arg1
-mm .REG %arg2
-ml .REG %arg3
-X1 .REG %r22
-X3 .REG %r1
-dm .REG %r29
-fLd .REG %fr5L
-fHd .REG %fr5R
-fLm .REG %fr7L
-fHm .REG %fr8L
-
-
- .SPACE $TEXT$
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnMultiplyDigit
- .PROC
- .CALLINFO CALLER, FRAME=8, SAVE_RP
- .ENTER ; (pp, pl1, mm, ml, dm)
-
- ldw -108(0, %r30), dm ; dm
- comb,= dm, %r0, L$BMD7 ; if (dm==0) goto L$BMD7
- nop
- comib,<>,n 1, dm, L$BMD2 ; if (dm<>1) goto L$BMD2
- .CALL ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR ;in=24,25,26;out=28;
- bl BnnAdd, %r2 ; return(BnnAdd(pp, pl1, mm, ml, 0))
- stw %r0, -52(0, %r30)
- b,n L$BMD8
-
-L$BMD2 comb,= ml, %r0, L$BMD7 ; if (ml==0) goto L$BMD7
- nop
- sub pl1, ml, pl1 ; pl1-=ml
-
- ldo -52(%r30), %r21
- extru dm, 31, 16, X ; Ld=dm & (2^16-1);
- stws X, 0(0, %r21)
- fldws 0(0, %r21), fLd
- extru dm, 15, 16, X ; Hd=dm>>16;
- stws X, 0(0, %r21)
- fldws 0(0, %r21), fHd
- ldi 0, dm ; dm=0
-
-L$BMD3 ldwm 4(mm), X1 ; X1=*(mm++)
- extru X1, 31, 16, X ; Lm=X1 & (2^16-1)
- stws X, 0(0, %r21)
- fldws 0(0, %r21), fLm
- extru X1, 15, 16, X ; Hm=X1>>16
- stws X, 0(0, %r21)
- fldws 0(0, %r21), fHm
-
- xmpyu fHm, fHd, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), X3
-
- xmpyu fLm, fHd, %fr4
- fstws %fr4R, -4(0, %r21)
-
- xmpyu fHm, fLd, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), X1
-
- xmpyu fLm, fLd, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), X
-
- add,nuv X, dm, dm
- ldo 1(X3), X3
- ldws -4(0, %r21), X
- add,nuv X1, X, X1 ; X1+=X
- addil L%(65536), X3 ; if overflow X3+=2^16;
- extru X1, 15, 16, X ; X = X1 >> 16
- add X3, X, X3 ; X3+=X
- zdep X1, 15, 16, X1 ; X1 =<< 16
- add,nuv dm, X1, dm ; dm+=X1
- ldo 1(X3), X3 ; if overflow X3++;
- ldws (pp), X ; X=*(pp)
- add,nuv X, dm, dm ; dm+=X;
- ldo 1(X3), X3 ; if overflow X3++;
- stwm dm, 4(pp) ; *(pp++)=dm
- addib,>,n -1, ml, L$BMD3 ; if ((--ml)>0) goto L$BMD3
- copy X3, dm ; dm=X3
-
- ldo -1(pl1), pl1 ; pl1--
- ldi 0, dm ; dm=0
- ldw (pp), X ; X=*pp
- add,nuv X, X3, X ; X+= X3
- ldi 1, dm ; if overflow dm=1;
- comb,= dm, %r0, L$BMD7 ; if (dm==0) goto L$BMD7
- stwm X, 4(pp) ; *(pp++)=X
- comb,=,n pl1, %r0, L$BMD9 ; if (pl1==0) goto L$BMD9
- ldw (pp), X
-L$BMD4 addi,uv 1, X, X ; X++
- b L$BMD7 ; if no overflow goto L$BMD7
- stwm X, 4(pp) ; *(pp++)=X
- addib,>,n -1, pl1, L$BMD4 ; if ((--pl1)>0) goto L$BMD4
- ldw (pp), X ; X=*(pp)
-L$BMD9 b L$BMD8 ; return(1)
- ldi 1, res
-L$BMD7 ldi 0, res ; return(0)
-L$BMD8 .LEAVE
- .PROCEND
-
-; conventions for BnnDivideDigit
-qq .REG %r3
-nn .REG %r4
-nl .REG %r5
-dd .REG %r6
-ch .REG %r7
-cl .REG %r8
-k .REG %r9
-f_qq .REG %r10
-o_nl .REG %r11
-rh .REG %r12
-rl .REG %r13
-ph .REG %r14
-pl .REG %r15
-qa .REG %r16
-fcl .REG %fr5L
-fch .REG %fr6L
-fqa .REG %fr7L
-
-
-
- .SPACE $TEXT$
- .SUBSPA $CODE$,QUAD=0,ALIGN=4,ACCESS=44,CODE_ONLY,SORT=24
-BnnDivideDigit
- .PROC
- .CALLINFO CALLER, FRAME=0, ENTRY_GR=16, SAVE_RP
- .ENTER ; (qq, nn, nl, dd)
- copy %arg0, qq ; qq=%arg0
- copy %arg1, nn ; nn=%arg1
- copy %arg2, nl ; nl=%arg2
- copy %arg3, dd ; dd=%arg3
- .CALL ;in=%arg0 ;out=%ret0 ; res=BnnNumLeadingZeroBitsInDigit(dd)
- bl BnnNumLeadingZeroBitsInDigit, %r2
- copy dd, %arg0
- comib,= 0, res, L$BDD1 ; k=res; if (k==0) goto L$BDD1
- copy res, k
- ldw (qq), f_qq ; f_qq=*qq
- copy nl, o_nl ; o_nl=nl
- subi 32, k, X
- mtsar X
- vshd dd, %r0, dd ; dd<<=k
- copy nn, %arg0
- copy nl, %arg1
- .CALL ;in=%arg0, %arg1, %arg2 ; out=%ret0
- bl BnnShiftLeft, %r2 ; BnnShiftLeft(nn, nl, k)
- copy k, %arg2
-
-L$BDD1 shd nl, %r0, 30, X ; X=nl<<2
- add nn, X, nn ; nn+=nl
- addi -1, nl, nl ; nl--
- shd nl, %r0, 30, X ; X=nl<<2
- add qq, X, qq ; qq+=nl
- extru dd, 15, 16, ch ; ch=dd>>16
- extru dd, 31, 16, cl ; cl=dd & (2^16-1)
- ldo -48(%r30), %r21
- stws cl, 0(0, %r21)
- fldws 0(0, %r21), fcl
- stws ch, 0(0, %r21)
- fldws 0(0, %r21), fch
- comib,= 0, nl, L$BDD3 ; if (nl==0) goto L$BDD3
- ldwm -4(nn), rl ; rl=*(--nn)
-
-L$BDD2 copy rl, rh ; rh=rl
- ldwm -4(nn), rl ; rl=*(--nn)
-
- copy rh, %arg0
- .CALL ;in=25,26;out=29; (MILLICALL)
- bl $$divU,%r31 ; %r29=rh/ch
- copy ch, %arg1
- copy %r29, qa ; qa=%r29
-
- stws qa, 0(0, %r21)
- fldws 0(0, %r21), fqa
- xmpyu fcl, fqa, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), pl
- xmpyu fch, fqa, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), %r29
-
- shd %r0, pl, 16, X ; X=pl>>16
- add %r29, X, ph ; ph=X+%r29
- comb,>> ph, rh, L$BDD84 ; if (ph>rh) goto L$BDD84
- shd pl, %r0, 16, pl ; pl<<=16
- comb,<> ph, rh, L$BDD88 ; if (ph!=rh) goto L$BDD88
- nop
- comb,<<=,n pl, rl, L$BDD88 ; if (pl<=rl) goto L$BDD88
-L$BDD84 shd cl, %r0, 16, X ; X = cl << 16
-L$BDD85 comb,<<= X, pl, L$BDD86 ; if (X<=pl) goto L$BDD86
- addi -1, qa, qa ; qa--
- addi -1, ph, ph ; ph--
-L$BDD86 sub pl, X, pl ; pl-=X
- sub ph, ch, ph ; ph-=ch
- comb,>> ph, rh, L$BDD85 ; if (ph>rh) goto L$BDD85
- nop
- comb,<> ph, rh, L$BDD88 ; if (ph!=rh) goto L$BDD88
- nop
- comb,>> pl, rl, L$BDD85 ; if (pl>rl) goto L$BDD85
- nop
-L$BDD88 comb,<<=,n pl, rl, L$BDD89 ; if (pl<=rl) goto L$BDD89
- addi -1, rh, rh ; rh--
-L$BDD89 sub rl, pl, rl ; rl-=pl
- sub rh, ph, rh ; rh-=ph
- shd qa, %r0, 16, X ; X=qa<<16
- stwm X, -4(qq) ; *(--qq)=X
- shd rh, %r0, 16, X ; X=rh<<16
- shd %r0, rl, 16, qa ; qa=rl>>16
- or qa, X, qa ; qa |=X
- copy qa, %arg0
- .CALL ;in=25,26;out=29; (MILLICALL)
- bl $$divU,%r31 ; %r29=qa/ch
- copy ch, %arg1
- copy %r29, qa ; qa=%r29
-
- stws qa, 0(0, %r21)
- fldws 0(0, %r21), fqa
- xmpyu fcl, fqa, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), pl
- xmpyu fch, fqa, %fr4
- fstws %fr4R, 0(0, %r21)
- ldws 0(0, %r21), %r29
-
- shd %r0, pl, 16, X ; X=pl>>16
- add %r29, X, ph ; ph+=X
- extru pl, 31, 16, pl ; pl &= (2^16-1)
- shd ph, %r0, 16, X ; X = ph<<16
- shd %r0, ph, 16, ph ; ph >>=16
- comb,>> ph, rh, L$BDD41 ; if (ph>rh) goto L$BDD41
- or X, pl, pl ; pl |= X
- comb,<> ph, rh, L$BDD44 ; if (ph!=rh) goto L$BDD44
- nop
- comb,<<= pl, rl, L$BDD44 ; if (pl<=rl) goto L$BDD44
- nop
-L$BDD41 comb,<<= dd, pl, L$BDD42 ; if (dd<=pl) goto L$BDD42
- addi -1, qa, qa ; qa--
- addi -1, ph, ph ; ph--
-L$BDD42 comb,>> ph, rh, L$BDD41 ; if (ph>rh) goto L$BDD4
- sub pl, dd, pl ; pl-=dd
- comb,<> ph, rh, L$BDD44 ; if (ph!=rh) goto L$BDD44
- nop
- comb,>>,n pl, rl, L$BDD41 ; if (pl>rl) goto L$BDD41
- nop
-L$BDD44 sub rl, pl, rl ; rl-=pl
- ldw (qq), X ; X=*qq
- or X, qa, X ; X |= qa
- addib,> -1, nl, L$BDD2 ; if ((--nl)>0) goto L$BDD2
- stws X, (qq) ; *qq=X
-
-
-L$BDD3 comib,= 0, k, L$BDD5 ; if (k==0) goto L$BDD5
- nop
- comb,<<,n qq, nn, L$BDD31 ; if (qq<nn) goto L$BDD31
- shd o_nl, %r0, 30, Y
- add nn, Y, X ; X=nn+o_nl
- comb,<<= X, qq, L$BDD31 ; if (X<=qq) goto L$BDD31
- nop
- sub qq, nn, o_nl ; o_nl=qq-nn
- shd %r0, o_nl, 2, o_nl ; o_nl>>=2
- ldw (qq), W ; W=*qq
- stws f_qq, (qq) ; *qq=f_qq
- copy nn, %arg0
- addi 1, o_nl, %arg1 ; %arg1=o_nl+1
- .CALL ;in=%arg0, %arg1, %arg2 ;out=%ret0
- bl BnnShiftRight, %r2 ; BnnShiftRight(nn, o_nl, k)
- copy k, %arg2
- b L$BDD5
- stws W, (qq) ; *qq=W
-L$BDD31 comb,<>,n qq, nn, L$BDD32 ; if (qq<>nn) goto L$BDD32
- addi -1, o_nl, o_nl ; o_nl--
- shd o_nl, %r0, 30, o_nl ; o_nl<<=2
- add nn, o_nl, nn ; nn+=o_nl
- ldi 1, o_nl
-L$BDD32 copy nn, %arg0
- copy o_nl, %arg1
- .CALL ;in=%arg0, %arg1, %arg2 ;out=%ret0
- bl BnnShiftRight, %r2 ; BnnShiftRight(nn, o_nl, k)
- copy k, %arg2
-
-L$BDD5 mtsar k
- vshd %r0, rl, res ; return(rl>>k)
-L$BDD6 .LEAVE
- .PROCEND
-
-
- .SPACE $TEXT$
- .SUBSPA $LIT$,QUAD=0,ALIGN=8,ACCESS=44,SORT=16
-$THIS_LIT$
-
- .SUBSPA $LITSTATIC$,QUAD=0,ALIGN=8,ACCESS=44,SORT=16
-$THIS_LITSTATIC$
-
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SUBSPA $CODE$
- .SPACE $PRIVATE$,SORT=16
- .SUBSPA $DATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=16
-$THIS_DATA$
-
- .SUBSPA $SHORTDATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=16
-$THIS_SHORTDATA$
-
- .SUBSPA $BSS$,QUAD=1,ALIGN=8,ACCESS=31,ZERO,SORT=82
-$THIS_BSS$
-
- .SUBSPA $SHORTBSS$,QUAD=1,ALIGN=8,ACCESS=31,ZERO,SORT=80
-$THIS_SHORTBSS$
-
- .SUBSPA $STATICDATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=16
-$THIS_STATICDATA$
- .ALIGN 4
- .STRINGZ "@(#)KerN.c: copyright Digital Equipment Corporation & INRIA 1988, 1989\n"
- .SUBSPA $SHORTSTATICDATA$,QUAD=1,ALIGN=8,ACCESS=31,SORT=24
-$THIS_SHORTSTATICDATA$
-
- .SPACE $TEXT$
- .SUBSPA $CODE$
- .EXPORT BnnSetToZero,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR
- .IMPORT bzero,CODE
- .SUBSPA $CODE$
- .EXPORT BnnAssign,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR
- .IMPORT bcopy,CODE
- .SUBSPA $CODE$
- .EXPORT BnnSetDigit,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR
- .SUBSPA $CODE$
- .EXPORT BnnGetDigit,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnNumDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnNumLeadingZeroBitsInDigit,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnDoesDigitFitInWord,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnIsDigitZero,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnIsDigitNormalized,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnIsDigitOdd,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnCompareDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnComplement,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR
- .SUBSPA $CODE$
- .EXPORT BnnAndDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR
- .SUBSPA $CODE$
- .EXPORT BnnOrDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR
- .SUBSPA $CODE$
- .EXPORT BnnXorDigits,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR
- .SUBSPA $CODE$
- .EXPORT BnnShiftLeft,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnShiftRight,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnAddCarry,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnAdd,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnSubtractBorrow,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnSubtract,ENTRY,PRIV_LEV=3,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR
- .SUBSPA $CODE$
- .EXPORT BnnMultiplyDigit,ENTRY,PRIV_LEV=0,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR
- .IMPORT $$mulU,MILLICODE
- .SUBSPA $CODE$
- .EXPORT BnnDivideDigit,ENTRY,PRIV_LEV=0,ARGW0=GR,ARGW1=GR,ARGW2=GR,ARGW3=GR,RTNVAL=GR
- .IMPORT $$divU,MILLICODE
- .IMPORT $$remU,MILLICODE
- .END
+++ /dev/null
-/*
-** (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
-
-
+++ /dev/null
- # 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
+++ /dev/null
-# 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
+++ /dev/null
-# 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
-
+++ /dev/null
-! 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
+++ /dev/null
-! 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
+++ /dev/null
-! 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
-
+++ /dev/null
-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
+++ /dev/null
-; Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990
-;
-; KerN for the VAX.
-; [Bepaul, Shand]
-; Last modified_on Mon Apr 2 21:03:05 GMT+2:00 1990 by shand
-; modified_on Mon Nov 20 13:51:10 GMT+1:00 1989 by herve
-; modified_on 17-OCT-1989 20:37:48 by Jim Lawton
-;
-; >>> IMPORTANT <<< DO NOT MODIFY THIS FILE -- IT IS GENERATED FROM vaxKerN.s
-;
-; >>> READ THIS <<<
-;
-; This file is automatically converted from unix to VAX/VMS assembler format.
-; On VMS it is the callee's rsponsiblity to save all modified registers
-; other than r0 and r1. On Ultrix r0-r5 are considered saved by caller.
-; Specify procedure entry masks that save ALL modified registers (including
-; r0 and r1) and "&" them with "callee_save" which is a predefined constant
-; that eliminates the saves which are unnecessary under whichever calling
-; convention the file is being assembler for.
- callee_save = ^C3
- ; WARNING: text after comment used in conversion to VMS format assembler
- .psect vaxKerN_data,noexe,quad
-_copyright: .ascii "@(#)vaxKerN.s: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\12\0"
- ; WARNING: text after comment used in conversion to VMS format assembler
- .psect vaxKerN,exe,shr,pic,nowrt,quad
- .globl BnnSetToZero
- .align 3
-BnnSetToZero:
- .word ^X3&callee_save ; mask<r0,r1>
- movl 4(ap),r0 ; nn
- movl 8(ap),r1 ; nl
- sobgeq r1,LSTZ1 ; if(nl--) goto LSTZ1
- ret ; return;
-LSTZ1: clrl (r0)+ ; *(nn++) = 0;
- sobgeq r1,LSTZ1 ; if(nl--) goto LSTZ1;
- ret
-
- .globl BnnAssign
- .align 3
-BnnAssign:
- .word ^X7&callee_save ; mask<r0,r1,r2>
- movl 4(ap),r0 ; mm
- movl 8(ap),r1 ; nn
- movl 12(ap),r2 ; nl
- cmpl r0,r1
- bgequ LAG2 ; if(mm >= nn) goto LAG2;
- sobgeq r2,LAG1 ; if(nl--) goto LAG1;
- ret ; return;
-LAG1: movl (r1)+,(r0)+ ; *(mm++) = *(nn++);
- sobgeq r2,LAG1 ; if(nl--) goto LAG1;
-LAG2: blequ LAG4 ; if(mm <= nn) goto LAG4;
- moval (r0)[r2],r0 ; mm = &mm[nl];
- moval (r1)[r2],r1 ; nn = &nn[nl];
- sobgeq r2,LAG3 ; if(nl--) goto LAG3;
- ret ; return;
-LAG3: movl -(r1),-(r0) ; *(--mm) = *(--nn);
- sobgeq r2,LAG3 ; if(nl--) goto LAG3;
-LAG4: ret ; return;
-
- .globl BnnSetDigit
- .align 3
-BnnSetDigit:
- .word ^X0&callee_save ; mask<>
- movl 8(ap),@4(ap) ; *nn = d;
- ret
-
- .globl BnnGetDigit
- .align 3
-BnnGetDigit:
- .word ^X0&callee_save ; mask<>
- movl @4(ap),r0 ; return(*nn);
- ret
-
- .globl BnnNumDigits
- .align 3
-BnnNumDigits:
- .word ^X2&callee_save ; mask<r1>
- movl 8(ap),r0 ; nl
- moval @4(ap)[r0],r1 ; nn = &nn[nd];
- sobgeq r0,LND1 ; if(nl-- != 0) goto LND1;
- movl #1,r0
- ret ; return(1);
-LND1: tstl -(r1)
- bneq LND3 ; if(*(--n) != 0) goto LND3;
- sobgeq r0,LND1 ; if(nl-- != 0) goto LND1;
- movl #1,r0
- ret ; return(1);
-LND3: incl r0
- ret ; return(nl + 1);
-
- .globl BnnNumLeadingZeroBitsInDigit
- .align 3
-BnnNumLeadingZeroBitsInDigit:
- .word ^X2&callee_save ; mask<r1>
- movl 4(ap),r1 ; d
- movl #31,r0
-LLZ1: bbs r0,r1,LLZ2
- sobgeq r0,LLZ1
-LLZ2: subl3 r0,#31,r0
- ret
-
- .globl BnnDoesDigitFitInWord
- .align 3
-BnnDoesDigitFitInWord:
- .word ^X0&callee_save ; mask<>
- movl #1,r0 ; C_VERSION
- ret
-
- .globl BnnIsDigitZero
- .align 3
-BnnIsDigitZero:
- .word ^X2&callee_save ; mask<r1>
- tstl 4(ap) ; d
- bneq LDZ1 ; if(d) goto LDZ1;
- movl #1,r0
- ret ; return(1);
-LDZ1: clrl r0
- ret ; return(0);
-
- .globl BnnIsDigitNormalized
-; Boolean BnIsDigitNormalized(n, nd) BigNum n; int nd; {
- .align 3
-BnnIsDigitNormalized:
- .word ^X0&callee_save ; mask<>
- movl 4(ap),r0 ; d
- extzv #31,#1,r0,r0 ; return(d >> 31);
- ret
-
- .globl BnnIsDigitOdd
- .align 3
-BnnIsDigitOdd:
- .word ^X0&callee_save ; mask<>
- bicl3 #-2,4(ap),r0 ; return(d || 1);
- ret
-
- .globl BnnCompareDigits
- .align 3
-BnnCompareDigits:
- .word ^X0&callee_save ; mask<>
- cmpl 4(ap),8(ap) ; cmpl d1,d2
- beql LCDeq ; if(d0 == d1) goto LCDeq
- blssu LCDinf ; if(d0 < d1) goto LCDinf
- movl #1,r0 ; return(1);
- ret
-LCDeq: clrl r0 ; return(0);
- ret
-LCDinf: movl #-1,r0 ; return(-1);
- ret
-
- .globl BnnComplement
- .align 3
-BnnComplement:
- .word ^X2&callee_save ; mask<r1>
- movl 4(ap),r0 ; nn
- movl 8(ap),r1 ; nl
- sobgeq r1,LCM1 ; if(nl-- != 0) goto LCM1;
- ret
-LCM1: mcoml (r0),(r0)+ ; *(n++) ^= -1;
- sobgeq r1,LCM1 ; if(nl-- != 0) goto LCM1;
- ret
-
- .globl BnnAndDigits
- .align 3
-BnnAndDigits:
- .word ^X0&callee_save ; mask<>
- mcoml 8(ap),r0 ; d = ~d;
- bicl2 r0,@4(ap) ; *nn &= ~d;
- ret
-
- .globl BnnOrDigits
- .align 3
-BnnOrDigits:
- .word ^X0&callee_save ; mask<>
- bisl2 8(ap),@4(ap) ; *nn |= d;
- ret
-
- .globl BnnXorDigits
- .align 3
-BnnXorDigits:
- .word ^X0&callee_save ; mask<>
- xorl2 8(ap),@4(ap) ; *nn ^= d;
- ret
-
- .globl BnnShiftLeft
- .align 3
-BnnShiftLeft:
- .word ^X7E&callee_save ; mask<r1,r2,r3,r4,r5,r6>
- clrl r0 ; res = 0;
- movl 12(ap),r3 ; nbi
- bneq LSL0 ; if(nbi) goto LSL0
- ret ; return(res);
-LSL0: movl 4(ap),r2 ; mm
- movl 8(ap),r1 ; ml
- subl3 r3,#32,r4 ; rnbi = BN_DIGIT_SIZE - nbi;
- sobgeq r1,LSL1 ; if(ml-- != 0) goto LSL1;
- ret ; return(res);
-LSL1: movl (r2),r5 ; save = *mm
- ashl r3,r5,r6 ; X = save << nbi;
- bisl3 r0,r6,(r2)+ ; *(mm++) = X | res;
- extzv r4,r3,r5,r0 ; res = save >> rnbits;
- sobgeq r1,LSL1 ; if(ml-- != 0) goto LSL1;
- ret ; return(res);
-
- .globl BnnShiftRight
- .align 3
-BnnShiftRight:
- .word ^X7E&callee_save ; mask<r1,r2,r3,r4,r5,r6>
- clrl r0 ; res = 0;
- movl 12(ap),r3 ; nbi
- bneq LSR0 ; if(nbi) goto LSR0;
- ret ; return(res);
-LSR0: movl 8(ap),r1 ; ml
- moval @4(ap)[r1],r2 ; mm = &mm[ml];
- subl3 r3,#32,r4 ; lnbi = BN_DIGIT_SIZE - nbi;
- sobgeq r1,LSR1 ; if(ml-- != 0) goto LSR1;
- ret ; return(res);
-LSR1: movl -(r2),r5 ; save = *(--mm);
- extzv r3,r4,r5,r6 ; X = save >> nbi;
- bisl3 r0,r6,(r2) ; *mm = X | res;
- ashl r4,r5,r0 ; res = save << lnbi;
- sobgeq r1,LSR1 ; if(ml-- != 0) goto LSR1;
- ret ; return(res);
-
- .globl BnnAddCarry
- .align 3
-BnnAddCarry:
- .word ^X2&callee_save ; mask<r1>
- movl 12(ap),r0 ; car
- beql LAC3 ; if(car == 0) return(car);
- movl 8(ap),r0 ; nl
- beql LAC2 ; if(nl == 0) return(1);
- movl 4(ap),r1 ; nn
-LAC1: incl (r1)+ ; ++(*nn++);
- bcc LAC4 ; if(!Carry) goto LAC4
- sobgtr r0,LAC1 ; if(--nl > 0) goto LAC1;
-LAC2: movl #1,r0 ; return(1);
-LAC3: ret
-LAC4: clrl r0 ; return(0);
- ret
-
- .globl BnnAdd
- .align 3
-BnnAdd:
- .word ^X1E&callee_save ; mask<r1,r2,r3,r4>
-LADDEntry: movl 4(ap),r0 ; mm
- movl 12(ap),r1 ; nn
- movl 16(ap),r3 ; nl
- bneq LADD1 ; if(nl) goto LADD1
- subl3 r3,8(ap),r2 ; ml -= nl;
- tstl 20(ap) ; car
- bneq LADD5 ; if(car) goto LADD5
- clrl r0
- ret ; return(0);
-LADD1: subl3 r3,8(ap),r2 ; ml -= nl;
- addl3 20(ap),#-1,r4 ; C = car
-
-LADD2: adwc (r1)+,(r0)+ ; *(m++) += *(n++) + C;
-LADD3: sobgtr r3,LADD2 ; if(--nl > 0) goto LADD2;
- bcs LADD5 ; if(C) goto LADD5;
-LADD4: clrl r0
- ret
-
-LADD6: incl (r0)+ ; ++(*m++);
- bcc LADD4 ; if(!C) goto LADD4;
-LADD5: sobgeq r2,LADD6 ; if(--ml >= 0) goto LADD6;
-LADD7: movl #1,r0
- ret
-
- .globl BnnSubtractBorrow
- .align 3
-BnnSubtractBorrow:
- .word ^X2&callee_save ; mask<r1>
- movl 12(ap),r0 ; car
- bneq LSB2 ; if(car) return(car);
- movl 8(ap),r0 ; nl
- beql LSB20 ; if(nl == 0) return(0);
- movl 4(ap),r1 ; nn
-LSB1: decl (r1)+ ; (*nn++)--;
- bcc LSB3 ; if(!Carry) goto LSB3;
- sobgtr r0,LSB1 ; if(--nl > 0) goto LSB1;
-LSB20: ; assert r0 == 0 return(0);
-LSB2: ret
-LSB3: movl #1,r0 ; return(1);
- ret
-
- .globl BnnSubtract
- .align 3
-BnnSubtract:
- .word ^X1E&callee_save ; mask<r1,r2,r3,r4>
- movl 4(ap),r2 ; mm
- movl 12(ap),r1 ; nn
- movl 16(ap),r3 ; nl
- bneq LS1 ; if(nl) goto LS1
- subl3 r3,8(ap),r0 ; ml -= nl;
- tstl 20(ap) ; car
- beql LS5 ; if(car) goto LS5
- movl #1,r0
- ret ; return(1);
-LS1: subl3 r3,8(ap),r0 ; ml -= nl;
- tstl 20(ap) ; C = 0; Z = (car == 0)
- bneq LS2 ; if(!(Z = (car == 0))) goto LS2
- addl3 #1,#-1,r4 ; C = 1;
-
-LS2: sbwc (r1)+,(r2)+ ; C..*m++ -= *n++ + C
- sobgtr r3,LS2 ; if(--nl > 0) goto LS2
- bcs LS5
-LS3: movl #1,r0
- ret
-LS4: decl (r2)+
- bcc LS3
-LS5: sobgeq r0,LS4 ; if (--ml >= 0) goto LS4
- clrl r0
- ret
-
- .globl BnnMultiplyDigit
-; note1: (2^32-1)*(2^32-1) = 2^64-1 - 2*(2^32-1)
-; thus 64 bits accomodates a*b+c+d for all a,b,c,d < 2^32
-; note2: inner loop is doubled to avoid unnecessary register moves.
- .align 3
-BnnMultiplyDigit:
- .word ^X1FE&callee_save ; mask<r1,r2,r3,r4,r5,r6,r7,r8>
- movl 20(ap),r2 ; r2 = d
- blss LMDNeg ; if (d<0) goto LMDNeg
- bneq LMD1 ; if (d) goto LMD1;
- clrl r0
- ret
-LMD1: cmpl #1,r2
- bneq LMD2 ; if (d != 1) goto LMD2
- clrl 20(ap) ; IN BnnAdd: car = 0
- brw LADDEntry ; BnnAdd(pp,pl,mm,ml,0);
-
-LMD2: movl 4(ap),r3 ; r3 = p
- movl 12(ap),r1 ; r1 = m
- movl 16(ap),r7 ; r7 = ml
- subl3 r7,8(ap),r8 ; r8 = pl-ml
- ashl #-1,r7,r0 ; loop counter r0 = (ml+1)/2
- clrl r5
- bitl #1,r7
- bneq LMDPOddLen ; if (ml is odd) goto LMDPOddLen
- clrl r7
- brb LMDPEvenLen ; if (ml is even) goto LMDPOddLen
-LMDPLoop: emul (r1)+,r2,#0,r4 ; r4:r5 = m[i]*d
- bgeq LMDMPos1 ; if (m[i] < 0)
- addl2 r2,r5 ; r5 += d
-LMDMPos1: addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ ; *p++ += r4
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2
-LMDPOddLen: emul (r1)+,r2,#0,r6 ; r6:r7 = m[i+1]*d
- bgeq LMDMPos2 ; if (m[i+1] < 0)
- addl2 r2,r7 ; r7 += d
-LMDMPos2: addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ ; *p++ += r6
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2
-LMDPEvenLen: sobgeq r0,LMDPLoop ; if ((i+=2)/2 < ml/2) repeat loop
- addl2 r7,(r3)+ ; *p += (m[ml-1]*d)/2^32
- bcs LMDTail
-LMDRet0: clrl r0
- ret
-
-LMDNeg: movl 4(ap),r3 ; r3 = p
- movl 12(ap),r1 ; r1 = m
- movl 16(ap),r7 ; r7 = ml
- subl3 r7,8(ap),r8 ; r8 = pl-ml
- ashl #-1,r7,r0 ; loop counter r0 = (ml+1)/2
- clrl r5
- bitl #1,r7
- bneq LMDNOddLen
- clrl r7
- brb LMDNEvenLen
-LMDNLoop: movl (r1)+,r6 ; r6 = m[i]
- emul r6,r2,#0,r4 ; r4:r5 = m[i]*d
- bleq LMDMPos3 ; if (m[i] < 0)
- addl2 r2,r5 ; r5 += d
-LMDMPos3: addl2 r6,r5 ; r5 += m[i]
- addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ ; *p++ += r4
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2
-LMDNOddLen: movl (r1)+,r4 ; r6 = m[i+1]
- emul r4,r2,#0,r6 ; r6:r7 = m[i+1]*d
- bleq LMDMPos4 ; if (m[i+1] < 0)
- addl2 r2,r7 ; r7 += d
-LMDMPos4: addl2 r4,r7 ; r7 += m[i+1]
- addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ ; *p++ += r6
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2
-LMDNEvenLen: sobgeq r0,LMDNLoop ; if ((i+=2)/2 < ml/2) repeat loop
- addl2 r7,(r3)+ ; *p += (m[ml-1]*d)/2^32
- bcs LMDTail
- clrl r0 ; r0 = carry
- ret
-
-LMDTailLoop: incl (r3)+
- bcc LMDRet0
-LMDTail: sobgtr r8,LMDTailLoop
- movl #1,r0 ; r0 = carry
- ret
-
- .globl BnnDivideDigit
- .align 3
-BnnDivideDigit:
- .word ^X3FE&callee_save ; mask<r1,r2,r3,r4,r5,r6,r7,r8,r9>
- movl 12(ap),r2 ; nl
- movl 16(ap),r3 ; d
- moval @8(ap)[r2],r0 ; nn = &nn[nl];
- decl r2 ; nl--;
- moval @4(ap)[r2],r1 ; qq = &qq[nl];
- movl -(r0),r5 ; X(hight) = *(--n);
- extzv #1,#31,r3,r7 ; r7 = D' <- D div 2
- tstl r3
- bgeq Lndivc2
- brw Lndiv5 ; D < 0!!
-
- ; D < 2**31
- brb Lndivc2 ; N < D * 2**32
-Lndivc1: movl -(r0),r4 ; (bdivu dx3 ax1 dx1)
- cmpl r5,r7
- blss Lndivc11
- extzv #0,#1,r4,r6 ; r6 <- n0
- ashq #-1,r4,r4 ; N' = r4 = N quo 2 < D * 2**31
- ediv r3,r4,r4,r5 ; r4 <- Q' = N' quo D < 2**31
- ; r5 <- R' = N' rem D < D
- ashq #1,r4,r4 ; r4 <- 2 * Q' < 2**32
- ; r5 <- 2 * R' < 2 * D
- addl2 r6,r5 ; r5 <- 2 * R' + n0 < 2 * D
- cmpl r5,r3 ; r5 < D -> Q = r4, R = r5
- blssu Lndivc12 ; sinon
- incl r4 ; Q = r4 + 1
- subl2 r3,r5 ; R = r5 - D
- brb Lndivc12
-Lndivc11: ediv r3,r4,r4,r5 ; Q = r4, R = r5
-Lndivc12: movl r4,-(r1) ; range r4 en me'moire
-Lndivc2: sobgeq r2,Lndivc1 ; (sobgez dx2 Lndivc1)
- movl r5,r0 ; return(X(hight));
- ret
-
-Lndiv3: movl -(r0),r4 ; r4 poid faible de N
- extzv #0,#1,r4,r9 ; r9 <- n0
- extzv #1,#1,r4,r6 ; r6 <- n1
- extzv #2,#1,r4,r8 ; r8 <- n2
- ashq #-3,r4,r4 ; r4 <- N'' = N quo 4
- bicl2 #^XE0000000,r5 ; Le ashq ne le fait pas
- ediv r7,r4,r4,r5 ; r4 <- Q' = N''' quo D'
- ; r5 <- R' = N''' rem D'
- ashl #1,r5,r5 ; r5 <- 2 * R'
- addl2 r8,r5 ; r5 <- 2 * R' + n2
- bbc #0,r3,Lndiv4 ; si d0 = 0
- cmpl r5,r4 ; sinon r5 <- 2R' + n1 - Q'
- blssu Lndiv30 ; la diff est < 0
- subl2 r4,r5 ; la diff est > 0
- brb Lndiv4 ; voila la diff!
-Lndiv30: subl2 r4,r5 ; la diff!
- decl r4 ; r4 <- r4 - 1
- addl2 r3,r5 ; r5 <- r5 + D
-Lndiv4: ashl #1,r4,r4 ; r4 <- 2Q'
- addl2 r5,r5 ; r5 <- 2r5
- bisl2 r6,r5 ; r5 <- r5 + n1 (flag C ok!)
- bcs Lndiv40 ; On deborde sur!
- cmpl r5,r3
- blssu Lndiv42 ; depasse pas D
-Lndiv40: incl r4 ; Q = r4 + 1
- subl2 r3,r5 ; R = r5 - D
-Lndiv42: ashl #1,r4,r4 ; r4 <- 2Q'
- addl2 r5,r5 ; r5 <- 2r5
- bisl2 r9,r5 ; r5 <- r5 + n0 (flag C ok!)
- bcs Lndiv43 ; On deborde sur!
- cmpl r5,r3
- blssu Lndiv44 ; depasse pas D
-Lndiv43: incl r4 ; Q = r4 + 1
- subl2 r3,r5 ; R = r5 - D
-Lndiv44: movl r4,-(r1) ; range le quotient en memoire
-Lndiv5: sobgeq r2,Lndiv3 ; On continue!
- movl r5,r0 ; return(X(hight));
- ret
-
-; BigNumCarry BnnMultiply (pp, pl, mm, ml, nn, nl)
-; BigNum pp, nn, mm;
-; BigNumLength pl, nl, ml;
-
-.globl BnnMultiply
- .align 3
-BnnMultiply:
- .word ^XFFE&callee_save ; mask<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
- movl 24(ap),r9 ; r9 = nl
- bneq LMM_nl_pos
-LMM_Ret0a:
- clrl r0
-LMM_Ret:
- ret
-LMM_nl_pos:
- movl 20(ap),r11 ; nn
- cmpl 12(ap),r11 ; if (nn == mm)
- beql BMM_Sqr
-LMM_NotSqr:
- movl 4(ap),r10 ; pp
- clrl r8 ; c_hi
-LMM_NLoop:
- movl 16(ap),r7 ; ml
- movl 12(ap),r1 ; mm
- moval (r10)+,r3 ; pp
- clrl r5 ; c_lo
- movl (r11)+,r2 ; digit
- bsbw BMM_MultiplyDigit
- sobgtr r9,LMM_NLoop
- movl r8,r0
- beql LMM_Ret
- movl 16(ap),r7 ; r7 = ml
- subl3 r7,8(ap),r1 ; r7 = pl-ml
- subl2 24(ap),r1 ; r7 = pl-ml-nl
- bleq LMM_Ret
- moval (r10)[r7],r10 ; pp += ml
-LMM_PLoop:
- incl (r10)+
- bcc LMM_Ret0a
- sobgtr r1,LMM_PLoop
- ret
-; Special squaring code based on:
-; n[0..nl-1]*n[0..nl-1] = sum (i = 0..nl-1):
-; B^2i * (n[i]*n[i] + 2*n[i] * n[i+1..nl-1] * B)
-; the 2*n[i] is tricky because it may overflow, but ...
-; suppose L[i] = 2*n[i]%2^32
-; and H[i] = 2*n[i]/2^32
-; Then:
-; sum (i = 0..nl-1):
-; B^2i * (n[i]*n[i] + L[i]+H[i-1] * n[i+1..nl-1] * B + H[i-1]*n[i])
-; notice that when i = nl-1 the final term is 2*n[nl-1] * n[nl..nl-1],
-; n[nl..nl-1] is zero length -- i.e. we can ignore it!
-; lastly we don't have quite enough registers to conveniently remember
-; the top bit of n[i-1] we encode it in the PC by duplicating
-; the loop--sometimes I love assembler.
-LMMS_NNLoop:
- ; execute this version of loop if n[i-1] was >= 2^31
- movl (r11)+,r0 ; d = r0 = *nn++
- movl r11,r1 ; r1 = mm
- emul r0,r0,#0,r4 ; r4:r5 = d*d
- addl2 r0,r4 ; r4 += (2*n[i-1])/2^32*n[i] (= d)
- adwc #0,r5
- addl2 r4,(r10)+ ; *pp++ += d*d%2^32
- adwc #0,r5 ; r5 += C
- moval (r10)+,r3 ; arg-p = pp++
- movl r9,r7 ; arg-ml = ml
- addl3 r0,r0,r2 ; if (d >= 0)
- bisl2 #1,r2
- bcc LMMS_DPos ; switch to < 2^31 loop
-LMMS_DNeg:
- addl2 r0,r5 ; compensate for signed mul
- addl2 r0,r5 ; r4:r5 += 2*r2*2^32
- tstl r2 ; set condition codes for entry to subr
- ; MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5)
- bsbb BMM_MultiplyDigit
- sobgeq r9,LMMS_NNLoop
- brb LMMS_Post
-; >>> ENTRY <<<
-BMM_Sqr:
- ; r9 = nl, r11 = nn
- movl 16(ap),r8 ; r8 = ml
- bneq LMMS_ml_pos
- clrl r0
- ret ; return 0;
-LMMS_ml_pos:
- cmpl r8,r9 ; if (ml != nl)
- bneq LMM_NotSqr
-
- ; r8 = 0, r9 = nl, r11 = nn, r10 = sgn(nn[nl-1])
- movl 4(ap),r10 ; r10 = pp
- ; r11 = nn
- clrl r8 ; r8 = high carry = 0
- decl r9 ; r9 = ml-1 = nl-1
-LMMS_NLoop:
- ; execute this version of loop if n[i-1] was < 2^31
- movl (r11)+,r0 ; d = r0 = *nn++
- movl r11,r1 ; r1 = mm
- emul r0,r0,#0,r4 ; r4:r5 = d*d
- addl2 r4,(r10)+ ; *pp++ += d*d%2^32
- adwc #0,r5 ; r5 += C
- moval (r10)+,r3 ; arg-p = pp++
- movl r9,r7 ; arg-ml = ml
- addl3 r0,r0,r2 ; if (d < 0)
- bcs LMMS_DNeg ; switch to >= 2^31 loop
-LMMS_DPos:
- tstl r2 ; set condition codes for entry to subr
- ; MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5)
- bsbb BMM_MultiplyDigit
- sobgeq r9,LMMS_NLoop
- ; r9 = 0, r10 = pp+2*ml, r2 = 2*nn[nl-1], r8 = carry_hi, r11 = nn+nl
-LMMS_Post:
- movl r8,r0
- bneq LMMS_CProp ; if (c != 0)
-LMMS_ret:
- ret ; return
-LMMS_CProp:
- movl 16(ap),r7 ; r7 = nl
- subl3 r7,8(ap),r2 ; r2 = pl-nl (note nl == ml)
- subl2 r7,r2 ; r2 = pl-nl-ml
- bleq LMMS_ret ; if (pl-nl > ml)
- ; ret = BnnAddCarry(pp+ml, pl-ml, c);
-LMMS_CPLoop:
- incl (r10)+ ; (*pp++)++
- bcc LMMS_Ret0
- sobgtr r2,LMMS_CPLoop
- ret
-LMMS_Ret0:
- clrl r0
- ret
-
-; Subroutine: MultiplyDigit(pp,mm,ml,d,c_hi,c_lo)
-; returns:
-; c_hi*base^(ml+1)+ pp[0..ml] = pp[0..ml]+(mm[0..ml-1]*d)+c_hi*base^ml+c_lo
-;
-; In:
-; ml_entry:r7
-; ml/2: r0
-; mm: r1
-; digit: r2
-; pp: r3
-; c_hi: r8
-; c_lo: r5
-;
-; multiply scratch: r4,r5 / r6,r7
-;
-; Out:
-; c_hi: r8
-LMMD_C_hi:
- addl2 r8,(r3)[r7] ; p[ml] += c_hi
- clrl r8
- adwc #0,r8
- rsb
-LMMD_Zero:
- tstl r5 ; Too complicated, return to
- beql LMMD_ZC_lo ; normal case.
- tstl r2
- brb LMMD_Retry
-LMMD_ZC_lo:
- tstl r8
- bneq LMMD_C_hi
- rsb
-BMM_MultiplyDigit:
- beql LMMD_Zero
-LMMD_Retry:
- blss LMMD_Neg ; if (d<0) goto LMMD_Neg
- ashl #-1,r7,r0 ; loop counter r0 = ml/2
- bitl #1,r7
- bneq LMMD_POddLen ; if (ml is odd) goto LMMD_POddLen
- movl r5,r7
- brb LMMD_PEvenLen ; if (ml is even) goto LMMD_POddLen
-LMMD_PLoop: emul (r1)+,r2,#0,r4 ; r4:r5 = m[i]*d
- bgeq LMMD_MPos1 ; if (m[i] < 0)
- addl2 r2,r5 ; r5 += d
-LMMD_MPos1: addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ ; *p++ += r4
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2
-LMMD_POddLen: emul (r1)+,r2,#0,r6 ; r6:r7 = m[i+1]*d
- bgeq LMMD_MPos2 ; if (m[i+1] < 0)
- addl2 r2,r7 ; r7 += d
-LMMD_MPos2: addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ ; *p++ += r6
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2
-LMMD_PEvenLen: sobgeq r0,LMMD_PLoop ; if ((i+=2)/2 < ml/2) repeat loop
- addl2 r8,r7
- clrl r8
- adwc #0,r8
- addl2 r7,(r3) ; *p += (m[ml-1]*d)/2^32
- adwc #0,r8
- rsb
-LMMD_Neg:
- ashl #-1,r7,r0 ; loop counter r0 = ml/2
- bitl #1,r7
- bneq LMMD_NOddLen
- movl r5,r7
- brb LMMD_NEvenLen
-LMMD_NLoop: movl (r1)+,r6 ; r6 = m[i]
- emul r6,r2,#0,r4 ; r4:r5 = m[i]*d
- bleq LMMD_MPos3 ; if (m[i] < 0)
- addl2 r2,r5 ; r5 += d
-LMMD_MPos3: addl2 r6,r5 ; r5 += m[i]
- addl2 r7,r4 ; r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ ; *p++ += r4
- adwc #0,r5 ; r5 = (m[i]*d)/2^32 + carry2
-LMMD_NOddLen: movl (r1)+,r4 ; r6 = m[i+1]
- emul r4,r2,#0,r6 ; r6:r7 = m[i+1]*d
- bleq LMMD_MPos4 ; if (m[i+1] < 0)
- addl2 r2,r7 ; r7 += d
-LMMD_MPos4: addl2 r4,r7 ; r7 += m[i+1]
- addl2 r5,r6 ; r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ ; *p++ += r6
- adwc #0,r7 ; r7 = (m[i+1]*d)/2^32 + carry2
-LMMD_NEvenLen: sobgeq r0,LMMD_NLoop ; if ((i+=2)/2 < ml/2) repeat loop
- addl2 r8,r7
- clrl r8
- adwc #0,r8
- addl2 r7,(r3) ; *p += (m[ml-1]*d)/2^32
- adwc #0,r8
- rsb
-.end
+++ /dev/null
-# Copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990
-#
-# KerN for the VAX.
-# [Bepaul, Shand]
-# Last modified_on Mon Apr 2 21:03:05 GMT+2:00 1990 by shand
-# modified_on Mon Nov 20 13:51:10 GMT+1:00 1989 by herve
-# modified_on 17-OCT-1989 20:37:48 by Jim Lawton
-#
-# >>> IMPORTANT <<< DO NOT MODIFY THIS LINE
-#
-# >>> READ THIS <<<
-#
-# This file is automatically converted from unix to VAX/VMS assembler format.
-# On VMS it is the callee's rsponsiblity to save all modified registers
-# other than r0 and r1. On Ultrix r0-r5 are considered saved by caller.
-# Specify procedure entry masks that save ALL modified registers (including
-# r0 and r1) and "&" them with "callee_save" which is a predefined constant
-# that eliminates the saves which are unnecessary under whichever calling
-# convention the file is being assembler for.
-.set callee_save,~63
- # WARNING: text after comment used in conversion to VMS format assembler
- .data # vaxKerN_data
-_copyright: .ascii "@(#)vaxKerN.s: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\12\0"
- # WARNING: text after comment used in conversion to VMS format assembler
- .text # vaxKerN
- .globl _BnnSetToZero
- .align 3
-_BnnSetToZero:
- .word 0x3&callee_save # mask<r0,r1>
- movl 4(ap),r0 # nn
- movl 8(ap),r1 # nl
- sobgeq r1,LSTZ1 # if(nl--) goto LSTZ1
- ret # return;
-LSTZ1: clrl (r0)+ # *(nn++) = 0;
- sobgeq r1,LSTZ1 # if(nl--) goto LSTZ1;
- ret
-
- .globl _BnnAssign
- .align 3
-_BnnAssign:
- .word 0x7&callee_save # mask<r0,r1,r2>
- movl 4(ap),r0 # mm
- movl 8(ap),r1 # nn
- movl 12(ap),r2 # nl
- cmpl r0,r1
- bgequ LAG2 # if(mm >= nn) goto LAG2;
- sobgeq r2,LAG1 # if(nl--) goto LAG1;
- ret # return;
-LAG1: movl (r1)+,(r0)+ # *(mm++) = *(nn++);
- sobgeq r2,LAG1 # if(nl--) goto LAG1;
-LAG2: blequ LAG4 # if(mm <= nn) goto LAG4;
- moval (r0)[r2],r0 # mm = &mm[nl];
- moval (r1)[r2],r1 # nn = &nn[nl];
- sobgeq r2,LAG3 # if(nl--) goto LAG3;
- ret # return;
-LAG3: movl -(r1),-(r0) # *(--mm) = *(--nn);
- sobgeq r2,LAG3 # if(nl--) goto LAG3;
-LAG4: ret # return;
-
- .globl _BnnSetDigit
- .align 3
-_BnnSetDigit:
- .word 0x0&callee_save # mask<>
- movl 8(ap),*4(ap) # *nn = d;
- ret
-
- .globl _BnnGetDigit
- .align 3
-_BnnGetDigit:
- .word 0x0&callee_save # mask<>
- movl *4(ap),r0 # return(*nn);
- ret
-
- .globl _BnnNumDigits
- .align 3
-_BnnNumDigits:
- .word 0x2&callee_save # mask<r1>
- movl 8(ap),r0 # nl
- moval *4(ap)[r0],r1 # nn = &nn[nd];
- sobgeq r0,LND1 # if(nl-- != 0) goto LND1;
- movl $1,r0
- ret # return(1);
-LND1: tstl -(r1)
- bneq LND3 # if(*(--n) != 0) goto LND3;
- sobgeq r0,LND1 # if(nl-- != 0) goto LND1;
- movl $1,r0
- ret # return(1);
-LND3: incl r0
- ret # return(nl + 1);
-
- .globl _BnnNumLeadingZeroBitsInDigit
- .align 3
-_BnnNumLeadingZeroBitsInDigit:
- .word 0x2&callee_save # mask<r1>
- movl 4(ap),r1 # d
- movl $31,r0
-LLZ1: bbs r0,r1,LLZ2
- sobgeq r0,LLZ1
-LLZ2: subl3 r0,$31,r0
- ret
-
- .globl _BnnDoesDigitFitInWord
- .align 3
-_BnnDoesDigitFitInWord:
- .word 0x0&callee_save # mask<>
- movl $1,r0 # C_VERSION
- ret
-
- .globl _BnnIsDigitZero
- .align 3
-_BnnIsDigitZero:
- .word 0x2&callee_save # mask<r1>
- tstl 4(ap) # d
- bneq LDZ1 # if(d) goto LDZ1;
- movl $1,r0
- ret # return(1);
-LDZ1: clrl r0
- ret # return(0);
-
- .globl _BnnIsDigitNormalized
-# Boolean BnIsDigitNormalized(n, nd) BigNum n; int nd; {
- .align 3
-_BnnIsDigitNormalized:
- .word 0x0&callee_save # mask<>
- movl 4(ap),r0 # d
- extzv $31,$1,r0,r0 # return(d >> 31);
- ret
-
- .globl _BnnIsDigitOdd
- .align 3
-_BnnIsDigitOdd:
- .word 0x0&callee_save # mask<>
- bicl3 $-2,4(ap),r0 # return(d || 1);
- ret
-
- .globl _BnnCompareDigits
- .align 3
-_BnnCompareDigits:
- .word 0x0&callee_save # mask<>
- cmpl 4(ap),8(ap) # cmpl d1,d2
- beql LCDeq # if(d0 == d1) goto LCDeq
- blssu LCDinf # if(d0 < d1) goto LCDinf
- movl $1,r0 # return(1);
- ret
-LCDeq: clrl r0 # return(0);
- ret
-LCDinf: movl $-1,r0 # return(-1);
- ret
-
- .globl _BnnComplement
- .align 3
-_BnnComplement:
- .word 0x2&callee_save # mask<r1>
- movl 4(ap),r0 # nn
- movl 8(ap),r1 # nl
- sobgeq r1,LCM1 # if(nl-- != 0) goto LCM1;
- ret
-LCM1: mcoml (r0),(r0)+ # *(n++) ^= -1;
- sobgeq r1,LCM1 # if(nl-- != 0) goto LCM1;
- ret
-
- .globl _BnnAndDigits
- .align 3
-_BnnAndDigits:
- .word 0x0&callee_save # mask<>
- mcoml 8(ap),r0 # d = ~d;
- bicl2 r0,*4(ap) # *nn &= ~d;
- ret
-
- .globl _BnnOrDigits
- .align 3
-_BnnOrDigits:
- .word 0x0&callee_save # mask<>
- bisl2 8(ap),*4(ap) # *nn |= d;
- ret
-
- .globl _BnnXorDigits
- .align 3
-_BnnXorDigits:
- .word 0x0&callee_save # mask<>
- xorl2 8(ap),*4(ap) # *nn ^= d;
- ret
-
- .globl _BnnShiftLeft
- .align 3
-_BnnShiftLeft:
- .word 0x7E&callee_save # mask<r1,r2,r3,r4,r5,r6>
- clrl r0 # res = 0;
- movl 12(ap),r3 # nbi
- bneq LSL0 # if(nbi) goto LSL0
- ret # return(res);
-LSL0: movl 4(ap),r2 # mm
- movl 8(ap),r1 # ml
- subl3 r3,$32,r4 # rnbi = BN_DIGIT_SIZE - nbi;
- sobgeq r1,LSL1 # if(ml-- != 0) goto LSL1;
- ret # return(res);
-LSL1: movl (r2),r5 # save = *mm
- ashl r3,r5,r6 # X = save << nbi;
- bisl3 r0,r6,(r2)+ # *(mm++) = X | res;
- extzv r4,r3,r5,r0 # res = save >> rnbits;
- sobgeq r1,LSL1 # if(ml-- != 0) goto LSL1;
- ret # return(res);
-
- .globl _BnnShiftRight
- .align 3
-_BnnShiftRight:
- .word 0x7E&callee_save # mask<r1,r2,r3,r4,r5,r6>
- clrl r0 # res = 0;
- movl 12(ap),r3 # nbi
- bneq LSR0 # if(nbi) goto LSR0;
- ret # return(res);
-LSR0: movl 8(ap),r1 # ml
- moval *4(ap)[r1],r2 # mm = &mm[ml];
- subl3 r3,$32,r4 # lnbi = BN_DIGIT_SIZE - nbi;
- sobgeq r1,LSR1 # if(ml-- != 0) goto LSR1;
- ret # return(res);
-LSR1: movl -(r2),r5 # save = *(--mm);
- extzv r3,r4,r5,r6 # X = save >> nbi;
- bisl3 r0,r6,(r2) # *mm = X | res;
- ashl r4,r5,r0 # res = save << lnbi;
- sobgeq r1,LSR1 # if(ml-- != 0) goto LSR1;
- ret # return(res);
-
- .globl _BnnAddCarry
- .align 3
-_BnnAddCarry:
- .word 0x2&callee_save # mask<r1>
- movl 12(ap),r0 # car
- beql LAC3 # if(car == 0) return(car);
- movl 8(ap),r0 # nl
- beql LAC2 # if(nl == 0) return(1);
- movl 4(ap),r1 # nn
-LAC1: incl (r1)+ # ++(*nn++);
- bcc LAC4 # if(!Carry) goto LAC4
- sobgtr r0,LAC1 # if(--nl > 0) goto LAC1;
-LAC2: movl $1,r0 # return(1);
-LAC3: ret
-LAC4: clrl r0 # return(0);
- ret
-
- .globl _BnnAdd
- .align 3
-_BnnAdd:
- .word 0x1E&callee_save # mask<r1,r2,r3,r4>
-LADDEntry: movl 4(ap),r0 # mm
- movl 12(ap),r1 # nn
- movl 16(ap),r3 # nl
- bneq LADD1 # if(nl) goto LADD1
- subl3 r3,8(ap),r2 # ml -= nl;
- tstl 20(ap) # car
- bneq LADD5 # if(car) goto LADD5
- clrl r0
- ret # return(0);
-LADD1: subl3 r3,8(ap),r2 # ml -= nl;
- addl3 20(ap),$-1,r4 # C = car
-
-LADD2: adwc (r1)+,(r0)+ # *(m++) += *(n++) + C;
-LADD3: sobgtr r3,LADD2 # if(--nl > 0) goto LADD2;
- bcs LADD5 # if(C) goto LADD5;
-LADD4: clrl r0
- ret
-
-LADD6: incl (r0)+ # ++(*m++);
- bcc LADD4 # if(!C) goto LADD4;
-LADD5: sobgeq r2,LADD6 # if(--ml >= 0) goto LADD6;
-LADD7: movl $1,r0
- ret
-
- .globl _BnnSubtractBorrow
- .align 3
-_BnnSubtractBorrow:
- .word 0x2&callee_save # mask<r1>
- movl 12(ap),r0 # car
- bneq LSB2 # if(car) return(car);
- movl 8(ap),r0 # nl
- beql LSB20 # if(nl == 0) return(0);
- movl 4(ap),r1 # nn
-LSB1: decl (r1)+ # (*nn++)--;
- bcc LSB3 # if(!Carry) goto LSB3;
- sobgtr r0,LSB1 # if(--nl > 0) goto LSB1;
-LSB20: # assert r0 == 0 return(0);
-LSB2: ret
-LSB3: movl $1,r0 # return(1);
- ret
-
- .globl _BnnSubtract
- .align 3
-_BnnSubtract:
- .word 0x1E&callee_save # mask<r1,r2,r3,r4>
- movl 4(ap),r2 # mm
- movl 12(ap),r1 # nn
- movl 16(ap),r3 # nl
- bneq LS1 # if(nl) goto LS1
- subl3 r3,8(ap),r0 # ml -= nl;
- tstl 20(ap) # car
- beql LS5 # if(car) goto LS5
- movl $1,r0
- ret # return(1);
-LS1: subl3 r3,8(ap),r0 # ml -= nl;
- tstl 20(ap) # C = 0; Z = (car == 0)
- bneq LS2 # if(!(Z = (car == 0))) goto LS2
- addl3 $1,$-1,r4 # C = 1;
-
-LS2: sbwc (r1)+,(r2)+ # C..*m++ -= *n++ + C
- sobgtr r3,LS2 # if(--nl > 0) goto LS2
- bcs LS5
-LS3: movl $1,r0
- ret
-LS4: decl (r2)+
- bcc LS3
-LS5: sobgeq r0,LS4 # if (--ml >= 0) goto LS4
- clrl r0
- ret
-
- .globl _BnnMultiplyDigit
-# note1: (2^32-1)*(2^32-1) = 2^64-1 - 2*(2^32-1)
-# thus 64 bits accomodates a*b+c+d for all a,b,c,d < 2^32
-# note2: inner loop is doubled to avoid unnecessary register moves.
- .align 3
-_BnnMultiplyDigit:
- .word 0x1FE&callee_save # mask<r1,r2,r3,r4,r5,r6,r7,r8>
- movl 20(ap),r2 # r2 = d
- blss LMDNeg # if (d<0) goto LMDNeg
- bneq LMD1 # if (d) goto LMD1;
- clrl r0
- ret
-LMD1: cmpl $1,r2
- bneq LMD2 # if (d != 1) goto LMD2
- clrl 20(ap) # IN BnnAdd: car = 0
- brw LADDEntry # BnnAdd(pp,pl,mm,ml,0);
-
-LMD2: movl 4(ap),r3 # r3 = p
- movl 12(ap),r1 # r1 = m
- movl 16(ap),r7 # r7 = ml
- subl3 r7,8(ap),r8 # r8 = pl-ml
- ashl $-1,r7,r0 # loop counter r0 = (ml+1)/2
- clrl r5
- bitl $1,r7
- bneq LMDPOddLen # if (ml is odd) goto LMDPOddLen
- clrl r7
- brb LMDPEvenLen # if (ml is even) goto LMDPOddLen
-LMDPLoop: emul (r1)+,r2,$0,r4 # r4:r5 = m[i]*d
- bgeq LMDMPos1 # if (m[i] < 0)
- addl2 r2,r5 # r5 += d
-LMDMPos1: addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ # *p++ += r4
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2
-LMDPOddLen: emul (r1)+,r2,$0,r6 # r6:r7 = m[i+1]*d
- bgeq LMDMPos2 # if (m[i+1] < 0)
- addl2 r2,r7 # r7 += d
-LMDMPos2: addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ # *p++ += r6
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2
-LMDPEvenLen: sobgeq r0,LMDPLoop # if ((i+=2)/2 < ml/2) repeat loop
- addl2 r7,(r3)+ # *p += (m[ml-1]*d)/2^32
- bcs LMDTail
-LMDRet0: clrl r0
- ret
-
-LMDNeg: movl 4(ap),r3 # r3 = p
- movl 12(ap),r1 # r1 = m
- movl 16(ap),r7 # r7 = ml
- subl3 r7,8(ap),r8 # r8 = pl-ml
- ashl $-1,r7,r0 # loop counter r0 = (ml+1)/2
- clrl r5
- bitl $1,r7
- bneq LMDNOddLen
- clrl r7
- brb LMDNEvenLen
-LMDNLoop: movl (r1)+,r6 # r6 = m[i]
- emul r6,r2,$0,r4 # r4:r5 = m[i]*d
- bleq LMDMPos3 # if (m[i] < 0)
- addl2 r2,r5 # r5 += d
-LMDMPos3: addl2 r6,r5 # r5 += m[i]
- addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ # *p++ += r4
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2
-LMDNOddLen: movl (r1)+,r4 # r6 = m[i+1]
- emul r4,r2,$0,r6 # r6:r7 = m[i+1]*d
- bleq LMDMPos4 # if (m[i+1] < 0)
- addl2 r2,r7 # r7 += d
-LMDMPos4: addl2 r4,r7 # r7 += m[i+1]
- addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ # *p++ += r6
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2
-LMDNEvenLen: sobgeq r0,LMDNLoop # if ((i+=2)/2 < ml/2) repeat loop
- addl2 r7,(r3)+ # *p += (m[ml-1]*d)/2^32
- bcs LMDTail
- clrl r0 # r0 = carry
- ret
-
-LMDTailLoop: incl (r3)+
- bcc LMDRet0
-LMDTail: sobgtr r8,LMDTailLoop
- movl $1,r0 # r0 = carry
- ret
-
- .globl _BnnDivideDigit
- .align 3
-_BnnDivideDigit:
- .word 0x3FE&callee_save # mask<r1,r2,r3,r4,r5,r6,r7,r8,r9>
- movl 12(ap),r2 # nl
- movl 16(ap),r3 # d
- moval *8(ap)[r2],r0 # nn = &nn[nl];
- decl r2 # nl--;
- moval *4(ap)[r2],r1 # qq = &qq[nl];
- movl -(r0),r5 # X(hight) = *(--n);
- extzv $1,$31,r3,r7 # r7 = D' <- D div 2
- tstl r3
- bgeq Lndivc2
- brw Lndiv5 # D < 0!!
-
- # D < 2**31
- brb Lndivc2 # N < D * 2**32
-Lndivc1: movl -(r0),r4 # (bdivu dx3 ax1 dx1)
- cmpl r5,r7
- blss Lndivc11
- extzv $0,$1,r4,r6 # r6 <- n0
- ashq $-1,r4,r4 # N' = r4 = N quo 2 < D * 2**31
- ediv r3,r4,r4,r5 # r4 <- Q' = N' quo D < 2**31
- # r5 <- R' = N' rem D < D
- ashq $1,r4,r4 # r4 <- 2 * Q' < 2**32
- # r5 <- 2 * R' < 2 * D
- addl2 r6,r5 # r5 <- 2 * R' + n0 < 2 * D
- cmpl r5,r3 # r5 < D -> Q = r4, R = r5
- blssu Lndivc12 # sinon
- incl r4 # Q = r4 + 1
- subl2 r3,r5 # R = r5 - D
- brb Lndivc12
-Lndivc11: ediv r3,r4,r4,r5 # Q = r4, R = r5
-Lndivc12: movl r4,-(r1) # range r4 en me'moire
-Lndivc2: sobgeq r2,Lndivc1 # (sobgez dx2 Lndivc1)
- movl r5,r0 # return(X(hight));
- ret
-
-Lndiv3: movl -(r0),r4 # r4 poid faible de N
- extzv $0,$1,r4,r9 # r9 <- n0
- extzv $1,$1,r4,r6 # r6 <- n1
- extzv $2,$1,r4,r8 # r8 <- n2
- ashq $-3,r4,r4 # r4 <- N'' = N quo 4
- bicl2 $0xE0000000,r5 # Le ashq ne le fait pas
- ediv r7,r4,r4,r5 # r4 <- Q' = N''' quo D'
- # r5 <- R' = N''' rem D'
- ashl $1,r5,r5 # r5 <- 2 * R'
- addl2 r8,r5 # r5 <- 2 * R' + n2
- bbc $0,r3,Lndiv4 # si d0 = 0
- cmpl r5,r4 # sinon r5 <- 2R' + n1 - Q'
- blssu Lndiv30 # la diff est < 0
- subl2 r4,r5 # la diff est > 0
- brb Lndiv4 # voila la diff!
-Lndiv30: subl2 r4,r5 # la diff!
- decl r4 # r4 <- r4 - 1
- addl2 r3,r5 # r5 <- r5 + D
-Lndiv4: ashl $1,r4,r4 # r4 <- 2Q'
- addl2 r5,r5 # r5 <- 2r5
- bisl2 r6,r5 # r5 <- r5 + n1 (flag C ok!)
- bcs Lndiv40 # On deborde sur!
- cmpl r5,r3
- blssu Lndiv42 # depasse pas D
-Lndiv40: incl r4 # Q = r4 + 1
- subl2 r3,r5 # R = r5 - D
-Lndiv42: ashl $1,r4,r4 # r4 <- 2Q'
- addl2 r5,r5 # r5 <- 2r5
- bisl2 r9,r5 # r5 <- r5 + n0 (flag C ok!)
- bcs Lndiv43 # On deborde sur!
- cmpl r5,r3
- blssu Lndiv44 # depasse pas D
-Lndiv43: incl r4 # Q = r4 + 1
- subl2 r3,r5 # R = r5 - D
-Lndiv44: movl r4,-(r1) # range le quotient en memoire
-Lndiv5: sobgeq r2,Lndiv3 # On continue!
- movl r5,r0 # return(X(hight));
- ret
-
-# BigNumCarry BnnMultiply (pp, pl, mm, ml, nn, nl)
-# BigNum pp, nn, mm;
-# BigNumLength pl, nl, ml;
-
-.globl _BnnMultiply
- .align 3
-_BnnMultiply:
- .word 0xFFE&callee_save # mask<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
- movl 24(ap),r9 # r9 = nl
- bneq LMM_nl_pos
-LMM_Ret0a:
- clrl r0
-LMM_Ret:
- ret
-LMM_nl_pos:
- movl 20(ap),r11 # nn
- cmpl 12(ap),r11 # if (nn == mm)
- beql BMM_Sqr
-LMM_NotSqr:
- movl 4(ap),r10 # pp
- clrl r8 # c_hi
-LMM_NLoop:
- movl 16(ap),r7 # ml
- movl 12(ap),r1 # mm
- moval (r10)+,r3 # pp
- clrl r5 # c_lo
- movl (r11)+,r2 # digit
- bsbw BMM_MultiplyDigit
- sobgtr r9,LMM_NLoop
- movl r8,r0
- beql LMM_Ret
- movl 16(ap),r7 # r7 = ml
- subl3 r7,8(ap),r1 # r7 = pl-ml
- subl2 24(ap),r1 # r7 = pl-ml-nl
- bleq LMM_Ret
- moval (r10)[r7],r10 # pp += ml
-LMM_PLoop:
- incl (r10)+
- bcc LMM_Ret0a
- sobgtr r1,LMM_PLoop
- ret
-# Special squaring code based on:
-# n[0..nl-1]*n[0..nl-1] = sum (i = 0..nl-1):
-# B^2i * (n[i]*n[i] + 2*n[i] * n[i+1..nl-1] * B)
-# the 2*n[i] is tricky because it may overflow, but ...
-# suppose L[i] = 2*n[i]%2^32
-# and H[i] = 2*n[i]/2^32
-# Then:
-# sum (i = 0..nl-1):
-# B^2i * (n[i]*n[i] + L[i]+H[i-1] * n[i+1..nl-1] * B + H[i-1]*n[i])
-# notice that when i = nl-1 the final term is 2*n[nl-1] * n[nl..nl-1],
-# n[nl..nl-1] is zero length -- i.e. we can ignore it!
-# lastly we don't have quite enough registers to conveniently remember
-# the top bit of n[i-1] we encode it in the PC by duplicating
-# the loop--sometimes I love assembler.
-LMMS_NNLoop:
- # execute this version of loop if n[i-1] was >= 2^31
- movl (r11)+,r0 # d = r0 = *nn++
- movl r11,r1 # r1 = mm
- emul r0,r0,$0,r4 # r4:r5 = d*d
- addl2 r0,r4 # r4 += (2*n[i-1])/2^32*n[i] (= d)
- adwc $0,r5
- addl2 r4,(r10)+ # *pp++ += d*d%2^32
- adwc $0,r5 # r5 += C
- moval (r10)+,r3 # arg-p = pp++
- movl r9,r7 # arg-ml = ml
- addl3 r0,r0,r2 # if (d >= 0)
- bisl2 $1,r2
- bcc LMMS_DPos # switch to < 2^31 loop
-LMMS_DNeg:
- addl2 r0,r5 # compensate for signed mul
- addl2 r0,r5 # r4:r5 += 2*r2*2^32
- tstl r2 # set condition codes for entry to subr
- # MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5)
- bsbb BMM_MultiplyDigit
- sobgeq r9,LMMS_NNLoop
- brb LMMS_Post
-# >>> ENTRY <<<
-BMM_Sqr:
- # r9 = nl, r11 = nn
- movl 16(ap),r8 # r8 = ml
- bneq LMMS_ml_pos
- clrl r0
- ret # return 0;
-LMMS_ml_pos:
- cmpl r8,r9 # if (ml != nl)
- bneq LMM_NotSqr
-
- # r8 = 0, r9 = nl, r11 = nn, r10 = sgn(nn[nl-1])
- movl 4(ap),r10 # r10 = pp
- # r11 = nn
- clrl r8 # r8 = high carry = 0
- decl r9 # r9 = ml-1 = nl-1
-LMMS_NLoop:
- # execute this version of loop if n[i-1] was < 2^31
- movl (r11)+,r0 # d = r0 = *nn++
- movl r11,r1 # r1 = mm
- emul r0,r0,$0,r4 # r4:r5 = d*d
- addl2 r4,(r10)+ # *pp++ += d*d%2^32
- adwc $0,r5 # r5 += C
- moval (r10)+,r3 # arg-p = pp++
- movl r9,r7 # arg-ml = ml
- addl3 r0,r0,r2 # if (d < 0)
- bcs LMMS_DNeg # switch to >= 2^31 loop
-LMMS_DPos:
- tstl r2 # set condition codes for entry to subr
- # MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5)
- bsbb BMM_MultiplyDigit
- sobgeq r9,LMMS_NLoop
- # r9 = 0, r10 = pp+2*ml, r2 = 2*nn[nl-1], r8 = carry_hi, r11 = nn+nl
-LMMS_Post:
- movl r8,r0
- bneq LMMS_CProp # if (c != 0)
-LMMS_ret:
- ret # return
-LMMS_CProp:
- movl 16(ap),r7 # r7 = nl
- subl3 r7,8(ap),r2 # r2 = pl-nl (note nl == ml)
- subl2 r7,r2 # r2 = pl-nl-ml
- bleq LMMS_ret # if (pl-nl > ml)
- # ret = BnnAddCarry(pp+ml, pl-ml, c);
-LMMS_CPLoop:
- incl (r10)+ # (*pp++)++
- bcc LMMS_Ret0
- sobgtr r2,LMMS_CPLoop
- ret
-LMMS_Ret0:
- clrl r0
- ret
-
-# Subroutine: MultiplyDigit(pp,mm,ml,d,c_hi,c_lo)
-# returns:
-# c_hi*base^(ml+1)+ pp[0..ml] = pp[0..ml]+(mm[0..ml-1]*d)+c_hi*base^ml+c_lo
-#
-# In:
-# ml_entry:r7
-# ml/2: r0
-# mm: r1
-# digit: r2
-# pp: r3
-# c_hi: r8
-# c_lo: r5
-#
-# multiply scratch: r4,r5 / r6,r7
-#
-# Out:
-# c_hi: r8
-LMMD_C_hi:
- addl2 r8,(r3)[r7] # p[ml] += c_hi
- clrl r8
- adwc $0,r8
- rsb
-LMMD_Zero:
- tstl r5 # Too complicated, return to
- beql LMMD_ZC_lo # normal case.
- tstl r2
- brb LMMD_Retry
-LMMD_ZC_lo:
- tstl r8
- bneq LMMD_C_hi
- rsb
-BMM_MultiplyDigit:
- beql LMMD_Zero
-LMMD_Retry:
- blss LMMD_Neg # if (d<0) goto LMMD_Neg
- ashl $-1,r7,r0 # loop counter r0 = ml/2
- bitl $1,r7
- bneq LMMD_POddLen # if (ml is odd) goto LMMD_POddLen
- movl r5,r7
- brb LMMD_PEvenLen # if (ml is even) goto LMMD_POddLen
-LMMD_PLoop: emul (r1)+,r2,$0,r4 # r4:r5 = m[i]*d
- bgeq LMMD_MPos1 # if (m[i] < 0)
- addl2 r2,r5 # r5 += d
-LMMD_MPos1: addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ # *p++ += r4
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2
-LMMD_POddLen: emul (r1)+,r2,$0,r6 # r6:r7 = m[i+1]*d
- bgeq LMMD_MPos2 # if (m[i+1] < 0)
- addl2 r2,r7 # r7 += d
-LMMD_MPos2: addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ # *p++ += r6
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2
-LMMD_PEvenLen: sobgeq r0,LMMD_PLoop # if ((i+=2)/2 < ml/2) repeat loop
- addl2 r8,r7
- clrl r8
- adwc $0,r8
- addl2 r7,(r3) # *p += (m[ml-1]*d)/2^32
- adwc $0,r8
- rsb
-LMMD_Neg:
- ashl $-1,r7,r0 # loop counter r0 = ml/2
- bitl $1,r7
- bneq LMMD_NOddLen
- movl r5,r7
- brb LMMD_NEvenLen
-LMMD_NLoop: movl (r1)+,r6 # r6 = m[i]
- emul r6,r2,$0,r4 # r4:r5 = m[i]*d
- bleq LMMD_MPos3 # if (m[i] < 0)
- addl2 r2,r5 # r5 += d
-LMMD_MPos3: addl2 r6,r5 # r5 += m[i]
- addl2 r7,r4 # r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry1
- addl2 r4,(r3)+ # *p++ += r4
- adwc $0,r5 # r5 = (m[i]*d)/2^32 + carry2
-LMMD_NOddLen: movl (r1)+,r4 # r6 = m[i+1]
- emul r4,r2,$0,r6 # r6:r7 = m[i+1]*d
- bleq LMMD_MPos4 # if (m[i+1] < 0)
- addl2 r2,r7 # r7 += d
-LMMD_MPos4: addl2 r4,r7 # r7 += m[i+1]
- addl2 r5,r6 # r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry1
- addl2 r6,(r3)+ # *p++ += r6
- adwc $0,r7 # r7 = (m[i+1]*d)/2^32 + carry2
-LMMD_NEvenLen: sobgeq r0,LMMD_NLoop # if ((i+=2)/2 < ml/2) repeat loop
- addl2 r8,r7
- clrl r8
- adwc $0,r8
- addl2 r7,(r3) # *p += (m[ml-1]*d)/2^32
- adwc $0,r8
- rsb
+++ /dev/null
-# 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<nn) BAG1
- cmpl %ecx,%edx
- jbe BAG2 # if(mm <= nnlim) BAG2
- .align 16
-BAG1: movl (%ebx),%eax # A = *nn
- leal 4(%ebx),%ebx # nn += 1
- movl %eax,(%edx) # *mm = A
- leal 4(%edx),%edx # mm += 1
- cmpl %ecx,%ebx # if(nn < nnlim) BAG1
- jb BAG1
- popl %ebx # return
- ret
-BAG2: cmpl %ebx,%edx
- jbe BAG4 # if(mm <= nn) return
- addl %eax,%edx # mm += nl
- .align 16
-BAG3: addl $-4,%edx # mm--
- addl $-4,%ecx # nnlim--
- movl (%ecx),%eax # A = *nnlim
- movl %eax,(%edx) # *mm = A
- cmpl %ecx,%ebx # if(nn<nnlim) BAG3
- jb BAG3
-BAG4: popl %ebx
- ret
-
- .align 16
- .globl BnnSetDigit
-BnnSetDigit: movl 4(%esp),%edx # nn
- movl 8(%esp),%eax # d
- movl %eax,(%edx) # *nn = d
- ret
-
- .align 16
- .globl BnnGetDigit
-BnnGetDigit: movl 4(%esp),%eax # nn
- movl (%eax),%eax # return(*nn)
- ret
-
- .align 16
- .globl BnnNumDigits
-BnnNumDigits: movl 8(%esp),%eax # nl
- leal 0(,%eax,4),%edx
- addl 4(%esp),%edx # nn += nl
- jmp BND2
- .align 16
-BND1: decl %eax # nl--
-BND2: testl %eax,%eax # if(nl == 0) BND3
- je BND3
- addl $-4,%edx # nn--
- cmpl $0,(%edx) # if(nn-- != 0) BND1
- je BND1
-BND3: testl %eax,%eax # if(nl != 0) return(nl)
- jne BND4
- movl $1,%eax # return(1)
-BND4: ret
-
- .align 16
- .globl BnnNumLeadingZeroBitsInDigit
-BnnNumLeadingZeroBitsInDigit:
- movl 4(%esp),%edx # d
- xorl %eax,%eax # p = 0
- testl %edx,%edx # if(d) BNLZ1
- jne BNLZ1
- movl $32,%eax # return(32)
- ret
-BNLZ1: testl $-65536,%edx # if(d & 0xFFFF0000) BNLZ2
- jne BNLZ2
- movl $16,%eax # p = 16
- sall $16,%edx # d <<= 16
-BNLZ2: testl $-16777216,%edx # if(d & 0xFF000000) BNLZ3
- jne BNLZ3
- addl $8,%eax # p += 8
- sall $8,%edx # d <<= 8
-BNLZ3: testl $-268435456,%edx # if(d & 0xF0000000) BNLZ4
- jne BNLZ4
- addl $4,%eax # p += 4
- sall $4,%edx # d <<= 4
-BNLZ4: testl $-1073741824,%edx # if(d & 0xC0000000) BNLZ5
- jne BNLZ5
- addl $2,%eax # p += 2
- sall $2,%edx # d <<= 2
-BNLZ5: testl %edx,%edx # if(d) BNLZ6
- jl BNLZ6
- incl %eax # p += 1
-BNLZ6: ret
-
- .align 16
- .globl BnnDoesDigitFitInWord
-BnnDoesDigitFitInWord:
- movl $1,%eax
- ret
-
- .align 16
- .globl BnnIsDigitZero
-BnnIsDigitZero: cmpl $0,4(%esp)
- sete %al
- andl $255,%eax
- ret
-
- .align 16
- .globl BnnIsDigitNormalized
-BnnIsDigitNormalized:
- movl 4(%esp),%eax
- shrl $31,%eax
- ret
-
- .align 16
- .globl BnnIsDigitOdd
-BnnIsDigitOdd: xorl %eax,%eax
- testb $1,4(%esp)
- setnz %al
- ret
-
- .align 16
- .globl BnnCompareDigits
-BnnCompareDigits:
- movl 4(%esp),%ecx # d1
- movl 8(%esp),%edx # d2
- xorl %eax,%eax
- cmpl %edx,%ecx
- ja .LBCD1
- je .LBCD2
- movl $-1,%eax
- ret
- .align 16
-.LBCD1: movl $1,%eax
-.LBCD2: ret
-
-# movl 4(%esp),%eax # d1
-# movl 8(%esp),%edx # d2
-# subl %edx,%eax # d1 = d1 - d2
-# setnz %cl # cl = d1 == d2 ? 0 : 1
-# sarl $31,%eax # d2 = SIGN(d2) * -1
-# or %cl,%al # return(d2 | cl)
-# ret
-
-# cmpl %ecx,%edx
-# setc %al # A = CF
-# setnz %cl # Z = !ZF
-# andl $255,%eax
-# andl $255,%ecx
-# subl %ecx,%eax # A = CF - !ZF
-# orl %ecx,%eax # A = (CF-!ZF)|!ZF
-# ret
-
- .align 16
- .globl BnnComplement
-BnnComplement: movl 4(%esp),%edx # nn
- movl 8(%esp),%eax # nl
- testl %eax,%eax # if(nl==0) return
- je BCOMP2
- leal (%edx,%eax,4),%ecx # nnlim = nn+nl
- .align 16
-BCOMP1: notl (%edx) # *nn = !*nn
- addl $4,%edx # nn++
- cmpl %ecx,%edx # if(nn<nnlim) BCOMP1
- jb BCOMP1
-BCOMP2: ret
-
- .align 16
- .globl BnnAndDigits
-BnnAndDigits:
- movl 4(%esp),%eax
- movl 8(%esp),%edx
- andl %edx,(%eax)
- ret
-
- .align 16
- .globl BnnOrDigits
-BnnOrDigits: movl 4(%esp),%eax
- movl 8(%esp),%edx
- orl %edx,(%eax)
- ret
-
- .align 16
- .globl BnnXorDigits
-BnnXorDigits: movl 4(%esp),%eax
- movl 8(%esp),%edx
- xorl %edx,(%eax)
- ret
-
- .align 16
- .globl BnnShiftLeft
-BnnShiftLeft: 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 BSL2
- testl %ebx,%ebx # if(ml == 0) return(res)
- je BSL2
- movl $32,%edx # rnbi = 32
- subl %ecx,%edx # rnbi -= nbi
- bswap %edx # Same as rnbi << 24..
- orl %edx,%ecx # C = rnbi .. nbi
- .align 16
-BSL1:
- movl (%ebp),%esi # save = *mm
- movl (%ebp),%edi # X = save
- sall %cl,%edi # X << nbi
- orl %eax,%edi # X |= res
- movl %edi,(%ebp) # *mm = X
- addl $4,%ebp # mm++
- movl %esi,%eax # res = save
- bswap %ecx
- shrl %cl,%eax # res >>= 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
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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;;
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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))
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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)
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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;
-}
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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 ( </ ) = lt_num
-and ( <=/ ) = le_num
-and ( >/ ) = gt_num
-and ( >=/ ) = ge_num
-
-let max_num num1 num2 = if lt_num num1 num2 then num2 else num1
-and min_num num1 num2 = if gt_num num1 num2 then num2 else num1
-
-(* Coercions with basic types *)
-
-(* Coercion with int type *)
-let int_of_num = function
- Int i -> i
-| Big_int bi -> int_of_big_int bi
-| Ratio r -> int_of_ratio r
-
-and num_of_int i =
- if i = monster_int
- then Big_int (big_int_of_int i)
- else Int i
-
-(* Coercion with nat type *)
-let nat_of_num = function
- Int i -> nat_of_int i
-| Big_int bi -> nat_of_big_int bi
-| Ratio r -> nat_of_ratio r
-
-and num_of_nat nat =
- if (is_nat_int nat 0 (length_nat nat))
- then Int (nth_digit_nat nat 0)
- else Big_int (big_int_of_nat nat)
-
-(* Coercion with big_int type *)
-let big_int_of_num = function
- Int i -> big_int_of_int i
-| Big_int bi -> bi
-| Ratio r -> big_int_of_ratio r
-
-(* Coercion with ratio type *)
-let ratio_of_num = function
- Int i -> ratio_of_int i
-| Big_int bi -> ratio_of_big_int bi
-| Ratio r -> r;;
-
-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
-
-
-
-
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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 -> 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
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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)
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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)
-;;
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* 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
+++ /dev/null
-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
+++ /dev/null
-#########################################################################
-# #
-# 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
+++ /dev/null
-#########################################################################
-# #
-# 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
+++ /dev/null
-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
+++ /dev/null
-#########################################################################
-# #
-# 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
+++ /dev/null
-Test.end_tests ();;
+++ /dev/null
-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;;
+++ /dev/null
-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");;
+++ /dev/null
-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']
-;;
+++ /dev/null
-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);;
+++ /dev/null
-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);;
-
-**************)
+++ /dev/null
-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");;
projects / ocaml.git / commitdiff