diff options
Diffstat (limited to 'ic-reals-6.3')
157 files changed, 23816 insertions, 0 deletions
diff --git a/ic-reals-6.3/CHANGE_LOG b/ic-reals-6.3/CHANGE_LOG new file mode 100644 index 0000000..7afccbe --- /dev/null +++ b/ic-reals-6.3/CHANGE_LOG @@ -0,0 +1,88 @@ +Sept 200 + - fixed bug in handling of rationals (found by Marko) + - set DEFAULT_FORCE_COUNT=1 + - added cotangent family of functions. + - corrected math-lib/Makefile to include neg_R + - corrected asin_R and acos_R to give correct sign for negative arguments + - moved to gmp-3.1 + - now version 6.2 + +Jul 2000 + - fixed pi bug (found by Marko and Reinhold) + - fixed bug in reduction code which meant that most functions failed + for rational arguments (found by Marko and Reinhold) + - added Marko's corrected force_R_Dec + - cleaned up stack structure + - added environment variables ICR_STACK_SIZE, ICR_FORCE_DEC_UPPER_BOUND and + ICR_DEFAULT_FORCE_COUNT. See the manual for details. + - a number of corrections to the manual. + - added secant and cosecant family of functions. + +Apr, May, Jun 2000 + - extensive modifications. Implemented lazy conditional (on the heap) + and in-place reduction. All eager reduction abandoned. Most of the + math-lib involving explicit tensors re-written. + - added Marko's force_R_Dec. + - added a couple of functions suggested by Reinhold. + - made atan_R work on the whole real line. + - extensive changes to the user manual by Reinhold. + +Mar 15,16 + - abandoned automatic guards on matrices and vectors. This represents + a fairly drastic change in the structure of the implementation and + advances us to version 6.0 + - extended predicates to operate on matrices and vectors directly rather + than only on streams. + +Mar 14 + - adjusted many math-lib functions (eg tan_R) to work with the more + eager reduction strategy. Also tan_R now uses stdTensorCont rather than + custom continuations. + - fixed the handling of strsep(3) in base/davinciInterface.c and borrowed + a copy of strsep from the GNU glibc library as strsep is not available + in Solaris 2.5. + - when running daVinci, the child process (which execls daVinci) now + sets the DAVINCI_ICONDIR environment variable. This requires that + REALDIR be set to the root of the real library tree in Makefile. + - rewrote the i/o routines which talk to daVinci since Linux version + would not work reliably with Solaris 2.5 and the interface to daVinci + was needed for debugging. + +Mar 13 + - extended (and simplified) the reduction of digit streams and lfts in + base/reduce.c. Reduction is now much more eager. This may be a mixed + blessing. Earlier it was the case that, in some circumstances, the arguments + to matrices and tensors would not be reduced. Hence, eventually, computation would be done as streams, even when the arguments are rational. For small + rationals, this is less efficient, but for large rationals, treating them + as streams is much more efficient. It could be there needs to be a test + introduced in reduce.c whereby reduction of lfts is inhibited when + the entries in the lft get too large (or some other criteria). + +Mar 12 + - fixed bug in forceInfo which caused unfair forcing of the arguments of + a tensor. Thanks to Reinhold Heckman for pointing out the problem. + +Mar 8 + - added static to qualify local variable `doneInit' in sqrt_R + - reverted to old version numbering sequence. Version 1.03 is now + version 5.03. + +Feb 18, 2000 + - fixed typos in sinh_R, cosh_R, tanh_R which meant they were useless + - fixed bug in tan_Q which caused it to diverge for 0. + - release version 1.03 + +Oct 22, 1999 + - A little tidying up prior to first public release + - fixed some compatability problems between the Solaris and Linux environments + and for different versions of gcc. + - release version 1.02 + +Sept 5, 1999 + - Added the file base/digitHandling.c and adjusted real.h and base/Makefile + - removed reference to error.h in math-lib files + - changed B_ constants for lazy booleans to avoid clash + with Solaris types.h file + - release version 1.01 + +June 1999 initial release verison (1.00), fifth version overall. diff --git a/ic-reals-6.3/Copyright b/ic-reals-6.3/Copyright new file mode 100644 index 0000000..5928987 --- /dev/null +++ b/ic-reals-6.3/Copyright @@ -0,0 +1,13 @@ +All software in this distribution comes under the following copyright notice: + +Copyright (c) 1998-2009 by Imperial College of Science, Technology and Medicine + +Permission to use, copy, modify, and distribute this software and its +documentation for any non-commercial purpose and without fee is hereby +granted, provided that this copyright notice appears in all copies. +The library cannot be used directly or indirectly for any commercial +application without a licence from Imperial College. + +Neither Imperial College nor Lindsay Errington make representations about +the suitability of this software for any purpose. It is provided "as is" +without express or implied warranty. diff --git a/ic-reals-6.3/Makefile b/ic-reals-6.3/Makefile new file mode 100644 index 0000000..5312f81 --- /dev/null +++ b/ic-reals-6.3/Makefile @@ -0,0 +1,87 @@ +REALDIR := $(shell dirname $(realpath $(firstword $(MAKEFILE_LIST)))) +GMPDIR=$(REALDIR)/../gmp-6.3.0 + + +# In OTHER_FLAGS: +# -DDAVINCI enables the davinci interface +# -DTRACE=traceOn enables tracing accoring to library function debugTrace() +# -DTRACE=0 disable tracing completely (or simply omit -DTRACE) +# -DSTACK_SIZE is the number of K words in the stack + +# I don't know what causes Wstringop-overflows, but they seem to cause no problems. +# Lots of the Wunused-but-set-variables are assignments for effect, e.g. POP +# There is one Wunused-varable: it defines a static symbol that I presume gets linked to. +# Lots of the Wunused-paramters are used to occupy pointers that usually do something. +# The Wsign-compares are internal to gmp-impl.h +# For all of these, I have gone through all the warnings with them enabled, +# and verified that the warning is actually essential. +CFLAGS = \ + $(INCLUDE) \ + -std=c11 \ + -Wall \ + -Wextra \ + -Wpedantic \ + -Wno-stringop-overflow \ + -Wno-unused-but-set-variable \ + -Wno-unused-variable \ + -Wno-unused-parameter \ + -Wno-sign-compare \ + -DPACK_DIGITS \ + -DDEFAULT_FORCE_COUNT=1 \ + -DSTACK_SIZE=20 \ + -DFORCE_DEC_UPPER_BOUND=10000 \ + -DREALDIR=\\\"$(REALDIR)\\\" \ + -O3 + +DEBUGFLAGS = \ + $(INCLUDE) \ + -ggdb \ + -gdwarf-4 \ + -std=c11 \ + -Wall \ + -Wextra \ + -Wpedantic \ + -DPACK_DIGITS \ + -DDEFAULT_FORCE_COUNT=1 \ + -DSTACK_SIZE=20 \ + -DFORCE_DEC_UPPER_BOUND=10000 \ + -DREALDIR=\\\"$(REALDIR)\\\" \ + -O0 + +# The following flags are not used. They are here for convenience; they can +# be cut and pasted easily into the list above +OTHER_FLAGS = \ + -pg \ + -lgmp \ + -DTRACE=traceOn \ + -DTRACE=1 \ + -DDEFAULT_FORCE_COUNT=1 \ + END + +LIB=$(GMPDIR)/libgmp.la + +INCLUDE = \ + -I.. \ + -I$(GMPDIR) \ + -I$(GMPDIR)/mpn/ + +CC = gcc +FLAGS_TO_PASS = \ + "CC=$(CC)" \ + "CFLAGS=$(CFLAGS)" \ + "REALDIR=$(REALDIR)" + "GMPDIR=$(GMPDIR)" + +real.a : force + cd base; $(MAKE) $(FLAGS_TO_PASS) + cd math-lib; $(MAKE) $(FLAGS_TO_PASS) + ar rc libreal.a math-lib/*.o base/*.o + +clean: + cd base; $(MAKE) clean + cd math-lib; $(MAKE) clean + cd tests; $(MAKE) clean + rm -f libreal.a + +force: +.PHONY: force diff --git a/ic-reals-6.3/Makefile~ b/ic-reals-6.3/Makefile~ new file mode 100644 index 0000000..acbace9 --- /dev/null +++ b/ic-reals-6.3/Makefile~ @@ -0,0 +1,57 @@ +REALDIR=/home/dnw/Code/ERA-calc/ic-reals-6.3 +GMPDIR=/home/dnw/Code/ERA-calc/gmp-6.3.0 + + +# In OTHER_FLAGS: +# -DDAVINCI enables the davinci interface +# -DTRACE=traceOn enables tracing accoring to library function debugTrace() +# -DTRACE=0 disable tracing completely (or simply omit -DTRACE) +# -DSTACK_SIZE is the number of K words in the stack + +CFLAGS = \ + $(INCLUDE) \ + -g \ + -DPACK_DIGITS \ + -DDEFAULT_FORCE_COUNT=1 \ + -DSTACK_SIZE=20 \ + -DFORCE_DEC_UPPER_BOUND=10000 \ + -DREALDIR=\\\"$(REALDIR)\\\" \ + -O3 + +# The following flags are not used. They are here for convenience; they can +# be cut and pasted easily into the list above +OTHER_FLAGS = \ + -pg \ + -DTRACE=traceOn \ + -DTRACE=1 \ + -DDEFAULT_FORCE_COUNT=1 \ + END + +LIB=$(GMPDIR)/libgmp.la + +INCLUDE = \ + -I.. \ + -I$(GMPDIR) \ + -I$(GMPDIR)/mpn/ + +CC = gcc +FLAGS_TO_PASS = \ + "CC=$(CC)" \ + "CFLAGS=$(CFLAGS)" \ + "GMPDIR=$(GMPDIR)" \ + "REALDIR=$(REALDIR)" + +real.a : force + cd base; $(MAKE) $(FLAGS_TO_PASS) + cd math-lib; $(MAKE) $(FLAGS_TO_PASS) + ar rc real.a math-lib/*.o base/*.o $(GMPDIR)/*.o $(GMPDIR)/mpz/*.o \ + $(GMPDIR)/mpn/*.o $(GMPDIR)/mpq/*.o $(GMPDIR)/mpf/*.o $(GMPDIR)/scanf/*.o + +clean: + cd base; $(MAKE) clean + cd math-lib; $(MAKE) clean + cd tests; $(MAKE) clean + rm -f real.a + +force: +.PHONY: force diff --git a/ic-reals-6.3/README b/ic-reals-6.3/README new file mode 100644 index 0000000..3c15ac1 --- /dev/null +++ b/ic-reals-6.3/README @@ -0,0 +1,60 @@ + +This is version 6.0 of the Imperial College Exact Real Arithmetic +Library. It provides support for lazy real and lazy boolean types +callable from C plus a suite of primitive functions on reals, predicates +and boolean operators. See the separate copyright file for conditions of +use and distribution. + +To install, you must have already installed the Gnu Multiple Precision +Arithemtic package (GMP) Version 3.0.1. Edit the Makefile in this +directory and change: + REALDIR to point to this directory and + GMPDIR to the root directory of the GMP tree. +Then type make. Further details and an explanation +of the compile flags can be found in doc/manual/manual.{tex,dvi}. + +The library makes trivial use of the utility strsep(3). This may not +be available on some platforms but is easily obtained from the web. +For example, the GNU version is available from: +http://www.gnu.org/software/libc/libc.html +Install strsep.c in the directory base and add the target to the Makefile. + +The library has compiled successfully under Linux and +SunOS 5.5.1 (Solaris 2.5.1?) + +Lindsay Errington, June, 2000 +lindsay@kestrel.edu + +-------- + +The library was written by Lindsay Errington with contributions from Marko +Krznaric and Reinhold Heckmann. It is based on theory developed by Abbas +Edalat, Martin Escardo, Reinhold Heckmann, Peter Potts, Philipp Sünderhauf +and Lindsay Errington (lazy booleans). + +-------- + +When viewing the source files, set tabstops to 4. +The directory has the following structure. + +base - the low-level routines used in the representation of the reals + including those for lfts and booleans. + +math-lib - a collection of analytic functions. + +doc - see manual/manual.tex for a description of the types and + functions provided by the library. + +icons - used when the tool is connected to daVinci + +tests + +Makefile + +------- + +Known bugs: + +sqrt_R diverges for 0. This is because sqrt is not continuous at +0. Various options are being considered for this. We may choose to make +sqrt continuous or introduce complex numbers. diff --git a/ic-reals-6.3/base/Alt.c b/ic-reals-6.3/base/Alt.c new file mode 100644 index 0000000..525d976 --- /dev/null +++ b/ic-reals-6.3/base/Alt.c @@ -0,0 +1,285 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This file contains support for realIf (aka alternation). + */ + +#include <stdarg.h> + +Real +realIf(int numGE, ...) +{ + va_list ap; + Alt *alt; + GuardedExpr *geList; + void force_To_Alt_From_The_Abyss(); + int i; + bool isSigned = FALSE; + + if ((alt = (Alt *) malloc(sizeof(Alt))) == NULL) + Error(FATAL, E_INT, "realIf", "malloc failed (Alt)"); + +#ifdef DAVINCI + newNodeId(alt); +#else +#ifdef TRACE + newNodeId(alt); +#endif +#endif + + va_start(ap, numGE); + + if ((geList = (GuardedExpr *) malloc(sizeof(GuardedExpr) * numGE)) == NULL) + Error(FATAL, E_INT, "realIf", "malloc failed (GE)"); + + alt->tag.type = ALT; + alt->tag.dumped = FALSE; + + alt->GE = geList; + alt->numGE = numGE; + alt->nextGE = 0; + alt->force = force_To_Alt_From_The_Abyss; + alt->redirect = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(alt, ALT); + endGraphUpdate(); +#endif + + /* + * Now we consume the arguments. Each is a guard/value pair. + */ + for (i = 0; i < numGE; i++) { + geList[i].guard = va_arg(ap, Bool); + geList[i].x = va_arg(ap, Real); + isSigned = isSigned || geList[i].x->gen.tag.isSigned; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToChildN(alt, geList[i].guard, i); + newEdgeToChildN(alt, geList[i].x, i); + endGraphUpdate(); +#endif + } + va_end(ap); + + alt->tag.isSigned = isSigned; + return (Real) alt; +} + +void +force_To_Alt_From_The_Abyss() +{ + Error(FATAL, E_INT, "force_To_Alt_From_The_Abyss", + "trying to force a conditional"); +} + +/* + * This force method is used to force (evaluate) an alt. To accommodate + * the case where the alt itself evaluates to an alt, the force methods are + * applied recursively and the alt chain reduced. Thus, once the force is + * complete, the alt on the stack has a value alt->redirect which is a real + * and which is not itself an alt. If we were writing a recursive function, + * rather than using an explicit stack, the following three functions + * including the reduction would be coded as a single function as follows: + * + * force_Alt(Alt *alt) + * { + * if (alt->redirect == NULL) + * force_Alt_Eval(alt); evaluate the single alt and set alt->redirect + * if (alt->redirect->gen.tag.type == ALT) { + * force_Alt(alt->redirect); make the recusive call and do the reduction + * alt->redirect = alt->redirect->alt.redirect; + * } + * } + */ +void +force_To_Alt_Entry() +{ + Alt *alt; + void force_To_Alt_Cont(); + void force_Alt_Eval(); + Bool guard; + + alt = (Alt *) POP; + + PUSH_2(force_To_Alt_Cont, alt); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + * This means forcing the first guard. + */ + if (alt->redirect == NULL) { + PUSH_2(force_Alt_Eval, alt); + guard = alt->GE[alt->nextGE].guard; + PUSH_2(guard->gen.force, guard); + } +} + +void +force_To_Alt_Cont() +{ + Alt *alt; + void force_To_Alt_Reduce(); + + alt = (Alt *) POP; + + /* + * So we have evaluated the alternation and alt->redirect is the real + * associated with the guard that evaluated to true. However, that + * real may itself be an alt. If so, then we arrange to evaluate the + * second alt and also to reduce the chain. + */ + if (alt->redirect->gen.tag.type == ALT) { + PUSH_2(force_To_Alt_Reduce, alt); + PUSH_2(force_To_Alt_Entry, alt->redirect); + } +} + +/* + * The following is used only when the alt evaluates to a real which is + * itself an alt. This function performs the reduction. + */ +void +force_To_Alt_Reduce() +{ + Alt *alt; + + alt = (Alt *) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(alt, alt->redirect); + newEdgeToOnlyChild(alt, alt->redirect->alt.redirect); + endGraphUpdate(); +#endif + + alt->redirect = alt->redirect->alt.redirect; + + if (alt->redirect->gen.tag.type == ALT) + Error(FATAL, E_INT, "force_To_Alt_Cont_Cont", + "alt chain not fully reduced"); +} + +/* + * Our objective here is to evaluate a single conditional. This means + * forcing each guard in turn and checking to see if it becomes true. + * This force function is only activated by force_To_Alt_Entry and by itself. + * When activated, we know that we have forced one of the guards so + * we start by checking the value of the guard. + */ +void +force_Alt_Eval() +{ + Alt *alt; + Bool guard; + int advanceToNextGE(Alt *alt); + + alt = (Alt *) POP; + guard = alt->GE[alt->nextGE].guard; + + switch (guard->gen.tag.value) { + /* + * If the current guard is true, then record the value of the guard + * in the Alt structure. Thereafter we will used the stored value. At this + * point it might be wise to make all the pointers in the guard/value + * pairs to NULL so that the garbage collector can have them. + */ + case LAZY_TRUE : + alt->redirect = alt->GE[alt->nextGE].x; +#ifdef DAVINCI + deleteEdgeToChildN(alt, alt->GE[alt->nextGE].guard, alt->nextGE); + deleteEdgeToChildN(alt, alt->GE[alt->nextGE].x, alt->nextGE); + drawEqEdge(alt, alt->GE[alt->nextGE].x); + alt->GE[alt->nextGE].guard = NULL; + alt->GE[alt->nextGE].x = NULL; + while (advanceToNextGE(alt)) { + deleteEdgeToChildN(alt, alt->GE[alt->nextGE].guard, alt->nextGE); + deleteEdgeToChildN(alt, alt->GE[alt->nextGE].x, alt->nextGE); + alt->GE[alt->nextGE].guard = NULL; + alt->GE[alt->nextGE].x = NULL; + } +#endif + break; + + /* + * If the current guard evaluates to false, then we want to eliminate the + * the guard (and value) from future consideration. So we set the fields + * to NULL and advance to the next pair and force the guard. + */ + case LAZY_FALSE : +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToChildN(alt, alt->GE[alt->nextGE].guard, alt->nextGE); + deleteEdgeToChildN(alt, alt->GE[alt->nextGE].x, alt->nextGE); + endGraphUpdate(); +#endif + alt->GE[alt->nextGE].guard = NULL; + alt->GE[alt->nextGE].x = NULL; + if (!advanceToNextGE(alt)) + Error(FATAL, E_INT, "force_Alt_Eval", "no guards left"); + PUSH_2(force_Alt_Eval, alt); + PUSH_2(alt->GE[alt->nextGE].guard->gen.force, + alt->GE[alt->nextGE].guard); + break; + + /* + * Finally, if the guard is still unknown, we simply advance to the + * next pair and force the guard. + */ + case LAZY_UNKNOWN : + if (!advanceToNextGE(alt)) + Error(FATAL, E_INT, "force_Alt_Eval", "no guards left"); + PUSH_2(force_Alt_Eval, alt); + PUSH_2(alt->GE[alt->nextGE].guard->gen.force, + alt->GE[alt->nextGE].guard); + break; + + default : + Error(FATAL, E_INT, "force_Alt_Eval", + "invalid boolean value encountered"); + break; + } +} + +/* + * This local function scans through the list of guarded expressions looking + * for the index of the next valid pair following the given index. Pairs in + * which the guard has been evaluated to false have been set to NULL. + * So we are looking for the first non-NULL pair. It may be the same + * index we are given though to be honest, if we are down to one GE pair + * without a true guard, then there is a pretty good chance the programmer + * has chosen guards which don't overlap. + * This returns 0 (false) if no pair is found. + */ +int +advanceToNextGE(Alt *alt) +{ + int i; + + for (i = (alt->nextGE + 1) % alt->numGE; + i != alt->nextGE; i = (i + 1) % alt->numGE) { + if (alt->GE[i].guard != NULL) { + alt->nextGE = i; + return 1; + } + } + + if (alt->GE[i].guard != NULL) { + alt->nextGE = i; + return 1; + } + return 0; +} diff --git a/ic-reals-6.3/base/DigsX.c b/ic-reals-6.3/base/DigsX.c new file mode 100644 index 0000000..bca8acf --- /dev/null +++ b/ic-reals-6.3/base/DigsX.c @@ -0,0 +1,850 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +/* + * Digits are removed from LFTs and deposited into DigsX structure. + * Each DigsX can hold an arbitrary number of digits. Nevertheless, + * these structures are chained since it makes it easier whenr + * there are many consumers. + */ + +extern int epsDelMatrix(Matrix, int); +extern void epsDelTensor(Tensor, int, int *, int *); +extern int epsDelTensorX(Tensor, int); + +extern bool emitDigitFromVector(Vector, Digit *); +extern bool emitDigitFromMatrix(Matrix, Digit *); +extern bool emitDigitFromTensor(Tensor, Digit *); + +void setDigsXMethod(DigsX *); +void absorbDigsXIntoDigsX(DigsX *); + +void redirectDigsX(DigsX *, Real); + +DigsX * +allocDigsX() +{ + DigsX *digsX; + + if ((digsX = (DigsX *) malloc (sizeof(DigsX))) == NULL) + Error(FATAL, E_INT, "allocDigsX", "malloc failed"); + +#ifdef DAVINCI + newNodeId(digsX); +#else +#ifdef TRACE + newNodeId(digsX); +#endif +#endif + + digsX->tag.type = DIGSX; + digsX->tag.dumped = FALSE; + digsX->tag.isSigned = FALSE; + digsX->count = 0; +#ifdef PACK_DIGITS + digsX->word.small = 0; +#else + mpz_init(digsX->word.big); +#endif + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(digsX, DIGSX); + endGraphUpdate(); +#endif + + return digsX; +} + +/* + * The use of the following function is a little subtle. Digits are emitted + * from LFTs into DigsX structures. Once this is done, we create a new + * (empty) DigsX structure and link it between where the digits were + * deposited and the residual of the LFT. This way, the consumer can take + * the digits, advance its pointer to the argument of the DigsX, and still + * be sure to point to another DigsX structure. It keeps the methods and + * list handling much simpler. + */ +void +newDigsX(DigsX *digsX) +{ + DigsX *new; + void force_To_DigsX_From_DigsX_Entry(); + + new = allocDigsX(); + + new->x = digsX->x; + new->force = digsX->force; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(new, digsX->x); + deleteOnlyEdge(digsX, digsX->x); + newEdgeToOnlyChild(digsX, new); + endGraphUpdate(); +#endif + + digsX->x = (Real) new; + digsX->force = force_To_DigsX_From_DigsX_Entry; +} + +/* + * This forces digits into and another list of digits. If the idea of + * having lists of DigsX structures (rather than just one) then remember + * that reals can be shared with digits consumed at different rates. + */ +void +force_To_DigsX_From_DigsX_Entry() +{ + DigsX *target, *source; + int digitsNeeded; + void force_To_DigsX_From_DigsX_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + source = (DigsX *) target->x; + + PUSH_3(force_To_DigsX_From_DigsX_Cont, target, digitsNeeded); + + /* + * Now see if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < (unsigned int)digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +void +force_To_DigsX_From_DigsX_Cont() +{ + DigsX *target; + int digitsNeeded; + target = (DigsX *) POP; + digitsNeeded = (int) POP; + + absorbDigsXIntoDigsX(target); +} + +/* + * This forces a vector to emit the requested number of digits. + * vecCont is the real (Vec *) (ie a vector) from which the + * digits are required and digsX is where to place the digits. I'm not + * sure this function will ever be used. Vectors represent + * rationals so I suppose when the numerator and denominator are + * very big numbers, and relatively little information is needed, then + * we might pull digits out rather than consume the whole rational. + * + * Nevertheless, having vectors is extremely useful for debugging. + */ +void +force_To_DigsX_From_Vec() +{ + DigsX *digsX; + Vec *vecCont; + int digitsNeeded; + int digitsEmitted = 0; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + vecCont = (Vec *) digsX->x; + + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromVector, + (void *) (vecCont->vec), + digitsNeeded); + +#ifdef TRACE + int bitsShifted = 0; + if (digitsEmitted > 0) + bitsShifted = normalizeVector(vecCont->vec); + + debugp("force_To_DigsX_From_Vec", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) vecCont, + digitsEmitted, + bitsShifted); +#endif + + if (digitsEmitted < digitsNeeded) + Error(FATAL, E_INT, "force_To_DigsX_From_Vec", + "failed to get enough digits"); + + newDigsX(digsX); +} + +/* + * This forces a matrix to emit the requested number of digits. + * matX is the real (MatX *) (ie a matrix with argument) from which the + * digits are required and digsX is where to place the digits. + * + * It is assumed that the number of digits needed is > 0. + */ +void +force_To_DigsX_From_MatX_Entry() +{ + DigsX *digsX; + MatX *matX; + int digitsNeeded; + void force_To_DigsX_From_Vec(); + void force_To_DigsX_From_MatX_Cont(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + matX = (MatX *) digsX->x; + + if (matX->tag.type == VECTOR) { + digsX->force = force_To_DigsX_From_Vec; + PUSH_3(digsX->force, digsX, digitsNeeded); + return; + } + + matX->totalEmitted = 0; + PUSH_3(force_To_DigsX_From_MatX_Cont, digsX, digitsNeeded); +} + +void +force_To_DigsX_From_MatX_Cont() +{ + DigsX *digsX; + MatX *matX; + int digitsNeeded; + int nArg, digitsEmitted = 0; + void force_To_DigsX_From_Vec(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + matX = (MatX *) digsX->x; + + /* + * First of all, we need to check that the MatX argument hasn't been + * reduced to a vector. + */ + if (matX->tag.type == VECTOR) { + digsX->force = force_To_DigsX_From_Vec; + PUSH_3(digsX->force, digsX, digitsNeeded); + return; + } + + /* + * First emit all the digits we can (up to the number of + * digits requested) + */ + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromMatrix, + (void *) (matX->mat), + digitsNeeded); + + /* + * If something has been emitted, then try to remove powers of 2 + * from the residual matrix. + */ + +#ifdef TRACE + int bitsShifted = 0; + if (digitsEmitted > 0) + bitsShifted = normalizeMatrix(matX->mat); + + debugp("force_To_DigsX_From_MatX", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) matX, + digitsEmitted, + bitsShifted); +#endif + + matX->totalEmitted += digitsEmitted; + digitsNeeded -= digitsEmitted; + + if (digitsNeeded <= 0) { + /* + * If we have managed to emit anything at all, then we + * introduce a new empty DigsX structure between where + * the digits have been deposited and the matrix. + */ + if (matX->totalEmitted > 0) + newDigsX(digsX); + return; + } + + /* + * So now we emitted what we can but still need more. First arrange + * to come back and try to emit again after forcing that necessary + * number of digits from the the argument. + */ + PUSH_3(force_To_DigsX_From_MatX_Cont, digsX, digitsNeeded); + + nArg = epsDelMatrix(matX->mat, digitsNeeded); + if (nArg > 0) + PUSH_3(matX->force, matX, nArg); + else + PUSH_3(matX->force, matX, defaultForceCount); + + /* + * ### If we have not successfully absorbed anything then we should give up. + */ +} + +/* + * This forces a tensor to emit the requested number of digits. tenXY is + * the real (TenXY *) (ie a tensor with two arguments) from which the + * digits are required and digsX is where to place the digits. + */ +void +force_To_DigsX_From_TenXY_Entry() +{ + DigsX *digsX; + TenXY *tenXY; + int digitsNeeded; + void force_To_DigsX_From_TenXY_Cont(); + void force_To_DigsX_From_MatX_Entry(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + tenXY = (TenXY *) digsX->x; + + if (tenXY->tag.type != TENXY) { + digsX->force = force_To_DigsX_From_MatX_Entry; + PUSH_3(digsX->force, digsX, digitsNeeded); + return; + } + + tenXY->totalEmitted = 0; + PUSH_3(force_To_DigsX_From_TenXY_Cont, digsX, digitsNeeded); +} + +void +force_To_DigsX_From_TenXY_Cont() +{ + DigsX *digsX; + TenXY *tenXY; + int digitsNeeded; + int nX, nY; + int digitsEmitted = 0; + void force_To_DigsX_From_MatX_Entry(); + void force_To_DigsX_From_MatX_Cont(); + void force_To_DigsX_From_TenXY_Cont_X(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + tenXY = (TenXY *) digsX->x; + + if (tenXY->tag.type != TENXY) { + digsX->force = force_To_DigsX_From_MatX_Entry; + PUSH_3(force_To_DigsX_From_MatX_Cont, digsX, digitsNeeded); + return; + } + + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromTensor, + (void *) tenXY->ten, + digitsNeeded); + +#ifdef TRACE + int bitsShifted = 0 + if (digitsEmitted > 0) + bitsShifted = normalizeTensor(tenXY->ten); + + debugp("force_To_DigsX_From_TenXY_Cont", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) tenXY, + digitsEmitted, + bitsShifted); +#endif + + tenXY->totalEmitted += digitsEmitted; + digitsNeeded -= digitsEmitted; + + if (digitsNeeded <= 0) { + if (tenXY->totalEmitted > 0) + newDigsX(digsX); + return; + } + + /* + * So now we emitted what we can but still need more. So we figure out + * how many we need from each of the arguments. + */ + + epsDelTensor(tenXY->ten, digitsNeeded, &nX, &nY); + +#ifdef TRACE + debugp("force_To_DigsX_From_TenXY_Cont", + "%x %x nX=%d nY=%d\n", + (unsigned) digsX, + (unsigned) tenXY, + nX, + nY); +#endif + + /* + * When the calculations for the number of digits needed from x and y + * yields values which are both less than 0, then we need some other + * scheme to decide from which branch to consume digits. I have tried + * two schemes. Right now the code implements Peter's strategy. + */ + if (nX <= 0 && nY <= 0) { + nX = 0; + nY = 0; + if (tensorIsRefining(tenXY->ten)) { + if (tensorStrategy(tenXY->ten) == 1) { + nY = defaultForceCount; +#ifdef TRACE + debugp("force_To_DigsX_From_TenXY_Cont", + "tensor refining, choosing y\n"); +#endif + } + else { + nX = defaultForceCount; +#ifdef TRACE + debugp("force_To_DigsX_From_TenXY_Cont", + "tensor refining, choosing x\n"); +#endif + } + } + else { + if (tenXY->tensorFairness > 0) { + nY = defaultForceCount; + tenXY->tensorFairness = 0; +#ifdef TRACE + debugp("force_To_DigsX_From_TenXY_Cont", + "tensor fairness, choosing y\n"); +#endif + } + else { + nX = defaultForceCount; + tenXY->tensorFairness = 1; +#ifdef TRACE + debugp("force_To_DigsX_From_TenXY_Cont", + "tensor fairness, choosing x\n"); +#endif + } + } + } + + if (nX > 0) { + if (nY > 0) { + /* + * If both x and y are to be forced, we do them in two stages + * (y first) using an intermediate continuation. This is because + * the first force may end up reducing the tensor to a matrix. + */ + tenXY->xDigitsNeeded = nX; + PUSH_3(force_To_DigsX_From_TenXY_Cont_X, digsX, digitsNeeded); + PUSH_3(tenXY->forceY, tenXY, nY); + } + else { + PUSH_3(force_To_DigsX_From_TenXY_Cont, digsX, digitsNeeded); + PUSH_3(tenXY->forceX, tenXY, nX); + } + } + else { + if (nY > 0) { + PUSH_3(force_To_DigsX_From_TenXY_Cont, digsX, digitsNeeded); + PUSH_3(tenXY->forceY, tenXY, nY); + } + else + Error(FATAL, E_INT, "force_To_DigsX_From_TenXY_Cont", + "assumed impossible case"); + } +} + +void +force_To_DigsX_From_TenXY_Cont_X() +{ + DigsX *digsX; + TenXY *tenXY; + int digitsNeeded; + void force_To_DigsX_From_MatX_Entry(); + void force_To_DigsX_From_MatX_Cont(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + tenXY = (TenXY *) digsX->x; + + if (tenXY->tag.type != TENXY) { + digsX->force = force_To_DigsX_From_MatX_Entry; + PUSH_3(force_To_DigsX_From_MatX_Cont, digsX, digitsNeeded); + return; + } + + PUSH_3(force_To_DigsX_From_TenXY_Cont, digsX, digitsNeeded); + + if (tenXY->xDigitsNeeded > 0) + PUSH_3(tenXY->forceX, tenXY, tenXY->xDigitsNeeded); +} + +void +force_To_DigsX_From_Alt_Entry() +{ + DigsX *digsX; + Alt *alt; + void force_To_Alt_Entry(); + void force_To_DigsX_From_Alt_Cont(); + int digitsNeeded; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + alt = (Alt *) digsX->x; + + PUSH_3(force_To_DigsX_From_Alt_Cont, digsX, digitsNeeded); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (alt->redirect == NULL) + PUSH_2(force_To_Alt_Entry, alt); +} + +void +force_To_DigsX_From_Alt_Cont() +{ + DigsX *digsX; + Alt *alt; + int digitsNeeded; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + alt = (Alt *) digsX->x; + + redirectDigsX(digsX, alt->redirect); + PUSH_3(digsX->force, digsX, digitsNeeded); +} + +void +force_To_DigsX_From_Cls_Entry() +{ + DigsX *digsX; + Cls *cls; + void force_To_DigsX_From_Cls_Cont(); + int digitsNeeded; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) digsX->x; + + PUSH_3(force_To_DigsX_From_Cls_Cont, digsX, digitsNeeded); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (cls->redirect == NULL) + PUSH_2(cls->force, cls); +} + +void +force_To_DigsX_From_Cls_Cont() +{ + DigsX *digsX; + Cls *cls; + int digitsNeeded; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) digsX->x; + + redirectDigsX(digsX, cls->redirect); + PUSH_3(digsX->force, digsX, digitsNeeded); +} + +void +setDigsXMethod(DigsX *digsX) +{ + void force_To_DigsX_From_Alt_Entry(); + void force_To_DigsX_From_Cls_Entry(); + void force_To_DigsX_From_DigsX_Entry(); + void force_To_DigsX_From_Vec(); + void force_To_DigsX_From_MatX_Entry(); + void force_To_DigsX_From_TenXY_Entry(); + + switch (digsX->x->gen.tag.type) { + case ALT : + digsX->force = force_To_DigsX_From_Alt_Entry; + break; + case SIGNX : + Error(FATAL, E_INT, "setDigsXMethod", "DigsX guarding a SignX"); + break; + case DIGSX : + digsX->force = force_To_DigsX_From_DigsX_Entry; + break; + case VECTOR : + digsX->force = force_To_DigsX_From_Vec; + break; + case MATX : + digsX->force = force_To_DigsX_From_MatX_Entry; + break; + case TENXY : + digsX->force = force_To_DigsX_From_TenXY_Entry; + break; + case CLOSURE : + digsX->force = force_To_DigsX_From_Cls_Entry; + break; + default : + Error(FATAL, E_INT, "setDigsXMethod", "argument has bad type"); + break; + } +} + +/* + * This function reduces a chain of DigsX structures to single DigsX holding + * digits followed by an empty structure. + */ +void +reduceDigsXList(DigsX *target) +{ + Real source; + + source = (Real) target->x; + while (source->gen.tag.type == DIGSX && source->digsX.count > 0) { + absorbDigsXIntoDigsX(target); + source = (Real) target->x; + } +} + +/* + * It can happen that we have lists of DigsX structures. This function + * reduces a pair of DigsX structures in a list. + */ +void +absorbDigsXIntoDigsX(DigsX *target) +{ + DigsX *source; + + source = (DigsX *) target->x; + + if (source->count > 0) { +#ifdef PACK_DIGITS + /* + * Now consume the digits from the source and add them to the target. + * There are three cases here. We might be accumulating into a machine + * word, we might be accumulating into a large integer, or we might + * have been accumulating into a small word but not have enough room + * for the new digits and need to switch to a large integer. + */ + if (target->count + source->count <= DIGITS_PER_WORD) + target->word.small = + (target->word.small << source->count) + source->word.small; + else { + if (target->count <= DIGITS_PER_WORD) + mpz_init_set_si(target->word.big, target->word.small); +#endif + mpz_mul_2exp(target->word.big, target->word.big, source->count); +#ifdef PACK_DIGITS + if (source->count <= DIGITS_PER_WORD) + if (source->word.small >= 0) { + mpz_add_ui(target->word.big, target->word.big, + source->word.small); + } + else { + mpz_sub_ui(target->word.big, target->word.big, + -(source->word.small)); + } + else +#endif + mpz_add(target->word.big, target->word.big, source->word.big); +#ifdef PACK_DIGITS + } +#endif + target->count += source->count; + +#ifdef TRACE + debugp("absorbDigsXIntoDigsX", + "%x %x emitted=%d\n", + (unsigned) target, + (unsigned) source, + source->count); +#endif + + /* + * We've consumed the source so advance to the next possible source + * of information + */ + target->x = source->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(target, source); + newEdgeToOnlyChild(target, source->x); + endGraphUpdate(); +#endif + } +} + +void +redirectDigsX(DigsX *digsX, Real x) +{ + Real r; + + void force_To_DigsX_From_Cls_Entry(); + void force_To_DigsX_From_Alt_Entry(); + void force_To_DigsX_From_DigsX_Entry(); + void force_To_DigsX_From_Vec(); + void force_To_DigsX_From_MatX_Entry(); + void force_To_DigsX_From_TenXY_Entry(); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(digsX, digsX->x); + newEdgeToOnlyChild(digsX, x); + endGraphUpdate(); +#endif + digsX->x = x; + + switch (x->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "redirectDigsX", "DigsX guarding a SignX"); + break; + case DIGSX : + digsX->force = force_To_DigsX_From_DigsX_Entry; + break; + case CLOSURE : + digsX->force = force_To_DigsX_From_Cls_Entry; + break; + case ALT : + digsX->force = force_To_DigsX_From_Alt_Entry; + break; + case VECTOR : + /* + * First we check that the Vector does not have an equivalent stream. + * If it doesn't then the DigsX consumer we already have, will + * become the root of the new equivalent stream. Note that we + * are oblidged to make a copy of the vector since there may be + * other consumers, and emitting the sign will change the vector. + */ + if (x->vec.strm == NULL) { + r = vector_Z(x->vec.vec[0], x->vec.vec[1]); + digsX->x = r; + x->vec.strm = (Real) digsX; +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(digsX, x); + newEdgeToOnlyChild(digsX, r); + drawEqEdge(digsX, x); + endGraphUpdate(); +#endif + digsX->force = force_To_DigsX_From_Vec; + } + /* + * If there already is an equivalent stream, then we arrange to + * equate the two streams. + */ + else { +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(digsX, x); + newEdgeToOnlyChild(digsX, x->vec.strm); + endGraphUpdate(); +#endif + digsX->x = x->vec.strm; + + /* we already have a stream, so we must equate them as above */ + switch (x->vec.strm->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "redirectDigsX", + "DigsX to guard a SignX vector stream"); + break; + case DIGSX : + digsX->force = force_To_DigsX_From_DigsX_Entry; + break; + default : + Error(FATAL, E_INT, "redirectDigsX", + "vector stream is not a stream"); + } + } + break; + + case MATX : + /* + * This code is the same as that for the vector case + */ + if (x->matX.strm == NULL) { + r = matrix_Z(x->matX.x, + x->matX.mat[0][0], x->matX.mat[0][1], + x->matX.mat[1][0], x->matX.mat[1][1]); + digsX->x = r; + x->matX.strm = (Real) digsX; +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(digsX, x); + newEdgeToOnlyChild(digsX, r); + drawEqEdge(digsX, x); + endGraphUpdate(); +#endif + digsX->force = force_To_DigsX_From_MatX_Entry; + } + + else { +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(digsX, x); + newEdgeToOnlyChild(digsX, x->matX.strm); + endGraphUpdate(); +#endif + digsX->x = x->matX.strm; + + /* we already have a stream, so we must equate them as above */ + switch (x->matX.strm->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "redirectDigsX", + "DigsX to guard a SignX matrix stream"); + break; + case DIGSX : + digsX->force = force_To_DigsX_From_DigsX_Entry; + break; + default : + Error(FATAL, E_INT, "redirectDigsX", + "matrix stream is not a stream"); + } + } + break; + + case TENXY : + /* + * This code is the same as that for the vector and matrix cases + * except that we don't need to worry about sharing and hence there + * is not need to make a copy of the tensor. + */ + if (x->tenXY.strm == NULL) { + x->tenXY.strm = (Real) digsX; + digsX->force = force_To_DigsX_From_TenXY_Entry; + } + + else { +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(digsX, x); + newEdgeToOnlyChild(digsX, x->tenXY.strm); + endGraphUpdate(); +#endif + digsX->x = x->tenXY.strm; + + /* we already have a stream, so we must equate them as above */ + switch (x->tenXY.strm->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "redirectDigsX", + "DigsX to guard a SignX tensor stream"); + break; + case DIGSX : + digsX->force = force_To_DigsX_From_DigsX_Entry; + break; + default : + Error(FATAL, E_INT, "redirectDigsX", + "tensor stream is not a stream"); + } + } + break; + default : + Error(FATAL, E_INT, "redirectDigsX", "redirection is not a real"); + } +} diff --git a/ic-reals-6.3/base/Makefile b/ic-reals-6.3/base/Makefile new file mode 100644 index 0000000..4b84c04 --- /dev/null +++ b/ic-reals-6.3/base/Makefile @@ -0,0 +1,46 @@ +# -DDAVINCI enables the davinci interface +# -DEBUG some debugging (for now just turns on nodeIds) +# -TRACE=traceOn enables tracing accoring to library function debugTrace() + +OBJS = \ + Vector.o \ + DigsX.o \ + MatX.o \ + TenXY.o \ + SignX.o \ + Alt.o \ + realLib.o \ + boolLib.o \ + force_R.o \ + force_B.o \ + forceFuncLookupTable.o \ + delay.o \ + emitDigit.o \ + emitSign.o \ + digitHandling.o \ + util.o \ + dump.o \ + epsDel.o \ + debug.o \ + nodeId.o \ + strategy.o \ + print.o \ + boolUtil.o \ + gteq0.o \ + gt0.o \ + boolOp.o \ + stack.o \ + davinciInterface.o \ + error.o + +# garbage.o +# strsep.o +# strictAlt.o +# reduce.o + +force : $(OBJS) + +$(OBJS): ../real.h ../real-impl.h + +clean: + rm -f $(OBJS) diff --git a/ic-reals-6.3/base/MatX.c b/ic-reals-6.3/base/MatX.c new file mode 100644 index 0000000..87cdcd6 --- /dev/null +++ b/ic-reals-6.3/base/MatX.c @@ -0,0 +1,902 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Functions for allocating and manipulating matrix LFTs in the heap. + */ + +void setMatXMethodSigned(MatX *); +void setMatXMethodUnsigned(MatX *); +void absorbDigsXIntoMatX(MatX *); + +MatX * +allocMatX() +{ + MatX *matX; + + if ((matX = (MatX *) malloc (sizeof(MatX))) == NULL) + Error(FATAL, E_INT, "allocMatX", "malloc failed"); + +#ifdef DAVINCI + newNodeId(matX); +#else +#ifdef TRACE + newNodeId(matX); +#endif +#endif + + matX->tag.type = MATX; + matX->tag.dumped = FALSE; + matX->strm = (Real) NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(matX, MATX); + endGraphUpdate(); +#endif + + + return matX; +} + +/* + * Allocates and fills a matrix object in the heap. Included below + * is code for eagerly reducing a matrix against its argument. Eager + * reduction reduces the amount of garbage in the heap. At this point, + * eager reduction is disabled as some functions which call this expect + * to get back a MatX object. With reduction they might get either + * a MatX or a Vec. + */ +Real +matrix_Int(Real x, int a, int b, int c, int d) +{ + MatX *matX; + +#ifdef LATER + /* + * If the argument is a vector, then we eagerly reduce our given + * matrix to a vector. We do this in tmp storage to avoid creating + * garbage in the heap. + */ + if (x->gen.tag.type == VECTOR) { + mpz_set_si(bigTmpMat[0][0], a); + mpz_set_si(bigTmpMat[0][1], b); + mpz_set_si(bigTmpMat[1][0], c); + mpz_set_si(bigTmpMat[1][1], d); + multVectorPairTimesVector(bigTmpMat[0], bigTmpMat[1], x->vec.vec); + return vector_Z(bigTmpMat[0][0], bigTmpMat[0][1]); + } +#endif + + /* + * So now we know we will end up with matrix, so we allocate one. + */ + matX = allocMatX(); + + mpz_init_set_si(matX->mat[0][0], a); + mpz_init_set_si(matX->mat[0][1], b); + mpz_init_set_si(matX->mat[1][0], c); + mpz_init_set_si(matX->mat[1][1], d); + + /* + * ### should perhaps check that there are no zero columns + */ + + /* remove powers of 2 from the matrix */ + normalizeMatrix(matX->mat); + + /* make the matrix positive if it is negative (ie no entries > 0) */ + if (matrixSign(matX->mat) < 0) + negateMatrix(matX->mat); + + matX->x = (Real) x; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(matX, x); + endGraphUpdate(); +#endif + +#ifdef LATER + /* + * Now we eagerly consume any matrix which follows. This may be unwise. + */ + if (x->gen.tag.type == MATX) { + multVectorPairTimesMatrix(matX->mat[0], matX->mat[1], x->matX.mat); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, x->matX.x); + endGraphUpdate(); +#endif + matX->x = x->matX.x; + } +#endif + + /* + * A MatX is signed if the there are entries in the matrix of different + * signs or if the argument to the MatX is signed. + */ + if (matX->x->gen.tag.isSigned || matrixSign(matX->mat) == 0) + matX->tag.isSigned = TRUE; + + if (matX->x->gen.tag.isSigned) + setMatXMethodSigned(matX); + else + setMatXMethodUnsigned(matX); + return (Real) matX; +} + +/* + * This is exactly as above but in this case the matrix is filled with + * large (GMP) integers rather than machine integers. + */ +Real +matrix_Z(Real x, mpz_t a, mpz_t b, mpz_t c, mpz_t d) +{ + MatX *matX; + +#ifdef LATER + /* + * If the argument is a vector, then we eagerly reduce our given + * matrix to a vector. We do this in tmp storage to avoid creating + * garbage in the heap. + */ + if (x->gen.tag.type == VECTOR) { + mpz_set(bigTmpMat[0][0], a); + mpz_set(bigTmpMat[0][1], b); + mpz_set(bigTmpMat[1][0], c); + mpz_set(bigTmpMat[1][1], d); + multVectorPairTimesVector(bigTmpMat[0], bigTmpMat[1], x->vec.vec); + return vector_Z(bigTmpMat[0][0], bigTmpMat[0][1]); + } +#endif + + /* + * So now we know we will end up with a matrix, so we allocate one. + */ + matX = allocMatX(); + + mpz_init_set(matX->mat[0][0], a); + mpz_init_set(matX->mat[0][1], b); + mpz_init_set(matX->mat[1][0], c); + mpz_init_set(matX->mat[1][1], d); + + /* + * ### should perhaps check that there are no zero columns + */ + + /* remove powers of 2 from the matrix */ + normalizeMatrix(matX->mat); + + /* make the matrix positive if it is negative (ie no entries > 0) */ + if (matrixSign(matX->mat) < 0) + negateMatrix(matX->mat); + + matX->x = (Real) x; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(matX, x); + endGraphUpdate(); +#endif + +#ifdef LATER + /* + * Now we eagerly consume any matrix which follows. This may be unwise. + */ + if (x->gen.tag.type == MATX) { + multVectorPairTimesMatrix(matX->mat[0], matX->mat[1], x->matX.mat); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, x->matX.x); + endGraphUpdate(); +#endif + matX->x = x->matX.x; + } +#endif + + /* + * A MatX is signed if the there are entries in the matrix of different + * signs or if the argument to the MatX is signed. + */ + if (matX->x->gen.tag.isSigned || matrixSign(matX->mat) == 0) + matX->tag.isSigned = TRUE; + + if (matX->x->gen.tag.isSigned) + setMatXMethodSigned(matX); + else + setMatXMethodUnsigned(matX); + return (Real) matX; +} + +void +force_To_MatX_From_DigsX_Entry() +{ + MatX *matX; + DigsX *digsX; + int digitsNeeded; + void force_To_MatX_From_DigsX_Cont(); + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + digsX = (DigsX *) matX->x; + + PUSH_3(force_To_MatX_From_DigsX_Cont, matX, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (digsX->count < (unsigned int)digitsNeeded) + PUSH_3(digsX->force, digsX, digitsNeeded - digsX->count); +} + +void +force_To_MatX_From_DigsX_Cont() +{ + MatX *matX; + int digitsNeeded; + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + + absorbDigsXIntoMatX(matX); +} + +/* + * It can happen that, for example, an Alt is deemed signed, and yet + * the value it ultimately yields is unsigned. In this case we need to + * emit a sign from a DigsZ. This is little more than a no-op. + */ +void +force_To_MatX_From_DigsX_Signed() +{ + MatX *matX; + void force_To_MatX_From_DigsX_Entry(); + + matX = (MatX *) POP; + matX->force = force_To_MatX_From_DigsX_Entry; +} + +/* + * When a matrix is applied to an vector, the matrix reduces to a vector. + * The reduction happens in place. That is, we overwrite the matrix + * with a vector. That way any other consumers which share the matrix + * (now vector), end up pointing to the vector. + */ +void +force_To_MatX_From_Vec() +{ + MatX *matX; + Vec *vec; + mpz_t a, b; /* temporary storage while we clobber the MatX */ + Real strm; /* temporary storage while we clobber the MatX */ + int digitsNeeded; + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + + multVectorPairTimesVector(matX->mat[0], matX->mat[1], matX->x->vec.vec); + + a[0] = matX->mat[0][0][0]; + b[0] = matX->mat[0][1][0]; + strm = matX->strm; + + mpz_clear(matX->mat[1][0]); + mpz_clear(matX->mat[1][1]); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + endGraphUpdate(); +#endif + + vec = (Vec *) matX; + + vec->tag.type = VECTOR; + vec->vec[0][0] = a[0]; + vec->vec[1][0] = b[0]; + normalizeVector(vec->vec); + vec->strm = strm; +} + +/* + * Same as the above, except for the signed case. The stack frame + * is different. + */ +void +force_To_MatX_From_Vec_Signed() +{ + MatX *matX; + Vec *vec; + mpz_t a, b; /* temporary storage while we clobber the MatX */ + Real strm; /* temporary storage while we clobber the MatX */ + + matX = (MatX *) POP; + + multVectorPairTimesVector(matX->mat[0], matX->mat[1], matX->x->vec.vec); + + a[0] = matX->mat[0][0][0]; + b[0] = matX->mat[0][1][0]; + strm = matX->strm; + + mpz_clear(matX->mat[1][0]); + mpz_clear(matX->mat[1][1]); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + endGraphUpdate(); +#endif + + vec = (Vec *) matX; + + vec->tag.type = VECTOR; + vec->vec[0][0] = a[0]; + vec->vec[1][0] = b[0]; + normalizeVector(vec->vec); + vec->tag.isSigned = TRUE; + vec->strm = strm; +} + +void +force_To_MatX_From_MatX() +{ + MatX *matX; + int digitsNeeded; + void force_To_MatX_From_Vec(); + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + + if (matX->x->gen.tag.type == VECTOR) { + PUSH_3(force_To_MatX_From_Vec, matX, digitsNeeded); + return; + } + + multVectorPairTimesMatrix(matX->mat[0], matX->mat[1], matX->x->matX.mat); + normalizeMatrix(matX->mat); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, matX->x->matX.x); + endGraphUpdate(); +#endif + matX->x = matX->x->matX.x; + setMatXMethodUnsigned(matX); +} + +/* + * This handles the case when the arg of a signed MatX is another MatX. + * This version is strict. It inspects its argument first. If it too is + * signed, then it forces it before reducing the two matrices to one. + */ +void +force_To_MatX_From_MatX_Signed_Entry() +{ + MatX *matX, *arg; + void force_To_MatX_From_MatX_Signed_Cont(); + void force_To_MatX_From_Vec_Signed(); + + matX = (MatX *) POP; + + if (matX->x->gen.tag.type == VECTOR) { + PUSH_2(force_To_MatX_From_Vec_Signed, matX); + return; + } + + arg = (MatX *) matX->x; + + PUSH_2(force_To_MatX_From_MatX_Signed_Cont, matX); + if (arg->x->gen.tag.isSigned) + PUSH_2(arg->force, arg); +} + +/* + * The following code is exactly the same as the unsigned case except there + * are fewer things on the stack. The two can probably be reconciled + * as the number of digits is irrelevant when reducing matrices. We leave + * them separate in case one or other can be improved at a later time. + */ +void +force_To_MatX_From_MatX_Signed_Cont() +{ + MatX *matX; + void force_To_MatX_From_Vec_Signed(); + + matX = (MatX *) POP; + + if (matX->x->gen.tag.type == VECTOR) { + PUSH_2(force_To_MatX_From_Vec_Signed, matX); + return; + } + + multVectorPairTimesMatrix(matX->mat[0], matX->mat[1], matX->x->matX.mat); + normalizeMatrix(matX->mat); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, matX->x->matX.x); + endGraphUpdate(); +#endif + + matX->x = matX->x->matX.x; + setMatXMethodUnsigned(matX); +} + +void +force_To_MatX_From_TenXY() +{ + MatX *matX; + int digitsNeeded; + void force_To_MatX_From_MatX(); + void force_To_MatX_From_DigsX_Entry(); + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + + if (matX->x->gen.tag.type != TENXY) { + PUSH_3(force_To_MatX_From_MatX, matX, digitsNeeded); + return; + } + + createUnsignedStreamForTenXY(&matX->x->tenXY); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, matX->x->tenXY.strm); + endGraphUpdate(); +#endif + + matX->x = matX->x->tenXY.strm; + matX->force = force_To_MatX_From_DigsX_Entry; + PUSH_3(matX->force, matX, digitsNeeded); +} + +void +force_To_MatX_From_TenXY_Signed_Entry() +{ + MatX *matX; + TenXY *tenXY; + void force_To_MatX_From_MatX_Signed_Entry(); + void force_To_MatX_From_TenXY_Signed_Cont(); + void force_To_MatX_From_TenXY_Signed_Cont_X(); + + matX = (MatX *) POP; + tenXY = (TenXY *) matX->x; + + if (matX->x->gen.tag.type != TENXY) { + PUSH_2(force_To_MatX_From_MatX_Signed_Entry, matX); + return; + } + + if (tenXY->x->gen.tag.isSigned) { + if (tenXY->y->gen.tag.isSigned) { + PUSH_2(force_To_MatX_From_TenXY_Signed_Cont_X, matX); + PUSH_2(tenXY->forceY, tenXY); + } + else { + PUSH_2(force_To_MatX_From_TenXY_Signed_Cont, matX); + PUSH_2(tenXY->forceX, tenXY); + } + } + else { + if (tenXY->y->gen.tag.isSigned) { + PUSH_2(force_To_MatX_From_TenXY_Signed_Cont, matX); + PUSH_2(tenXY->forceY, tenXY); + } + else + PUSH_2(force_To_MatX_From_TenXY_Signed_Cont, matX); + } +} + +/* + * Here we have already forced the y argument, and now we force the sign + * from the x side of the tensor. + */ +void +force_To_MatX_From_TenXY_Signed_Cont_X() +{ + MatX *matX; + TenXY *tenXY; + void force_To_MatX_From_MatX_Signed_Entry(); + void force_To_MatX_From_TenXY_Signed_Cont(); + + matX = (MatX *) POP; + tenXY = (TenXY *) matX->x; + + if (matX->x->gen.tag.type != TENXY) { + PUSH_2(force_To_MatX_From_MatX_Signed_Entry, matX); + return; + } + + PUSH_2(force_To_MatX_From_TenXY_Signed_Cont, matX); + if (tenXY->x->gen.tag.isSigned) + PUSH_2(tenXY->forceX, tenXY); +} + +void +force_To_MatX_From_TenXY_Signed_Cont() +{ + MatX *matX; + void force_To_MatX_From_MatX_Signed_Cont(); + void force_To_MatX_From_SignX_Entry(); + + matX = (MatX *) POP; + + if (matX->x->gen.tag.type != TENXY) { + PUSH_2(force_To_MatX_From_MatX_Signed_Cont, matX); + return; + } + + createSignedStreamForTenXY(&matX->x->tenXY); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, matX->x->tenXY.strm); + endGraphUpdate(); +#endif + + matX->x = matX->x->tenXY.strm; + matX->force = force_To_MatX_From_SignX_Entry; + PUSH_2(matX->force, matX); +} + +void +force_To_MatX_From_Alt_Entry() +{ + MatX *matX; + Alt *alt; + void force_To_Alt_Entry(); + void force_To_MatX_From_Alt_Cont(); + int digitsNeeded; + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + alt = (Alt *) matX->x; + + PUSH_3(force_To_MatX_From_Alt_Cont, matX, digitsNeeded); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (alt->redirect == NULL) + PUSH_2(force_To_Alt_Entry, alt); +} + +void +force_To_MatX_From_Alt_Cont() +{ + MatX *matX; + Alt *alt; + int digitsNeeded; + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + alt = (Alt *) matX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, alt); + newEdgeToOnlyChild(matX, alt->redirect); + endGraphUpdate(); +#endif + matX->x = alt->redirect; + setMatXMethodUnsigned(matX); + + PUSH_3(matX->force, matX, digitsNeeded); +} + +void +force_To_MatX_From_Cls_Entry() +{ + MatX *matX; + Cls *cls; + void force_To_MatX_From_Cls_Cont(); + int digitsNeeded; + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) matX->x; + + PUSH_3(force_To_MatX_From_Cls_Cont, matX, digitsNeeded); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (cls->redirect == NULL) + PUSH_2(cls->force, cls); +} + +void +force_To_MatX_From_Cls_Cont() +{ + MatX *matX; + Cls *cls; + int digitsNeeded; + + matX = (MatX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) matX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, cls); + newEdgeToOnlyChild(matX, cls->redirect); + endGraphUpdate(); +#endif + matX->x = cls->redirect; + setMatXMethodUnsigned(matX); + + PUSH_3(matX->force, matX, digitsNeeded); +} + +void +force_To_MatX_From_Alt_Signed_Entry() +{ + MatX *matX; + Alt *alt; + void force_To_Alt_Entry(); + void force_To_MatX_From_Alt_Signed_Cont(); + + matX = (MatX *) POP; + alt = (Alt *) matX->x; + + PUSH_2(force_To_MatX_From_Alt_Signed_Cont, matX); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (alt->redirect == NULL) + PUSH_2(force_To_Alt_Entry, alt); +} + +void +force_To_MatX_From_Alt_Signed_Cont() +{ + MatX *matX; + Alt *alt; + + matX = (MatX *) POP; + alt = (Alt *) matX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, alt); + newEdgeToOnlyChild(matX, alt->redirect); + endGraphUpdate(); +#endif + + matX->x = alt->redirect; + setMatXMethodSigned(matX); + + PUSH_2(matX->force, matX); +} + +void +force_To_MatX_From_Cls_Signed_Entry() +{ + MatX *matX; + Cls *cls; + void force_To_MatX_From_Cls_Signed_Cont(); + + matX = (MatX *) POP; + cls = (Cls *) matX->x; + + PUSH_2(force_To_MatX_From_Cls_Signed_Cont, matX); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (cls->redirect == NULL) + PUSH_2(cls->force, cls); +} + +void +force_To_MatX_From_Cls_Signed_Cont() +{ + MatX *matX; + Cls *cls; + + matX = (MatX *) POP; + cls = (Cls *) matX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, cls); + newEdgeToOnlyChild(matX, cls->redirect); + endGraphUpdate(); +#endif + + matX->x = cls->redirect; + setMatXMethodSigned(matX); + + PUSH_2(matX->force, matX); +} + +void +force_To_MatX_From_SignX_Entry() +{ + MatX *matX; + SignX *signX; + void force_To_MatX_From_SignX_Cont(); + + matX = (MatX *) POP; + signX = (SignX *) matX->x; + + PUSH_2(force_To_MatX_From_SignX_Cont, matX); + if (signX->tag.value == SIGN_UNKN) + PUSH_2(signX->force, signX); +} + +void +force_To_MatX_From_SignX_Cont() +{ + MatX *matX; + void absorbSignIntoMatX(MatX *); + + matX = (MatX *) POP; + absorbSignIntoMatX(matX); +} + +void +absorbSignIntoMatX(MatX *matX) +{ + absorbSignIntoVectorPair(matX->mat[0], matX->mat[1], + matX->x->signX.tag.value); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, matX->x); + newEdgeToOnlyChild(matX, matX->x->signX.x); + endGraphUpdate(); +#endif + matX->x = matX->x->signX.x; + setMatXMethodUnsigned(matX); +} + +void +setMatXMethodSigned(MatX *matX) +{ + void force_To_MatX_From_SignX_Entry(); + void force_To_MatX_From_DigsX_Signed(); + void force_To_MatX_From_Vec_Signed(); + void force_To_MatX_From_MatX_Signed_Entry(); + void force_To_MatX_From_TenXY_Signed_Entry(); + void force_To_MatX_From_Alt_Signed_Entry(); + void force_To_MatX_From_Cls_Signed_Entry(); + + switch (matX->x->gen.tag.type) { + case SIGNX : + matX->force = force_To_MatX_From_SignX_Entry; + break; + case DIGSX : + matX->force = force_To_MatX_From_DigsX_Signed; + break; + case ALT : + matX->force = force_To_MatX_From_Alt_Signed_Entry; + break; + case VECTOR : + matX->force = force_To_MatX_From_Vec_Signed; + break; + case MATX : + matX->force = force_To_MatX_From_MatX_Signed_Entry; + break; + case TENXY : + matX->force = force_To_MatX_From_TenXY_Signed_Entry; + break; + case CLOSURE : + matX->force = force_To_MatX_From_Cls_Signed_Entry; + break; + default : + Error(FATAL, E_INT, "setMatXMethodSigned", "something wrong with x"); + break; + } +} + +void +setMatXMethodUnsigned(MatX *matX) +{ + void force_To_MatX_From_SignX_Entry(); + void force_To_MatX_From_DigsX_Entry(); + void force_To_MatX_From_Vec(); + void force_To_MatX_From_MatX(); + void force_To_MatX_From_TenXY(); + void force_To_MatX_From_Alt_Entry(); + void force_To_MatX_From_Cls_Entry(); + + switch (matX->x->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "setMatXMethodUnsigned", "x is signed"); + break; + case DIGSX : + matX->force = force_To_MatX_From_DigsX_Entry; + break; + case ALT : + matX->force = force_To_MatX_From_Alt_Entry; + break; + case VECTOR : + matX->force = force_To_MatX_From_Vec; + break; + case MATX : + matX->force = force_To_MatX_From_MatX; + break; + case TENXY : + matX->force = force_To_MatX_From_TenXY; + break; + case CLOSURE : + matX->force = force_To_MatX_From_Cls_Entry; + break; + default : + Error(FATAL, E_INT, "setMatXMethodUnsigned", "something wrong with x"); + break; + } +} + +void +absorbDigsXIntoMatX(MatX *matX) +{ + DigsX *digsX; + SmallMatrix smallAccumMat; + + digsX = (DigsX *) matX->x; + + /* + * Now accumulate the digits into a matrix (large or small integers) + * and augment the matrix (matX) with the information. + */ + if (digsX->count > 0) { +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + makeSmallMatrixFromDigits(smallAccumMat, digsX); + multVectorPairTimesSmallMatrix(matX->mat[0], matX->mat[1], + smallAccumMat); + } + else { +#endif + makeMatrixFromDigits(bigTmpMat, digsX); + multVectorPairTimesMatrix(matX->mat[0], matX->mat[1], bigTmpMat); +#ifdef PACK_DIGITS + } +#endif + matX->x = digsX->x; +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(matX, digsX); + newEdgeToOnlyChild(matX, digsX->x); + endGraphUpdate(); +#endif + + /* + * Now try to remove powers of 2 from the residual matrix. + */ + normalizeMatrix(matX->mat); + + } + +#ifdef TRACE + debugp("force_To_MatX_From_DigsX", + "%x %x absorbed=%d\n", + (unsigned) matX, + (unsigned) digsX, + digsX->count); +#endif +} diff --git a/ic-reals-6.3/base/SignX.c b/ic-reals-6.3/base/SignX.c new file mode 100644 index 0000000..f138a5d --- /dev/null +++ b/ic-reals-6.3/base/SignX.c @@ -0,0 +1,675 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include <gmp-impl.h> +#include <longlong.h> +#include "real-impl.h" + +/* + * Functions for forcing signs from LFTs. Bear in mind that, unlike digits, + * sign emission is strict. We cannot emit a sign from an lft + * without first absorbing the sign(s) from the argument(s) of the lft. + * + * Unlike digit emission which is associated with edges, sign emission is + * node based. + */ + +bool emitSignFromVector(Vector, Sign *); +bool emitSignFromMatrix(Matrix, Sign *); +bool emitSignFromTensor(Tensor, Sign *); + +void redirectSignX(SignX *, Real); + +/* + * Allocate a structure in the heap for a SignX. + */ +SignX * +allocSignX(Real x, int sign) +{ + SignX *signX; + void force_To_SignX_From_DigsX(); + void force_To_SignX_From_Vec(); + void force_To_SignX_From_MatX_Entry(); + void force_To_SignX_From_TenXY_Entry(); + void force_To_SignX_From_Cls_Entry(); + void force_To_SignX_From_Alt_Entry(); + + if ((signX = (SignX *) malloc (sizeof(SignX))) == NULL) + Error(FATAL, E_INT, "allocSignX", "malloc failed"); + +#ifdef DAVINCI + newNodeId(signX); +#else +#ifdef TRACE + newNodeId(signX); +#endif +#endif + + signX->tag.type = SIGNX; + signX->tag.dumped = FALSE; + signX->tag.isSigned = TRUE; + signX->tag.value = sign; + + signX->x = x; + + /* + * Now set the method to retrieve the sign from the argument. + * We do a sanity check along the way. If the sign is specified, then + * the force method assigned here is irrelevant. + */ + switch (x->gen.tag.type) { + case DIGSX : + signX->force = force_To_SignX_From_DigsX; + break; + case ALT : + signX->force = force_To_SignX_From_Alt_Entry; + break; + case CLOSURE : + signX->force = force_To_SignX_From_Cls_Entry; + break; + case VECTOR : + if (sign != SIGN_UNKN && !vectorIsPositive(x->vec.vec)) + Error(FATAL, E_INT, "allocSignX", + "sign specified but vector not positive"); + signX->force = force_To_SignX_From_Vec; + break; + case MATX : + if (sign != SIGN_UNKN && !matrixIsPositive(x->matX.mat)) + Error(FATAL, E_INT, "allocSignX", + "sign specified but matrix not positive"); + signX->force = force_To_SignX_From_MatX_Entry; + break; + case TENXY : + if (sign != SIGN_UNKN && !tensorIsPositive(x->tenXY.ten)) + Error(FATAL, E_INT, "allocSignX", + "sign specified but tensor not positive"); + signX->force = force_To_SignX_From_TenXY_Entry; + break; + default : + Error(FATAL, E_INT, "allocSignX", "bad argument type"); + } + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(signX, SIGNX); + newEdgeToOnlyChild(signX, x); + endGraphUpdate(); +#endif + + return signX; +} + +void +setSignXMethods(SignX *signX) +{ + void force_To_SignX_From_Alt_Entry(); + void force_To_SignX_From_Cls_Entry(); + void force_To_SignX_From_SignX_Entry(); + void force_To_SignX_From_DigsX(); + void force_To_SignX_From_Vec(); + void force_To_SignX_From_MatX_Entry(); + void force_To_SignX_From_TenXY_Entry(); + + switch (signX->x->gen.tag.type) { + case ALT : + signX->force = force_To_SignX_From_Alt_Entry; + break; + case SIGNX : + signX->force = force_To_SignX_From_SignX_Entry; + break; + case DIGSX : + signX->force = force_To_SignX_From_DigsX; + break; + case VECTOR : + signX->force = force_To_SignX_From_Vec; + break; + case MATX : + signX->force = force_To_SignX_From_MatX_Entry; + break; + case TENXY : + signX->force = force_To_SignX_From_TenXY_Entry; + break; + case CLOSURE : + signX->force = force_To_SignX_From_Cls_Entry; + break; + default : + Error(FATAL, E_INT, "setSignXMethod", "bad argument type"); + } +} + +/* + * When an lft is guarded by a SIGNX and we emit the sign then we introduce + * an empty DigsX between the sign and the residual lft. + */ +void +introDigsX(SignX *signX) +{ + DigsX *digsX; + void force_To_SignX_From_DigsX(); + + digsX = allocDigsX(signX->x); + digsX->x = signX->x; + setDigsXMethod(digsX); + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, signX->x); + deleteOnlyEdge(signX, signX->x); + newEdgeToOnlyChild(signX, digsX); + endGraphUpdate(); +#endif + + signX->x = (Real) digsX; + signX->force = force_To_SignX_From_DigsX; +} + +/* + * This is called when the sign is unknown. In fact, in the case + * of vectors, it is always possible to determine the sign when the + * vector is created. But we leave it for now. + */ +void +force_To_SignX_From_Vec() +{ + SignX *signX; + Vec *vec; + Sign s; + + signX = (SignX *) POP; + vec = (Vec *) signX->x; + + if (emitSignFromVector(vec->vec, &s)) { + signX->tag.value = s; + introDigsX(signX); + } + else + Error(FATAL, E_INT, "force_To_SignX_From_Vecr", + "Failed to get sign from vector"); +} + +void +force_To_SignX_From_MatX_Entry() +{ + SignX *signX; + MatX *matX; + void force_To_SignX_From_MatX_Cont(); + void force_To_SignX_From_Vec(); + + signX = (SignX *) POP; + matX = (MatX *) signX->x; + + if (matX->tag.type == VECTOR) { + PUSH_2(force_To_SignX_From_Vec, signX); + return; + } + + PUSH_2(force_To_SignX_From_MatX_Cont, signX); + + /* + * First check to see if the argument is signed. If + * so then we must force it. + */ + if (matX->x->gen.tag.isSigned) + PUSH_2(matX->force, matX); +} + +void +force_To_SignX_From_MatX_Cont() +{ + SignX *signX; + MatX *matX; + void force_To_SignX_From_Vec(); + Sign s; + + signX = (SignX *) POP; + + /* + * First of all, we need to check that the MatX argument hasn't been + * reduced to a vector. + */ + if (signX->x->gen.tag.type == VECTOR) { + PUSH_2(force_To_SignX_From_Vec, signX); + return; + } + + matX = (MatX *) signX->x; + + /* + * Now try to emit our sign, and if we fail to do so, we get a digit + * from the argument. + */ + if (emitSignFromMatrix(matX->mat, &s)) { + signX->tag.value = s; + introDigsX(signX); + return; + } + + PUSH_2(force_To_SignX_From_MatX_Cont, signX); + PUSH_3(matX->force, matX, defaultForceCount); +} + +void +force_To_SignX_From_TenXY_Entry() +{ + SignX *signX; + TenXY *tenXY; + void force_To_SignX_From_TenXY_Cont(); + void force_To_SignX_From_MatX_Entry(); + void force_To_SignX_From_TenXY_Cont_X(); + + signX = (SignX *) POP; + tenXY = (TenXY *) signX->x; + + if (tenXY->tag.type != TENXY) { + PUSH_2(force_To_SignX_From_MatX_Entry, signX); + return; + } + + tenXY->tensorFairness = 1; + + if (tenXY->x->gen.tag.isSigned) { + if (tenXY->y->gen.tag.isSigned) { + PUSH_2(force_To_SignX_From_TenXY_Cont_X, signX); + PUSH_2(tenXY->forceY, tenXY); + } + else { + PUSH_2(force_To_SignX_From_TenXY_Cont, signX); + PUSH_2(tenXY->forceX, tenXY); + } + } + else { + if (tenXY->y->gen.tag.isSigned) { + PUSH_2(force_To_SignX_From_TenXY_Cont, signX); + PUSH_2(tenXY->forceY, tenXY); + } + else + PUSH_2(force_To_SignX_From_TenXY_Cont, signX); + } +} + +void +force_To_SignX_From_TenXY_Cont_X() +{ + SignX *signX; + TenXY *tenXY; + void force_To_SignX_From_TenXY_Cont(); + void force_To_SignX_From_MatX_Entry(); + + signX = (SignX *) POP; + tenXY = (TenXY *) signX->x; + + if (tenXY->tag.type != TENXY) { + PUSH_2(force_To_SignX_From_MatX_Entry, signX); + return; + } + + PUSH_2(force_To_SignX_From_TenXY_Cont, signX); + + if (tenXY->x->gen.tag.isSigned) + PUSH_2(tenXY->forceX, tenXY); +} + +void +force_To_SignX_From_TenXY_Cont() +{ + SignX *signX; + TenXY *tenXY; + Sign s; + void force_To_SignX_From_MatX_Entry(); + void force_To_SignX_From_MatX_Cont(); + + signX = (SignX *) POP; + + /* + * First of all, we need to check that the TenXY argument hasn't been + * reduced to a matrix or vector. + */ + if (signX->x->gen.tag.type != TENXY) { + PUSH_2(force_To_SignX_From_MatX_Cont, signX); + return; + } + + tenXY = (TenXY *) signX->x; + + /* + * Now try to emit the sign, and if we fail to do so, we get information + * from one or other of the arguments. + */ + if (emitSignFromTensor(tenXY->ten, &s)) { + signX->tag.value = s; + introDigsX(signX); + return; + } + + /* + * If we get here, then we have failed to emit the sign. + * So we take turns absorbing digits from left and right until + * we succeed. + */ + PUSH_2(force_To_SignX_From_TenXY_Cont, signX); + + tenXY->tensorFairness = !tenXY->tensorFairness; + if (tenXY->tensorFairness) + PUSH_3(tenXY->forceX, tenXY, defaultForceCount); + else + PUSH_3(tenXY->forceY, tenXY, defaultForceCount); +} + +void +force_To_SignX_From_DigsX() +{ + SignX *signX; + + signX = (SignX *) POP; + signX->tag.value = SPOS; +} + + +/* + * If we prefix an alt with a SignX, then it can happen that after reduction + * we end up with a SignX consuming from another SignX. When this happens + * then when we force the top level SignX, we must force the second + * and then copy the sign from the second to the first. + */ +void +force_To_SignX_From_SignX_Entry() +{ + SignX *signX; + void force_To_SignX_From_SignX_Cont(); + + signX = (SignX *) POP; + + PUSH_2(force_To_SignX_From_SignX_Cont, signX); + if (signX->x->signX.tag.value == SIGN_UNKN) + PUSH_2(signX->x->signX.force, signX->x); +} + +void +force_To_SignX_From_SignX_Cont() +{ + SignX *signX; + + signX = (SignX *) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, signX->x); + newEdgeToOnlyChild(signX, signX->x->signX.x); + endGraphUpdate(); +#endif + + /* copy the sign from the second to the first */ + signX->tag.value = signX->x->signX.tag.value; + signX->x = signX->x->signX.x; +} + +/* + * These functions are only used when an alt has been explicitly guarded + * using makeStream(); + * + * force_To_SignX_From_Alt(Alt *alt) + * { + * if (alt->redirect == NULL) + * force_To_Alt_Entry(alt); + * + * # we need to handle the special case when the alt evaluates to a real + * # prefixed by a SignX. We need to force the sign. + * + * if (alt->redirect->gen.tag.type == SIGNX + && alt->redirect->signX.value == SIGN_UNKN) + * *(alt->redirect->signX.force)(alt->redirect); + * + * # now inspect the tag on alt->redirect to decide how to tranferi + * # or evaluate the sign. + * # Because of sharing and since emission has side-effects + * # then in the case of matrices and vectors, we must make a copy + * # of the lft. + * ... see below for the cases. + * } + */ +void +force_To_SignX_From_Alt_Entry() +{ + SignX *signX; + Alt *alt; + void force_To_Alt_Entry(); + void force_To_SignX_From_Alt_Cont(); + + signX = (SignX *) POP; + alt = (Alt *) signX->x; + + PUSH_2(force_To_SignX_From_Alt_Cont, signX); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to evaluate it. + */ + if (alt->redirect == NULL) + PUSH_2(force_To_Alt_Entry, alt); +} + +/* + * At this point we know that the alt has evaluated to a real. We need + * to consume a sign from this real. + */ +void +force_To_SignX_From_Alt_Cont() +{ + SignX *signX; + Alt *alt; + + signX = (SignX *) POP; + alt = (Alt *) signX->x; + redirectSignX(signX, alt->redirect); + PUSH_2(signX->force, signX); +} + +void +force_To_SignX_From_Cls_Entry() +{ + SignX *signX; + Cls *cls; + void force_To_SignX_From_Cls_Cont(); + + signX = (SignX *) POP; + cls = (Cls *) signX->x; + + PUSH_2(force_To_SignX_From_Cls_Cont, signX); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to evaluate it. + */ + if (cls->redirect == NULL) + PUSH_2(cls->force, cls); +} + +/* + * At this point we know that the cls has evaluated to a real. We need + * to consume a sign from this real. + */ +void +force_To_SignX_From_Cls_Cont() +{ + SignX *signX; + Cls *cls; + + signX = (SignX *) POP; + cls = (Cls *) signX->x; + redirectSignX(signX, cls->redirect); + PUSH_2(signX->force, signX); +} + +void +redirectSignX(SignX *signX, Real x) +{ + Real r; + + void force_To_SignX_From_SignX_Entry(); + void force_To_SignX_From_Cls_Entry(); + void force_To_SignX_From_Alt_Entry(); + void force_To_SignX_From_DigsX(); + void force_To_SignX_From_Vec(); + void force_To_SignX_From_MatX_Entry(); + void force_To_SignX_From_TenXY_Entry(); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, signX->x); + newEdgeToOnlyChild(signX, x); + endGraphUpdate(); +#endif + signX->x = x; + + switch (x->gen.tag.type) { + case SIGNX : + signX->force = force_To_SignX_From_SignX_Entry; + break; + case DIGSX : + signX->force = force_To_SignX_From_DigsX; + break; + case CLOSURE : + signX->force = force_To_SignX_From_Cls_Entry; + break; + case ALT : + signX->force = force_To_SignX_From_Alt_Entry; + break; + case VECTOR : + /* + * First we check that the Vector does not have an equivalent stream. + * If it doesn't then the SignX consumer we already have, will + * become the root of the new equivalent stream. Note that we + * are oblidged to make a copy of the vector since there may be + * other consumers, and emitting the sign will change the vector. + */ + if (x->vec.strm == NULL) { + r = vector_Z(x->vec.vec[0], x->vec.vec[1]); + signX->x = r; + x->vec.strm = (Real) signX; +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, x); + newEdgeToOnlyChild(signX, r); + drawEqEdge(signX, x); + endGraphUpdate(); +#endif + signX->force = force_To_SignX_From_Vec; + } + /* + * If there already is an equivalent stream, then we arrange to + * equate the two streams. + */ + else { +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, x); + newEdgeToOnlyChild(signX, x->vec.strm); + endGraphUpdate(); +#endif + signX->x = x->vec.strm; + + /* we already have a stream, so we must equate them as above */ + switch (x->vec.strm->gen.tag.type) { + case SIGNX : + signX->force = force_To_SignX_From_SignX_Entry; + break; + case DIGSX : + signX->force = force_To_SignX_From_DigsX; + break; + default : + Error(FATAL, E_INT, "redirectSignX", + "vector stream is not a stream"); + } + } + break; + + case MATX : + /* + * This code is the same as that for the vector case + */ + if (x->matX.strm == NULL) { + r = matrix_Z(x->matX.x, + x->matX.mat[0][0], x->matX.mat[0][1], + x->matX.mat[1][0], x->matX.mat[1][1]); + signX->x = r; + x->matX.strm = (Real) signX; +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, x); + newEdgeToOnlyChild(signX, r); + drawEqEdge(signX, x); + endGraphUpdate(); +#endif + signX->force = force_To_SignX_From_MatX_Entry; + } + + else { +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, x); + newEdgeToOnlyChild(signX, x->matX.strm); + endGraphUpdate(); +#endif + signX->x = x->matX.strm; + + /* we already have a stream, so we must equate them as above */ + switch (x->matX.strm->gen.tag.type) { + case SIGNX : + signX->force = force_To_SignX_From_SignX_Entry; + break; + case DIGSX : + signX->force = force_To_SignX_From_DigsX; + break; + default : + Error(FATAL, E_INT, "redirectSignX", + "matrix stream is not a stream"); + } + } + break; + + case TENXY : + /* + * This code is the same as that for the vector and matrix cases + * except that we don't need to worry about sharing and hence there + * is not need to make a copy of the tensor. + */ + if (x->tenXY.strm == NULL) { + x->tenXY.strm = (Real) signX; + signX->force = force_To_SignX_From_TenXY_Entry; + } + + else { +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(signX, x); + newEdgeToOnlyChild(signX, x->tenXY.strm); + endGraphUpdate(); +#endif + signX->x = x->tenXY.strm; + + /* we already have a stream, so we must equate them as above */ + switch (x->tenXY.strm->gen.tag.type) { + case SIGNX : + signX->force = force_To_SignX_From_SignX_Entry; + break; + case DIGSX : + signX->force = force_To_SignX_From_DigsX; + break; + default : + Error(FATAL, E_INT, "redirectSignX", + "tensor stream is not a stream"); + } + } + break; + default : + Error(FATAL, E_INT, "redirectSignX", + "value of alternation is not a real"); + } +} diff --git a/ic-reals-6.3/base/TenXY.c b/ic-reals-6.3/base/TenXY.c new file mode 100644 index 0000000..7199966 --- /dev/null +++ b/ic-reals-6.3/base/TenXY.c @@ -0,0 +1,1752 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Functions for allocating and manipulating tensor LFTs in the heap. + */ + +void setTenXY_Y_MethodSigned(TenXY *); +void setTenXY_X_MethodSigned(TenXY *); +void setTenXY_Y_MethodUnsigned(TenXY *); +void setTenXY_X_MethodUnsigned(TenXY *); + +void absorbDigsXIntoTenXY_X(TenXY *); +void absorbDigsXIntoTenXY_Y(TenXY *); +void createUnsignedStreamForTenXY(TenXY *); + +TenXY * +allocTenXY() +{ + TenXY *tenXY; + + if ((tenXY = (TenXY *) malloc (sizeof(TenXY))) == NULL) + Error(FATAL, E_INT, "allocTenXY", "malloc failed"); + +#ifdef DAVINCI + newNodeId(tenXY); +#else +#ifdef TRACE + newNodeId(tenXY); +#endif +#endif + tenXY->tag.type = TENXY; + tenXY->tag.dumped = FALSE; + tenXY->strm = (Real) NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(tenXY, TENXY); + endGraphUpdate(); +#endif + + return tenXY; +} + +/* + * The following function allocates a tensor, fills in the tensor + * entries and sets the arguments to the tensors. + * + * There is code here for eagerly reducing a tensor against vector and + * matrix arguments. Eager reduction has the advantage that it reduces + * the amount of garbage created in the heap. For the time being, however, + * reduction is disabled since there are functions which call this function + * and assume the result they get back is genuinely a tensor. With reduction + * it may return a tensor, matrix or vector. + */ + +Real +tensor_Int(Real x, Real y, + int a, int b, int c, int d, + int e, int f, int g, int h) +{ + TenXY *tenXY; + +#ifdef LATER + /* + * If either or both of the arguments are vectors, then there is room + * for reduction. + */ + if (x->gen.tag.type == VECTOR || y->gen.tag.type == VECTOR) { + mpz_init_set_si(bigTmpTen[0][0], a); + mpz_init_set_si(bigTmpTen[0][1], b); + mpz_init_set_si(bigTmpTen[1][0], c); + mpz_init_set_si(bigTmpTen[1][1], d); + mpz_init_set_si(bigTmpTen[2][0], e); + mpz_init_set_si(bigTmpTen[2][1], f); + mpz_init_set_si(bigTmpTen[3][0], g); + mpz_init_set_si(bigTmpTen[3][1], h); + + if (x->gen.tag.type == VECTOR) { + multVectorPairTimesVector(bigTmpTen[0], bigTmpTen[2], x->vec.vec); + multVectorPairTimesVector(bigTmpTen[1], bigTmpTen[3], x->vec.vec); + } + + if (y->gen.tag.type == VECTOR) { + multVectorPairTimesVector(bigTmpTen[0], bigTmpTen[1], y->vec.vec); + multVectorPairTimesVector(bigTmpTen[2], bigTmpTen[3], y->vec.vec); + } + + if (x->gen.tag.type == VECTOR) { + if (y->gen.tag.type == VECTOR) + return vector_Z(bigTmpTen[0][0], bigTmpTen[0][1]); + else + return matrix_Z(y, bigTmpTen[0][0], bigTmpTen[0][1], + bigTmpTen[1][0], bigTmpTen[1][1]); + } + else { /* then y->gen.tag.type == VECTOR */ + return matrix_Z(x, bigTmpTen[0][0], bigTmpTen[0][1], + bigTmpTen[2][0], bigTmpTen[2][1]); + } + } +#endif + + /* + * So now we know we will end up with a tensor, so we allocate one. + */ + tenXY = allocTenXY(); + + mpz_init_set_si(tenXY->ten[0][0], a); + mpz_init_set_si(tenXY->ten[0][1], b); + mpz_init_set_si(tenXY->ten[1][0], c); + mpz_init_set_si(tenXY->ten[1][1], d); + mpz_init_set_si(tenXY->ten[2][0], e); + mpz_init_set_si(tenXY->ten[2][1], f); + mpz_init_set_si(tenXY->ten[3][0], g); + mpz_init_set_si(tenXY->ten[3][1], h); + + /* remove powers of 2 from the tensor */ + normalizeTensor(tenXY->ten); + + /* make the tensor positive if it is negative (no entries > 0) */ + if (tensorSign(tenXY->ten) < 0) + negateTensor(tenXY->ten); + + tenXY->x = x; + tenXY->y = y; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToXChild(tenXY, x); + newEdgeToYChild(tenXY, y); + endGraphUpdate(); +#endif + +#ifdef LATER + /* + * Now we eagerly consume any matrix which follows. + */ + if (x->gen.tag.type == MATX) { + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[2], x->matX.mat); + multVectorPairTimesMatrix(tenXY->ten[1], tenXY->ten[3], x->matX.mat); +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, x->matX.x); + endGraphUpdate(); +#endif + tenXY->x = x->matX.x; + } + + /* + * Do the same as the above on the y side now. + */ + if (y->gen.tag.type == MATX) { + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[1], y->matX.mat); + multVectorPairTimesMatrix(tenXY->ten[2], tenXY->ten[3], y->matX.mat); +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, y->matX.x); + endGraphUpdate(); +#endif + tenXY->y = y->matX.x; + } +#endif + + /* + * A TenXY is signed if the there are entries in the tensor of different + * signs or if either argument to the TenXY is signed. + */ + if (tenXY->x->gen.tag.isSigned + || tenXY->y->gen.tag.isSigned + || tensorSign(tenXY->ten) == 0) + tenXY->tag.isSigned = TRUE; + + if (tenXY->x->gen.tag.isSigned) + setTenXY_X_MethodSigned(tenXY); + else + setTenXY_X_MethodUnsigned(tenXY); + + if (tenXY->y->gen.tag.isSigned) + setTenXY_Y_MethodSigned(tenXY); + else + setTenXY_Y_MethodUnsigned(tenXY); + + return (Real) tenXY; +} + +Real +tensor_Z(Real x, Real y, + mpz_t a, mpz_t b, mpz_t c, mpz_t d, + mpz_t e, mpz_t f, mpz_t g, mpz_t h) +{ + TenXY *tenXY; + + /* + * So now we know we will end up with a tensor, so we allocate one. + */ + tenXY = allocTenXY(); + + mpz_init_set(tenXY->ten[0][0], a); + mpz_init_set(tenXY->ten[0][1], b); + mpz_init_set(tenXY->ten[1][0], c); + mpz_init_set(tenXY->ten[1][1], d); + mpz_init_set(tenXY->ten[2][0], e); + mpz_init_set(tenXY->ten[2][1], f); + mpz_init_set(tenXY->ten[3][0], g); + mpz_init_set(tenXY->ten[3][1], h); + + /* remove powers of 2 from the tensor */ + normalizeTensor(tenXY->ten); + + /* make the tensor positive if it is negative (no entries > 0) */ + if (tensorSign(tenXY->ten) < 0) + negateTensor(tenXY->ten); + + tenXY->x = x; + tenXY->y = y; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToXChild(tenXY, x); + newEdgeToYChild(tenXY, y); + endGraphUpdate(); +#endif + + /* + * A TenXY is signed if the there are entries in the tensor of different + * signs or if either argument to the TenXY is signed. + */ + if (tenXY->x->gen.tag.isSigned + || tenXY->y->gen.tag.isSigned + || tensorSign(tenXY->ten) == 0) + tenXY->tag.isSigned = TRUE; + + if (tenXY->x->gen.tag.isSigned) + setTenXY_X_MethodSigned(tenXY); + else + setTenXY_X_MethodUnsigned(tenXY); + + if (tenXY->y->gen.tag.isSigned) + setTenXY_Y_MethodSigned(tenXY); + else + setTenXY_Y_MethodUnsigned(tenXY); + + return (Real) tenXY; +} + +void +force_To_TenXY_X_From_DigsX_Entry() +{ + TenXY *tenXY; + DigsX *digsX; + int digitsNeeded; + void force_To_TenXY_X_From_DigsX_Cont(); + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + digsX = (DigsX *) tenXY->x; + + PUSH_3(force_To_TenXY_X_From_DigsX_Cont, tenXY, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (digsX->count < (unsigned int)digitsNeeded) + PUSH_3(digsX->force, digsX, digitsNeeded - digsX->count); +} + +void +force_To_TenXY_X_From_DigsX_Cont() +{ + TenXY *tenXY; + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + absorbDigsXIntoTenXY_X(tenXY); +} + +void +force_To_TenXY_X_From_DigsX_Signed() +{ + TenXY *tenXY; + void force_To_TenXY_X_From_DigsX_Entry(); + + tenXY = (TenXY *) POP; + tenXY->forceX = force_To_TenXY_X_From_DigsX_Entry; +} + +void +force_To_TenXY_Y_From_DigsX_Signed() +{ + TenXY *tenXY; + void force_To_TenXY_Y_From_DigsX_Entry(); + + tenXY = (TenXY *) POP; + tenXY->forceY = force_To_TenXY_Y_From_DigsX_Entry; +} + +/* + * When a tensor absorbs a vector, the tensor reduces to a matrix. We do this + * in place. That is, we overwrite the tensor with a matrix. We do this + * since the tensor might be shared. It might waste a bit of space + * but the garbage collector will deal with this (eventually). + * + * Note that the node drawn by daVinci still has type tensor but this + * doesn't matter. + */ +void +force_To_TenXY_X_From_Vec() +{ + TenXY *tenXY; + MatX *matX; + mpz_t a, b, c, d; /* temporary storage while we clobber the TenXY */ + Real strm; /* temporary storage again */ + int digitsNeeded; + int totalEmitted; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + multVectorPairTimesVector(tenXY->ten[0], tenXY->ten[2], tenXY->x->vec.vec); + multVectorPairTimesVector(tenXY->ten[1], tenXY->ten[3], tenXY->x->vec.vec); + + a[0] = tenXY->ten[0][0][0]; + b[0] = tenXY->ten[0][1][0]; + c[0] = tenXY->ten[1][0][0]; + d[0] = tenXY->ten[1][1][0]; + strm = tenXY->strm; + totalEmitted = tenXY->totalEmitted; + + mpz_clear(tenXY->ten[2][0]); + mpz_clear(tenXY->ten[2][1]); + mpz_clear(tenXY->ten[3][0]); + mpz_clear(tenXY->ten[3][1]); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + deleteEdgeToYChild(tenXY, tenXY->y); + endGraphUpdate(); +#endif + + matX = (MatX *) tenXY; + matX->tag.type = MATX; + matX->x = tenXY->y; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(matX, matX->x); + endGraphUpdate(); +#endif + + matX->mat[0][0][0] = a[0]; + matX->mat[0][1][0] = b[0]; + matX->mat[1][0][0] = c[0]; + matX->mat[1][1][0] = d[0]; + normalizeMatrix(matX->mat); + matX->strm = strm; + matX->totalEmitted = totalEmitted; + + setMatXMethodUnsigned(matX); +} + +/* + * When a tensor absorbs a vector, the tensor reduces to a matrix. We do this + * in place. That is, we overwrite the tensor with a matrix. We do this + * since the tensor might be shared. It might waste a bit of space + * but the garbage collector will deal with this (eventually). + * + * Note that the node drawn by daVinci still has type tensor but this + * doesn't matter. + */ +void +force_To_TenXY_Y_From_Vec() +{ + TenXY *tenXY; + MatX *matX; + mpz_t a, b, c, d; /* temporary storage while we clobber the TenXY */ + Real strm; /* temporary storage again */ + int digitsNeeded; + int totalEmitted; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + multVectorPairTimesVector(tenXY->ten[0], tenXY->ten[1], tenXY->y->vec.vec); + multVectorPairTimesVector(tenXY->ten[2], tenXY->ten[3], tenXY->y->vec.vec); + + a[0] = tenXY->ten[0][0][0]; + b[0] = tenXY->ten[0][1][0]; + c[0] = tenXY->ten[2][0][0]; + d[0] = tenXY->ten[2][1][0]; + strm = tenXY->strm; + totalEmitted = tenXY->totalEmitted; + + mpz_clear(tenXY->ten[1][0]); + mpz_clear(tenXY->ten[1][1]); + mpz_clear(tenXY->ten[3][0]); + mpz_clear(tenXY->ten[3][1]); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + deleteEdgeToYChild(tenXY, tenXY->y); + endGraphUpdate(); +#endif + + matX = (MatX *) tenXY; + matX->tag.type = MATX; + matX->x = tenXY->x; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(matX, matX->x); + endGraphUpdate(); +#endif + matX->mat[0][0][0] = a[0]; + matX->mat[0][1][0] = b[0]; + matX->mat[1][0][0] = c[0]; + matX->mat[1][1][0] = d[0]; + normalizeMatrix(matX->mat); + matX->strm = strm; + matX->totalEmitted = totalEmitted; + + setMatXMethodUnsigned(matX); +} + +void +force_To_TenXY_X_From_MatX() +{ + TenXY *tenXY; + int digitsNeeded; + void force_To_TenXY_X_From_Vec(); + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + if (tenXY->x->gen.tag.type == VECTOR) { + PUSH_3(force_To_TenXY_X_From_Vec, tenXY, digitsNeeded); + return; + } + + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[2], tenXY->x->matX.mat); + multVectorPairTimesMatrix(tenXY->ten[1], tenXY->ten[3], tenXY->x->matX.mat); + normalizeTensor(tenXY->ten); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->matX.x); + endGraphUpdate(); +#endif + tenXY->x = tenXY->x->matX.x; + setTenXY_X_MethodUnsigned(tenXY); +} + +void +force_To_TenXY_Y_From_MatX() +{ + TenXY *tenXY; + int digitsNeeded; + void force_To_TenXY_Y_From_Vec(); + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + if (tenXY->y->gen.tag.type == VECTOR) { + PUSH_3(force_To_TenXY_Y_From_Vec, tenXY, digitsNeeded); + return; + } + + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[1], tenXY->y->matX.mat); + multVectorPairTimesMatrix(tenXY->ten[2], tenXY->ten[3], tenXY->y->matX.mat); + normalizeTensor(tenXY->ten); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->matX.x); + endGraphUpdate(); +#endif + tenXY->y = tenXY->y->matX.x; + setTenXY_Y_MethodUnsigned(tenXY); +} + +/* + * This forces information (ie digits, not a sign) from one tensor into + * the x argument of another. It is assumed that the argument is unsigned, + * otherwise it would already have changed into a SignX or DigsX. + */ +void +force_To_TenXY_X_From_TenXY() +{ + TenXY *tenXY; + int digitsNeeded; + void force_To_TenXY_X_From_DigsX_Entry(); + void force_To_TenXY_X_From_MatX(); + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + if (tenXY->x->gen.tag.type != TENXY) { + PUSH_3(force_To_TenXY_X_From_MatX, tenXY, digitsNeeded); + return; + } + + createUnsignedStreamForTenXY((TenXY *) tenXY->x); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->tenXY.strm); + endGraphUpdate(); +#endif + + tenXY->x = tenXY->x->tenXY.strm; + tenXY->forceX = force_To_TenXY_X_From_DigsX_Entry; + PUSH_3(tenXY->forceX, tenXY, digitsNeeded); +} + +/* + * This forces information (ie digits, not a sign) from one tensor into + * the y argument of another. It is assumed that the argument is unsigned, + * otherwise it would already have changed into a SignX or DigsX. + */ +void +force_To_TenXY_Y_From_TenXY() +{ + TenXY *tenXY; + int digitsNeeded; + void force_To_TenXY_Y_From_DigsX_Entry(); + void force_To_TenXY_Y_From_MatX(); + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + if (tenXY->y->gen.tag.type != TENXY) { + PUSH_3(force_To_TenXY_Y_From_MatX, tenXY, digitsNeeded); + return; + } + + createUnsignedStreamForTenXY((TenXY *) tenXY->y); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->tenXY.strm); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->tenXY.strm; + tenXY->forceY = force_To_TenXY_Y_From_DigsX_Entry; + PUSH_3(tenXY->forceY, tenXY, digitsNeeded); +} + +void +force_To_TenXY_Y_From_DigsX_Entry() +{ + TenXY *tenXY; + DigsX *digsX; + int digitsNeeded; + void force_To_TenXY_Y_From_DigsX_Cont(); + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + digsX = (DigsX *) tenXY->y; + + PUSH_3(force_To_TenXY_Y_From_DigsX_Cont, tenXY, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (digsX->count < (unsigned int)digitsNeeded) + PUSH_3(digsX->force, digsX, digitsNeeded - digsX->count); +} + +void +force_To_TenXY_Y_From_DigsX_Cont() +{ + TenXY *tenXY; + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + absorbDigsXIntoTenXY_Y(tenXY); +} + +/* + * In some cases when we generate a chain of tensors, the tensors + * themselves are not refining. What we have to do is force information + * from the argument until the tensor is refining. + * + * If the tensor is not refining, we force a digit from it's argument + * and push a continuation to check again. + */ +void +force_To_TenXY_X_Until_Refining() +{ + TenXY *tenXY; + int sgn; + + tenXY = (TenXY *) POP; + + if (tenXY->tag.type != TENXY) + return; + + sgn = tensorSign(tenXY->ten); + + if (sgn > 0) /* tensor is refining and entries positive */ + return; + + if (sgn < 0) { /* tensor is refining and entries negative */ + negateTensor(tenXY->ten); + return; + } + + PUSH_2(force_To_TenXY_X_Until_Refining, tenXY); + PUSH_3(tenXY->forceX, tenXY, defaultForceCount); +} + +void +force_To_TenXY_X_From_Alt_Entry() +{ + TenXY *tenXY; + void force_To_Alt_Entry(); + void force_To_TenXY_X_From_Alt_Cont(); + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + PUSH_3(force_To_TenXY_X_From_Alt_Cont, tenXY, digitsNeeded); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (tenXY->x->alt.redirect == NULL) + PUSH_2(force_To_Alt_Entry, tenXY->x); +} + +void +force_To_TenXY_X_From_Alt_Cont() +{ + TenXY *tenXY; + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->alt.redirect); + endGraphUpdate(); +#endif + + tenXY->x = tenXY->x->alt.redirect; + setTenXY_X_MethodUnsigned(tenXY); + PUSH_3(tenXY->forceX, tenXY, digitsNeeded); +} + +void +force_To_TenXY_X_From_Cls_Entry() +{ + TenXY *tenXY; + void force_To_TenXY_X_From_Cls_Cont(); + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + PUSH_3(force_To_TenXY_X_From_Cls_Cont, tenXY, digitsNeeded); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (tenXY->x->cls.redirect == NULL) + PUSH_2(tenXY->x->cls.force, tenXY->x); +} + +void +force_To_TenXY_X_From_Cls_Cont() +{ + TenXY *tenXY; + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->cls.redirect); + endGraphUpdate(); +#endif + + tenXY->x = tenXY->x->cls.redirect; + setTenXY_X_MethodUnsigned(tenXY); + PUSH_3(tenXY->forceX, tenXY, digitsNeeded); +} + +void +force_To_TenXY_X_From_Alt_Signed_Entry() +{ + TenXY *tenXY; + void force_To_Alt_Entry(); + void force_To_TenXY_X_From_Alt_Signed_Cont(); + + tenXY = (TenXY *) POP; + + PUSH_2(force_To_TenXY_X_From_Alt_Signed_Cont, tenXY); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (tenXY->x->alt.redirect == NULL) + PUSH_2(force_To_Alt_Entry, tenXY->x); +} + +void +force_To_TenXY_X_From_Alt_Signed_Cont() +{ + TenXY *tenXY; + + tenXY = (TenXY *) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->alt.redirect); + endGraphUpdate(); +#endif + tenXY->x = tenXY->x->alt.redirect; + setTenXY_X_MethodSigned(tenXY); + + PUSH_2(tenXY->forceX, tenXY); +} + +void +force_To_TenXY_X_From_Cls_Signed_Entry() +{ + TenXY *tenXY; + void force_To_TenXY_X_From_Cls_Signed_Cont(); + + tenXY = (TenXY *) POP; + + PUSH_2(force_To_TenXY_X_From_Cls_Signed_Cont, tenXY); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (tenXY->x->cls.redirect == NULL) + PUSH_2(tenXY->x->cls.force, tenXY->x); +} + +void +force_To_TenXY_X_From_Cls_Signed_Cont() +{ + TenXY *tenXY; + + tenXY = (TenXY *) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->cls.redirect); + endGraphUpdate(); +#endif + tenXY->x = tenXY->x->cls.redirect; + setTenXY_X_MethodSigned(tenXY); + + PUSH_2(tenXY->forceX, tenXY); +} + +void +force_To_TenXY_Y_From_Alt_Entry() +{ + TenXY *tenXY; + void force_To_Alt_Entry(); + void force_To_TenXY_Y_From_Alt_Cont(); + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + PUSH_3(force_To_TenXY_Y_From_Alt_Cont, tenXY, digitsNeeded); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (tenXY->y->alt.redirect == NULL) + PUSH_2(force_To_Alt_Entry, tenXY->y); +} + +void +force_To_TenXY_Y_From_Alt_Cont() +{ + TenXY *tenXY; + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->alt.redirect); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->alt.redirect; + setTenXY_Y_MethodUnsigned(tenXY); + PUSH_3(tenXY->forceY, tenXY, digitsNeeded); +} + +void +force_To_TenXY_Y_From_Cls_Entry() +{ + TenXY *tenXY; + void force_To_TenXY_Y_From_Cls_Cont(); + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + PUSH_3(force_To_TenXY_Y_From_Cls_Cont, tenXY, digitsNeeded); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (tenXY->y->cls.redirect == NULL) + PUSH_2(tenXY->y->cls.force, tenXY->y); +} + +void +force_To_TenXY_Y_From_Cls_Cont() +{ + TenXY *tenXY; + int digitsNeeded; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->cls.redirect); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->cls.redirect; + setTenXY_Y_MethodUnsigned(tenXY); + PUSH_3(tenXY->forceY, tenXY, digitsNeeded); +} + +void +force_To_TenXY_Y_From_Alt_Signed_Entry() +{ + TenXY *tenXY; + void force_To_Alt_Entry(); + void force_To_TenXY_Y_From_Alt_Signed_Cont(); + + tenXY = (TenXY *) POP; + + PUSH_2(force_To_TenXY_Y_From_Alt_Signed_Cont, tenXY); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (tenXY->y->alt.redirect == NULL) + PUSH_2(force_To_Alt_Entry, tenXY->y); +} + +void +force_To_TenXY_Y_From_Alt_Signed_Cont() +{ + TenXY *tenXY; + + tenXY = (TenXY *) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->alt.redirect); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->alt.redirect; + setTenXY_Y_MethodSigned(tenXY); + PUSH_2(tenXY->forceY, tenXY); +} + +void +force_To_TenXY_Y_From_Cls_Signed_Entry() +{ + TenXY *tenXY; + void force_To_TenXY_Y_From_Cls_Signed_Cont(); + + tenXY = (TenXY *) POP; + + PUSH_2(force_To_TenXY_Y_From_Cls_Signed_Cont, tenXY); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (tenXY->y->cls.redirect == NULL) + PUSH_2(tenXY->y->cls.force, tenXY->y); +} + +void +force_To_TenXY_Y_From_Cls_Signed_Cont() +{ + TenXY *tenXY; + + tenXY = (TenXY *) POP; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->cls.redirect); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->cls.redirect; + setTenXY_Y_MethodSigned(tenXY); + PUSH_2(tenXY->forceY, tenXY); +} + +void +absorbSignIntoTenXY_Y(TenXY *tenXY) +{ + absorbSignIntoVectorPair(tenXY->ten[0], tenXY->ten[1], + tenXY->y->signX.tag.value); + absorbSignIntoVectorPair(tenXY->ten[2], tenXY->ten[3], + tenXY->y->signX.tag.value); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->signX.x); + endGraphUpdate(); +#endif + tenXY->y = tenXY->y->signX.x; + setTenXY_Y_MethodUnsigned(tenXY); +} + +void +absorbSignIntoTenXY_X(TenXY *tenXY) +{ + absorbSignIntoVectorPair(tenXY->ten[0], tenXY->ten[2], + tenXY->x->signX.tag.value); + absorbSignIntoVectorPair(tenXY->ten[1], tenXY->ten[3], + tenXY->x->signX.tag.value); +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->signX.x); + endGraphUpdate(); +#endif + tenXY->x = tenXY->x->signX.x; + setTenXY_X_MethodUnsigned(tenXY); +} + +void +absorbDigsXIntoTenXY_Y(TenXY *tenXY) +{ + DigsX *digsX; + SmallMatrix smallAccumMat; + + digsX = (DigsX *) tenXY->y; + + /* + * Accumulate the digits into a matrix (large or small integers) + * and augment the tensor with the information. + */ + if (digsX->count > 0) { +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + makeSmallMatrixFromDigits(smallAccumMat, digsX); + multVectorPairTimesSmallMatrix(tenXY->ten[0], tenXY->ten[1], + smallAccumMat); + multVectorPairTimesSmallMatrix(tenXY->ten[2], tenXY->ten[3], + smallAccumMat); + } + else { +#endif + makeMatrixFromDigits(bigTmpMat, digsX); + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[1], bigTmpMat); + multVectorPairTimesMatrix(tenXY->ten[2], tenXY->ten[3], bigTmpMat); +#ifdef PACK_DIGITS + } +#endif + normalizeTensor(tenXY->ten); + tenXY->y = digsX->x; +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, digsX); + newEdgeToYChild(tenXY, digsX->x); + endGraphUpdate(); +#endif + } + +#ifdef TRACE + debugp("absorbDigsXIntoTenXY_Y", + "%x %x absorbed=%d\n", + (unsigned) tenXY, + (unsigned) digsX, + digsX->count); +#endif +} + +void +absorbDigsXIntoTenXY_X(TenXY *tenXY) +{ + DigsX *digsX; + SmallMatrix smallAccumMat; + + digsX = (DigsX *) tenXY->x; + + /* + * Now accumulate the digits into a matrix (large or small integers) + * and augment the tensor with the information. + */ + if (digsX->count > 0) { +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + makeSmallMatrixFromDigits(smallAccumMat, digsX); + multVectorPairTimesSmallMatrix(tenXY->ten[0], tenXY->ten[2], + smallAccumMat); + multVectorPairTimesSmallMatrix(tenXY->ten[1], tenXY->ten[3], + smallAccumMat); + } + else { +#endif + makeMatrixFromDigits(bigTmpMat, digsX); + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[2], bigTmpMat); + multVectorPairTimesMatrix(tenXY->ten[1], tenXY->ten[3], bigTmpMat); +#ifdef PACK_DIGITS + } +#endif + normalizeTensor(tenXY->ten); + tenXY->x = digsX->x; +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, digsX); + newEdgeToXChild(tenXY, digsX->x); + endGraphUpdate(); +#endif + } + +#ifdef TRACE + debugp("absorbDigsXIntoTenXY_X", + "%x %x absorbed=%d\n", + (unsigned) tenXY, + (unsigned) digsX, + digsX->count); +#endif +} + +void +createSignedStreamForTenXY(TenXY *tenXY) +{ + Real r; + void force_To_SignX_From_TenXY_Entry(); + + if (tenXY->strm == NULL) { + r = tensor_Z(tenXY->x, tenXY->y, + tenXY->ten[0][0], tenXY->ten[0][1], + tenXY->ten[1][0], tenXY->ten[1][1], + tenXY->ten[2][0], tenXY->ten[2][1], + tenXY->ten[3][0], tenXY->ten[3][1]); + tenXY->strm = (Real) allocSignX(r, SIGN_UNKN); +#ifdef DAVINCI + beginGraphUpdate(); + drawEqEdge(tenXY, tenXY->strm); + endGraphUpdate(); +#endif + } +} + +void +createUnsignedStreamForTenXY(TenXY *tenXY) +{ + DigsX *digsX; + Real r; + void force_To_DigsX_From_TenXY_Entry(); + + if (tenXY->strm == NULL) { + if (tenXY->tag.isSigned) + Error(FATAL, E_INT, "createUnsignedStreamForTenXY", + "creating unsigned stream for signed tensor"); + else { + r = tensor_Z(tenXY->x, tenXY->y, + tenXY->ten[0][0], tenXY->ten[0][1], + tenXY->ten[1][0], tenXY->ten[1][1], + tenXY->ten[2][0], tenXY->ten[2][1], + tenXY->ten[3][0], tenXY->ten[3][1]); + digsX = allocDigsX(); + digsX->x = (Real) r; + digsX->force = force_To_DigsX_From_TenXY_Entry; + tenXY->strm = (Real) digsX; +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, r); + drawEqEdge(tenXY, tenXY->strm); + endGraphUpdate(); +#endif + } + } +} + +void +force_To_TenXY_X_From_SignX_Entry() +{ + TenXY *tenXY; + SignX *signX; + void force_To_TenXY_X_From_SignX_Cont(); + + tenXY = (TenXY *) POP; + signX = (SignX *) tenXY->x; + + PUSH_2(force_To_TenXY_X_From_SignX_Cont, tenXY); + if (signX->tag.value == SIGN_UNKN) + PUSH_2(signX->force, signX); +} + +void +force_To_TenXY_X_From_SignX_Cont() +{ + TenXY *tenXY; + + tenXY = (TenXY *) POP; + absorbSignIntoTenXY_X(tenXY); +} + +void +force_To_TenXY_Y_From_SignX_Entry() +{ + TenXY *tenXY; + SignX *signX; + void force_To_TenXY_Y_From_SignX_Cont(); + + tenXY = (TenXY *) POP; + signX = (SignX *) tenXY->y; + + PUSH_2(force_To_TenXY_Y_From_SignX_Cont, tenXY); + if (signX->tag.value == SIGN_UNKN) + PUSH_2(signX->force, signX); +} + +void +force_To_TenXY_Y_From_SignX_Cont() +{ + TenXY *tenXY; + + tenXY = (TenXY *) POP; + absorbSignIntoTenXY_Y(tenXY); +} + +/* + * This handles the case when the x arg of a signed TenXY is a MatX. + * This version is strict. It inspects its argument first. If it too is + * signed, then it forces it before reducing the two matrices to one. + */ +void +force_To_TenXY_X_From_MatX_Signed_Entry() +{ + TenXY *tenXY; + MatX *matX; + void force_To_TenXY_X_From_MatX_Signed_Cont(); + void force_To_TenXY_X_From_Vec_Signed(); + + tenXY = (TenXY *) POP; + + if (tenXY->x->gen.tag.type == VECTOR) { + PUSH_2(force_To_TenXY_X_From_Vec_Signed, tenXY); + return; + } + + matX = (MatX *) tenXY->x; + + PUSH_2(force_To_TenXY_X_From_MatX_Signed_Cont, tenXY); + if (matX->x->gen.tag.isSigned) + PUSH_2(matX->force, matX); +} + +/* + * The following code is exactly the same as the unsigned case except there + * are fewer things on the stack. The two can probably be reconciled + * as the number of digits is irrelevant when reducing matrices. We leave + * them separate in case one or other can be improved at a later time. + */ +void +force_To_TenXY_X_From_MatX_Signed_Cont() +{ + TenXY *tenXY; + void force_To_TenXY_X_From_Vec_Signed(); + + tenXY = (TenXY *) POP; + + if (tenXY->x->gen.tag.type == VECTOR) { + PUSH_2(force_To_TenXY_X_From_Vec_Signed, tenXY); + return; + } + + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[2], tenXY->x->matX.mat); + multVectorPairTimesMatrix(tenXY->ten[1], tenXY->ten[3], tenXY->x->matX.mat); + normalizeTensor(tenXY->ten); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->matX.x); + endGraphUpdate(); +#endif + + tenXY->x = tenXY->x->matX.x; + setTenXY_X_MethodUnsigned(tenXY); +} + +void +force_To_TenXY_X_From_Vec_Signed() +{ + TenXY *tenXY; + MatX *matX; + mpz_t a, b, c, d; /* temporary storage while we clobber the TenXY */ + Real strm; /* temporary storage again */ + int totalEmitted; + + tenXY = (TenXY *) POP; + + multVectorPairTimesVector(tenXY->ten[0], tenXY->ten[2], tenXY->x->vec.vec); + multVectorPairTimesVector(tenXY->ten[1], tenXY->ten[3], tenXY->x->vec.vec); + + a[0] = tenXY->ten[0][0][0]; + b[0] = tenXY->ten[0][1][0]; + c[0] = tenXY->ten[1][0][0]; + d[0] = tenXY->ten[1][1][0]; + strm = tenXY->strm; + totalEmitted = tenXY->totalEmitted; + + mpz_clear(tenXY->ten[2][0]); + mpz_clear(tenXY->ten[2][1]); + mpz_clear(tenXY->ten[3][0]); + mpz_clear(tenXY->ten[3][1]); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + deleteEdgeToYChild(tenXY, tenXY->y); + endGraphUpdate(); +#endif + + matX = (MatX *) tenXY; + matX->tag.type = MATX; + matX->x = tenXY->y; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(matX, matX->x); + endGraphUpdate(); + +#endif + matX->mat[0][0][0] = a[0]; + matX->mat[0][1][0] = b[0]; + matX->mat[1][0][0] = c[0]; + matX->mat[1][1][0] = d[0]; + normalizeMatrix(matX->mat); + matX->strm = strm; + matX->totalEmitted = totalEmitted; + +/* + setMatXMethodUnsigned(matX); +*/ + if (matX->x->gen.tag.isSigned) + setMatXMethodSigned(matX); + else + setMatXMethodUnsigned(matX); +} + +void +force_To_TenXY_X_From_TenXY_Signed_Entry() +{ + TenXY *tenXY, *arg; + void force_To_TenXY_X_From_MatX_Signed_Entry(); + void force_To_TenXY_X_From_TenXY_Signed_Cont(); + void force_To_TenXY_X_From_TenXY_Signed_Cont_X(); + + tenXY = (TenXY *) POP; + arg = (TenXY *) tenXY->x; + + if (arg->tag.type != TENXY) { + PUSH_2(force_To_TenXY_X_From_MatX_Signed_Entry, tenXY); + return; + } + + if (arg->x->gen.tag.isSigned) { + if (arg->y->gen.tag.isSigned) { + PUSH_2(force_To_TenXY_X_From_TenXY_Signed_Cont_X, tenXY); + PUSH_2(arg->forceY, arg); + } + else { + PUSH_2(force_To_TenXY_X_From_TenXY_Signed_Cont, tenXY); + PUSH_2(arg->forceX, arg); + } + } + else { + if (arg->y->gen.tag.isSigned) { + PUSH_2(force_To_TenXY_X_From_TenXY_Signed_Cont, tenXY); + PUSH_2(arg->forceY, arg); + } + else + PUSH_2(force_To_TenXY_X_From_TenXY_Signed_Cont, tenXY); + } +} + +void +force_To_TenXY_X_From_TenXY_Signed_Cont_X() +{ + TenXY *tenXY, *arg; + void force_To_TenXY_X_From_TenXY_Signed_Cont(); + void force_To_TenXY_X_From_MatX_Signed_Entry(); + + tenXY = (TenXY *) POP; + arg = (TenXY *) tenXY->x; + + if (arg->tag.type != TENXY) { + PUSH_2(force_To_TenXY_X_From_MatX_Signed_Entry, tenXY); + return; + } + + PUSH_2(force_To_TenXY_X_From_TenXY_Signed_Cont, tenXY); + + if (arg->x->gen.tag.isSigned) + PUSH_2(arg->forceX, arg); +} + +void +force_To_TenXY_X_From_TenXY_Signed_Cont() +{ + TenXY *tenXY; + void force_To_TenXY_X_From_MatX_Signed_Cont(); + void force_To_TenXY_X_From_SignX_Entry(); + + tenXY = (TenXY *) POP; + + if (tenXY->x->gen.tag.type != TENXY) { + PUSH_2(force_To_TenXY_X_From_MatX_Signed_Cont, tenXY); + return; + } + + createSignedStreamForTenXY((TenXY *) tenXY->x); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + newEdgeToXChild(tenXY, tenXY->x->tenXY.strm); + endGraphUpdate(); +#endif + + tenXY->x = tenXY->x->tenXY.strm; + tenXY->forceX = force_To_TenXY_X_From_SignX_Entry; + PUSH_2(tenXY->forceX, tenXY); +} + +/* + * This handles the case when the x arg of a signed TenXY is a MatX. + * This version is strict. It inspects its argument first. If it too is + * signed, then it forces it before reducing the two matrices to one. + */ +void +force_To_TenXY_Y_From_MatX_Signed_Entry() +{ + TenXY *tenXY; + MatX *matX; + void force_To_TenXY_Y_From_MatX_Signed_Cont(); + void force_To_TenXY_Y_From_Vec_Signed(); + + tenXY = (TenXY *) POP; + + if (tenXY->y->gen.tag.type == VECTOR) { + PUSH_2(force_To_TenXY_Y_From_Vec_Signed, tenXY); + return; + } + + matX = (MatX *) tenXY->y; + + PUSH_2(force_To_TenXY_Y_From_MatX_Signed_Cont, tenXY); + if (matX->x->gen.tag.isSigned) + PUSH_2(matX->force, matX); +} + +/* + * The following code is exactly the same as the unsigned case except there + * are fewer things on the stack. The two can probably be reconciled + * as the number of digits is irrelevant when reducing matrices. We leave + * them separate in case one or other can be improved at a later time. + */ +void +force_To_TenXY_Y_From_MatX_Signed_Cont() +{ + TenXY *tenXY; + void force_To_TenXY_Y_From_Vec_Signed(); + + tenXY = (TenXY *) POP; + + if (tenXY->y->gen.tag.type == VECTOR) { + PUSH_2(force_To_TenXY_Y_From_Vec_Signed, tenXY); + return; + } + + multVectorPairTimesMatrix(tenXY->ten[0], tenXY->ten[1], tenXY->y->matX.mat); + multVectorPairTimesMatrix(tenXY->ten[2], tenXY->ten[3], tenXY->y->matX.mat); + normalizeTensor(tenXY->ten); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->matX.x); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->matX.x; + setTenXY_Y_MethodUnsigned(tenXY); +} + +void +force_To_TenXY_Y_From_Vec_Signed() +{ + TenXY *tenXY; + MatX *matX; + mpz_t a, b, c, d; /* temporary storage while we clobber the TenXY */ + Real strm; /* temporary storage again */ + int totalEmitted; + + tenXY = (TenXY *) POP; + + multVectorPairTimesVector(tenXY->ten[0], tenXY->ten[1], tenXY->y->vec.vec); + multVectorPairTimesVector(tenXY->ten[2], tenXY->ten[3], tenXY->y->vec.vec); + + a[0] = tenXY->ten[0][0][0]; + b[0] = tenXY->ten[0][1][0]; + c[0] = tenXY->ten[2][0][0]; + d[0] = tenXY->ten[2][1][0]; + strm = tenXY->strm; + totalEmitted = tenXY->totalEmitted; + + mpz_clear(tenXY->ten[1][0]); + mpz_clear(tenXY->ten[1][1]); + mpz_clear(tenXY->ten[3][0]); + mpz_clear(tenXY->ten[3][1]); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(tenXY, tenXY->x); + deleteEdgeToYChild(tenXY, tenXY->y); + endGraphUpdate(); +#endif + + matX = (MatX *) tenXY; + matX->tag.type = MATX; + matX->x = tenXY->x; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(matX, matX->x); + endGraphUpdate(); + +#endif + matX->mat[0][0][0] = a[0]; + matX->mat[0][1][0] = b[0]; + matX->mat[1][0][0] = c[0]; + matX->mat[1][1][0] = d[0]; + normalizeMatrix(matX->mat); + matX->strm = strm; + matX->totalEmitted = totalEmitted; + +/* + setMatXMethodUnsigned(matX); +*/ + if (matX->x->gen.tag.isSigned) + setMatXMethodSigned(matX); + else + setMatXMethodUnsigned(matX); +} + +void +force_To_TenXY_Y_From_TenXY_Signed_Entry() +{ + TenXY *tenXY, *arg; + void force_To_TenXY_Y_From_MatX_Signed_Entry(); + void force_To_TenXY_Y_From_TenXY_Signed_Cont(); + void force_To_TenXY_Y_From_TenXY_Signed_Cont_X(); + + tenXY = (TenXY *) POP; + arg = (TenXY *) tenXY->y; + + if (arg->tag.type != TENXY) { + PUSH_2(force_To_TenXY_Y_From_MatX_Signed_Entry, tenXY); + return; + } + + if (arg->x->gen.tag.isSigned) { + if (arg->y->gen.tag.isSigned) { + PUSH_2(force_To_TenXY_Y_From_TenXY_Signed_Cont_X, tenXY); + PUSH_2(arg->forceY, arg); + } + else { + PUSH_2(force_To_TenXY_Y_From_TenXY_Signed_Cont, tenXY); + PUSH_2(arg->forceX, arg); + } + } + else { + if (arg->y->gen.tag.isSigned) { + PUSH_2(force_To_TenXY_Y_From_TenXY_Signed_Cont, tenXY); + PUSH_2(arg->forceY, arg); + } + else + PUSH_2(force_To_TenXY_Y_From_TenXY_Signed_Cont, tenXY); + } +} + +void +force_To_TenXY_Y_From_TenXY_Signed_Cont_X() +{ + TenXY *tenXY, *arg; + void force_To_TenXY_Y_From_TenXY_Signed_Cont(); + void force_To_TenXY_Y_From_MatX_Signed_Entry(); + + tenXY = (TenXY *) POP; + arg = (TenXY *) tenXY->y; + + if (arg->tag.type != TENXY) { + PUSH_2(force_To_TenXY_Y_From_MatX_Signed_Entry, tenXY); + return; + } + + PUSH_2(force_To_TenXY_Y_From_TenXY_Signed_Cont, tenXY); + + if (arg->x->gen.tag.isSigned) + PUSH_2(arg->forceX, arg); +} + +void +force_To_TenXY_Y_From_TenXY_Signed_Cont() +{ + TenXY *tenXY; + void force_To_TenXY_Y_From_MatX_Signed_Cont(); + void force_To_TenXY_Y_From_SignX_Entry(); + + tenXY = (TenXY *) POP; + + if (tenXY->y->gen.tag.type != TENXY) { + PUSH_2(force_To_TenXY_Y_From_MatX_Signed_Cont, tenXY); + return; + } + + createSignedStreamForTenXY((TenXY *) tenXY->y); + +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToYChild(tenXY, tenXY->y); + newEdgeToYChild(tenXY, tenXY->y->tenXY.strm); + endGraphUpdate(); +#endif + + tenXY->y = tenXY->y->tenXY.strm; + tenXY->forceY = force_To_TenXY_Y_From_SignX_Entry; + PUSH_2(tenXY->forceY, tenXY); +} + +void +setTenXY_X_MethodUnsigned(TenXY *tenXY) +{ + void force_To_TenXY_X_From_SignX_Entry(); + void force_To_TenXY_X_From_DigsX_Entry(); + void force_To_TenXY_X_From_Vec(); + void force_To_TenXY_X_From_MatX(); + void force_To_TenXY_X_From_TenXY(); + void force_To_TenXY_X_From_Alt_Entry(); + void force_To_TenXY_X_From_Cls_Entry(); + + switch (tenXY->x->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "setTenXY_X_MethodUnsigned", "x is signed"); + break; + case DIGSX : + tenXY->forceX = force_To_TenXY_X_From_DigsX_Entry; + break; + case ALT : + tenXY->forceX = force_To_TenXY_X_From_Alt_Entry; + break; + case VECTOR : + tenXY->forceX = force_To_TenXY_X_From_Vec; + break; + case MATX : + tenXY->forceX = force_To_TenXY_X_From_MatX; + break; + case TENXY : + tenXY->forceX = force_To_TenXY_X_From_TenXY; + break; + case CLOSURE : + tenXY->forceX = force_To_TenXY_X_From_Cls_Entry; + break; + default : + Error(FATAL, E_INT, "setTenXY_X_MethodUnsigned", + "something wrong with x"); + break; + } +} + +void +setTenXY_Y_MethodUnsigned(TenXY *tenXY) +{ + void force_To_TenXY_Y_From_SignX_Entry(); + void force_To_TenXY_Y_From_DigsX_Entry(); + void force_To_TenXY_Y_From_Vec(); + void force_To_TenXY_Y_From_MatX(); + void force_To_TenXY_Y_From_TenXY(); + void force_To_TenXY_Y_From_Alt_Entry(); + void force_To_TenXY_Y_From_Cls_Entry(); + + switch (tenXY->y->gen.tag.type) { + case SIGNX : + Error(FATAL, E_INT, "setTenXY_Y_MethodUnsigned", "y is signed"); + break; + case DIGSX : + tenXY->forceY = force_To_TenXY_Y_From_DigsX_Entry; + break; + case ALT : + tenXY->forceY = force_To_TenXY_Y_From_Alt_Entry; + break; + case VECTOR : + tenXY->forceY = force_To_TenXY_Y_From_Vec; + break; + case MATX : + tenXY->forceY = force_To_TenXY_Y_From_MatX; + break; + case TENXY : + tenXY->forceY = force_To_TenXY_Y_From_TenXY; + break; + case CLOSURE : + tenXY->forceY = force_To_TenXY_Y_From_Cls_Entry; + break; + default : + Error(FATAL, E_INT, "setTenXY_Y_MethodUnsigned", + "something wrong with y"); + break; + } +} + +void +setTenXY_X_MethodSigned(TenXY *tenXY) +{ + void force_To_TenXY_X_From_SignX_Entry(); + void force_To_TenXY_X_From_DigsX_Signed(); + void force_To_TenXY_X_From_Vec_Signed(); + void force_To_TenXY_X_From_MatX_Signed_Entry(); + void force_To_TenXY_X_From_TenXY_Signed_Entry(); + void force_To_TenXY_X_From_Alt_Signed_Entry(); + void force_To_TenXY_X_From_Cls_Signed_Entry(); + + switch (tenXY->x->gen.tag.type) { + case SIGNX : + tenXY->forceX = force_To_TenXY_X_From_SignX_Entry; + break; + case DIGSX : + tenXY->forceX = force_To_TenXY_X_From_DigsX_Signed; + break; + case ALT : + tenXY->forceX = force_To_TenXY_X_From_Alt_Signed_Entry; + break; + case VECTOR : + tenXY->forceX = force_To_TenXY_X_From_Vec_Signed; + break; + case MATX : + tenXY->forceX = force_To_TenXY_X_From_MatX_Signed_Entry; + break; + case TENXY : + tenXY->forceX = force_To_TenXY_X_From_TenXY_Signed_Entry; + break; + case CLOSURE : + tenXY->forceX = force_To_TenXY_X_From_Cls_Signed_Entry; + break; + default : + Error(FATAL, E_INT, "setTenXY_X_MethodSigned", + "something wrong with x"); + break; + } +} + +void +setTenXY_Y_MethodSigned(TenXY *tenXY) +{ + void force_To_TenXY_Y_From_SignX_Entry(); + void force_To_TenXY_Y_From_DigsX_Signed(); + void force_To_TenXY_Y_From_Vec_Signed(); + void force_To_TenXY_Y_From_MatX_Signed_Entry(); + void force_To_TenXY_Y_From_TenXY_Signed_Entry(); + void force_To_TenXY_Y_From_Alt_Signed_Entry(); + void force_To_TenXY_Y_From_Cls_Signed_Entry(); + + switch (tenXY->y->gen.tag.type) { + case SIGNX : + tenXY->forceY = force_To_TenXY_Y_From_SignX_Entry; + break; + case DIGSX : + tenXY->forceY = force_To_TenXY_Y_From_DigsX_Signed; + break; + case ALT : + tenXY->forceY = force_To_TenXY_Y_From_Alt_Signed_Entry; + break; + case VECTOR : + tenXY->forceY = force_To_TenXY_Y_From_Vec_Signed; + break; + case MATX : + tenXY->forceY = force_To_TenXY_Y_From_MatX_Signed_Entry; + break; + case TENXY : + tenXY->forceY = force_To_TenXY_Y_From_TenXY_Signed_Entry; + break; + case CLOSURE : + tenXY->forceY = force_To_TenXY_Y_From_Cls_Signed_Entry; + break; + default : + Error(FATAL, E_INT, "setTenXY_Y_MethodSigned", + "something wrong with y"); + break; + } +} diff --git a/ic-reals-6.3/base/Vector.c b/ic-reals-6.3/base/Vector.c new file mode 100644 index 0000000..51cef26 --- /dev/null +++ b/ic-reals-6.3/base/Vector.c @@ -0,0 +1,99 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Functions for allocating and managing vector LFTs in the heap. + */ + +Vec * +allocVec() +{ + Vec *vec; + + if ((vec = (Vec *) malloc (sizeof(Vec))) == NULL) + Error(FATAL, E_INT, "allocVec", "malloc failed"); + + +#ifdef DAVINCI + newNodeId(vec); +#else +#ifdef TRACE + newNodeId(vec); +#endif +#endif + + + vec->tag.type = VECTOR; + vec->tag.dumped = FALSE; + vec->strm = (Real) NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(vec, VECTOR); + endGraphUpdate(); +#endif + + return vec; +} + +/* + * The next family of functions are one level up. They allocate structures + * in the heap for lfts and also initialize both the entries in the lft + * as well as the pointers to the heap objects to which the lft is being + * applied. + */ + +/* + * Create a vector with small entries. A vector is a rational. We might + * wish to disallow 0/0. + */ +Real +vector_Int(int a, int b) +{ + Vec *vec; + + if ((a == 0) && (b == 0)) + Error(FATAL, E_INT, "vector_Int", "zero column vector"); + + vec = allocVec(); + mpz_init_set_si(vec->vec[0], a); + mpz_init_set_si(vec->vec[1], b); + canonVector(vec->vec); + + if (vectorSign(vec->vec) == 0) + vec->tag.isSigned = TRUE; + else + vec->tag.isSigned = FALSE; + + return (Real) vec; +} + +Real +vector_Z(mpz_t a, mpz_t b) +{ + Vec *vec; + + if ((mpz_sgn(a) == 0) && (mpz_sgn(b) == 0)) + Error(FATAL, E_INT, "vector_Z", "zero column vector"); + + vec = allocVec(); + mpz_init_set(vec->vec[0], a); + mpz_init_set(vec->vec[1], b); + canonVector(vec->vec); + + if (vectorSign(vec->vec) == 0) + vec->tag.isSigned = TRUE; + else + vec->tag.isSigned = FALSE; + + return (Real) vec; +} diff --git a/ic-reals-6.3/base/boolLib.c b/ic-reals-6.3/base/boolLib.c new file mode 100644 index 0000000..d6af083 --- /dev/null +++ b/ic-reals-6.3/base/boolLib.c @@ -0,0 +1,77 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * A collection of convenient boolean predicates written in terms of + * more primitive functions defined elsewhere. + */ + +Bool +gt_R_QInt(Real x, int a, int b) +{ + return gt_R_0(sub_R_QInt(x, a, b)); +} + +Bool +ltEq_R_0(Real x) +{ + return not_B(gt_R_0(x)); +} + +Bool +ltEq_R_R(Real x, Real y) +{ + return ltEq_R_0(sub_R_R(x, y)); +} + +Bool +lt_R_R(Real x, Real y) +{ + return lt_R_0(sub_R_R(x, y)); +} + +Bool +lt_R_QInt(Real x, int a, int b) +{ + return gt_R_0(sub_QInt_R(a, b, x)); +} + +Bool +lt_R_0(Real x) +{ + return not_B(gtEq_R_0(x)); +} + +Bool +gtEq_R_QInt(Real x, int a, int b) +{ + return gtEq_R_0(sub_R_QInt(x, a, b)); +} + +Bool +ltEq_R_QInt(Real x, int a, int b) +{ + return gtEq_R_0(sub_QInt_R(a, b, x)); +} + +Bool +gtEq_R_R(Real x, Real y) +{ + return gtEq_R_0(sub_R_R(x, y)); +} + +Bool +gt_R_R(Real x, Real y) +{ + return gt_R_0(sub_R_R(x, y)); +} + diff --git a/ic-reals-6.3/base/boolOp.c b/ic-reals-6.3/base/boolOp.c new file mode 100644 index 0000000..a018e9a --- /dev/null +++ b/ic-reals-6.3/base/boolOp.c @@ -0,0 +1,397 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Here is everything to do with the unary and binary boolean operators. + */ + +BoolXY * +allocBoolXY(Bool x, Bool y) +{ + BoolXY *boolXY; + + if ((boolXY = (BoolXY *) malloc(sizeof(BoolXY))) == NULL) + Error(FATAL, E_INT, "allocBoolXY", "malloc failed"); + +#ifdef DAVINCI + newNodeId(boolXY); +#else +#ifdef TRACE + newNodeId(boolXY); +#endif +#endif + + boolXY->tag.type = BOOLXY; + boolXY->tag.value = LAZY_UNKNOWN; + boolXY->tag.dumped = FALSE; + boolXY->x = x; + boolXY->y = y; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(boolXY, BOOLXY); + newEdgeToXChild(boolXY, x); + newEdgeToYChild(boolXY, y); + endGraphUpdate(); +#endif + + + return boolXY; +} + +BoolX * +allocBoolX(Bool x) +{ + BoolX *boolX; + + if ((boolX = (BoolX *) malloc(sizeof(BoolX))) == NULL) + Error(FATAL, E_INT, "allocBoolX", "malloc failed"); + +#ifdef DAVINCI + newNodeId(boolX); +#else +#ifdef TRACE + newNodeId(boolX); +#endif +#endif + + boolX->tag.type = BOOLX; + boolX->tag.value = LAZY_UNKNOWN; + boolX->tag.dumped = FALSE; + boolX->x = x; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(boolX, BOOLX); + newEdgeToOnlyChild(boolX, x); + endGraphUpdate(); +#endif + + return boolX; +} + +Bool +and_B_B(Bool x, Bool y) +{ + BoolXY *boolXY; + void force_To_And_From_Bool_X_Entry(); + + boolXY = allocBoolXY(x, y); + boolXY->force = force_To_And_From_Bool_X_Entry; + return (Bool) boolXY; +} + +Bool +or_B_B(Bool x, Bool y) +{ + BoolXY *boolXY; + void force_To_Or_From_Bool_X_Entry(); + + boolXY = allocBoolXY(x, y); + boolXY->force = force_To_Or_From_Bool_X_Entry; + return (Bool) boolXY; +} + +Bool +not_B(Bool x) +{ + BoolX *boolX; + void force_To_Not_From_Bool_Entry(); + + boolX = allocBoolX(x); + boolX->force = force_To_Not_From_Bool_Entry; + return (Bool) boolX; +} + +void +force_To_Not_From_Bool_Entry() +{ + BoolX *boolX; + Bool x; + void force_To_Not_From_Bool_Cont(); + + boolX = (BoolX *) POP; + x = boolX->x; + + PUSH_2(force_To_Not_From_Bool_Cont, boolX); + if (x->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(x->gen.force, x); +} + +void +force_To_Not_From_Bool_Cont() +{ + BoolX *boolX; + Bool x; + + boolX = (BoolX *) POP; + x = boolX->x; + + switch (x->gen.tag.value) { + case LAZY_TRUE : + setBoolX(boolX, LAZY_FALSE); + break; + case LAZY_FALSE : + setBoolX(boolX, LAZY_TRUE); + break; + case LAZY_UNKNOWN : + break; + default : + Error(FATAL, E_INT, "force_To_Not_From_Bool_Cont", "bad boolean value"); + } +} + +void +force_To_And_From_Bool_X_Entry() +{ + BoolXY *boolXY; + Bool x; + void force_To_And_From_Bool_X_Cont(); + + boolXY = (BoolXY *) POP; + x = boolXY->x; + + PUSH_2(force_To_And_From_Bool_X_Cont, boolXY); + if (x->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(x->gen.force, x); +} + +void +force_To_And_From_Bool_X_Cont() +{ + BoolXY *boolXY; + Bool x; + void force_To_And_From_Bool_Y_Entry(); + void force_From_Bool_Y_Only_Entry(); + + boolXY = (BoolXY *) POP; + x = boolXY->x; + + switch (x->gen.tag.value) { + case LAZY_TRUE : + boolXY->force = force_From_Bool_Y_Only_Entry; + break; + case LAZY_FALSE : + setBoolXY(boolXY, LAZY_FALSE); + break; + case LAZY_UNKNOWN : + boolXY->force = force_To_And_From_Bool_Y_Entry; + break; + default : + Error(FATAL, E_INT, "force_To_And_From_Bool_X_Cont", + "bad boolean value"); + } +} + +void +force_To_And_From_Bool_Y_Entry() +{ + BoolXY *boolXY; + Bool y; + void force_To_And_From_Bool_Y_Cont(); + + boolXY = (BoolXY *) POP; + y = boolXY->y; + + PUSH_2(force_To_And_From_Bool_Y_Cont, boolXY); + if (y->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(y->gen.force, y); +} + +void +force_To_And_From_Bool_Y_Cont() +{ + BoolXY *boolXY; + Bool y; + void force_To_And_From_Bool_X_Entry(); + void force_From_Bool_X_Only_Entry(); + + boolXY = (BoolXY *) POP; + y = boolXY->y; + + switch (y->gen.tag.value) { + case LAZY_TRUE : + boolXY->force = force_From_Bool_X_Only_Entry; + break; + case LAZY_FALSE : + setBoolXY(boolXY, LAZY_FALSE); + break; + case LAZY_UNKNOWN : + boolXY->force = force_To_And_From_Bool_X_Entry; + break; + default : + Error(FATAL, E_INT, "force_To_And_From_Bool_Y_Cont", + "bad boolean value"); + } +} + +void +force_To_Or_From_Bool_X_Entry() +{ + BoolXY *boolXY; + Bool x; + void force_To_Or_From_Bool_X_Cont(); + + boolXY = (BoolXY *) POP; + x = boolXY->x; + + PUSH_2(force_To_Or_From_Bool_X_Cont, boolXY); + if (x->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(x->gen.force, x); +} + +void +force_To_Or_From_Bool_X_Cont() +{ + BoolXY *boolXY; + Bool x; + void force_To_Or_From_Bool_Y_Entry(); + void force_From_Bool_Y_Only_Entry(); + + boolXY = (BoolXY *) POP; + x = boolXY->x; + + switch (x->gen.tag.value) { + case LAZY_TRUE : + setBoolXY(boolXY, LAZY_TRUE); + break; + case LAZY_FALSE : + boolXY->force = force_From_Bool_Y_Only_Entry; + break; + case LAZY_UNKNOWN : + boolXY->force = force_To_Or_From_Bool_Y_Entry; + break; + default : + Error(FATAL, E_INT, "force_To_Or_From_Bool_X_Cont", + "bad boolean value"); + } +} + +void +force_To_Or_From_Bool_Y_Entry() +{ + BoolXY *boolXY; + Bool y; + void force_To_Or_From_Bool_Y_Cont(); + + boolXY = (BoolXY *) POP; + y = boolXY->y; + + PUSH_2(force_To_Or_From_Bool_Y_Cont, boolXY); + if (y->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(y->gen.force, y); +} + +void +force_To_Or_From_Bool_Y_Cont() +{ + BoolXY *boolXY; + Bool y; + void force_To_Or_From_Bool_X_Entry(); + void force_From_Bool_X_Only_Entry(); + + boolXY = (BoolXY *) POP; + y = boolXY->y; + + switch (y->gen.tag.value) { + case LAZY_TRUE : + setBoolXY(boolXY, LAZY_TRUE); + break; + case LAZY_FALSE : + boolXY->force = force_From_Bool_X_Only_Entry; + break; + case LAZY_UNKNOWN : + boolXY->force = force_To_Or_From_Bool_X_Entry; + break; + default : + Error(FATAL, E_INT, "force_To_Or_From_Bool_Y_Cont", + "bad boolean value"); + } +} + +void +force_From_Bool_X_Only_Entry() +{ + BoolXY *boolXY; + Bool x; + void force_From_Bool_X_Only_Cont(); + + boolXY = (BoolXY *) POP; + x = boolXY->x; + + PUSH_2(force_From_Bool_X_Only_Cont, boolXY); + if (x->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(x->gen.force, x); +} + +void +force_From_Bool_X_Only_Cont() +{ + BoolXY *boolXY; + Bool x; + + boolXY = (BoolXY *) POP; + x = boolXY->x; + + switch (x->gen.tag.value) { + case LAZY_TRUE : + setBoolXY(boolXY, LAZY_TRUE); + break; + case LAZY_FALSE : + setBoolXY(boolXY, LAZY_FALSE); + break; + case LAZY_UNKNOWN : + break; + default : + Error(FATAL, E_INT, "force_From_Bool_X_Only_Cont", + "bad boolean value"); + } +} + +void +force_From_Bool_Y_Only_Entry() +{ + BoolXY *boolXY; + Bool y; + void force_From_Bool_Y_Only_Cont(); + + boolXY = (BoolXY *) POP; + y = boolXY->y; + + PUSH_2(force_From_Bool_Y_Only_Cont, boolXY); + if (y->gen.tag.value == LAZY_UNKNOWN) + PUSH_2(y->gen.force, y); +} + +void +force_From_Bool_Y_Only_Cont() +{ + BoolXY *boolXY; + Bool y; + + boolXY = (BoolXY *) POP; + y = boolXY->y; + + switch (y->gen.tag.value) { + case LAZY_TRUE : + setBoolXY(boolXY, LAZY_TRUE); + break; + case LAZY_FALSE : + setBoolXY(boolXY, LAZY_FALSE); + break; + case LAZY_UNKNOWN : + break; + default : + Error(FATAL, E_INT, "force_From_Bool_Y_Only_Cont", + "bad boolean value"); + } +} diff --git a/ic-reals-6.3/base/boolUtil.c b/ic-reals-6.3/base/boolUtil.c new file mode 100644 index 0000000..f768a46 --- /dev/null +++ b/ic-reals-6.3/base/boolUtil.c @@ -0,0 +1,405 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Various utilities used by predicates and boolean operators. + */ +void +force_To_Bool_From_The_Abyss() +{ + Bool b; + b = (Bool) POP; + + Error(FATAL, E_INT, "force_To_Bool_From_The_Abyss", + "trying to force a boolean which is already known"); +} + +void +force_To_PredX_From_The_Abyss() +{ + PredX *predX; + predX = (PredX *) POP; + + Error(FATAL, E_INT, "force_To_PredX_From_The_Abyss", + "trying to force a predicate which is already known"); +} + + +void +absorbDigsXIntoPredX(PredX *predX) +{ + DigsX *digsX; + + digsX = (DigsX *) predX->x; + predX->x = digsX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, digsX); + newEdgeToOnlyChild(predX, digsX->x); + endGraphUpdate(); +#endif +} + +void +absorbSignXIntoPredX(PredX *predX) +{ + SignX *signX; + + signX = (SignX *) predX->x; + predX->x = signX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, signX); + newEdgeToOnlyChild(predX, signX->x); + endGraphUpdate(); +#endif +} + +void +setBoolXY(BoolXY *boolXY, BoolVal v) +{ + boolXY->tag.value = v; + + switch (v) { + case LAZY_TRUE : + case LAZY_FALSE : +#ifdef DAVINCI + beginGraphUpdate(); + deleteEdgeToXChild(boolXY, boolXY->x); + deleteEdgeToYChild(boolXY, boolXY->y); + endGraphUpdate(); +#endif + boolXY->force = force_To_Bool_From_The_Abyss; + boolXY->x = NULL; + boolXY->y = NULL; + break; + case LAZY_UNKNOWN : + break; + default : + Error(FATAL, E_INT, "setBoolXY", "bad boolean value"); + } +} + +void +setPredX(PredX *predX, BoolVal v) +{ + predX->tag.value = v; + + switch (v) { + case LAZY_TRUE : + case LAZY_FALSE : +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, predX->x); + endGraphUpdate(); +#endif + predX->force = force_To_Bool_From_The_Abyss; + predX->x = NULL; + break; + case LAZY_UNKNOWN : + break; + default : + Error(FATAL, E_INT, "setPredX", "bad boolean value"); + } +} + +void +setBoolX(BoolX *boolX, BoolVal v) +{ + boolX->tag.value = v; + + switch (v) { + case LAZY_TRUE : + case LAZY_FALSE : +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(boolX, boolX->x); + endGraphUpdate(); +#endif + boolX->force = force_To_Bool_From_The_Abyss; + boolX->x = NULL; + break; + case LAZY_UNKNOWN : + break; + default : + Error(FATAL, E_INT, "setBoolX", "bad boolean value"); + } +} + +PredX * +allocPredX(Real x) +{ + PredX *predX; + + if ((predX = (PredX *) malloc(sizeof(PredX))) == NULL) + Error(FATAL, E_INT, "allocPredX", "malloc failed"); + +#ifdef DAVINCI + newNodeId(predX); +#else +#ifdef TRACE + newNodeId(predX); +#endif +#endif + + predX->tag.type = PREDX; + predX->tag.value = LAZY_UNKNOWN; + predX->tag.dumped = FALSE; + predX->x = x; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(predX, PREDX); + newEdgeToOnlyChild(predX, x); + endGraphUpdate(); +#endif + + return predX; +} + +/* + * This consumes a stream of characteristic pairs. If a pair (c,n) has the + * property that c = 2n-1, then the boolean is LAZY_UNKNOWN, otherwise + * it gets set to LAZY_TRUE and we advance to the next pair. + */ +void +force_To_PredX_From_DigsX_2n_minus_1_True_Entry() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_2n_minus_1_True_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(force_To_PredX_From_DigsX_2n_minus_1_True_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +/* + * At this point we know we have some digits available, ie a characteristic + * pair (c,n) with n > 0. The predicate is set LAZY_TRUE if c != 2n-1. + * Otherwise we just arrange to consume more digits. + */ +void +force_To_PredX_From_DigsX_2n_minus_1_True_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_Bool_From_The_Abyss(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small == (1 << digsX->count) - 1) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_TRUE); + } + else { +#endif + /* + * This is comparing a big word with +(2^n - 1). It would be faster + * to compare each word with 0xffffffff but this may have to + * wait. #### + */ + if (mpz_sgn(digsX->word.big) > 0 && + mpz_popcount(digsX->word.big) == digsX->count) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_TRUE); +#ifdef PACK_DIGITS + } +#endif +} + +/* + * This consumes a stream of characteristic pairs. If a pair (c,n) has the + * property that c = 2n-1, then the boolean is LAZY_UNKNOWN, otherwise + * it gets set to LAZY_FALSE and we advance to the next pair. + */ +void +force_To_PredX_From_DigsX_2n_minus_1_False_Entry() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_2n_minus_1_False_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(force_To_PredX_From_DigsX_2n_minus_1_False_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +/* + * At this point we know we have some digits available, ie a characteristic + * pair (c,n) with n > 0. The predicate is set LAZY_FALSE if c != 2n-1. + * Otherwise we just arrange to consume more digits. + */ +void +force_To_PredX_From_DigsX_2n_minus_1_False_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_Bool_From_The_Abyss(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small == (1 << digsX->count) - 1) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_FALSE); + } + else { +#endif + /* + * This is comparing a big word with +(2^n - 1). It would be faster + * to compare each word with 0xffffffff but this may have to + * wait. #### + */ + if (mpz_sgn(digsX->word.big) > 0 && + mpz_popcount(digsX->word.big) == digsX->count) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_FALSE); +#ifdef PACK_DIGITS + } +#endif +} + +/* + * This consumes a stream of characteristic pairs. If a pair (c,n) has the + * property that -c = 2n-1, then the boolean is LAZY_UNKNOWN, otherwise + * it gets set to LAZY_FALSE and we advance to the next pair. + */ +void +force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_minus_2n_minus_1_False_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(force_To_PredX_From_DigsX_minus_2n_minus_1_False_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +/* + * At this point we know we have some digits available, ie a characteristic + * pair (c,n) with n > 0. The predicate is set LAZY_FALSE if -c != 2n-1. + * Otherwise we just arrange to consume more digits. + */ +void +force_To_PredX_From_DigsX_minus_2n_minus_1_False_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_Bool_From_The_Abyss(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small == -((1 << digsX->count) - 1)) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_FALSE); + } + else { +#endif + /* + * This is comparing a big word with -(2^n - 1). + * + * THIS RELIES ON GMP USING SIGN/MAGNITUDE REPRESENTATION. + */ + if (mpz_sgn(digsX->word.big) < 0 && + mpz_popcount(digsX->word.big) == digsX->count) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_FALSE); +#ifdef PACK_DIGITS + } +#endif +} + +/* + * This consumes a stream of characteristic pairs. If a pair (c,n) has the + * property that -c = 2n-1, then the boolean is LAZY_UNKNOWN, otherwise + * it gets set to LAZY_TRUE and we advance to the next pair. + */ +void +force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_minus_2n_minus_1_True_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(force_To_PredX_From_DigsX_minus_2n_minus_1_True_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +/* + * At this point we know we have some digits available, ie a characteristic + * pair (c,n) with n > 0. The predicate is set LAZY_TRUE if -c != 2n-1. + * Otherwise we just arrange to consume more digits. + */ +void +force_To_PredX_From_DigsX_minus_2n_minus_1_True_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_Bool_From_The_Abyss(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small == -((1 << digsX->count) - 1)) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_TRUE); + } + else { +#endif + /* + * This is comparing a big word with -(2^n - 1). + * + * THIS RELIES ON GMP USING SIGN/MAGNITUDE REPRESENTATION. + */ + if (mpz_sgn(digsX->word.big) < 0 && + mpz_popcount(digsX->word.big) == digsX->count) + absorbDigsXIntoPredX(predX); + else + setPredX(predX, LAZY_TRUE); +#ifdef PACK_DIGITS + } +#endif +} diff --git a/ic-reals-6.3/base/davinciInterface.c b/ic-reals-6.3/base/davinciInterface.c new file mode 100644 index 0000000..dda5ec8 --- /dev/null +++ b/ic-reals-6.3/base/davinciInterface.c @@ -0,0 +1,947 @@ + /* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include <unistd.h> +#include <sys/time.h> +#include <sys/types.h> +#include <fcntl.h> + +/* + * This file defines the functions for talking to the graph visualization + * tool daVinci. The collection of functions are divided into two groups. + * + * The first part of this file deals with sending graph updates to daVinci. + * Updates consist of instructions to create new nodes or edges. + * + * The second part of the file deals with reading and processing daVinci + * answers. + * + * DaVinci requires that all nodes are assigned unique identifiers. + * Each heap object is assigned an identifier (an integer) when created + * Unlike the address of the object, this is invariant under + * copying garbage collection. + * + * Edges connect nodes to child nodes. As with nodes, daVinci requires + * that we assign a unique identifier (a string) to each edge. This + * is formed from the id of the source of the edge and the index of + * the child. + * + * A sequence of calls to the functions to create new nodes and + * edges must be bracketted between calls to beginGraphUpdate() and + * endGraphUpdate(). Calls to create new nodes and edges can appear in + * any order between the begin and end. + * + * According to the daVinci documentation, one can send a list + * of "mixed_updates" with new_node and new_edge commands in any + * order. However, there is a bug and mixed updates don't work. Node and + * edge updates must be in separate lists. The code below gets around + * this bug. + */ + +char davBuf[2 * 1024]; +char *davPtr; +int makeNodeUpdateList = 0; + +/* + * The ``abstact machine'' has four states. RUNNING and STOPPED apply when + * the stack is non-empty. When the stack runs out and we are about to + * return to the caller, the machine state WAITING, that way we can still + * interact with daVinci before passing control back. + */ +#define RUNNING 1 +#define STOPPED 2 +#define WAITING 3 +#define FINISHED 4 + +int machineState = STOPPED; + +int repliesExpected = 1; /* from the outset we expect an ok from davinci */ + +#define NODE_LIST 1 +#define EDGE_LIST 2 + +int toDavFds[2]; +int fromDavFds[2]; +FILE *davReadFP, *davWriteFP; + +void setMachineState(int); + +/* + * Communication with daVinci is through a bounded buffer. I would prefer + * to use stdio(3) buffered IO since I want to work with lines (terminated + * with newlines) suggesting fgets(3), but I want non-blocking IO, + * which seems not possible with the stdio(3) functions. + */ +struct { + char start[BUFSIZ]; + char *current; + int count; +} daBuf; + +/* + * This initializes the interface to daVinci. We create a couple of pipes + * spawn the daVinci process, and then send some initialization parameters. + */ +void initDaVinci() +{ + int pid; + char buf[1024]; + + /* + * We need two pipes to talk with daVinci. Info flows both ways. + */ + if (pipe(toDavFds) != 0) + Error(FATAL, E_SYS, "initDavinci", "can't open to daVinci pipe\n"); + + if (pipe(fromDavFds) != 0) + Error(FATAL, E_SYS, "initDavinci", "can't open from daVinci pipe\n"); + + switch (pid = fork()) { + case -1 : /* parent error */ + Error(FATAL, E_SYS, "initDavinci", "can't fork\n"); + break; + + case 0 : /* child */ + if (close(toDavFds[1]) == -1) + Error(FATAL, E_SYS, "initDavinci (child)", "close toDav failed\n"); + + if (dup2(toDavFds[0], fileno(stdin)) == -1) + Error(FATAL, E_SYS, "initDavinci (child)", "dup2 stdin failed\n"); + + if (close(fromDavFds[0]) == -1) + Error(FATAL, E_SYS, "initDavinci (child)", "close fromDav failed\n"); + + if (dup2(fromDavFds[1], fileno(stdout)) == -1) + Error(FATAL, E_SYS, "initDavinci (child)", "dup2 stdout failed\n"); + + sprintf(buf, "DAVINCI_ICONDIR=%s/icons", REALDIR); + putenv(buf); + + if (execlp("daVinci", "daVinci", "-pipe", (char *)0) == -1) + Error(FATAL, E_SYS, "initDavinci (child)", + "execlp daVinci -pipe failed\n"); + break; + + default : /* parent */ + if (close(fromDavFds[1]) == -1) + Error(FATAL, E_SYS, "initDavinci (parent)", "close fromDav failed\n"); + + if ((davReadFP = fdopen(fromDavFds[0], "r")) == NULL) + Error(FATAL, E_SYS, "initDavinci (parent)", "read fdopen failed\n"); + + if (close(toDavFds[0]) == -1) + Error(FATAL, E_SYS, "initDavinci (parent)", "close toDav failed\n"); + + if ((davWriteFP = fdopen(toDavFds[1], "w")) == NULL) + Error(FATAL, E_SYS, "initDavinci (parent)", + "write fdopen failed\n"); + + setlinebuf(davWriteFP); + setlinebuf(davReadFP); /* useless */ + break; + } + + /* + * Now set up the bounded buffer for receiving answers from daVinci. + */ + daBuf.count = 0; + daBuf.current = daBuf.start; + + /* + * Get the initial "ok" (though it doesn't seem necessary) + */ + handleDaVinciMessages(BLOCK); + + fprintf(davWriteFP, "menu(layout(orientation(left_right)))\n"); + fprintf(davWriteFP, "set(font_size(8))\n"); + fprintf(davWriteFP, "set(keep_nodes_at_levels(false))\n"); + fprintf(davWriteFP, "set(layout_accuracy(1))\n"); + fprintf(davWriteFP, "set(gap_height(10))\n"); + fprintf(davWriteFP, "set(gap_width(10))\n"); + fprintf(davWriteFP, "app_menu(create_icons(["); + fprintf(davWriteFP, "icon_entry(\"stop-program\",\"stop.xbm\",\"Stop\"),"); + fprintf(davWriteFP, "icon_entry(\"run-program\",\"go.xbm\",\"Run\"),"); + fprintf(davWriteFP, "icon_entry(\"step-program\",\"step.xbm\",\"Single step\"),"); + fprintf(davWriteFP, "icon_entry(\"continue-program\",\"continue.xbm\",\"Continue\"),"); + fprintf(davWriteFP, "icon_entry(\"collect-garbage\",\"collect.xbm\",\"Garbage Collection\")]))\n"); + + /* + * The number of replies expected should be the same as the number + * of newlines transmitted. Perhaps the code should reflect that. + */ + repliesExpected += 7; + setMachineState(STOPPED); +} + +static int updateState; + +/* + * Calls to add and delete edges must be bracketed between calls to + * beginGraphUpdate() and endGraphUpdate(). This serves also to get around + * a bug in daVinci. + */ +void beginGraphUpdate() +{ + davPtr = davBuf + sprintf(davBuf, "graph(update(["); + updateState = NODE_LIST; +} + +void endGraphUpdate() +{ + if (*(davPtr - 1) == ',') + davPtr--; + if (updateState == NODE_LIST) + davPtr += sprintf(davPtr, "],["); + davPtr += sprintf(davPtr, "]))\n"); + repliesExpected++; + fputs(davBuf, davWriteFP); +/* + fputs(davBuf, stderr); + fflush(stderr); +*/ + /* fflush(davWriteFP); */ +} + +/* + * This assigns a couple to each type of object in the heap. Yes the case + * statement is slow, but the moment is doesn't matter. + */ +char * +typeToColor(unsigned type) +{ + switch (type) { + case ALT : + return "pink"; + case VECTOR : + return "red"; + case MATX : + return "red"; + case TENXY : + return "red"; + case SIGNX : + return "blue"; + case DIGSX : + return "cyan"; + case CLOSURE : + return "green"; + case BOOLX : + return "orange"; + case BOOLXY : + return "orange"; + case PREDX : + return "yellow"; + default : + Error(FATAL, E_INT, "typeToColor", "bad type: %d", type); + return NULL; + break; + } +} + +/* + * This assigns a shape (box, circle, rhombus etc) to render each heap object + * with. + */ +char * +typeToShape(unsigned type) +{ + switch (type) { + case ALT : + return "circle"; + case VECTOR : + return "box"; + case MATX : + return "box"; + case TENXY : + return "box"; + case SIGNX : + return "circle"; + case DIGSX : + return "circle"; + case CLOSURE : + return "box"; + case BOOLX : + return "box"; + case BOOLXY : + return "box"; + case PREDX : + return "box"; + default : + Error(FATAL, E_INT, "typeToColor", "bad type: %d", type); + return ""; + break; + } +} + +/* + * This assigns a string label to each type of object in the heap. Not used + * at present. + */ +char * +typeToLabel(unsigned type) +{ + switch (type) { + case ALT : + return "A"; + case VECTOR : + return "V"; + case MATX : + return "M"; + case TENXY : + return "T"; + case SIGNX : + return "S"; + case DIGSX : + return "D"; + case CLOSURE : + return "C"; + case BOOLX : + return "U"; + case BOOLXY : + return "N"; + case PREDX : + return "P"; + default : + Error(FATAL, E_INT, "typeToLabel", "bad type: %d", type); + return NULL; + break; + } +} + +void newNode(Generic *node, ObjType nodetype) +{ + if (updateState != NODE_LIST) { + endGraphUpdate(); + beginGraphUpdate(); + } + + davPtr += sprintf(davPtr, "new_node("); + davPtr += sprintf(davPtr, "\"n%d\"", node->tag.nodeId); + davPtr += sprintf(davPtr, ",\"%s\"", typeToString(nodetype)); + davPtr += sprintf(davPtr, ",["); +/* + davPtr += sprintf(davPtr, "a(\"_GO\",\"icon\")"); + davPtr += sprintf(davPtr, ",a(\"ICONFILE\",\"node.xbm\")"); + davPtr += sprintf(davPtr, ",a(\"BORDER\",\"none\")"); + davPtr += sprintf(davPtr, "a(\"OBJECT\",\"%s\")", typeToLabel(nodetype)); +*/ + davPtr += sprintf(davPtr, "a(\"_GO\",\"%s\")", typeToShape(nodetype)); + davPtr += sprintf(davPtr, ",a(\"OBJECT\",\" \")"); +/* + davPtr += sprintf(davPtr, ",a(\"OBJECT\",\"%d\")", node->tag.nodeId); +*/ + davPtr += sprintf(davPtr, ",a(\"COLOR\",\"%s\")", typeToColor(nodetype)); + davPtr += sprintf(davPtr, ",m(["); + davPtr += sprintf(davPtr, "menu_entry(\"set-break\",\"Set break\")"); + davPtr += sprintf(davPtr, ",menu_entry(\"clear-break\",\"Clear break\")"); + davPtr += sprintf(davPtr, ",menu_entry(\"show-contents\",\"Show contents\")"); + davPtr += sprintf(davPtr, "])"); + davPtr += sprintf(davPtr, "]),"); +} + +/* + * This connects node1 to node2 where node2 is childIdx is the index amongst + * all the children of node1. The index is needed since, node1 maybe + * connected to node2 more than once and we need to distinguish the + * edges. + */ +void newEdgeToChildN(Generic *node1, Generic *node2, int childIdx) +{ + if (updateState == NODE_LIST) { + if (*(davPtr - 1) == ',') + davPtr--; + davPtr += sprintf(davPtr, "],["); + updateState = EDGE_LIST; + } + + davPtr += sprintf(davPtr, "new_edge("); + davPtr += sprintf(davPtr, "\"e%d.%d.%d\"", + node1->tag.nodeId, node2->tag.nodeId, childIdx); +/* + printf("new e%d.%d.%d\n", node1->tag.nodeId, node2->tag.nodeId, childIdx); +*/ + davPtr += sprintf(davPtr, ",\"edge\""); + davPtr += sprintf(davPtr, ",[]"); + davPtr += sprintf(davPtr, ",\"n%d\"", node1->tag.nodeId); + davPtr += sprintf(davPtr, ",\"n%d\"),", node2->tag.nodeId); +} + +/* + * This is exactly the same as the above, only the edge is drawn + * double and without an arrow. This is used to connect two node which + * denote the same real value. + */ +void drawEqEdge(Generic *node1, Generic *node2) +{ + if (updateState == NODE_LIST) { + if (*(davPtr - 1) == ',') + davPtr--; + davPtr += sprintf(davPtr, "],["); + updateState = EDGE_LIST; + } + + davPtr += sprintf(davPtr, "new_edge("); + davPtr += sprintf(davPtr, "\"e%d.%d.eq\"", + node1->tag.nodeId, node2->tag.nodeId); +/* + printf("new eq e%d.%d.eq\n", node1->tag.nodeId, node2->tag.nodeId); +*/ + davPtr += sprintf(davPtr, ",\"edge\""); + davPtr += sprintf(davPtr, ",["); + davPtr += sprintf(davPtr, "a(\"_DIR\",\"none\")"); + davPtr += sprintf(davPtr, ",a(\"EDGEPATTERN\",\"double\")"); + davPtr += sprintf(davPtr, "],\"n%d\"", node1->tag.nodeId); + davPtr += sprintf(davPtr, ",\"n%d\"),", node2->tag.nodeId); +} + + +void highlightEdge(Generic *node1, Generic *node2, int childIdx) +{ + davPtr = davBuf + sprintf(davBuf, "graph(change_attr(["); + davPtr += sprintf(davPtr, "edge("); + davPtr += sprintf(davPtr, "\"e%d.%d.%d\"", + node1->tag.nodeId, node2->tag.nodeId, childIdx); +/* + printf("e%d.%d.%d\n", node1->tag.nodeId, node2->tag.nodeId, childIdx); +*/ + davPtr += sprintf(davPtr, ",["); + davPtr += sprintf(davPtr, "a(\"EDGECOLOR\",\"red\")"); + davPtr += sprintf(davPtr, ",a(\"EDGEPATTERN\",\"dashed\")"); + davPtr += sprintf(davPtr, "])]))\n"); + repliesExpected++; + fputs(davBuf, davWriteFP); + /* fflush(davWriteFP); */ +} + +void unhighlightEdge(Generic *node1, Generic *node2, int childIdx) +{ + davPtr = davBuf + sprintf(davBuf, "graph(change_attr(["); + davPtr += sprintf(davPtr, "edge("); + davPtr += sprintf(davPtr, "\"e%d.%d.%d\"", + node1->tag.nodeId, node2->tag.nodeId, childIdx); + davPtr += sprintf(davPtr, ",["); + davPtr += sprintf(davPtr, "a(\"EDGECOLOR\",\"black\")"); + davPtr += sprintf(davPtr, ",a(\"EDGEPATTERN\",\"solid\")"); + davPtr += sprintf(davPtr, "])]))\n"); + repliesExpected++; + fputs(davBuf, davWriteFP); + /* fflush(davWriteFP); */ +} + +void highlightNode(Generic *node) +{ + davPtr = davBuf + sprintf(davBuf, "graph(change_attr(["); + davPtr += sprintf(davPtr, "node("); + davPtr += sprintf(davPtr, "\"n%d\"", node->tag.nodeId); + davPtr += sprintf(davPtr, ",["); + davPtr += sprintf(davPtr, "a(\"BORDER\",\"double\")"); + davPtr += sprintf(davPtr, "])]))\n"); + repliesExpected++; + fputs(davBuf, davWriteFP); + /* fflush(davWriteFP); */ +} + +void unhighlightNode(Generic *node) +{ + davPtr = davBuf + sprintf(davBuf, "graph(change_attr(["); + davPtr += sprintf(davPtr, "node("); + davPtr += sprintf(davPtr, "\"n%d\"", node->tag.nodeId); + davPtr += sprintf(davPtr, ",["); + davPtr += sprintf(davPtr, "a(\"BORDER\",\"single\")"); + davPtr += sprintf(davPtr, "])]))\n"); + repliesExpected++; + fputs(davBuf, davWriteFP); + /* fflush(davWriteFP); */ +} + +/* + * Some convenient abbreviations of the the newEdge function + */ +void newEdgeToOnlyChild(Generic *node1, Generic *node2) +{ + newEdgeToChildN(node1, node2, 0); +} + +void newEdgeToXChild(Generic *node1, Generic *node2) +{ + newEdgeToChildN(node1, node2, 0); +} + +void newEdgeToYChild(Generic *node1, Generic *node2) +{ + newEdgeToChildN(node1, node2, 1); +} + +void deleteEdgeToChildN(Generic *node1, Generic *node2, int childIdx) +{ + if (updateState == NODE_LIST) { + if (*(davPtr - 1) == ',') + davPtr--; + davPtr += sprintf(davPtr, "],["); + updateState = EDGE_LIST; + } + + davPtr += sprintf(davPtr, "delete_edge("); + davPtr += sprintf(davPtr, "\"e%d.%d.%d\"", + node1->tag.nodeId, node2->tag.nodeId, childIdx); + davPtr += sprintf(davPtr, "),"); +} + +/* + * More legacy abbreviations. + */ +void deleteOnlyEdge(Generic *node1, Generic *node2) +{ + deleteEdgeToChildN(node1, node2, 0); +} + +void deleteEdgeToXChild(Generic *node1, Generic *node2) +{ + deleteEdgeToChildN(node1, node2, 0); +} + +void deleteEdgeToYChild(Generic *node1, Generic *node2) +{ + deleteEdgeToChildN(node1, node2, 1); +} + +void +setMachineState(int state) +{ + if (state == STOPPED) { + machineState = STOPPED; + fprintf(davWriteFP, "app_menu(activate_icons([\"run-program\",\"step-program\"]))\n"); + /* fflush(davWriteFP); */ + repliesExpected++; + return; + } + if (state == RUNNING) { + machineState = RUNNING; + fprintf(davWriteFP, "app_menu(activate_icons([\"stop-program\"]))\n"); + /* fflush(davWriteFP); */ + repliesExpected++; + return; + } + if (state == WAITING) { + machineState = WAITING; + fprintf(davWriteFP, "app_menu(activate_icons([\"continue-program\"]))\n"); + /* fflush(davWriteFP); */ + repliesExpected++; + return; + } + if (state == FINISHED) { + machineState = FINISHED; + fprintf(davWriteFP, "app_menu(activate_icons([]))\n"); + /* fflush(davWriteFP); */ + repliesExpected++; + return; + } +} + +void +singleStep() +{ + void (*f)(); + + if (machineState == STOPPED && sp >= stack) { +#ifdef TRACE + dumpTopOfStack(); +#endif + unhighlightTOS(); + f = (void (*)()) POP; + (*f)(); + } +} + +/* + * I include both of these for portability. Linux needs only the first + * while Solaris seems to need both + */ +#include <string.h> +#include <strings.h> + +/* + * For each answer (a string) we attach an action (a function). This + * takes a string as an argument which is the remaining unparsed string + * (whether or not there is anything left). These functions return a + * pointer to the next character beyond the answer. + */ +typedef struct { + char *string; + char *(*action)(char *); +} Token; + +/* + * There are a number of answers/messages from daVinci for which we are + * not interested in in which case, the following is their action. + */ +char * +doNothing(char *p) +{ + return p; +} + +/* + * Action for "ok" message. + */ +char * +doOK(char *p) +{ + repliesExpected--; + return p; +} + +/* + * Action for "exit" message. + */ +char * +doExit(char *p) +{ + fprintf(stderr, "\n"); + exit(0); +} + +/* + * This is for messages (answers) from daVinci which we don't care about + * but which include an argument delimited by '(' and ')'. So we just go + * scan for ')' and return a pointer to the next character. The assumption + * here is that there are no nested parentheses in answers (ie in node and + * edge identifiers) which is reasonable since we are the ones choosing + * the identifiers. The + 2 skips the closing bracket and the newline. + */ +char * +doNothingWithArg(char *p) +{ +/* + char *q; + + q = index(p, ')'); + *q = '\0'; + fprintf(stderr, "%s", p + 1); + return q + 2; +*/ + return index(p, ')') + 2; +} + +char * +iconSelection(char *p) +{ + char *q; + + /* + * p is at the opening '"', we look for the closing ')' + */ + p++; + q = index(p, '"'); + *q = '\0'; + + if (strcmp(p, "stop-program") == 0) + setMachineState(STOPPED); + else { + if (strcmp(p, "run-program") == 0) + setMachineState(RUNNING); + else { + if (strcmp(p, "step-program") == 0) { + singleStep(); + } + else + if (strcmp(p, "continue-program") == 0) + setMachineState(FINISHED); + else + fprintf(stderr, "bad icon selection: %s\n", p+1); + } + } + + return q + 3; +} + +/* + * Activated when we get a "popup-selection-node" message. This happens when + * the user clicks on a menu entry attached to the node popup. The menu + * includes entries for setting and clearing breakpoints and for displaying + * the contents of the object in the heap. Only the last, "show-contents", + * is implemented. + */ +char * +popupSelectionNode(char *p) +{ + char *q; + unsigned nodeId; + Generic *mapNodeIdToHeapCell(int); + + /* + * p is at the '"', and we look for the closing '"'. + */ + q = index(p + 1, '"'); + *q = '\0'; + + /* + * the first argument should be a node id which is a string enclosed + * in '"' with prefix 'n' followed by a number + * so we skip the quotes and the 'n'. + */ + sscanf(p + 2, "%d", (int *) &nodeId); + + /* + * q is at the null and next there is a ',' and '"' which we skip + */ + p = q + 3; + + /* + * The second argument should be a string enclosed in '"' which should + * be the menu entry + */ + q = index(p, '"'); + *q = '\0'; + if (strcmp(p, "show-contents") == 0) + dumpCell((void *) mapNodeIdToHeapCell(nodeId)); + else + fprintf(stderr, "unknown menu entry: %s\n", q); + + /* + * q is at the null, we skip the closing ')' and newline and return. + */ + return q + 3; +} + +/* + * Called when we get a "communication-error" message from daVinci. + * Just write the message and exit. + */ +char * +communicationError(char *p) +{ + char *q; + + /* + * The first character should be '"' which we skip and the + * scan for a closing bracket. The character preceeding the + * closing bracket should also be '"' which we clobber with a + * null char and then return q+2 to skip the closing bracket + * and the newline. + * For now, a communication error exits the program. + */ + q = index(p + 1, ')'); + *(q - 1) = '\0'; + Error(FATAL, E_INT, "daVinci interface", "communication error %s", (p + 1)); + return q + 2; +} + +/* + * The following is the list of possible answers provided by daVinci. The list + * is sorted for a binary search. + */ +Token tokens[] = { + {"browser_answer", doNothingWithArg}, /* (string,string) */ + {"close", doNothing}, + {"close_window", doNothingWithArg}, /* (window_id) */ + {"communication_error", communicationError}, /* (string) */ + {"context", doNothingWithArg}, /* (context_id) */ + {"context_window", doNothingWithArg}, /* (context_id,window_id) */ + {"create_edge", doNothingWithArg}, /* (node_id,node_id) */ + {"create_node", doNothing}, + {"create_node_and_edge", doNothingWithArg}, /* (node_id) */ + {"disconnect", doExit}, + {"drop_node", doNothingWithArg}, /* (node_id,context_id,window_id,node_id) */ + {"edge_double_click", doNothing}, + {"edge_selection_label", doNothingWithArg}, /* (edge_id) */ + {"edge_selection_labels", doNothingWithArg}, /* (node_id,node_id) */ + {"icon_selection", iconSelection}, /* (icon_id) */ + {"menu_selection", doNothingWithArg}, /* (menu_id) */ + {"node_double_click", doNothing}, + {"node_selections_labels", doNothingWithArg}, /* (node_ids) */ + {"ok", doOK}, + {"open_window", doNothing}, + {"popup_selection_edge", doNothingWithArg}, /* (edge_id,menu_id) */ + {"popup_selection_node", popupSelectionNode}, /* (node_id,menu_id) */ + {"quit", doExit}, + {"tcl_answer", doNothingWithArg} /* (string) */ +}; + +static int +compare(const void *t1, const void *t2) +{ + return strcmp(((Token *)t1)->string, ((Token *)t2)->string); +} + +/* + * This retieves the next message from the daVinci buffer. A message is complete + * when it ends in a newline. This copies the message into the given line + * buffer and terminates it with a null. The buffer is assumed to be + * big enough to receive the line. The function returns TRUE if the newline + * is found. If no newline is found, the function returns FALSE and the + * daVinci buffer is unaffected. + */ +int +getNextAnswer(char *line) +{ + char *current; + int count; + char c; + + count = daBuf.count; + current = daBuf.current; + while (count > 0) { + c = *current; + count--; + *line++ = *current++; + if (current == daBuf.start + BUFSIZ) + current = daBuf.start; + if (c == '\n') { + *line = '\0'; + daBuf.count = count; + daBuf.current = current; + return TRUE; + } + } + if (daBuf.count == BUFSIZ) + Error(FATAL, E_INT, "getNextAnswer", + "buffer full but no complete answers"); + + return FALSE; +} + +/* + * As the name suggests, this function handles the messages from daVinci. + * We read from davReadFP (into a fixed size buffer) and then parse and handle + * the different messages. It is possible (and likely) that in some cases there + * will be more than one message in the buffer. + */ +void readAndProcessDaVinciMessages() +{ + char *p, line[BUFSIZ]; + Token key, *tokPtr; + int n; + char *next; + int size; +/* + char *strsep(char **, char *); +*/ + + /* + * First we try to read what we can from the pipe into the space left + * in the buffer. + */ + if (daBuf.count < BUFSIZ) { + next = ((daBuf.current - daBuf.start + daBuf.count) % BUFSIZ) + + daBuf.start; + if (next >= daBuf.current) + size = daBuf.start + BUFSIZ - next; + else + size = daBuf.current - next; + n = read(fileno(davReadFP), next, size); + + if (n == -1) + Error(FATAL, E_SYS, "readAndProcessDaVinciMessages", "read failed"); + if (n == 0) + Error(FATAL, E_INT, "readAndProcessDaVinciMessages", + "unexpected EOF"); + daBuf.count += n; + } + + /* + * Now we go through the buffer and process all the answers and + * messages sent from daVinci. + */ + while (getNextAnswer(line)) { + for (p = line; (key.string = strsep(&p, "\n(")) != NULL;) { + if (*key.string != '\0') { + tokPtr = (Token *) bsearch(&key, tokens, + sizeof(tokens) / sizeof(Token), sizeof(Token), compare); + + if (tokPtr == NULL) + Error(FATAL, E_INT, "readAndProcessDaVinciMessages", + "bad answer: %s", key.string); + /* + * Now we activate the function associated with the + * message received + */ + p = (*(tokPtr->action))(p); + } + } + } +} + +/* + * This is the function actually called to read and process daVinci messages. + * If the parameter is true, it will block until data is available. Otherwise + * it polls (via select(2)). + */ +void handleDaVinciMessages(int block) +{ + fd_set rfds; + struct timeval tv; + int retval; + + /* Watch davinci input fd to see when it has input. */ + + do { + FD_ZERO(&rfds); + FD_SET(fileno(davReadFP), &rfds); + + if (block || repliesExpected > 0) + retval = select(fileno(davReadFP) + 1, &rfds, NULL, NULL, NULL); + else { + /* + * Set timeout to 0, so we are essentially polling + */ + tv.tv_sec = 0; + tv.tv_usec = 0; + retval = select(fileno(davReadFP) + 1, &rfds, NULL, NULL, &tv); + } + + switch (retval) { + case -1 : + Error(FATAL, E_SYS, "", "select failed"); + break; + + case 0 : + break; + + default : + if (FD_ISSET(fileno(davReadFP), &rfds)) { + readAndProcessDaVinciMessages(); + } + break; + } + } while (repliesExpected > 0); +} + +/* + * The abstract machine can be controlled via the icons on the left side of + * the daVinci window. This is the function used to run the stack when + * daVinci is compiled in. + */ +void +runStackViaDaVinci() +{ + void (*f)(); + + setMachineState(STOPPED); + + while (sp >= stack) { + if (machineState == RUNNING) + handleDaVinciMessages(!BLOCK); + else + handleDaVinciMessages(BLOCK); + if (machineState == RUNNING) { +#ifdef TRACE + dumpTopOfStack(); +#endif + unhighlightTOS(); + f = (void (*)()) POP; + (*f)(); + } + } + + setMachineState(WAITING); + while (machineState == WAITING) + handleDaVinciMessages(BLOCK); +} diff --git a/ic-reals-6.3/base/debug.c b/ic-reals-6.3/base/debug.c new file mode 100644 index 0000000..385941c --- /dev/null +++ b/ic-reals-6.3/base/debug.c @@ -0,0 +1,24 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdarg.h> +#include <stdio.h> + +/* + * A small utility for procedures to write debug information. + */ +void +debugp(char *proc, char *fmt, ...) +{ + va_list ap; + + va_start(ap, fmt); + fprintf(stderr, "%-35s", proc); + vfprintf(stderr, fmt, ap); + va_end(ap); +} diff --git a/ic-reals-6.3/base/delay.c b/ic-reals-6.3/base/delay.c new file mode 100644 index 0000000..6dc8af8 --- /dev/null +++ b/ic-reals-6.3/base/delay.c @@ -0,0 +1,49 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * realDelay(f, x) allows for a user to construct a real valued + * closure which reduces to f(x) when forced. + */ +typedef struct { + Delay_Arg x; + Delay_Fun f; +} DelayData; + +Real +realDelay(Delay_Fun f, Delay_Arg x) +{ + Cls *cls; + DelayData *data; + void delayCont(); + + if ((data = (DelayData *) malloc(sizeof(DelayData))) == NULL) + Error(FATAL, E_INT, "realDelay", "malloc failed"); + + data->f = f; + data->x = x; + + cls = allocCls(delayCont, data); + cls->tag.isSigned = TRUE; + return (Real) cls; +} + +void +delayCont() +{ + Cls *cls; + DelayData *data; + + cls = (Cls *) POP; + data = (DelayData *) cls->userData; + cls->redirect = (data->f)(data->x); +} diff --git a/ic-reals-6.3/base/digitHandling.c b/ic-reals-6.3/base/digitHandling.c new file mode 100644 index 0000000..79e9dfb --- /dev/null +++ b/ic-reals-6.3/base/digitHandling.c @@ -0,0 +1,78 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * For a real that has been forced to a stream (by force_R_Digs) + * this function retrieves the sign and the most significant digit information. + */ +void +retrieveInfo(Real x, Sign *sign, int *count, mpz_t digits) +{ + Real derefToStrm(Real); + + x = derefToStrm(x); + + if (x == NULL) + Error(FATAL, E_INT, "retrieveInfo", "argument not forced"); + + if (x->gen.tag.type == SIGNX) { + *sign = x->signX.tag.value; + x = x->signX.x; + } + else + *sign = SPOS; + + if ((x->gen.tag.type = DIGSX)) { + *count = x->digsX.count; +#ifdef PACK_DIGITS + if (*count <= DIGITS_PER_WORD) + mpz_set_si(digits, x->digsX.word.small); + else +#endif + mpz_set(digits, x->digsX.word.big); + } + else + Error(FATAL, E_INT, "retrieveInfo", + "no information has been forced from the argument"); +} + +/* + * Given a characteristic pair (c,n) where n is the number + * of digits recorded in c, this function returns the most significant + * digit yielding also (c', n-1) + */ +Digit +takeDigit(int *count, mpz_t digits) +{ + Digit digit; + + if (*count > 0) + mpz_tdiv_q_2exp(tmpa_z, digits, *count - 1); + if (mpz_cmp_ui(tmpa_z, 0) == 0) + digit = DZERO; + else + if (mpz_cmp_ui(tmpa_z, 1) == 0) + digit = DPOS; + else + if (mpz_cmp_si(tmpa_z, -1) == 0) + digit = DNEG; + else { + Error(FATAL, E_INT, "takeDigit", + "characteristic pair is not well formed"); + digit = DZERO; + } + + mpz_mul_2exp(tmpa_z, tmpa_z, *count - 1); + mpz_sub(digits, digits, tmpa_z); + *count = *count - 1; + return digit; +} diff --git a/ic-reals-6.3/base/dump.c b/ic-reals-6.3/base/dump.c new file mode 100644 index 0000000..5b48223 --- /dev/null +++ b/ic-reals-6.3/base/dump.c @@ -0,0 +1,382 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include <math.h> + +/* + * Debugging routines for displaying heap cells. + * + * This file needs a little cleaning up a bit. + */ + +int dumpBase = 10; + +static void dumpReal1(Real); +static void clearDumpedFlag(Real); + +void +dumpTag(Tag tag) +{ + char *typeToString(ObjType); + char *boolValToString(ObjType); + + fprintf(stderr, " id=%d", tag.nodeId); + fprintf(stderr, " %s", typeToString(tag.type)); + fprintf(stderr, "%s", (tag.isSigned ? "(si)" : "----")); + + if (tag.type == PREDX || tag.type == BOOLX || tag.type == BOOLXY) + fprintf(stderr, "%s", boolValToString(tag.value)); + + if (tag.type == SIGNX) + fprintf(stderr, "%s", signToString(tag.value)); +} + +void +dumpVector(Vector v) +{ + fprintf(stderr, " a="); + mpz_out_str(stderr, dumpBase, v[0]); + fprintf(stderr, "\n b="); + mpz_out_str(stderr, dumpBase, v[1]); + fprintf(stderr, "\n"); +} + +void +dumpMatrix(Matrix m) +{ + fprintf(stderr, " a="); + mpz_out_str(stderr, dumpBase, m[0][0]); + fprintf(stderr, "\n b="); + mpz_out_str(stderr, dumpBase, m[0][1]); + fprintf(stderr, "\n c="); + mpz_out_str(stderr, dumpBase, m[1][0]); + fprintf(stderr, "\n d="); + mpz_out_str(stderr, dumpBase, m[1][1]); + fprintf(stderr, "\n"); +} + +void +dumpTensor(Tensor t) +{ + fprintf(stderr, " a="); + mpz_out_str(stderr, dumpBase, t[0][0]); + fprintf(stderr, "\n b="); + mpz_out_str(stderr, dumpBase, t[0][1]); + fprintf(stderr, "\n c="); + mpz_out_str(stderr, dumpBase, t[1][0]); + fprintf(stderr, "\n d="); + mpz_out_str(stderr, dumpBase, t[1][1]); + fprintf(stderr, "\n e="); + mpz_out_str(stderr, dumpBase, t[2][0]); + fprintf(stderr, "\n f="); + mpz_out_str(stderr, dumpBase, t[2][1]); + fprintf(stderr, "\n g="); + mpz_out_str(stderr, dumpBase, t[3][0]); + fprintf(stderr, "\n h="); + mpz_out_str(stderr, dumpBase, t[3][1]); + fprintf(stderr, "\n"); +} + +void +dumpForceFunc(void (*func)()) +{ + ForceFuncDesc *p; + + p = getDescForForceFunc(func); + if (p == NULL) + fprintf(stderr, " force=%x\n", (unsigned int)func); + else + fprintf(stderr, " force=%s\n", p->funcName); +} + +void +dumpMatX(MatX *matX) +{ + fprintf(stderr, " x=%x\n", (unsigned) matX->x); + dumpForceFunc(matX->force); + dumpMatrix(matX->mat); +} + +void +dumpTenXY(TenXY *tenXY) +{ + fprintf(stderr, " fair=%d", tenXY->tensorFairness); + fprintf(stderr, " x=%x y=%x\n", (unsigned) tenXY->x, (unsigned) tenXY->y); + dumpForceFunc(tenXY->forceX); + dumpForceFunc(tenXY->forceY); + dumpTensor(tenXY->ten); +} + +void +dumpSignX(SignX *signX) +{ + fprintf(stderr, " x=%x\n", (unsigned) signX->x); + dumpForceFunc(signX->force); +} + +void +dumpDigsX(DigsX *digsX) +{ + fprintf(stderr, " x=%x", (unsigned) digsX->x); + fprintf(stderr, " count=%d", (int) digsX->count); + fprintf(stderr, "\n word="); +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + fprintf(stderr, "%d ", digsX->word.small); + fprintf(stderr, "(0x%x) ", digsX->word.small); + } + else { +#endif + mpz_out_str(stderr, 10, digsX->word.big); + fprintf(stderr, " (0x"); + mpz_out_str(stderr, 16, digsX->word.big); + fprintf(stderr, " )"); +#ifdef PACK_DIGITS + } +#endif + fprintf(stderr, "\n"); + dumpForceFunc(digsX->force); +} + +void +dumpCls(Cls *cls) +{ + fprintf(stderr, " redirect=%x\n", (unsigned) cls->redirect); + dumpForceFunc(cls->force); + dumpReal1(cls->redirect); +} + +void +dumpAlt(Alt *alt) +{ + fprintf(stderr, " redirect=%x num ge=%d\n", + (unsigned) alt->redirect, alt->numGE); +} + +void +dumpAltChildren(Alt *alt) +{ + int i; + + for (i = 0; i < alt->numGE; i++) { + if (alt->GE[i].guard != NULL) { + fprintf(stderr, " (%x,%x)\n", (unsigned) alt->GE[i].guard, + (unsigned) alt->GE[i].x); + } + } + + for (i = 0; i < alt->numGE; i++) { + if (alt->GE[i].guard != NULL) { + dumpBool(alt->GE[i].guard); + dumpReal1(alt->GE[i].x); + } + } +} + +void +dumpPredX(PredX *predX) +{ + fprintf(stderr, " x=%x\n", (unsigned) predX->x); + dumpForceFunc(predX->force); +} + +void +dumpBoolX(BoolX *boolX) +{ + fprintf(stderr, " x=%x\n", (unsigned) boolX->x); + dumpForceFunc(boolX->force); +} + +void +dumpBoolXY(BoolXY *boolXY) +{ + fprintf(stderr, " x=%x", (unsigned) boolXY->x); + fprintf(stderr, " y=%x\n", (unsigned) boolXY->y); + dumpForceFunc(boolXY->force); +} + + +void +dumpCell(void *p) +{ + Tag tag = *((Tag *) p); + + fprintf(stderr, "%x ", (unsigned) p); + + dumpTag(tag); + + switch (tag.type) { + case ALT : + dumpAlt((Alt *) p); + break; + case VECTOR : + fprintf(stderr, "\n"); + dumpVector(((Vec *)p)->vec); + break; + case MATX : + dumpMatX((MatX *) p); + break; + case TENXY : + dumpTenXY((TenXY *) p); + break; + case DIGSX : + dumpDigsX((DigsX *) p); + break; + case SIGNX : + dumpSignX((SignX *) p); + break; + case CLOSURE : + dumpCls((Cls *) p); + break; + case PREDX : + dumpPredX((PredX *) p); + break; + case BOOLX : + dumpBoolX((BoolX *) p); + break; + case BOOLXY : + dumpBoolXY((BoolXY *) p); + break; + default : + break; + } +} + +void +dumpReal(Real r) +{ + dumpReal1(r); + clearDumpedFlag(r); +} + +static void +dumpReal1(Real x) +{ + if (x == NULL) + return; + + if (x->gen.tag.dumped) + return; + x->gen.tag.dumped = TRUE; + + fprintf(stderr, "%x ", (unsigned) x); + dumpTag(x->gen.tag); + + switch (x->gen.tag.type) { + case ALT : + dumpAlt((Alt *) x); + dumpAltChildren((Alt *) x); + break; + + case VECTOR : + fprintf(stderr, "\n"); + dumpVector(x->vec.vec); + break; + + case MATX : + dumpMatX((MatX *) x); + dumpReal1((Real) x->matX.x); + break; + + case TENXY : + dumpTenXY((TenXY *) x); + dumpReal1((Real) x->tenXY.x); + dumpReal1((Real) x->tenXY.y); + break; + + case SIGNX : + dumpSignX((SignX *) x); + dumpReal1(x->signX.x); + break; + + case DIGSX : + dumpDigsX((DigsX *) x); + dumpReal1(x->digsX.x); + break; + + case CLOSURE : + fprintf(stderr, "\n"); + break; + + default : + break; + } +} + +static void +clearDumpedFlag(Real x) +{ + int i; + + if (x == NULL) + return; + + if (x->gen.tag.dumped == FALSE) + return; + + x->gen.tag.dumped = FALSE; + + switch (x->gen.tag.type) { + case ALT : + for (i = 0; i < x->alt.numGE; i++) + if (x->alt.GE[i].guard != NULL) + clearDumpedFlag(x->alt.GE[i].x); + break; + case VECTOR : + break; + case MATX : + clearDumpedFlag((Real) x->matX.x); + break; + case TENXY : + clearDumpedFlag((Real) x->tenXY.x); + clearDumpedFlag((Real) x->tenXY.y); + break; + case SIGNX : + clearDumpedFlag(x->signX.x); + break; + case DIGSX : + clearDumpedFlag(x->digsX.x); + break; + case CLOSURE : + break; + default : + break; + } +} + +void +dumpBool(Bool b) +{ + if (b == NULL) + return; + + fprintf(stderr, "%x ", (unsigned) b); + dumpTag(b->gen.tag); + + switch (b->gen.tag.type) { + case PREDX : + dumpPredX((PredX *) b); + dumpReal(b->predX.x); + break; + case BOOLX : + dumpBoolX((BoolX *) b); + dumpBool(b->boolX.x); + break; + case BOOLXY : + dumpBoolXY((BoolXY *) b); + dumpBool(b->boolXY.x); + dumpBool(b->boolXY.y); + break; + default : + break; + } +} + diff --git a/ic-reals-6.3/base/emitDigit.c b/ic-reals-6.3/base/emitDigit.c new file mode 100644 index 0000000..50e0439 --- /dev/null +++ b/ic-reals-6.3/base/emitDigit.c @@ -0,0 +1,560 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This is the algorithm for emitting digits from vectors, matrices and + * tensors. The naive algorithm is to try each digit in turn. This means + * given an LFT, L, then for each digit D, we compute inv(D) * L and + * see if the result is refining (all entries positive). This is hopelessly + * inefficient. A better way is to assume that L is initially refining + * and then see for which digits the property is preserved. + * + * The objective with the emission algorithm is to decide which digit(s) if + * any can be emitted and to compute the residual LFT. + * + * The algorithm works with vectors. Given a vector we determine in which + * digit interval it falls: D_{1} = [0,1], D_0 = [1/3,3] and D_{+1} = + * [1,infty]. For matrices and tensors, this can be done column by column + * and then merge sort the list of digits. See my ``Notes on sign and + * digit emission'' from April 98 for further details. + + * The algorithm makes extensive use of continuations. This way we + * have postpone the expensive comparisons and residual calculations + * until needed. + + * Strictly speaking we don't need a functional continuation. There are + * only a few options so we could do with just an integer to hold the + * current state. But continuations are nicer. + */ + +/* + * For the purposes of this file, digits are assigned numbers so as to + * be ordered in such a way that a merge of digit streams prefers + * Dpos and Dneg over Dzero + */ + +typedef enum {_DPOS = 0, _DNEG = 1, _DZERO = 2} _Digit; + +#define ConvertDigit(x) (((x)==_DPOS) ? DPOS : (((x)==_DNEG) ? DNEG : DZERO)) + +typedef struct VS { + mpz_t *v; /* the original vector */ + struct TE *e; + mpz_t three_a; /* 3 * a */ + mpz_t three_b; /* 3 * b */ +} VecState; + +typedef struct TE { + _Digit digit; + void (*residual)(struct VS *); /* the function to compute the residual */ + bool (*next)(struct VS *); /* computes next digit in the sequence */ +} TblEntry; + +typedef struct { + VecState *vs0; + VecState *vs1; +} MatState; + +static bool digitFromVector(VecState *); +static bool digitFromMatrix(MatState *); +static bool digitFromTensor(); + +static VecState vs0, vs1, vs2, vs3; + +static MatState ms0 = {&vs0, &vs1}; +static MatState ms1 = {&vs2, &vs3}; + +static mpz_t tmp_z; + +static TblEntry tStart = {99, NULL, digitFromVector}; + +void +initEmitDigit(void) +{ + mpz_init(vs0.three_a); + mpz_init(vs0.three_b); + + mpz_init(vs1.three_a); + mpz_init(vs1.three_b); + + mpz_init(vs2.three_a); + mpz_init(vs2.three_b); + + mpz_init(vs3.three_a); + mpz_init(vs3.three_b); + + mpz_init(tmp_z); +} + +bool +validVector(Vector vec) +{ + int c0 = mpz_sgn(vec[0]); + int c1 = mpz_sgn(vec[1]); + + if (c0 >= 0 && c1 >= 0) + return TRUE; + else + return FALSE; +} + +bool +validMatrix(Matrix mat) +{ + return validVector(mat[0]) && validVector(mat[1]); +} + +bool +validTensor(Tensor ten) +{ + return validVector(ten[0]) && validVector(ten[1]) + && validVector(ten[2]) && validVector(ten[3]); +} + +/* + * This function returns a bool to indicate if a digit has been + * found. The digit itself is placed in the space indicated by the + * second argument. This also includes the continuation for computing + * the remaining digits. + */ +bool +emitDigitFromVector(Vector v, Digit *d) +{ + vs0.v = v; + if (digitFromVector(&vs0)) { + (*vs0.e->residual)(&vs0); + *d = ConvertDigit(vs0.e->digit); +#ifdef TRACE + if (!validVector(v)) { + printf("emitDigitFromVector: bad vector, digit=%d\n", *d); + dumpVector(v); + Error(FATAL, E_INT, "emitDigitFromVector", "bad vector"); + } +#endif + return TRUE; + } + else + return FALSE; +} + +bool +emitDigitFromMatrix(Matrix m, Digit *d) +{ +#ifdef TRACE + if (!validMatrix(m)) { + dumpMatrix(m); + Error(FATAL, E_INT, "emitDigitFromMatrix", "bad matrix (1)"); + } +#endif + + vs0.v = m[0]; + vs0.e = &tStart; + vs1.v = m[1]; + vs1.e = &tStart; + + if (digitFromMatrix(&ms0)) { + (*vs0.e->residual)(&vs0); + (*vs1.e->residual)(&vs1); + *d = ConvertDigit(vs0.e->digit); +#ifdef TRACE + if (!validMatrix(m)) { + printf("emitDigitFromMatrix: bad matrix, digit=%d\n", *d); + dumpMatrix(m); + Error(FATAL, E_INT, "emitDigitFromMatrix", "bad matrix (2)"); + } +#endif + return TRUE; + } else + return FALSE; +} + +bool +emitDigitFromTensor(Tensor t, Digit *d) +{ +#ifdef TRACE + if (!validTensor(t)) { + dumpTensor(t); + Error(FATAL, E_INT, "emitDigitFromTensor", "bad tensor (1)"); + } +#endif + + vs0.v = t[0]; + vs0.e = &tStart; + vs1.v = t[1]; + vs1.e = &tStart; + vs2.v = t[2]; + vs2.e = &tStart; + vs3.v = t[3]; + vs3.e = &tStart; + + if (digitFromTensor(d)) { + (*vs0.e->residual)(&vs0); + (*vs1.e->residual)(&vs1); + (*vs2.e->residual)(&vs2); + (*vs3.e->residual)(&vs3); + *d = ConvertDigit(vs0.e->digit); +#ifdef TRACE + if (!validTensor(t)) { + printf("emitDigitFromTensor: bad tensor, digit=%d\n", *d); + dumpTensor(t); + Error(FATAL, E_INT, "emitDigitFromTensor", "bad tensor (2)"); + } +#endif + return TRUE; + } else + return FALSE; +} + +static bool +digitFromTensor() +{ + int flag; + TblEntry *e1, *e2; + + flag = digitFromMatrix(&ms0) && digitFromMatrix(&ms1); + while (flag) { + e1 = ms0.vs0->e; + e2 = ms1.vs0->e; + if (e1->digit == e2->digit) + return TRUE; + else { + if (e1->digit < e2->digit) + flag = digitFromMatrix(&ms0); + else + flag = digitFromMatrix(&ms1); + } + } + return FALSE; +} + +static bool +digitFromMatrix(MatState *ms) +{ + int flag; + TblEntry *e1, *e2; + + e1 = ms->vs0->e; + e2 = ms->vs1->e; + flag = (*e1->next)(ms->vs0) && (*e2->next)(ms->vs1); + while (flag) { + e1 = ms->vs0->e; + e2 = ms->vs1->e; + if (e1->digit == e2->digit) + return TRUE; + else { + if (e1->digit < e2->digit) + flag = (*e1->next)(ms->vs0); + else + flag = (*e2->next)(ms->vs1); + } + } + return FALSE; +} + +/* + * Functions prefixed c are comparisons. The suffixes e, g, l refer + * to equal, greater, or less than in the comparison between the two entries + * in a vector. + */ +static bool cFalse(VecState *); +static bool cee1(VecState *); +static bool cee2(VecState *); +static bool cgge1(VecState *); +static bool cgge2(VecState *); +static bool cggl(VecState *); +static bool cggg(VecState *); + +/* + * Functions prefixed r compute residuals. + */ +static void rNoOp(VecState *); +static void rgge1(VecState *); +static void rgge2(VecState *); +static void rgge3(VecState *); + +static void rggg(VecState *); +static void rggge(VecState *); +static void rgggl(VecState *); + +static void rggl(VecState *); +static void rggle(VecState *); +static void rgglg(VecState *); + +/* + * This table drives the search for digits. It corresponds to the + * table in ``Notes on sign and digit emission''. + */ +static TblEntry tee1 = {_DPOS, rNoOp, cee1}; +static TblEntry tee2 = {_DNEG, rNoOp, cee2}; +static TblEntry tee3 = {_DZERO, rNoOp, cFalse}; + +static TblEntry teg1 = {_DNEG, rNoOp, cFalse}; +static TblEntry tge1 = {_DPOS, rNoOp, cFalse}; + +static TblEntry tgge1 = {_DPOS, rgge1, cgge1}; +static TblEntry tgge2 = {_DNEG, rgge2, cgge2}; +static TblEntry tgge3 = {_DZERO, rgge3, cFalse}; + +static TblEntry tggg = {_DPOS, rggg, cggg}; +static TblEntry tggge = {_DZERO, rggge, cFalse}; +static TblEntry tgggl = {_DZERO, rgggl, cFalse}; + +static TblEntry tggl = {_DNEG, rggl, cggl}; +static TblEntry tggle = {_DZERO, rggle, cFalse}; +static TblEntry tgglg = {_DZERO, rgglg, cFalse}; + +static bool +digitFromVector(VecState *vs) +{ + int sign_a, sign_b; + int tmp; + + sign_a = mpz_sgn(vs->v[0]); + sign_b = mpz_sgn(vs->v[1]); + switch (sign_a) { + case 0 : + switch (sign_b) { + case 0 : /* a == 0, b == 0 */ + return FALSE; + break; + case 1 : /* a == 0, b > 0 */ + vs->e = &teg1; + return TRUE; + break; + case -1 : + return FALSE; + break; + default : + Error(FATAL,E_INT,"digitFromVector", + "bad value returned by mpz_sgn"); + break; + } + break; + case 1 : + switch (sign_b) { + case 0 : /* a > 0, b == 0 */ + vs->e = &tge1; + return TRUE; + break; + case 1 : + tmp = mpz_cmp(vs->v[0],vs->v[1]); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a > 0, b > 0, a == b */ + vs->e = &tgge1; + return TRUE; + break; + case 1 : /* a > b, b > 0, a > b */ + vs->e = &tggg; + return TRUE; + break; + case -1 : /* a > b, b > 0, a < b */ + vs->e = &tggl; + return TRUE; + break; + } + break; + case -1 : + return FALSE; + break; + default : + Error(FATAL,E_INT,"digitFromVector", + "bad value returned by mpz_sgn"); + return FALSE; + break; + } + break; + case -1 : + return FALSE; + break; + default : + Error(FATAL,E_INT,"digitFromVector","bad value returned by mpz_sgn"); + return FALSE; + break; + } + return FALSE; +} + +static bool +cFalse(VecState *vs) +{ + return FALSE; +} + +static bool +cee1(VecState *vs) +{ + vs->e = &tee2; + return TRUE; +} + +static bool +cee2(VecState *vs) +{ + vs->e = &tee3; + return TRUE; +} + +static bool +cgge1(VecState *vs) +{ + vs->e = &tgge2; + return TRUE; +} + +static bool +cgge2(VecState *vs) +{ + vs->e = &tgge3; + return TRUE; +} + +static void +rNoOp(VecState *vs) +{ +} + +static void +rgge1(VecState *vs) +{ + mpz_set_ui(vs->v[0], (unsigned long) 0); + mpz_mul_2exp(vs->v[1], vs->v[1], 1); +} + +static void +rgge2(VecState *vs) +{ + mpz_set_ui(vs->v[1], (unsigned long) 0); + mpz_mul_2exp(vs->v[0], vs->v[0], 1); +} + +static void +rgge3(VecState *vs) +{ + mpz_mul_2exp(vs->v[0], vs->v[0], 1); + mpz_mul_2exp(vs->v[1], vs->v[1], 1); +} + +static bool +cggg(VecState *vs) +{ + int tmp; + + mpz_mul_ui(vs->three_b, vs->v[1], (unsigned long) 3); + tmp = mpz_cmp(vs->v[0], vs->three_b); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a > 0, b > 0, a > b, a = 3b */ + vs->e = &tggge; + return TRUE; + break; + case 1 : + return FALSE; + break; + case -1 : + vs->e = &tgggl; + return TRUE; + break; + default: + return FALSE; + break; + } +} + +static void +rggg(VecState *vs) +{ + mpz_set(tmp_z, vs->v[1]); + mpz_sub(vs->v[0], vs->v[0], vs->v[1]); + mpz_mul_2exp(vs->v[1], tmp_z, 1); +} + +static void +rgggl(VecState *vs) +{ + mpz_set(tmp_z, vs->v[0]); + mpz_mul_ui(vs->three_a, vs->v[0], (unsigned long) 3); + mpz_sub(vs->v[0], vs->three_a, vs->v[1]); + mpz_sub(vs->v[1], vs->three_b, tmp_z); +} + +static void +rggge(VecState *vs) +{ + mpz_mul_2exp(vs->v[0], vs->v[1], (unsigned long) 3); + mpz_set_ui(vs->v[1], (unsigned long) 0); +} + +static bool +cggl(VecState *vs) +{ + int tmp; + + mpz_mul_ui(vs->three_a, vs->v[0], (unsigned long) 3); + tmp = mpz_cmp(vs->three_a, vs->v[1]); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a > 0, b > 0, a < b, 3a = b */ + vs->e = &tggle; + return TRUE; + break; + case 1 : + vs->e = &tgglg; + return TRUE; + break; + case -1 : + return FALSE; + break; + default: + return FALSE; + break; + } +} + +static void +rggl(VecState *vs) +{ + mpz_set(tmp_z, vs->v[0]); + mpz_sub(vs->v[1], vs->v[1], vs->v[0]); + mpz_mul_2exp(vs->v[0], tmp_z, 1); +} + +static void +rggle(VecState *vs) +{ + mpz_mul_2exp(vs->v[1], vs->v[0], (unsigned long) 3); + mpz_set_ui(vs->v[0], (unsigned long) 0); +} + + +static void +rgglg(VecState *vs) +{ + mpz_set(tmp_z, vs->v[1]); + mpz_mul_ui(vs->three_b, vs->v[1], (unsigned long) 3); + mpz_sub(vs->v[1], vs->three_b, vs->v[0]); + mpz_sub(vs->v[0], vs->three_a, tmp_z); +} + +#ifdef JUNK +(\Comp{a}{0}, \Comp{b}{0}, \Comp{a}{b}, \Comp{3a}{b}, \Comp{a}{3b}) +(=,=,\square,\square,\square) & [(\Dpos, (0,0)), +\Dneg, (0,0)), +(\Dzero, (0,0))] \\ +(=,>,\square,\square,\square) & [(\Dneg, (0,b))] \\ +(>,=,\square,\square,\square) & [(\Dpos, (a,0))] \\ +(>,>,=,\square,\square) & [(\Dpos, (0, 2b)), (\Dneg, (2a, 0)), (\Dzero, (2a, 2a) +)] \\ +(>,>,>,<,\square) & [(\Dpos, (a-b, 2b)), (\Dzero, (3a-b, 3b-a))] \\ +(>,>,>,>,\square) & [(\Dpos, (a-b, 2b))] \\ +(>,>,>,=,\square) & [(\Dpos, (2b,2b)), (\Dzero, (8b,0))]\\ +(>,>,<,\square,<) & [(\Dneg, (2a, b-a))] \\ +(>,>,<,\square,>) & [(\Dneg, (2a, b-a)), (\Dzero, (3a-b, 3b-a))] \\ +(>,>,<,\square,=) & [(\Dneg, (2a, 2a)), (\Dzero, (0, 8a))] +#endif diff --git a/ic-reals-6.3/base/emitSign.c b/ic-reals-6.3/base/emitSign.c new file mode 100644 index 0000000..d25aa03 --- /dev/null +++ b/ic-reals-6.3/base/emitSign.c @@ -0,0 +1,618 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This file deals with emitting signs from LFTs. The algorithm is similar + * to digit emission. See ``Notes on sign and digit emission'' for details. + */ + +/* + * This version of emitSign favours SZERO over all other signs. This + * is because most of the analytic functions prefer SZERO. + */ +typedef struct TE { + Sign sign; + Comparison compare; + void (*residual)(Vector); /* the function to compute the residual */ + struct TE *next; /* computes next entry in the sequence */ +} TblEntry; + +static bool mergeTwoLists(TblEntry **, TblEntry **, Comparison *); +static bool mergeFourLists(TblEntry **, TblEntry **, TblEntry **, TblEntry **); +static TblEntry *setList(Vector); + +static mpz_t tmp_z; + +/* + * Functions prefixed with 'r' compute the residual vectors. This is done + * "in-place". By this we mean that once we have decided that a sign 's' + * can be emitted from a vector 'v', then we overwrite 'v' with residual + * after 's' is emitted. + */ + +static void rNoOp(Vector); + +#define rgg rNoOp +#define regSPOS rNoOp +#define rgeSPOS rNoOp + +static void regSNEG(Vector); +static void regSZERO(Vector); +static void relSPOS(Vector); +static void relSNEG(Vector); +static void relSZERO(Vector); +static void rgeSNEG(Vector); +static void rgeSINF(Vector); +static void rleSPOS(Vector); +static void rleSNEG(Vector); +static void rleSINF(Vector); +static void rggeSZERO(Vector); +static void rggeSINF(Vector); +static void rgggSINF(Vector); +static void rgglSZERO(Vector); +static void rll(Vector); +static void rlleSZERO(Vector); +static void rlleSINF(Vector); +static void rllgSZERO(Vector); +static void rlllSINF(Vector); +static void rgl(Vector); +static void rgleSZERO(Vector); +static void rgleSINF(Vector); +static void rglgSZERO(Vector); +static void rgllSINF(Vector); +static void rlg(Vector); +static void rlgeSZERO(Vector); +static void rlgeSINF(Vector); +static void rlggSINF(Vector); +static void rlglSZERO(Vector); + +static TblEntry tee4 = {SNEG, EQ, rNoOp, NULL}; +static TblEntry tee3 = {SPOS, EQ, rNoOp, &tee4}; +static TblEntry tee2 = {SINF, EQ, rNoOp, &tee3}; +static TblEntry tee1 = {SZERO, EQ, rNoOp, &tee2}; + +static TblEntry teg3 = {SNEG, GT, regSNEG, NULL}; +static TblEntry teg2 = {SPOS, GT, regSPOS, &teg3}; +static TblEntry teg1 = {SZERO, GT, regSZERO, &teg2}; + +static TblEntry tel3 = {SNEG, LT, relSNEG, NULL}; +static TblEntry tel2 = {SPOS, LT, relSPOS, &tel3}; +static TblEntry tel1 = {SZERO, LT, relSZERO, &tel2}; + +static TblEntry tge3 = {SNEG, LT, rgeSNEG, NULL}; +static TblEntry tge2 = {SPOS, GT, rgeSPOS, &tge3}; +static TblEntry tge1 = {SINF, GT, rgeSINF, &tge2}; + +static TblEntry tle3 = {SNEG, GT, rleSNEG, NULL}; +static TblEntry tle2 = {SPOS, LT, rleSPOS, &tle3}; +static TblEntry tle1 = {SINF, LT, rleSINF, &tle2}; + +static TblEntry tgge3 = {SPOS, GT, rgg, NULL}; +static TblEntry tgge2 = {SINF, GT, rggeSINF, &tgge3}; +static TblEntry tgge1 = {SZERO, GT, rggeSZERO, &tgge2}; + +static TblEntry tggg2 = {SPOS, GT, rgg, NULL}; +static TblEntry tggg1 = {SINF, GT, rgggSINF, &tggg2}; + +static TblEntry tggl2 = {SPOS, GT, rgg, NULL}; +static TblEntry tggl1 = {SZERO, GT, rgglSZERO, &tggl2}; + +static TblEntry tlle3 = {SPOS, LT, rll, NULL}; +static TblEntry tlle2 = {SINF, LT, rlleSINF, &tlle3}; +static TblEntry tlle1 = {SZERO, LT, rlleSZERO, &tlle2}; + +static TblEntry tllg2 = {SPOS, LT, rll, NULL}; +static TblEntry tllg1 = {SZERO, LT, rllgSZERO, &tllg2}; + +static TblEntry tlll2 = {SPOS, LT, rll, NULL}; +static TblEntry tlll1 = {SINF, LT, rlllSINF, &tlll2}; + +static TblEntry tgle3 = {SNEG, LT, rgl, NULL}; +static TblEntry tgle2 = {SINF, GT, rgleSINF, &tgle3}; +static TblEntry tgle1 = {SZERO, LT, rgleSZERO, &tgle2}; + +static TblEntry tglg2 = {SNEG, LT, rgl, NULL}; +static TblEntry tglg1 = {SZERO, LT, rglgSZERO, &tglg2}; + +static TblEntry tgll2 = {SNEG, LT, rgl, NULL}; +static TblEntry tgll1 = {SINF, GT, rgllSINF, &tgll2}; + +static TblEntry tlge3 = {SNEG, GT, rlg, NULL}; +static TblEntry tlge2 = {SINF, LT, rlgeSINF, &tlge3}; +static TblEntry tlge1 = {SZERO, GT, rlgeSZERO, &tlge2}; + +static TblEntry tlgg2 = {SNEG, GT, rlg, NULL}; +static TblEntry tlgg1 = {SINF, LT, rlggSINF, &tlgg2}; + +static TblEntry tlgl2 = {SNEG, GT, rlg, NULL}; +static TblEntry tlgl1 = {SZERO, GT, rlglSZERO, &tlgl2}; + +void +initEmitSign(void) +{ + mpz_init(tmp_z); +} + +bool +emitSignFromVector(Vector v, Sign *s) +{ + TblEntry *e; + + if ((e = setList(v)) != NULL) { + (e->residual)(v); + *s = e->sign; +#ifdef TRACE + if (TRACE && !validVector(v)) { + printf("emitSignFromVector: bad vector, sign=%d\n", *s); + dumpVector(v); + Error(FATAL, E_INT, "emitSignFromVector", "bad vector"); + } +#endif + return TRUE; + } else + return FALSE; +} + +bool +emitSignFromMatrix(Matrix m, Sign *s) +{ + TblEntry *e0, *e1; + Comparison comp; /* not used */ + + e0 = setList(m[0]); + e1 = setList(m[1]); + + if (mergeTwoLists(&e0, &e1, &comp)) { + (e0->residual)(m[0]); + (e1->residual)(m[1]); + *s = e0->sign; +#ifdef TRACE + if (TRACE && !validMatrix(m)) { + printf("emitSignFromMatrix: bad matrix, sign=%d\n", *s); + dumpMatrix(m); + Error(FATAL, E_INT, "emitSignFromMatrix", "bad matrix"); + } +#endif + return TRUE; + } else + return FALSE; +} + +bool +emitSignFromTensor(Tensor t, Sign *s) +{ + TblEntry *e0, *e1, *e2, *e3; + + e0 = setList(t[0]); + e1 = setList(t[1]); + e2 = setList(t[2]); + e3 = setList(t[3]); + + if (mergeFourLists(&e0, &e1, &e2, &e3)) { + (e0->residual)(t[0]); + (e1->residual)(t[1]); + (e2->residual)(t[2]); + (e3->residual)(t[3]); + *s = e0->sign; +#ifdef TRACE + if (TRACE && !validTensor(t)) { + printf("emitSignFromTensor: bad tensor, sign=%d\n", *s); + dumpTensor(t); + Error(FATAL, E_INT, "emitSignFromTensor", "bad tensor"); + } +#endif + return TRUE; + } else + return FALSE; +} + +static bool +mergeFourLists(TblEntry **e0, TblEntry **e1, TblEntry **e2, TblEntry **e3) +{ + bool flag; + Comparison compLeft, compRight; + + flag = mergeTwoLists(e0, e1, &compLeft) + && mergeTwoLists(e2, e3, &compRight); + + while (flag) { + if ((*e0)->sign == (*e2)->sign) { + if (compLeft == compRight || compLeft == EQ || compRight == EQ) + return TRUE; + else { + *e0 = (*e0)->next; + *e1 = (*e1)->next; + *e2 = (*e2)->next; + *e3 = (*e3)->next; + flag = mergeTwoLists(e0, e1, &compLeft) + && mergeTwoLists(e2, e3, &compRight); + } + } + else { + if ((*e0)->sign < (*e2)->sign) { + *e0 = (*e0)->next; + *e1 = (*e1)->next; + flag = mergeTwoLists(e0, e1, &compLeft); + } + else { + *e2 = (*e2)->next; + *e3 = (*e3)->next; + flag = mergeTwoLists(e2, e3, &compRight); + } + } + } + return FALSE; +} + +static bool +mergeTwoLists(TblEntry **e0, TblEntry **e1, Comparison *comp) +{ + while (*e0 != NULL && *e1 != NULL) { + if ((*e0)->sign == (*e1)->sign) { + if ((*e0)->compare == (*e1)->compare) { + *comp = (*e0)->compare; + return TRUE; + } + else { + if ((*e0)->compare == EQ) { + *comp = (*e1)->compare; /* must be GT or LT */ + return TRUE; + } + else { + if ((*e1)->compare == EQ) { + *comp = (*e0)->compare; /* must be GT or LT */ + return TRUE; + } + else { /* one is LT and the other GT */ + *e0 = (*e0)->next; + *e1 = (*e1)->next; + } + } + } + } + else { + if ((*e0)->sign < (*e1)->sign) + *e0 = (*e0)->next; + else + *e1 = (*e1)->next; + } + } + return FALSE; +} + +/* + * Given a vector, this function returns a pointer to the table entry (a list) + * which classifies the vector in terms of what signs can be emitted for + * that vector. + */ +static TblEntry * +setList(Vector v) +{ + int sign_a, sign_b; + int tmp; + + sign_a = mpz_sgn(v[0]); + sign_b = mpz_sgn(v[1]); + switch (sign_a) { + case 0 : + switch (sign_b) { + case 0 : /* a == 0, b == 0 */ + return &tee1; + case 1 : /* a == 0, b > 0 */ + return &teg1; + case -1 : /* a == 0, b < 0 */ + return &tel1; + default : + Error(FATAL,E_INT,"signFromVector", + "bad value returned by mpz_sgn"); + return NULL; + } + break; + case 1 : + switch (sign_b) { + case 0 : /* a > 0, b == 0 */ + return &tge1; + + case 1 : /* a > 0, b > 0 */ + tmp = mpz_cmp(v[0], v[1]); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a > 0, b > 0, a == b */ + return &tgge1; + case 1 : /* a > b, b > 0, a > b */ + return &tggg1; + case -1 : /* a > b, b > 0, a < b */ + return &tggl1; + } + break; + + case -1 : /* a > 0, b < 0 */ + /* it is faster to negate a twice */ + mpz_neg(v[0], v[0]); + tmp = mpz_cmp(v[0], v[1]); + mpz_neg(v[0], v[0]); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a > 0, b < 0, -a == b */ + return &tgle1; + case 1 : /* a > b, b < 0, -a > b */ + return &tglg1; + case -1 : /* a > b, b < 0, -a < b */ + return &tgll1; + } + break; + + default : + Error(FATAL,E_INT,"signFromVector", + "bad value returned by mpz_sgn"); + return NULL; + } + break; + + case -1 : + switch (sign_b) { + case 0 : /* a < 0, b == 0 */ + return &tle1; + case 1 : /* a < 0, b > 0 */ + /* it is faster to negate a twice */ + mpz_neg(v[0], v[0]); + tmp = mpz_cmp(v[0], v[1]); + mpz_neg(v[0], v[0]); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a < 0, b > 0, -a == b */ + return &tlge1; + case 1 : /* a < b, b > 0, -a > b */ + return &tlgg1; + case -1 : /* a < b, b > 0, -a < b */ + return &tlgl1; + } + break; + + case -1 : /* a < 0, b < 0 */ + tmp = mpz_cmp(v[0], v[1]); + switch (MPZ_SIGN(tmp)) { + case 0 : /* a < 0, b < 0, a == b */ + return &tlle1; + case 1 : /* a < b, b < 0, a > b */ + return &tllg1; + case -1 : /* a < b, b < 0, a < b */ + return &tlll1; + } + break; + + default : + Error(FATAL,E_INT,"signFromVector", + "bad value returned by mpz_sgn"); + return NULL; + } + break; + + default : + Error(FATAL,E_INT,"signFromVector","bad value returned by mpz_sgn"); + return NULL; + } + return NULL; +} + +static void +rNoOp(Vector v) +{ +} + +static void +regSNEG(Vector v) +{ + MPZ_SWAP(v[0], v[1]); +} + +static void +regSZERO(Vector v) +{ + mpz_set(v[0], v[1]); +} + +static void +relSPOS(Vector v) +{ + mpz_neg(v[1], v[1]); +} + +static void +relSNEG(Vector v) +{ + mpz_neg(v[1], v[1]); + MPZ_SWAP(v[0], v[1]); +} + +static void +relSZERO(Vector v) +{ + mpz_neg(v[1], v[1]); + mpz_set(v[0], v[1]); +} + +static void +rgeSNEG(Vector v) +{ + MPZ_SWAP(v[0], v[1]); +} + +static void +rgeSINF(Vector v) +{ + mpz_set(v[1], v[0]); +} + +static void +rleSPOS(Vector v) +{ + mpz_neg(v[0], v[0]); +} + +static void +rleSNEG(Vector v) +{ + mpz_neg(v[0], v[0]); + MPZ_SWAP(v[0], v[1]); +} + +static void +rleSINF(Vector v) +{ + mpz_neg(v[0], v[0]); + mpz_set(v[1], v[0]); +} + +static void +rggeSZERO(Vector v) +{ + mpz_mul_2exp(v[0], v[0], (unsigned long) 1); + mpz_set_ui(v[1], (unsigned long) 0); +} + +static void +rggeSINF(Vector v) +{ + mpz_mul_2exp(v[1], v[0], (unsigned long) 1); + mpz_set_ui(v[0], (unsigned long) 0); +} + +static void +rgggSINF(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_sub(v[0], v[0], v[1]); + mpz_add(v[1], tmp_z, v[1]); +} + +static void +rgglSZERO(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_add(v[0], v[0], v[1]); + mpz_sub(v[1], v[1], tmp_z); +} + +static void +rll(Vector v) +{ + mpz_neg(v[0], v[0]); + mpz_neg(v[1], v[1]); +} + +static void +rlleSZERO(Vector v) +{ + mpz_neg(v[0], v[0]); + mpz_mul_2exp(v[0], v[0], (unsigned long) 1); + mpz_set_ui(v[1], (unsigned long) 0); +} + +static void +rlleSINF(Vector v) +{ + mpz_neg(v[0], v[0]); + mpz_mul_2exp(v[1], v[0], (unsigned long) 1); + mpz_set_ui(v[0], (unsigned long) 0); +} + +static void +rllgSZERO(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_add(v[0], v[0], v[1]); + mpz_neg(v[0], v[0]); + mpz_sub(v[1], tmp_z, v[1]); +} + +static void +rlllSINF(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_sub(v[0], v[1], v[0]); + mpz_add(v[1], tmp_z, v[1]); + mpz_neg(v[1], v[1]); +} + +static void +rgl(Vector v) +{ + mpz_neg(v[1], v[1]); + MPZ_SWAP(v[0], v[1]); +} + +static void +rgleSZERO(Vector v) +{ + mpz_mul_2exp(v[1], v[0], (unsigned long) 1); + mpz_set_ui(v[0], (unsigned long) 0); +} + +static void +rgleSINF(Vector v) +{ + mpz_mul_2exp(v[0], v[0], (unsigned long) 1); + mpz_set_ui(v[1], (unsigned long) 0); +} + +static void +rglgSZERO(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_add(v[0], v[0], v[1]); + mpz_neg(v[0], v[0]); + mpz_sub(v[1], tmp_z, v[1]); /* - (b - a) */ +} + +static void +rgllSINF(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_sub(v[0], v[0], v[1]); + mpz_add(v[1], tmp_z, v[1]); +} + +static void +rlg(Vector v) +{ + mpz_neg(v[0], v[0]); + MPZ_SWAP(v[0], v[1]); +} + +static void +rlgeSZERO(Vector v) +{ + mpz_mul_2exp(v[1], v[1], (unsigned long) 1); + mpz_set_ui(v[0], (unsigned long) 0); +} + +static void +rlgeSINF(Vector v) +{ + mpz_mul_2exp(v[0], v[1], (unsigned long) 1); + mpz_set_ui(v[1], (unsigned long) 0); +} + +static void +rlggSINF(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_sub(v[0], v[1], v[0]); + mpz_add(v[1], tmp_z, v[1]); + mpz_neg(v[1], v[1]); +} + +static void +rlglSZERO(Vector v) +{ + mpz_set(tmp_z, v[0]); + mpz_add(v[0], v[0], v[1]); + mpz_sub(v[1], v[1], tmp_z); +} diff --git a/ic-reals-6.3/base/epsDel.c b/ic-reals-6.3/base/epsDel.c new file mode 100644 index 0000000..3f4fe08 --- /dev/null +++ b/ic-reals-6.3/base/epsDel.c @@ -0,0 +1,133 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Functions dealing with the epsilon-delta analysis for matrices and + * tensors. + */ + +/* +static mpz_t vec0_sum, vec1_sum, vec2_sum, vec3_sum; +*/ + +#define vec0_sum tmpc_z +#define vec1_sum tmpd_z +#define vec2_sum tmpe_z +#define vec3_sum tmpf_z + +static int EpsDelVectorPair(Vector, Vector, mpz_t, mpz_t, int); + +void +initEpsDel() +{ +/* + * These aren't needed anymore as temporary storage is shared amongst + * the entire library + * + mpz_init(vec0_sum); + mpz_init(vec1_sum); + mpz_init(vec2_sum); + mpz_init(vec3_sum); +*/ +} + +/* + * Given a matrix and an epsilon (number of digits needed), this returns + * the number of digits the matrix must consume from its argument + */ +int +epsDelMatrix(Matrix mat, int epsilon) +{ + mpz_add(vec0_sum, mat[0][0], mat[0][1]); + mpz_add(vec1_sum, mat[1][0], mat[1][1]); + return EpsDelVectorPair(mat[0], mat[1], vec0_sum, vec1_sum, epsilon); +} + +/* + * As for matrices above, but this gives the number of digits needed from + * the two arguments of a tensor. + */ +void +epsDelTensor(Tensor ten, int epsilon, int *nLeft, int *nRight) +{ + int r, s, p, q; + + mpz_add(vec0_sum, ten[0][0], ten[0][1]); + mpz_abs(vec0_sum, vec0_sum); + mpz_add(vec1_sum, ten[1][0], ten[1][1]); + mpz_abs(vec1_sum, vec1_sum); + mpz_add(vec2_sum, ten[2][0], ten[2][1]); + mpz_abs(vec2_sum, vec2_sum); + mpz_add(vec3_sum, ten[3][0], ten[3][1]); + mpz_abs(vec3_sum, vec3_sum); + + r = EpsDelVectorPair(ten[0], ten[2], vec0_sum, vec2_sum, epsilon); + s = EpsDelVectorPair(ten[1], ten[3], vec1_sum, vec3_sum, epsilon); + p = EpsDelVectorPair(ten[0], ten[1], vec0_sum, vec1_sum, epsilon); + q = EpsDelVectorPair(ten[2], ten[3], vec2_sum, vec3_sum, epsilon); + + *nLeft = MIN(r,s); + *nRight = MIN(p,q); +} + +/* + * As above for tensors, but we are interested only in the number + * of arguments needed from the x (left) argument. + */ +int +epsDelTensorX(Tensor ten, int epsilon) +{ + int r, s; + + mpz_add(vec0_sum, ten[0][0], ten[0][1]); + mpz_abs(vec0_sum, vec0_sum); + mpz_add(vec1_sum, ten[1][0], ten[1][1]); + mpz_abs(vec1_sum, vec1_sum); + mpz_add(vec2_sum, ten[2][0], ten[2][1]); + mpz_abs(vec2_sum, vec2_sum); + mpz_add(vec3_sum, ten[3][0], ten[3][1]); + mpz_abs(vec3_sum, vec3_sum); + + r = EpsDelVectorPair(ten[0], ten[2], vec0_sum, vec2_sum, epsilon); + s = EpsDelVectorPair(ten[1], ten[3], vec1_sum, vec3_sum, epsilon); + + return MIN(r,s); +} + +static int +EpsDelVectorPair(Vector vec0, Vector vec1, + mpz_t vec0_sum, + mpz_t vec1_sum, + int epsilon) +{ + int logdet, logalsq, bitcount; + + mpz_mul(tmpa_z, vec0[0], vec1[1]); + mpz_mul(tmpb_z, vec0[1], vec1[0]); + mpz_sub(tmpa_z, tmpa_z, tmpb_z); + mpz_abs(tmpa_z, tmpa_z); + logdet = mpz_sizeinbase(tmpa_z, 2); + + if (mpz_cmp(vec0_sum, vec1_sum) >= 0) { + bitcount = mpz_popcount(vec0_sum); + mpz_mul(tmpa_z, vec0_sum, vec0_sum); + } + else { + bitcount = mpz_popcount(vec1_sum); + mpz_mul(tmpa_z, vec1_sum, vec1_sum); + } + logalsq = mpz_sizeinbase(tmpa_z, 2); + if (bitcount == 1) + return epsilon + logdet - logalsq; + else + return epsilon + logdet - logalsq - 1; +} diff --git a/ic-reals-6.3/base/error.c b/ic-reals-6.3/base/error.c new file mode 100644 index 0000000..07de0e3 --- /dev/null +++ b/ic-reals-6.3/base/error.c @@ -0,0 +1,66 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include <stdarg.h> +#include <string.h> +#include <errno.h> + +/* + * An application may choose to set this to a string giving the name + * of the program, typically argv[0]. + */ +char *MyName = NULL; + +/* + * Prints an error message + * Error(fatal, error_type, proc, fmt, arg1, arg2, ....) + * + * fatal = FATAL then we exit after printing a message + * error_type = E_SYS then perror or E_INT + * proc - a pointer to a string containing the name of the calling procedure + * fmt - format string for printf + * arg1... + */ +void +Error(int fatal, int error_type, char *proc, char *fmt, ...) +{ + va_list ap; + + if (MyName != NULL) + fprintf(stderr, "%s: ", MyName); + + if (fatal == FATAL) + fprintf(stderr, "fatal error: %s: ", proc); + else + fprintf(stderr, "%s: ", proc); + + va_start(ap, fmt); + vfprintf(stderr, fmt, ap); + va_end(ap); + + switch (error_type) { + case E_INT : + fprintf(stderr, "\n"); + break; + + case E_SYS : + perror(strerror(errno)); + break; + + default : + fprintf(stderr, "\n%s: %s: unknown error type: %d\n", + MyName, proc, error_type); + break; + } + + if (fatal == FATAL) + exit(1); +} diff --git a/ic-reals-6.3/base/forceFuncLookupTable.c b/ic-reals-6.3/base/forceFuncLookupTable.c new file mode 100644 index 0000000..7227d83 --- /dev/null +++ b/ic-reals-6.3/base/forceFuncLookupTable.c @@ -0,0 +1,399 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <search.h> +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * For debugging purposes we keep a table which describes each force method. + * The table maps a pointer to a function to a descriptor which gives a + * printable string for the function name and the number of arguments + * expected by the function. + */ + +void delayCont(); +void force_Alt_Eval(); +void force_From_Bool_X_Only_Cont(); +void force_From_Bool_X_Only_Entry(); +void force_From_Bool_Y_Only_Cont(); +void force_From_Bool_Y_Only_Entry(); +void forceGtEqZero_To_PredX_From_Alt_Cont(); +void forceGtEqZero_To_PredX_From_Alt_Entry(); +void forceGtEqZero_To_PredX_From_Cls_Cont(); +void forceGtEqZero_To_PredX_From_Cls_Entry(); +void forceGtEqZero_To_PredX_From_DigsX_SINF_Cont(); +void forceGtEqZero_To_PredX_From_DigsX_SINF_Entry(); +void forceGtEqZero_To_PredX_From_DigsX_SNEG_Cont(); +void forceGtEqZero_To_PredX_From_DigsX_SNEG_Entry(); +void forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont(); +void forceGtEqZero_To_PredX_From_DigsX_SZERO_Entry(); +void forceGtEqZero_To_PredX_From_MatX_Cont(); +void forceGtEqZero_To_PredX_From_MatX_Entry(); +void forceGtEqZero_To_PredX_From_MatX_Signed_Cont(); +void forceGtEqZero_To_PredX_From_MatX_Signed_Entry(); +void forceGtEqZero_To_PredX_From_SignX_Cont(); +void forceGtEqZero_To_PredX_From_SignX_Entry(); +void forceGtEqZero_To_PredX_From_TenXY(); +void forceGtZero_To_PredX_From_Alt_Cont(); +void forceGtZero_To_PredX_From_Alt_Entry(); +void forceGtZero_To_PredX_From_Cls_Cont(); +void forceGtZero_To_PredX_From_Cls_Entry(); +void forceGtZero_To_PredX_From_DigsX_SPOS_Cont(); +void forceGtZero_To_PredX_From_DigsX_SPOS_Entry(); +void forceGtZero_To_PredX_From_DigsX_SZERO_Cont(); +void forceGtZero_To_PredX_From_DigsX_SZERO_Entry(); +void forceGtZero_To_PredX_From_MatX_Cont(); +void forceGtZero_To_PredX_From_MatX_Entry(); +void forceGtZero_To_PredX_From_MatX_Signed_Cont(); +void forceGtZero_To_PredX_From_MatX_Signed_Entry(); +void forceGtZero_To_PredX_From_SignX_Cont(); +void forceGtZero_To_PredX_From_SignX_Entry(); +void forceGtZero_To_PredX_From_TenXY(); +void force_To_Alt_Cont(); +void force_To_Alt_Entry(); +void force_To_Alt_From_The_Abyss(); +void force_To_Alt_Reduce(); +void force_To_And_From_Bool_X_Cont(); +void force_To_And_From_Bool_X_Entry(); +void force_To_And_From_Bool_Y_Cont(); +void force_To_And_From_Bool_Y_Entry(); +void force_To_Bool_From_The_Abyss(); +void force_To_DigsX_From_Alt_Cont(); +void force_To_DigsX_From_Alt_Entry(); +void force_To_DigsX_From_Cls_Cont(); +void force_To_DigsX_From_Cls_Entry(); +void force_To_DigsX_From_DigsX_Cont(); +void force_To_DigsX_From_DigsX_Entry(); +void force_To_DigsX_From_MatX_Cont(); +void force_To_DigsX_From_MatX_Entry(); +void force_To_DigsX_From_TenXY_Cont(); +void force_To_DigsX_From_TenXY_Cont_X(); +void force_To_DigsX_From_TenXY_Entry(); +void force_To_DigsX_From_Vec(); +void force_To_MatX_From_Alt_Cont(); +void force_To_MatX_From_Alt_Entry(); +void force_To_MatX_From_Alt_Signed_Cont(); +void force_To_MatX_From_Alt_Signed_Entry(); +void force_To_MatX_From_Cls_Cont(); +void force_To_MatX_From_Cls_Entry(); +void force_To_MatX_From_Cls_Signed_Cont(); +void force_To_MatX_From_Cls_Signed_Entry(); +void force_To_MatX_From_DigsX_Cont(); +void force_To_MatX_From_DigsX_Entry(); +void force_To_MatX_From_DigsX_Signed(); +void force_To_MatX_From_MatX(); +void force_To_MatX_From_MatX_Signed_Cont(); +void force_To_MatX_From_MatX_Signed_Entry(); +void force_To_MatX_From_SignX_Cont(); +void force_To_MatX_From_SignX_Entry(); +void force_To_MatX_From_TenXY(); +void force_To_MatX_From_TenXY_Signed_Cont(); +void force_To_MatX_From_TenXY_Signed_Cont_X(); +void force_To_MatX_From_TenXY_Signed_Entry(); +void force_To_MatX_From_Vec(); +void force_To_MatX_From_Vec_Signed(); +void force_To_Not_From_Bool_Cont(); +void force_To_Not_From_Bool_Entry(); +void force_To_Or_From_Bool_X_Cont(); +void force_To_Or_From_Bool_X_Entry(); +void force_To_Or_From_Bool_Y_Cont(); +void force_To_Or_From_Bool_Y_Entry(); +void force_To_PredX_From_DigsX_2n_minus_1_False_Cont(); +void force_To_PredX_From_DigsX_2n_minus_1_False_Entry(); +void force_To_PredX_From_DigsX_2n_minus_1_True_Cont(); +void force_To_PredX_From_DigsX_2n_minus_1_True_Entry(); +void force_To_PredX_From_DigsX_minus_2n_minus_1_False_Cont(); +void force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry(); +void force_To_PredX_From_DigsX_minus_2n_minus_1_True_Cont(); +void force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry(); +void force_To_PredX_From_The_Abyss(); +void force_To_SignX_From_Alt_Cont(); +void force_To_SignX_From_Alt_Entry(); +void force_To_SignX_From_Cls_Cont(); +void force_To_SignX_From_Cls_Entry(); +void force_To_SignX_From_DigsX(); +void force_To_SignX_From_MatX_Cont(); +void force_To_SignX_From_MatX_Entry(); +void force_To_SignX_From_TenXY_Cont(); +void force_To_SignX_From_TenXY_Cont_X(); +void force_To_SignX_From_TenXY_Entry(); +void force_To_SignX_From_Vec(); +void force_To_TenXY_X_From_Alt_Cont(); +void force_To_TenXY_X_From_Alt_Entry(); +void force_To_TenXY_X_From_Alt_Signed_Cont(); +void force_To_TenXY_X_From_Alt_Signed_Entry(); +void force_To_TenXY_X_From_Cls_Cont(); +void force_To_TenXY_X_From_Cls_Entry(); +void force_To_TenXY_X_From_Cls_Signed_Cont(); +void force_To_TenXY_X_From_Cls_Signed_Entry(); +void force_To_TenXY_X_From_DigsX_Cont(); +void force_To_TenXY_X_From_DigsX_Entry(); +void force_To_TenXY_X_From_DigsX_Signed(); +void force_To_TenXY_X_From_MatX(); +void force_To_TenXY_X_From_MatX_Signed_Cont(); +void force_To_TenXY_X_From_MatX_Signed_Entry(); +void force_To_TenXY_X_From_SignX_Cont(); +void force_To_TenXY_X_From_SignX_Entry(); +void force_To_TenXY_X_From_TenXY(); +void force_To_TenXY_X_From_TenXY_Signed_Cont(); +void force_To_TenXY_X_From_TenXY_Signed_Cont_X(); +void force_To_TenXY_X_From_TenXY_Signed_Entry(); +void force_To_TenXY_X_From_Vec(); +void force_To_TenXY_X_From_Vec_Signed(); +void force_To_TenXY_X_Until_Refining(); +void force_To_TenXY_Y_From_Alt_Cont(); +void force_To_TenXY_Y_From_Alt_Entry(); +void force_To_TenXY_Y_From_Alt_Signed_Cont(); +void force_To_TenXY_Y_From_Alt_Signed_Entry(); +void force_To_TenXY_Y_From_Cls_Cont(); +void force_To_TenXY_Y_From_Cls_Entry(); +void force_To_TenXY_Y_From_Cls_Signed_Cont(); +void force_To_TenXY_Y_From_Cls_Signed_Entry(); +void force_To_TenXY_Y_From_DigsX_Cont(); +void force_To_TenXY_Y_From_DigsX_Entry(); +void force_To_TenXY_Y_From_DigsX_Signed(); +void force_To_TenXY_Y_From_MatX(); +void force_To_TenXY_Y_From_MatX_Signed_Cont(); +void force_To_TenXY_Y_From_MatX_Signed_Entry(); +void force_To_TenXY_Y_From_SignX_Cont(); +void force_To_TenXY_Y_From_SignX_Entry(); +void force_To_TenXY_Y_From_TenXY(); +void force_To_TenXY_Y_From_TenXY_Signed_Cont(); +void force_To_TenXY_Y_From_TenXY_Signed_Cont_X(); +void force_To_TenXY_Y_From_TenXY_Signed_Entry(); +void force_To_TenXY_Y_From_Vec(); +void force_To_TenXY_Y_From_Vec_Signed(); + +ForceFuncDesc descTable[] = { + {delayCont, "delayCont", 2, ARG_NEITHER}, + {force_Alt_Eval, "force_Alt_Eval", 2, ARG_NEITHER}, + {force_From_Bool_X_Only_Cont, "force_From_Bool_X_Only_Cont", 2, ARG_NEITHER}, + {force_From_Bool_X_Only_Entry, "force_From_Bool_X_Only_Entry", 2, ARG_NEITHER}, + {force_From_Bool_Y_Only_Cont, "force_From_Bool_Y_Only_Cont", 2, ARG_NEITHER}, + {force_From_Bool_Y_Only_Entry, "force_From_Bool_Y_Only_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_Alt_Cont, "forceGtEqZero_To_PredX_From_Alt_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_Alt_Entry, "forceGtEqZero_To_PredX_From_Alt_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_Cls_Cont, "forceGtEqZero_To_PredX_From_Cls_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_Cls_Entry, "forceGtEqZero_To_PredX_From_Cls_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_DigsX_SINF_Cont, "forceGtEqZero_To_PredX_From_DigsX_SINF_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_DigsX_SINF_Entry, "forceGtEqZero_To_PredX_From_DigsX_SINF_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_DigsX_SNEG_Cont, "forceGtEqZero_To_PredX_From_DigsX_SNEG_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_DigsX_SNEG_Entry, "forceGtEqZero_To_PredX_From_DigsX_SNEG_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont, "forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_DigsX_SZERO_Entry, "forceGtEqZero_To_PredX_From_DigsX_SZERO_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_MatX_Cont, "forceGtEqZero_To_PredX_From_MatX_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_MatX_Entry, "forceGtEqZero_To_PredX_From_MatX_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_MatX_Signed_Cont, "forceGtEqZero_To_PredX_From_MatX_Signed_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_MatX_Signed_Entry, "forceGtEqZero_To_PredX_From_MatX_Signed_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_SignX_Cont, "forceGtEqZero_To_PredX_From_SignX_Cont", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_SignX_Entry, "forceGtEqZero_To_PredX_From_SignX_Entry", 2, ARG_NEITHER}, + {forceGtEqZero_To_PredX_From_TenXY, "forceGtEqZero_To_PredX_From_TenXY", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_Alt_Cont, "forceGtZero_To_PredX_From_Alt_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_Alt_Entry, "forceGtZero_To_PredX_From_Alt_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_Cls_Cont, "forceGtZero_To_PredX_From_Cls_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_Cls_Entry, "forceGtZero_To_PredX_From_Cls_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_DigsX_SPOS_Cont, "forceGtZero_To_PredX_From_DigsX_SPOS_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_DigsX_SPOS_Entry, "forceGtZero_To_PredX_From_DigsX_SPOS_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_DigsX_SZERO_Cont, "forceGtZero_To_PredX_From_DigsX_SZERO_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_DigsX_SZERO_Entry, "forceGtZero_To_PredX_From_DigsX_SZERO_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_MatX_Cont, "forceGtZero_To_PredX_From_MatX_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_MatX_Entry, "forceGtZero_To_PredX_From_MatX_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_MatX_Signed_Cont, "forceGtZero_To_PredX_From_MatX_Signed_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_MatX_Signed_Entry, "forceGtZero_To_PredX_From_MatX_Signed_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_SignX_Cont, "forceGtZero_To_PredX_From_SignX_Cont", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_SignX_Entry, "forceGtZero_To_PredX_From_SignX_Entry", 2, ARG_NEITHER}, + {forceGtZero_To_PredX_From_TenXY, "forceGtZero_To_PredX_From_TenXY", 2, ARG_NEITHER}, + {force_To_Alt_Cont, "force_To_Alt_Cont", 2, ARG_NEITHER}, + {force_To_Alt_Entry, "force_To_Alt_Entry", 2, ARG_NEITHER}, + {force_To_Alt_From_The_Abyss, "force_To_Alt_From_The_Abyss", 2, ARG_NEITHER}, + {force_To_Alt_Reduce, "force_To_Alt_Reduce", 2, ARG_NEITHER}, + {force_To_And_From_Bool_X_Cont, "force_To_And_From_Bool_X_Cont", 2, ARG_X}, + {force_To_And_From_Bool_X_Entry, "force_To_And_From_Bool_X_Entry", 2, ARG_X}, + {force_To_And_From_Bool_Y_Cont, "force_To_And_From_Bool_Y_Cont", 2, ARG_Y}, + {force_To_And_From_Bool_Y_Entry, "force_To_And_From_Bool_Y_Entry", 2, ARG_Y}, + {force_To_Bool_From_The_Abyss, "force_To_Bool_From_The_Abyss", 2, ARG_NEITHER}, + {force_To_DigsX_From_Alt_Cont, "force_To_DigsX_From_Alt_Cont", 3, ARG_NEITHER}, + {force_To_DigsX_From_Alt_Entry, "force_To_DigsX_From_Alt_Entry", 3, ARG_NEITHER}, + {force_To_DigsX_From_Cls_Cont, "force_To_DigsX_From_Cls_Cont", 2, ARG_NEITHER}, + {force_To_DigsX_From_Cls_Entry, "force_To_DigsX_From_Cls_Entry", 2, ARG_NEITHER}, + {force_To_DigsX_From_DigsX_Cont, "force_To_DigsX_From_DigsX_Cont", 3, ARG_NEITHER}, + {force_To_DigsX_From_DigsX_Entry, "force_To_DigsX_From_DigsX_Entry", 3, ARG_NEITHER}, + {force_To_DigsX_From_MatX_Cont, "force_To_DigsX_From_MatX_Cont", 3, ARG_NEITHER}, + {force_To_DigsX_From_MatX_Entry, "force_To_DigsX_From_MatX_Entry", 3, ARG_NEITHER}, + {force_To_DigsX_From_TenXY_Cont, "force_To_DigsX_From_TenXY_Cont", 3, ARG_NEITHER}, + {force_To_DigsX_From_TenXY_Cont_X, "force_To_DigsX_From_TenXY_Cont_X", 3, ARG_NEITHER}, + {force_To_DigsX_From_TenXY_Entry, "force_To_DigsX_From_TenXY_Entry", 3, ARG_NEITHER}, + {force_To_DigsX_From_Vec, "force_To_DigsX_From_Vec", 3, ARG_NEITHER}, + {force_To_MatX_From_Alt_Cont, "force_To_MatX_From_Alt_Cont", 3, ARG_NEITHER}, + {force_To_MatX_From_Alt_Entry, "force_To_MatX_From_Alt_Entry", 3, ARG_NEITHER}, + {force_To_MatX_From_Alt_Signed_Cont, "force_To_MatX_From_Alt_Signed_Cont", 2, ARG_NEITHER}, + {force_To_MatX_From_Alt_Signed_Entry, "force_To_MatX_From_Alt_Signed_Entry", 2, ARG_NEITHER}, + {force_To_MatX_From_Cls_Cont, "force_To_MatX_From_Cls_Cont", 2, ARG_NEITHER}, + {force_To_MatX_From_Cls_Entry, "force_To_MatX_From_Cls_Entry", 2, ARG_NEITHER}, + {force_To_MatX_From_Cls_Signed_Cont, "force_To_MatX_From_Cls_Signed_Cont", 2, ARG_NEITHER}, + {force_To_MatX_From_Cls_Signed_Entry, "force_To_MatX_From_Cls_Signed_Entry", 2, ARG_NEITHER}, + {force_To_MatX_From_DigsX_Cont, "force_To_MatX_From_DigsX_Cont", 3, ARG_NEITHER}, + {force_To_MatX_From_DigsX_Entry, "force_To_MatX_From_DigsX_Entry", 3, ARG_NEITHER}, + {force_To_MatX_From_DigsX_Signed, "force_To_MatX_From_DigsX_Signed", 2, ARG_NEITHER}, + {force_To_MatX_From_MatX, "force_To_MatX_From_MatX", 3, ARG_NEITHER}, + {force_To_MatX_From_MatX_Signed_Cont, "force_To_MatX_From_MatX_Signed_Cont", 2, ARG_NEITHER}, + {force_To_MatX_From_MatX_Signed_Entry, "force_To_MatX_From_MatX_Signed_Entry", 2, ARG_NEITHER}, + {force_To_MatX_From_SignX_Cont, "force_To_MatX_From_SignX_Cont", 2, ARG_NEITHER}, + {force_To_MatX_From_SignX_Entry, "force_To_MatX_From_SignX_Entry", 2, ARG_NEITHER}, + {force_To_MatX_From_TenXY, "force_To_MatX_From_TenXY", 3, ARG_NEITHER}, + {force_To_MatX_From_TenXY_Signed_Cont, "force_To_MatX_From_TenXY_Signed_Cont", 2, ARG_NEITHER}, + {force_To_MatX_From_TenXY_Signed_Cont_X, "force_To_MatX_From_TenXY_Signed_Cont_X", 2, ARG_NEITHER}, + {force_To_MatX_From_TenXY_Signed_Entry, "force_To_MatX_From_TenXY_Signed_Entry", 2, ARG_NEITHER}, + {force_To_MatX_From_Vec, "force_To_MatX_From_Vec", 3, ARG_NEITHER}, + {force_To_MatX_From_Vec_Signed, "force_To_MatX_From_Vec_Signed", 2, ARG_NEITHER}, + {force_To_Not_From_Bool_Cont, "force_To_Not_From_Bool_Cont", 2, ARG_NEITHER}, + {force_To_Not_From_Bool_Entry, "force_To_Not_From_Bool_Entry", 2, ARG_NEITHER}, + {force_To_Or_From_Bool_X_Cont, "force_To_Or_From_Bool_X_Cont", 2, ARG_X}, + {force_To_Or_From_Bool_X_Entry, "force_To_Or_From_Bool_X_Entry", 2, ARG_X}, + {force_To_Or_From_Bool_Y_Cont, "force_To_Or_From_Bool_Y_Cont", 2, ARG_Y}, + {force_To_Or_From_Bool_Y_Entry, "force_To_Or_From_Bool_Y_Entry", 2, ARG_Y}, + {force_To_PredX_From_DigsX_2n_minus_1_False_Cont, "force_To_PredX_From_DigsX_2n_minus_1_False_Cont", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_2n_minus_1_False_Entry, "force_To_PredX_From_DigsX_2n_minus_1_False_Entry", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_2n_minus_1_True_Cont, "force_To_PredX_From_DigsX_2n_minus_1_True_Cont", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_2n_minus_1_True_Entry, "force_To_PredX_From_DigsX_2n_minus_1_True_Entry", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_minus_2n_minus_1_False_Cont, "force_To_PredX_From_DigsX_minus_2n_minus_1_False_Cont", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry, "force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_minus_2n_minus_1_True_Cont, "force_To_PredX_From_DigsX_minus_2n_minus_1_True_Cont", 2, ARG_NEITHER}, + {force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry, "force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry", 2, ARG_NEITHER}, + {force_To_PredX_From_The_Abyss, "force_To_PredX_From_The_Abyss", 2, ARG_NEITHER}, + {force_To_SignX_From_Alt_Cont, "force_To_SignX_From_Alt_Cont", 2, ARG_NEITHER}, + {force_To_SignX_From_Alt_Entry, "force_To_SignX_From_Alt_Entry", 2, ARG_NEITHER}, + {force_To_SignX_From_Cls_Cont, "force_To_SignX_From_Cls_Cont", 2, ARG_NEITHER}, + {force_To_SignX_From_Cls_Entry, "force_To_SignX_From_Cls_Entry", 2, ARG_NEITHER}, + {force_To_SignX_From_DigsX, "force_To_SignX_From_DigsX", 2, ARG_NEITHER}, + {force_To_SignX_From_MatX_Cont, "force_To_SignX_From_MatX_Cont", 2, ARG_NEITHER}, + {force_To_SignX_From_MatX_Entry, "force_To_SignX_From_MatX_Entry", 2, ARG_NEITHER}, + {force_To_SignX_From_TenXY_Cont, "force_To_SignX_From_TenXY_Cont", 2, ARG_NEITHER}, + {force_To_SignX_From_TenXY_Cont_X, "force_To_SignX_From_TenXY_Cont_X", 2, ARG_NEITHER}, + {force_To_SignX_From_TenXY_Entry, "force_To_SignX_From_TenXY_Entry", 2, ARG_NEITHER}, + {force_To_SignX_From_Vec, "force_To_SignX_From_Vec", 2, ARG_NEITHER}, + {force_To_TenXY_X_From_Alt_Cont, "force_To_TenXY_X_From_Alt_Cont", 3, ARG_X}, + {force_To_TenXY_X_From_Alt_Entry, "force_To_TenXY_X_From_Alt_Entry", 3, ARG_X}, + {force_To_TenXY_X_From_Alt_Signed_Cont, "force_To_TenXY_X_From_Alt_Signed_Cont", 2, ARG_X}, + {force_To_TenXY_X_From_Alt_Signed_Entry, "force_To_TenXY_X_From_Alt_Signed_Entry", 2, ARG_X}, + {force_To_TenXY_X_From_Cls_Cont, "force_To_TenXY_X_From_Cls_Cont", 3, ARG_X}, + {force_To_TenXY_X_From_Cls_Entry, "force_To_TenXY_X_From_Cls_Entry", 3, ARG_X}, + {force_To_TenXY_X_From_Cls_Signed_Cont, "force_To_TenXY_X_From_Cls_Signed_Cont", 2, ARG_X}, + {force_To_TenXY_X_From_Cls_Signed_Entry, "force_To_TenXY_X_From_Cls_Signed_Entry", 2, ARG_X}, + {force_To_TenXY_X_From_DigsX_Cont, "force_To_TenXY_X_From_DigsX_Cont", 3, ARG_X}, + {force_To_TenXY_X_From_DigsX_Entry, "force_To_TenXY_X_From_DigsX_Entry", 3, ARG_X}, + {force_To_TenXY_X_From_DigsX_Signed, "force_To_TenXY_X_From_DigsX_Signed", 2, ARG_X}, + {force_To_TenXY_X_From_MatX, "force_To_TenXY_X_From_MatX", 3, ARG_X}, + {force_To_TenXY_X_From_MatX_Signed_Cont, "force_To_TenXY_X_From_MatX_Signed_Cont", 2, ARG_X}, + {force_To_TenXY_X_From_MatX_Signed_Entry, "force_To_TenXY_X_From_MatX_Signed_Entry", 2, ARG_X}, + {force_To_TenXY_X_From_SignX_Cont, "force_To_TenXY_X_From_SignX_Cont", 2, ARG_X}, + {force_To_TenXY_X_From_SignX_Entry, "force_To_TenXY_X_From_SignX_Entry", 2, ARG_X}, + {force_To_TenXY_X_From_TenXY, "force_To_TenXY_X_From_TenXY", 3, ARG_X}, + {force_To_TenXY_X_From_TenXY_Signed_Cont, "force_To_TenXY_X_From_TenXY_Signed_Cont", 2, ARG_X}, + {force_To_TenXY_X_From_TenXY_Signed_Cont_X, "force_To_TenXY_X_From_TenXY_Signed_Cont_X", 2, ARG_X}, + {force_To_TenXY_X_From_TenXY_Signed_Entry, "force_To_TenXY_X_From_TenXY_Signed_Entry", 2, ARG_X}, + {force_To_TenXY_X_From_Vec, "force_To_TenXY_X_From_Vec", 3, ARG_X}, + {force_To_TenXY_X_From_Vec_Signed, "force_To_TenXY_X_From_Vec_Signed", 2, ARG_X}, + {force_To_TenXY_X_Until_Refining, "force_To_TenXY_X_Until_Refining", 2, ARG_X}, + {force_To_TenXY_Y_From_Alt_Cont, "force_To_TenXY_Y_From_Alt_Cont", 3, ARG_Y}, + {force_To_TenXY_Y_From_Alt_Entry, "force_To_TenXY_Y_From_Alt_Entry", 3, ARG_Y}, + {force_To_TenXY_Y_From_Alt_Signed_Cont, "force_To_TenXY_Y_From_Alt_Signed_Cont", 2, ARG_Y}, + {force_To_TenXY_Y_From_Alt_Signed_Entry, "force_To_TenXY_Y_From_Alt_Signed_Entry", 2, ARG_Y}, + {force_To_TenXY_Y_From_Cls_Cont, "force_To_TenXY_Y_From_Cls_Cont", 3, ARG_Y}, + {force_To_TenXY_Y_From_Cls_Entry, "force_To_TenXY_Y_From_Cls_Entry", 3, ARG_Y}, + {force_To_TenXY_Y_From_Cls_Signed_Cont, "force_To_TenXY_Y_From_Cls_Signed_Cont", 2, ARG_Y}, + {force_To_TenXY_Y_From_Cls_Signed_Entry, "force_To_TenXY_Y_From_Cls_Signed_Entry", 2, ARG_Y}, + {force_To_TenXY_Y_From_DigsX_Cont, "force_To_TenXY_Y_From_DigsX_Cont", 3, ARG_Y}, + {force_To_TenXY_Y_From_DigsX_Entry, "force_To_TenXY_Y_From_DigsX_Entry", 3, ARG_Y}, + {force_To_TenXY_Y_From_DigsX_Signed, "force_To_TenXY_Y_From_DigsX_Signed", 2, ARG_Y}, + {force_To_TenXY_Y_From_MatX, "force_To_TenXY_Y_From_MatX", 3, ARG_Y}, + {force_To_TenXY_Y_From_MatX_Signed_Cont, "force_To_TenXY_Y_From_MatX_Signed_Cont", 2, ARG_Y}, + {force_To_TenXY_Y_From_MatX_Signed_Entry, "force_To_TenXY_Y_From_MatX_Signed_Entry", 2, ARG_Y}, + {force_To_TenXY_Y_From_SignX_Cont, "force_To_TenXY_Y_From_SignX_Cont", 2, ARG_Y}, + {force_To_TenXY_Y_From_SignX_Entry, "force_To_TenXY_Y_From_SignX_Entry", 2, ARG_Y}, + {force_To_TenXY_Y_From_TenXY, "force_To_TenXY_Y_From_TenXY", 3, ARG_Y}, + {force_To_TenXY_Y_From_TenXY_Signed_Cont, "force_To_TenXY_Y_From_TenXY_Signed_Cont", 2, ARG_Y}, + {force_To_TenXY_Y_From_TenXY_Signed_Cont_X, "force_To_TenXY_Y_From_TenXY_Signed_Cont_X", 2, ARG_Y}, + {force_To_TenXY_Y_From_TenXY_Signed_Entry, "force_To_TenXY_Y_From_TenXY_Signed_Entry", 2, ARG_Y}, + {force_To_TenXY_Y_From_Vec, "force_To_TenXY_Y_From_Vec", 3, ARG_Y}, + {force_To_TenXY_Y_From_Vec_Signed, "force_To_TenXY_Y_From_Vec_Signed", 2, ARG_Y} +}; + +void *root; + +/* + * Compares the functions in two descriptors. + */ +static int +compare(const void *p, const void *q) +{ + if (((ForceFuncDesc *) p)->func < ((ForceFuncDesc *) q)->func) + return -1; + if (((ForceFuncDesc *) p)->func > ((ForceFuncDesc *) q)->func) + return 1; + return 0; +} + +/* + * Retrieves the descriptor for the specified function. + */ +ForceFuncDesc * +getDescForForceFunc(void (*func)()) +{ + void *p; + ForceFuncDesc fd = {NULL, "no-name", 0, 0}; + + fd.func = func; + p = tfind((void *) &fd, (void **) &root, compare); + if (p == NULL) + return (ForceFuncDesc *) NULL; + else + return *((ForceFuncDesc **) p); +} + +/* + * The table above only lists those continuation/force functions pertaining + * to bools, signs and digits for the basic types of objects in the heap. + * These include lfts and booleans. It does not include any information + * relating to user defined continutions/closures. These include the closures + * for analytic functions which generate more matrices and tensors when + * forced. The function below allows one to add descriptive information + * for user-defined continuations. + */ +void +registerForceFunc(void (*func)(), char *funcName, int nArgs) +{ + ForceFuncDesc *p; + + if ((p = (ForceFuncDesc *) malloc(sizeof(ForceFuncDesc))) == NULL) + Error(FATAL, E_INT, "registerForceMethod", "malloc failed"); + + p->func = func; + p->funcName = funcName; + p->nArgs = nArgs; + p->argXOrY = ARG_NEITHER; + + (void) tsearch((void *) p, &root, compare); +} + +void +initForceMethodLookupTable() +{ + unsigned int i; + void *p; + + root = NULL; + for (i = 0; i < sizeof(descTable) / sizeof(ForceFuncDesc); i++) { + p = tsearch((void *) (descTable + i), &root, compare); + if (p == NULL) + Error(FATAL, E_INT, "initForceMethodLookupTable", + "tsearch returned NULL"); + } +} diff --git a/ic-reals-6.3/base/force_B.c b/ic-reals-6.3/base/force_B.c new file mode 100644 index 0000000..750d79a --- /dev/null +++ b/ic-reals-6.3/base/force_B.c @@ -0,0 +1,23 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +void +force_B(Bool b, int n) +{ + int i; + + for (i = 0; i < n; i++) { + if (boolValue(b) != LAZY_UNKNOWN) break; + PUSH_2 (b->gen.force, b); + runStack(); + } +} diff --git a/ic-reals-6.3/base/force_R.c b/ic-reals-6.3/base/force_R.c new file mode 100644 index 0000000..c67c0f3 --- /dev/null +++ b/ic-reals-6.3/base/force_R.c @@ -0,0 +1,231 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include <math.h> + +/* + * This is the toplevel function called by the user to force information + * from a real stream. + */ +void +force_R_Digs(Real x, int digitsNeeded) +{ + DigsX *digsX; + void runStack(); + void force_To_Alt_Entry(); + + if (x->gen.tag.type == ALT) { + if (x->alt.redirect == NULL) { + PUSH_2(force_To_Alt_Entry, x); + runStack(); + } + force_R_Digs(x->alt.redirect, digitsNeeded); + return; + } + + if (x->gen.tag.type == CLOSURE) { + if (x->cls.redirect == NULL) { + PUSH_2(x->cls.force, x); + runStack(); + } + force_R_Digs(x->cls.redirect, digitsNeeded); + return; + } + + x = makeStream(x); + + /* + * So now we know that x is a real stream. If x is signed and + * the sign has not been determined, we force it. + */ + if (x->gen.tag.type == SIGNX) { + if (x->signX.tag.value == SIGN_UNKN) { + PUSH_2(x->signX.force, x); + runStack(); + } + digsX = (DigsX *) x->signX.x; + } + else + digsX = (DigsX *) x; + + if (digsX->tag.type != DIGSX) + Error(FATAL, E_INT, "force_R_Digs", "badly formed real"); + + /* + * Now, if there is not enough information available, we force + * the number of digits needed. + */ + if (digsX->count < (unsigned int)digitsNeeded) { + PUSH_3(digsX->force, digsX, digitsNeeded - digsX->count); + runStack(); + } +} + +/* force_R_Dec + * July 2000, Marko Krznaric + * + * force_R_Digs(x,digitsNeeded) is a function which forces an + * emission of digitsNeeded digit matrices from x (of the + * type Real). + * + * On the other hand, force_R_Dec(x,decimalPrecision) guarantees + * that enough digit matrices, say digitsNeeded, will be emitted + * from a real number x in order to have required absolute + * decimal precision, i.e. it guarantees that the result will be + * accurate within 10^(-decimalPrecision). + * + * NOTES: + * - initGuess = an initial guess (minimum number) of digit + * matrices which has to be emitted from a real number x. + * - digitsNeeded = number of digit matrices required. + * - e = number of 'bad' digits. + * - using function retrieveInfo, we can extract the sign (=sign), + * the number of digits emitted so far (=count) and the + * compressed digits (=digits) for a Real x. + * - 3.322 = an upper bound for log2(10). + * + * + * PROBLEMS: + * - should decimalPrecision & digitsNeeded be of type long int? + * + */ +void +force_R_Dec(Real x, int decimalPrecision) +{ + int initGuess = ceil(3.322 * decimalPrecision) + 2; + int digitsNeeded; + int e = 0; + + mpz_t digits; + Sign sign; + int count; + + mpz_init(digits); + + digitsNeeded = initGuess; + force_R_Digs(x, digitsNeeded); + retrieveInfo(x, &sign, &count, digits); + + switch (sign) { + case SZERO: + /* + * SZERO: every digit matrix will half the interval + * (starting with [-1,1]). Easy to determine digitsNeeded. + */ + digitsNeeded = initGuess - 1; + break; + + case SPOS: + case SNEG: + /* + * SPOS, SNEG: e, the number of 'bad' digits is actually + * the number of leading 1s in the binary representation + * of digits (the value of compressed digits). + */ + while (digitsNeeded < forceDecUpperBound) { + force_R_Digs(x, digitsNeeded); + retrieveInfo(x, &sign, &count, digits); + if (sign == SNEG) + mpz_neg(digits, digits); + e = leadingOnes (digits); + digitsNeeded = 2 * e + 2 + initGuess; + if (count > e) + /* not all of the extracted digit matrices are 'bad', + * i.e. the interval is bounded. Therefore, we can + * leave the loop. + */ + break; + } + if (digitsNeeded >= forceDecUpperBound) + Error(FATAL, E_INT, "force_R_Dec", + "forceDecUpperBound reached (1)"); + break; + + case SINF: + /* SINF: we are still dealing with the unbounded interval, + * i.e. the interval contains infinity, as far as digits + * (the value of compressed digits matrices) is either + * -1, 0 or 1. As soon as we get something greater (in + * absolute value) than 1, the interval doesn't contain + * the infinity, and we can calculate digitsNeeded. + */ + while (digitsNeeded < forceDecUpperBound) { + force_R_Digs(x, digitsNeeded); + retrieveInfo(x, &sign, &count, digits); + if (mpz_cmpabs_ui(digits, 1) > 0) { + e = count - mpz_sizeinbase(digits, 2); + digitsNeeded = 2 * e + 2 + initGuess; + break; + } + else { + e = count; + digitsNeeded = 2 * e + 2+ initGuess; + } + } + if (digitsNeeded >= forceDecUpperBound) + Error(FATAL, E_INT, "force_R_Dec", + "forceDecUpperBound reached (2)"); + break; + + case SIGN_UNKN: + Error(FATAL, E_INT, "force_R_Dec", "argument is signed"); + break; + + default: + Error(FATAL, E_INT, "force_R_Dec", "bad sign"); + break; + } + + force_R_Digs(x, digitsNeeded); + mpz_clear(digits); +} + +/* leadingOnes + * July 2000, Marko Krznaric + * + * For input variable c (of type mpz_t) check how many 1s + * are leading the binary representation of c. + * + * We use this function as an auxiliary function to + * force_R_Dec. We have to check how many D+ (D-) digit + * matrices follow S+ (S-). This seems to be the fastest + * way to do it. + * + * If c is zero or negative - result = 0. + * If there are no zeros at all - result = binary size of c. + * Otherwise, we scan from left-most digit and count until + * we reach 0. + * + * NOTES: + * - The index of the right-most digit is 0, while the index + * of the left-most digit is (size-1). + */ +int +leadingOnes(mpz_t c) +{ + int size = mpz_sizeinbase(c,2); + int i; + int count = 0; + + if (mpz_sgn(c) <= 0) + return 0; + + if (mpz_scan0(c, 0) == (long unsigned int)size) + return size; + + for (i = size - 1; i >= 0; i--) { + if (mpz_scan1(c, i) == (long unsigned int)i) + count++; + else + return count; + } + return 0; +} diff --git a/ic-reals-6.3/base/garbage.c b/ic-reals-6.3/base/garbage.c new file mode 100644 index 0000000..b081d6a --- /dev/null +++ b/ic-reals-6.3/base/garbage.c @@ -0,0 +1,44 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include <gmp-impl.h> +#include <longlong.h> +#include "real-impl.h" + +void evacuateCls(Cls *); +void evacuateDigsX(DigsX *); +void evacuateVec(Vec *); +void evacuateMatX(MatX *); +void evacuateTenXY(TenXY *); + +void +evacuateCls(Cls *vec) +{ +} + +void +evacuateDigsX(DigsX *digsX) +{ +} + +void +evacuateVec(Vec *vec) +{ +} + +void +evacuateMatX(MatX *matX) +{ +} + +void +evacuateTenXY(TenXY *tenXY) +{ +} diff --git a/ic-reals-6.3/base/gt0.c b/ic-reals-6.3/base/gt0.c new file mode 100644 index 0000000..83ed0af --- /dev/null +++ b/ic-reals-6.3/base/gt0.c @@ -0,0 +1,551 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This file contains everything to do with the predicate x > 0. + * This can be defined in terms of x >= 0 since + * x > 0 \equiv not_B(-x >= 0) but no matter. + */ + +void setPredX(PredX *, BoolVal); +void absorbDigsXIntoPredX(PredX *); +void absorbSignXIntoPredX(PredX *); +void force_To_PredX_From_The_Abyss(); +static BoolVal gt_Vec_0(Vec *); +static BoolVal gt_MatX_0(MatX *); + +#define forceGtZero_To_PredX_From_DigsX_SINF_Entry \ + forceGtEqZero_To_PredX_From_DigsX_SINF_Entry +#define forceGtZero_To_PredX_From_DigsX_SNEG_Entry \ + force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry + +void setGtZeroPredXMethod(PredX *); + +/* + * You'll find slightly more comments in the file gteq0.c + */ +Bool +gt_R_0(Real x) +{ + PredX *predX; + PredX *allocPredX(); + void setGtZeroPredXMethod(PredX *); + + predX = allocPredX(x); + setGtZeroPredXMethod(predX); + return (Bool) predX; +} + +void +setGtZeroPredXMethod(PredX *predX) +{ + void forceGtZero_To_PredX_From_SignX_Entry(); + void forceGtZero_To_PredX_From_DigsX_SPOS_Entry(); + void forceGtZero_To_PredX_From_MatX_Entry(); + void forceGtZero_To_PredX_From_MatX_Signed_Entry(); + void forceGtZero_To_PredX_From_TenXY(); + void forceGtZero_To_PredX_From_Alt_Entry(); + void forceGtZero_To_PredX_From_Cls_Entry(); + + switch (predX->x->gen.tag.type) { + case VECTOR : + setPredX(predX, gt_Vec_0((Vec *) predX->x)); + predX->force = force_To_PredX_From_The_Abyss; + break; + case MATX : + if (predX->x->matX.x->gen.tag.isSigned) + predX->force = forceGtZero_To_PredX_From_MatX_Signed_Entry; + else { + setPredX(predX, gt_MatX_0((MatX *) predX->x)); + predX->force = forceGtZero_To_PredX_From_MatX_Entry; + } + break; + case TENXY : + predX->force = forceGtZero_To_PredX_From_TenXY; + break; + case SIGNX : + predX->force = forceGtZero_To_PredX_From_SignX_Entry; + break; + case DIGSX : + predX->force = forceGtZero_To_PredX_From_DigsX_SPOS_Entry; + break; + case CLOSURE : + predX->force = forceGtZero_To_PredX_From_Cls_Entry; + break; + case ALT : + predX->force = forceGtZero_To_PredX_From_Alt_Entry; + break; + default : + Error(FATAL, E_INT, "compareGtZero", "argument is not a stream"); + } +} + +void +forceGtZero_To_PredX_From_Alt_Entry() +{ + PredX *predX; + Alt *alt; + void force_To_Alt_Entry(); + void forceGtZero_To_PredX_From_Alt_Cont(); + + predX = (PredX *) POP; + alt = (Alt *) predX->x; + + PUSH_2(forceGtZero_To_PredX_From_Alt_Cont, predX); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (alt->redirect == NULL) + PUSH_2(force_To_Alt_Entry, alt); +} + +void +forceGtZero_To_PredX_From_Alt_Cont() +{ + PredX *predX; + Alt *alt; + + predX = (PredX *) POP; + alt = (Alt *) predX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, alt); + newEdgeToOnlyChild(predX, alt->redirect); + endGraphUpdate(); +#endif + predX->x = alt->redirect; + setGtZeroPredXMethod(predX); + + PUSH_2(predX->force, predX); +} + +void +forceGtZero_To_PredX_From_Cls_Entry() +{ + PredX *predX; + Cls *cls; + void forceGtZero_To_PredX_From_Cls_Cont(); + + predX = (PredX *) POP; + cls = (Cls *) predX->x; + + PUSH_2(forceGtZero_To_PredX_From_Cls_Cont, predX); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (cls->redirect == NULL) + PUSH_2(cls->force, cls); +} + +void +forceGtZero_To_PredX_From_Cls_Cont() +{ + PredX *predX; + Cls *cls; + + predX = (PredX *) POP; + cls = (Cls *) predX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, cls); + newEdgeToOnlyChild(predX, cls->redirect); + endGraphUpdate(); +#endif + predX->x = cls->redirect; + setGtZeroPredXMethod(predX); + + PUSH_2(predX->force, predX); +} + +/* + * If we get here then we need to get more information into the matrix. + */ +void +forceGtZero_To_PredX_From_MatX_Entry() +{ + PredX *predX; + MatX *matX; + void forceGtZero_To_PredX_From_MatX_Cont(); + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gt_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + PUSH_2(forceGtZero_To_PredX_From_MatX_Cont, predX); + PUSH_3(predX->x->matX.force, predX->x, defaultForceCount); +} + +void +forceGtZero_To_PredX_From_MatX_Cont() +{ + PredX *predX; + MatX *matX; + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gt_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + setPredX(predX, gt_MatX_0((MatX *) (predX->x))); +} + +void +forceGtZero_To_PredX_From_MatX_Signed_Entry() +{ + PredX *predX; + MatX *matX; + void forceGtZero_To_PredX_From_MatX_Signed_Cont(); + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gt_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + PUSH_2(forceGtZero_To_PredX_From_MatX_Signed_Cont, predX); + + if (matX->x->gen.tag.isSigned) + PUSH_2(matX->force, matX); +} + +void +forceGtZero_To_PredX_From_MatX_Signed_Cont() +{ + PredX *predX; + MatX *matX; + void forceGtZero_To_PredX_From_MatX_Entry(); + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gt_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + predX->force = forceGtZero_To_PredX_From_MatX_Entry; + setPredX(predX, gt_MatX_0(matX)); +} + +void +forceGtZero_To_PredX_From_TenXY() +{ + PredX *predX; + TenXY *tenXY; + void forceGtZero_To_PredX_From_SignX_Entry(); + void forceGtZero_To_PredX_From_DigsX_SPOS_Entry(); + + predX = (PredX *) POP; + tenXY = (TenXY *) predX->x; + + /* + * The tensor may have reduced to a vector + */ + if (tenXY->tag.type == VECTOR) { + setPredX(predX, gt_Vec_0((Vec *) tenXY)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + /* + * The tensor may have reduced to a matrix (signed or otherwise) + */ + if (tenXY->tag.type == MATX) { + if (predX->x->matX.x->gen.tag.isSigned) { + predX->force = forceGtZero_To_PredX_From_MatX_Signed_Entry; + PUSH_2(predX->force, predX); + } + else { + setPredX(predX, gt_MatX_0((MatX *) predX->x)); + predX->force = forceGtZero_To_PredX_From_MatX_Entry; + } + return; + } + + if (tenXY->tag.isSigned) { + createSignedStreamForTenXY(tenXY); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, predX->x); + newEdgeToOnlyChild(predX, tenXY->strm); + endGraphUpdate(); +#endif + predX->x = tenXY->strm; + predX->force = forceGtZero_To_PredX_From_SignX_Entry; + PUSH_2(predX->force, predX); + } + else { + createUnsignedStreamForTenXY(tenXY); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, predX->x); + newEdgeToOnlyChild(predX, tenXY->strm); + endGraphUpdate(); +#endif + predX->x = tenXY->strm; + predX->force = forceGtZero_To_PredX_From_DigsX_SPOS_Entry; + PUSH_2(predX->force, predX); + } +} + +void +forceGtZero_To_PredX_From_SignX_Entry() +{ + PredX *predX; + SignX *signX; + void forceGtZero_To_PredX_From_SignX_Cont(); + + predX = (PredX *) POP; + signX = (SignX *) predX->x; + + PUSH_2(forceGtZero_To_PredX_From_SignX_Cont, predX); + + if (signX->tag.value == SIGN_UNKN) + PUSH_2(signX->force, signX); +} + +/* + * At this point we know the sign is valid so we ``absorb'' it. In this + * case that means that we have to inspect the sign and reset the methods + * before advancing to the first characteristic pair. + */ +void +forceGtZero_To_PredX_From_SignX_Cont() +{ + PredX *predX; + SignX *signX; + void forceGtZero_To_PredX_From_DigsX_SPOS_Entry(); + void forceGtZero_To_PredX_From_DigsX_SNEG_Entry(); + void forceGtZero_To_PredX_From_DigsX_SZERO_Entry(); + void forceGtZero_To_PredX_From_DigsX_SINF_Entry(); + + predX = (PredX *) POP; + signX = (SignX *) predX->x; + + switch (signX->tag.value) { + case SPOS : + predX->force = forceGtZero_To_PredX_From_DigsX_SPOS_Entry; + break; + case SNEG : + predX->force = forceGtZero_To_PredX_From_DigsX_SNEG_Entry; + break; + case SZERO : + predX->force = forceGtZero_To_PredX_From_DigsX_SZERO_Entry; + break; + case SINF : + predX->force = forceGtZero_To_PredX_From_DigsX_SINF_Entry; + break; + default : + Error(FATAL, E_INT, "forceGtZero_To_PredX_From_SignX_Cont", + "invalid sign"); + } + absorbSignXIntoPredX(predX); + PUSH_2(predX->force, predX); +} + +void +forceGtZero_To_PredX_From_DigsX_SPOS_Entry() +{ + PredX *predX; + DigsX *digsX; + void forceGtZero_To_PredX_From_DigsX_SPOS_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(forceGtZero_To_PredX_From_DigsX_SPOS_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +void +forceGtZero_To_PredX_From_DigsX_SPOS_Cont() +{ + PredX *predX; + DigsX *digsX; + int k; + void force_To_PredX_From_DigsX_2n_minus_1_True_Entry(); + void force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + k = (1 << digsX->count) - 1; + if (digsX->word.small == k) { + absorbDigsXIntoPredX(predX); + predX->force = force_To_PredX_From_DigsX_2n_minus_1_True_Entry; + } + else { + if (digsX->word.small == -k) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry; + } + else + setPredX(predX, LAZY_TRUE); + } + } + else { +#endif + /* + * This is comparing a big word with +-(2^n - 1). It would be faster + * to compare each word with 0xffffffff but this may have to + * wait. #### + */ + if (mpz_sgn(digsX->word.big) >= 0) { + if (mpz_popcount(digsX->word.big) == digsX->count) { + absorbDigsXIntoPredX(predX); + predX->force = force_To_PredX_From_DigsX_2n_minus_1_True_Entry; + } + else + setPredX(predX, LAZY_TRUE); + } + else { + /* + * We negate things here but I don't think it is necessary + * since GMP uses sign and magnitude representation + * for big integers. Leave it for now. + */ + mpz_neg(digsX->word.big, digsX->word.big); + if (mpz_popcount(digsX->word.big) == digsX->count) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry; + } + else + setPredX(predX, LAZY_TRUE); + mpz_neg(digsX->word.big, digsX->word.big); + } +#ifdef PACK_DIGITS + } +#endif +} + +void +forceGtZero_To_PredX_From_DigsX_SZERO_Entry() +{ + PredX *predX; + DigsX *digsX; + void forceGtZero_To_PredX_From_DigsX_SZERO_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(forceGtZero_To_PredX_From_DigsX_SZERO_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +void +forceGtZero_To_PredX_From_DigsX_SZERO_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small < 0) + setPredX(predX, LAZY_FALSE); + else { + if (digsX->word.small == 0) + absorbDigsXIntoPredX(predX); + else + if (digsX->word.small == 1) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry; + } + else + setPredX(predX, LAZY_TRUE); + } + } + else { +#endif + switch (mpz_sgn(digsX->word.big)) { + case 1 : + if (mpz_cmp_si(digsX->word.big, 1) > 0) + setPredX(predX, LAZY_TRUE); + else { /* word == 1 */ + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_True_Entry; + } + break; + case 0 : + absorbDigsXIntoPredX(predX); + break; + case -1 : + setPredX(predX, LAZY_FALSE); + break; + default : + Error(FATAL, E_INT, "forceGtZero_To_PredX_From_DigsX_SZERO_Cont", + "bad value returned from mpz_sgn"); + } +#ifdef PACK_DIGITS + } +#endif +} + +static BoolVal +gt_MatX_0(MatX *matX) +{ + if (mpz_sgn(matX->mat[0][1]) * mpz_sgn(matX->mat[1][1]) > 0) { + if (mpz_sgn(matX->mat[0][0]) * mpz_sgn(matX->mat[0][1]) > 0) { + if (mpz_sgn(matX->mat[1][0]) * mpz_sgn(matX->mat[1][1]) > 0) + return LAZY_TRUE; + } + else { + if (mpz_sgn(matX->mat[1][0]) * mpz_sgn(matX->mat[1][1]) <= 0) + return LAZY_FALSE; + } + } + return LAZY_UNKNOWN; +} + +static BoolVal +gt_Vec_0(Vec *vec) +{ + if (mpz_sgn(vec->vec[1]) != 0) { + if (mpz_sgn(vec->vec[0]) * mpz_sgn(vec->vec[1]) > 0) + return LAZY_TRUE; + else + return LAZY_FALSE; + } + if (mpz_sgn(vec->vec[0]) == 0) + Error(FATAL, E_INT, "gt_Vec_0", "malformed vector"); + + return LAZY_UNKNOWN; +} diff --git a/ic-reals-6.3/base/gteq0.c b/ic-reals-6.3/base/gteq0.c new file mode 100644 index 0000000..80afce9 --- /dev/null +++ b/ic-reals-6.3/base/gteq0.c @@ -0,0 +1,676 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This file contains everything to do with the predicate x >= 0. + */ + +#define forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry \ + force_To_PredX_From_DigsX_2n_minus_1_True_Entry + +void setPredX(PredX *, BoolVal); +void absorbDigsXIntoPredX(PredX *); +void absorbSignXIntoPredX(PredX *); +void force_To_PredX_From_The_Abyss(); +static BoolVal gtEq_Vec_0(Vec *); +static BoolVal gtEq_MatX_0(MatX *); + +void setGtZeroPredXMethod(PredX *); + +/* + * There are many cases when computing predicates over the reals. First of + * all, we handle vectors, matrices and streams differently. To understand + * the vector and matrices, assume a function (sgn n) which yields the + * sign (-1,0,1) of a large integer. Vectors are simple, For matrices, + * we need to determine if (info m) is in the interval [0,infty). This can + * be done by inspecting only the signs of the entries in the matrix. The + * proof that the following algorithm works is straightforward bearing in + * mind the definition of (info m). Note that this applies only when + * the argument of the matrix is unsigned. + * + * mat_gtEq_0 ((a,b),(c,d)) = + * if ((sgn a) * (sgn b) >= 0) + * && ((sgn c) * (sgn d) >= 0) && ((sgn b) * (sgn d) > 0) then + * True else + * if ((sgn a) * (sgn b) < 0) + * && ((sgn c) * (sgn d) < 0) && ((sgn b) * (sgn d) > 0) then + * False else + * Unknown + * + * The conditionals can be sorted to eliminate redundant comparisons to yield + * the following decision procedure. + * + * mat_gtEq_0 ((a,b),(c,d)) = + * if (sgn b) * (sgn d) > 0 then + * if (sgn a) * (sgn b) >= 0 then + * if (sgn c) * (sgn d) >= 0 then + * True + * else + * Unkown + * else + * if (sgn c) * (sgn d) < 0 then + * False + * else + * Unknown + * else + * Unknown + * + * No doubt a similar scheme works for tensors but this has not been coded. + * Right now we deal with the digit streams emitted from the tensor. The + * algorithm for handling digit streams is described elsewhere. + */ + +Bool +gtEq_R_0(Real x) +{ + PredX *predX; + PredX *allocPredX(); + void setGtEqZeroPredXMethod(PredX *); + + predX = allocPredX(x); + setGtEqZeroPredXMethod(predX); + return (Bool) predX; +} + +void +setGtEqZeroPredXMethod(PredX *predX) +{ + void forceGtEqZero_To_PredX_From_SignX_Entry(); + void forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry(); + void forceGtEqZero_To_PredX_From_MatX_Entry(); + void forceGtEqZero_To_PredX_From_MatX_Signed_Entry(); + void forceGtEqZero_To_PredX_From_TenXY(); + void forceGtEqZero_To_PredX_From_Alt_Entry(); + void forceGtEqZero_To_PredX_From_Cls_Entry(); + + switch (predX->x->gen.tag.type) { + case VECTOR : + setPredX(predX, gtEq_Vec_0((Vec *) predX->x)); + predX->force = force_To_PredX_From_The_Abyss; + break; + case MATX : + if (predX->x->matX.x->gen.tag.isSigned) + predX->force = forceGtEqZero_To_PredX_From_MatX_Signed_Entry; + else { + setPredX(predX, gtEq_MatX_0((MatX *) predX->x)); + predX->force = forceGtEqZero_To_PredX_From_MatX_Entry; + } + break; + case TENXY : + predX->force = forceGtEqZero_To_PredX_From_TenXY; + break; + case SIGNX : + predX->force = forceGtEqZero_To_PredX_From_SignX_Entry; + break; + case DIGSX : + predX->force = forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry; + break; + case CLOSURE : + predX->force = forceGtEqZero_To_PredX_From_Cls_Entry; + break; + case ALT : + predX->force = forceGtEqZero_To_PredX_From_Alt_Entry; + break; + default : + Error(FATAL, E_INT, "compareGtEqZero", "argument is not a stream"); + } +} + +void +forceGtEqZero_To_PredX_From_Alt_Entry() +{ + PredX *predX; + Alt *alt; + void force_To_Alt_Entry(); + void forceGtEqZero_To_PredX_From_Alt_Cont(); + + predX = (PredX *) POP; + alt = (Alt *) predX->x; + + PUSH_2(forceGtEqZero_To_PredX_From_Alt_Cont, predX); + + /* + * If alt->redirect is not valid (equals NULL) then the value of + * the conditional has not been determined so we need to force it. + */ + if (alt->redirect == NULL) + PUSH_2(force_To_Alt_Entry, alt); +} + +void +forceGtEqZero_To_PredX_From_Alt_Cont() +{ + PredX *predX; + Alt *alt; + + predX = (PredX *) POP; + alt = (Alt *) predX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, alt); + newEdgeToOnlyChild(predX, alt->redirect); + endGraphUpdate(); +#endif + predX->x = alt->redirect; + setGtEqZeroPredXMethod(predX); + + PUSH_2(predX->force, predX); +} + +void +forceGtEqZero_To_PredX_From_Cls_Entry() +{ + PredX *predX; + Cls *cls; + void forceGtEqZero_To_PredX_From_Cls_Cont(); + + predX = (PredX *) POP; + cls = (Cls *) predX->x; + + PUSH_2(forceGtEqZero_To_PredX_From_Cls_Cont, predX); + + /* + * If cls->redirect is not valid (equals NULL) then the value of + * the closure has not been determined so we need to force it. + */ + if (cls->redirect == NULL) + PUSH_2(cls->force, cls); +} + +void +forceGtEqZero_To_PredX_From_Cls_Cont() +{ + PredX *predX; + Cls *cls; + + predX = (PredX *) POP; + cls = (Cls *) predX->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, cls); + newEdgeToOnlyChild(predX, cls->redirect); + endGraphUpdate(); +#endif + predX->x = cls->redirect; + setGtEqZeroPredXMethod(predX); + + PUSH_2(predX->force, predX); +} + +/* + * If we get here then we need to get more information into the matrix. + */ +void +forceGtEqZero_To_PredX_From_MatX_Entry() +{ + PredX *predX; + MatX *matX; + void forceGtEqZero_To_PredX_From_MatX_Cont(); + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gtEq_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + PUSH_2(forceGtEqZero_To_PredX_From_MatX_Cont, predX); + PUSH_3(predX->x->matX.force, predX->x, defaultForceCount); +} + +void +forceGtEqZero_To_PredX_From_MatX_Cont() +{ + PredX *predX; + MatX *matX; + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gtEq_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + setPredX(predX, gtEq_MatX_0((MatX *) (predX->x))); +} + +/* + * If we get here then we need to get more information into the matrix. + */ +void +forceGtEqZero_To_PredX_From_MatX_Signed_Entry() +{ + PredX *predX; + MatX *matX; + void forceGtEqZero_To_PredX_From_MatX_Signed_Cont(); + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gtEq_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + PUSH_2(forceGtEqZero_To_PredX_From_MatX_Signed_Cont, predX); + + if (matX->x->gen.tag.isSigned) + PUSH_2(matX->force, matX); +} + +void +forceGtEqZero_To_PredX_From_MatX_Signed_Cont() +{ + PredX *predX; + MatX *matX; + void forceGtEqZero_To_PredX_From_MatX_Entry(); + + predX = (PredX *) POP; + matX = (MatX *) predX->x; + + if (matX->tag.type == VECTOR) { + setPredX(predX, gtEq_Vec_0((Vec *) matX)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + predX->force = forceGtEqZero_To_PredX_From_MatX_Entry; + setPredX(predX, gtEq_MatX_0(matX)); +} + +void +forceGtEqZero_To_PredX_From_TenXY() +{ + PredX *predX; + TenXY *tenXY; + void forceGtEqZero_To_PredX_From_SignX_Entry(); + void forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry(); + + predX = (PredX *) POP; + tenXY = (TenXY *) predX->x; + + /* + * The tensor may have reduced to a vector + */ + if (tenXY->tag.type == VECTOR) { + setPredX(predX, gtEq_Vec_0((Vec *) tenXY)); + predX->force = force_To_PredX_From_The_Abyss; + return; + } + + /* + * The tensor may have reduced to a matrix (signed or otherwise) + */ + if (tenXY->tag.type == MATX) { + if (predX->x->matX.x->gen.tag.isSigned) { + predX->force = forceGtEqZero_To_PredX_From_MatX_Signed_Entry; + PUSH_2(predX->force, predX); + } + else { + setPredX(predX, gtEq_MatX_0((MatX *) predX->x)); + predX->force = forceGtEqZero_To_PredX_From_MatX_Entry; + } + return; + } + + if (tenXY->tag.isSigned) { + createSignedStreamForTenXY(tenXY); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, predX->x); + newEdgeToOnlyChild(predX, tenXY->strm); + endGraphUpdate(); +#endif + predX->x = tenXY->strm; + predX->force = forceGtEqZero_To_PredX_From_SignX_Entry; + PUSH_2(predX->force, predX); + } + else { + createUnsignedStreamForTenXY(tenXY); +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(predX, predX->x); + newEdgeToOnlyChild(predX, tenXY->strm); + endGraphUpdate(); +#endif + predX->x = tenXY->strm; + predX->force = forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry; + PUSH_2(predX->force, predX); + } +} + +void +forceGtEqZero_To_PredX_From_SignX_Entry() +{ + PredX *predX; + SignX *signX; + void forceGtEqZero_To_PredX_From_SignX_Cont(); + + predX = (PredX *) POP; + signX = (SignX *) predX->x; + + PUSH_2(forceGtEqZero_To_PredX_From_SignX_Cont, predX); + + if (signX->tag.value == SIGN_UNKN) + PUSH_2(signX->force, signX); +} + +/* + * At this point we know the sign is valid so we ``absorb'' it. In this + * case that means that we have to inspect the sign and reset the methods + * before advancing to the first characteristic pair. + */ +void +forceGtEqZero_To_PredX_From_SignX_Cont() +{ + PredX *predX; + SignX *signX; + void forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry(); + void forceGtEqZero_To_PredX_From_DigsX_SNEG_Entry(); + void forceGtEqZero_To_PredX_From_DigsX_SZERO_Entry(); + void forceGtEqZero_To_PredX_From_DigsX_SINF_Entry(); + + predX = (PredX *) POP; + signX = (SignX *) predX->x; + + switch (signX->tag.value) { + case SPOS : + predX->force = forceGtEqZero_To_PredX_From_DigsX_SPOS_Entry; + break; + case SNEG : + predX->force = forceGtEqZero_To_PredX_From_DigsX_SNEG_Entry; + break; + case SZERO : + predX->force = forceGtEqZero_To_PredX_From_DigsX_SZERO_Entry; + break; + case SINF : + predX->force = forceGtEqZero_To_PredX_From_DigsX_SINF_Entry; + break; + default : + Error(FATAL, E_INT, "forceGtEqZero_To_PredX_From_SignX_Cont", + "invalid sign"); + } + + absorbSignXIntoPredX(predX); + + PUSH_2(predX->force, predX); +} + +void +forceGtEqZero_To_PredX_From_DigsX_SNEG_Entry() +{ + PredX *predX; + DigsX *digsX; + void forceGtEqZero_To_PredX_From_DigsX_SNEG_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(forceGtEqZero_To_PredX_From_DigsX_SNEG_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +void +forceGtEqZero_To_PredX_From_DigsX_SNEG_Cont() +{ + PredX *predX; + DigsX *digsX; + int k; + void force_To_PredX_From_DigsX_2n_minus_1_False_Entry(); + void force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + k = (1 << digsX->count) - 1; + if (digsX->word.small == k) { + absorbDigsXIntoPredX(predX); + predX->force = force_To_PredX_From_DigsX_2n_minus_1_False_Entry; + } + else { + if (digsX->word.small == -k) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry; + } + else + setPredX(predX, LAZY_FALSE); + } + } + else { +#endif + /* + * This is comparing a big word with +-(2^n - 1). It would be faster + * to compare each word with 0xffffffff but this may have to + * wait. #### + */ + if (mpz_sgn(digsX->word.big) >= 0) { + if (mpz_popcount(digsX->word.big) == digsX->count) { + absorbDigsXIntoPredX(predX); + predX->force = force_To_PredX_From_DigsX_2n_minus_1_False_Entry; + } + else + setPredX(predX, LAZY_FALSE); + } + else { + /* + * We negate things here but I don't think it is necessary + * since GMP uses sign and magnitude representation + * for big integers. Leave it for now. + */ + mpz_neg(digsX->word.big, digsX->word.big); + if (mpz_popcount(digsX->word.big) == digsX->count) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry; + } + else + setPredX(predX, LAZY_FALSE); + mpz_neg(digsX->word.big, digsX->word.big); + } +#ifdef PACK_DIGITS + } +#endif +} + +void +forceGtEqZero_To_PredX_From_DigsX_SZERO_Entry() +{ + PredX *predX; + DigsX *digsX; + void forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +void +forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_2n_minus_1_False_Entry(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small > 0) + setPredX(predX, LAZY_TRUE); + else { + if (digsX->word.small == 0) + absorbDigsXIntoPredX(predX); + else + if (digsX->word.small == -1) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_2n_minus_1_False_Entry; + } + else + setPredX(predX, LAZY_FALSE); + } + } + else { +#endif + switch (mpz_sgn(digsX->word.big)) { + case -1 : + if (mpz_cmp_si(digsX->word.big, -1) < 0) + setPredX(predX, LAZY_FALSE); + else { /* word == -1 */ + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_2n_minus_1_False_Entry; + } + break; + case 0 : + absorbDigsXIntoPredX(predX); + break; + case 1 : + setPredX(predX, LAZY_TRUE); + break; + default : + Error(FATAL, E_INT, "forceGtEqZero_To_PredX_From_DigsX_SZERO_Cont", + "bad value returned from mpz_sgn"); + } +#ifdef PACK_DIGITS + } +#endif +} + +void +forceGtEqZero_To_PredX_From_DigsX_SINF_Entry() +{ + PredX *predX; + DigsX *digsX; + void forceGtEqZero_To_PredX_From_DigsX_SINF_Cont(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + + PUSH_2(forceGtEqZero_To_PredX_From_DigsX_SINF_Cont, predX); + if (digsX->count == 0) + PUSH_3(digsX->force, digsX, defaultForceCount); +} + +void +forceGtEqZero_To_PredX_From_DigsX_SINF_Cont() +{ + PredX *predX; + DigsX *digsX; + void force_To_PredX_From_DigsX_2n_minus_1_True_Entry(); + void force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry(); + + predX = (PredX *) POP; + digsX = (DigsX *) predX->x; + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + if (digsX->word.small > 1) + setPredX(predX, LAZY_FALSE); + else { + if (digsX->word.small == 1) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry; + } + else { + if (digsX->word.small == 0) + absorbDigsXIntoPredX(predX); + else { + if (digsX->word.small == -1) { + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_2n_minus_1_True_Entry; + } + else + setPredX(predX, LAZY_TRUE); + } + } + } + } + else { +#endif + switch (mpz_sgn(digsX->word.big)) { + case -1 : + if (mpz_cmp_si(digsX->word.big, -1) < 0) + setPredX(predX, LAZY_TRUE); + else { /* word == -1 */ + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_2n_minus_1_True_Entry; + } + break; + case 0 : + absorbDigsXIntoPredX(predX); + break; + case 1 : + if (mpz_cmp_si(digsX->word.big, 1) > 0) + setPredX(predX, LAZY_FALSE); + else { /* word == 1 */ + absorbDigsXIntoPredX(predX); + predX->force = + force_To_PredX_From_DigsX_minus_2n_minus_1_False_Entry; + } + break; + default : + Error(FATAL, E_INT, "forceGtEqZero_To_PredX_From_DigsX_SINF_Cont", + "bad value returned from mpz_sgn"); + } +#ifdef PACK_DIGITS + } +#endif +} + +static BoolVal +gtEq_MatX_0(MatX *matX) +{ + if (mpz_sgn(matX->mat[0][1]) * mpz_sgn(matX->mat[1][1]) > 0) { + if (mpz_sgn(matX->mat[0][0]) * mpz_sgn(matX->mat[0][1]) >= 0) { + if (mpz_sgn(matX->mat[1][0]) * mpz_sgn(matX->mat[1][1]) >= 0) + return LAZY_TRUE; + } + else { + if (mpz_sgn(matX->mat[1][0]) * mpz_sgn(matX->mat[1][1]) < 0) + return LAZY_FALSE; + } + } + return LAZY_UNKNOWN; +} + +static BoolVal +gtEq_Vec_0(Vec *vec) +{ + if (mpz_sgn(vec->vec[1]) != 0) { + if (mpz_sgn(vec->vec[0]) * mpz_sgn(vec->vec[1]) >= 0) + return LAZY_TRUE; + else + return LAZY_FALSE; + } + if (mpz_sgn(vec->vec[0]) == 0) + Error(FATAL, E_INT, "gtEq_Vec_0", "malformed vector"); + + return LAZY_UNKNOWN; +} + diff --git a/ic-reals-6.3/base/nodeId.c b/ic-reals-6.3/base/nodeId.c new file mode 100644 index 0000000..035fa49 --- /dev/null +++ b/ic-reals-6.3/base/nodeId.c @@ -0,0 +1,81 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * For debugging purposes, we assign a unique identifier to each object in + * the heap. This identifier is invariant under copying in garbage collection. + * Also the names of the nodes in daVinci are strings formed from the + * assigned nodeId. + */ +int nodeId = 1; + +/* + * For debugging purposes, nodes are assigned id's which (unlike the address + * of the node) is invariant under garbage collection. + * + * This file allocates ids and provides a function for mapping ids to + * heap addresses. + */ +void +newNodeId(Generic *node) +{ + void addHashTableEntry(Generic *); + + node->tag.nodeId = nodeId++; + addHashTableEntry(node); +} + +/* + * We use a naive hash table to map node identifiers to heap cells. + */ +typedef struct HTE { + struct HTE *next; + Generic *node; +} HashTableEntry; + +/* + * The following must be an integer power of 2 + */ +#define HASH_TABLE_SIZE 512 +#define HASH_TABLE_MASK (HASH_TABLE_SIZE - 1) + +static HashTableEntry *hashTable[HASH_TABLE_SIZE] = {NULL}; + +void +addHashTableEntry(Generic *node) +{ + HashTableEntry *new; + + if ((new = (HashTableEntry *) malloc(sizeof(HashTableEntry))) == NULL) + Error(FATAL, E_INT, "addHashTableEntry", "malloc failed"); + + new->node = node; + new->next = hashTable[node->tag.nodeId & HASH_TABLE_MASK]; + hashTable[node->tag.nodeId & HASH_TABLE_MASK] = new; +} + +Generic * +mapNodeIdToHeapCell(int nodeId) +{ + HashTableEntry *p; + + p = hashTable[nodeId & HASH_TABLE_MASK]; + + while (p != NULL) { + if (p->node->tag.nodeId == nodeId) + return p->node; + else + p = p->next; + } + Error(FATAL, E_INT, "mapNodeIdToHeapCell", "failed to find nodeId %d", nodeId); + return NULL; +} diff --git a/ic-reals-6.3/base/print.c b/ic-reals-6.3/base/print.c new file mode 100644 index 0000000..8f001cd --- /dev/null +++ b/ic-reals-6.3/base/print.c @@ -0,0 +1,321 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include <math.h> + +void +print_R_Dec(Real x, int precision) +{ + force_R_Dec(x, precision); + print_R(x); +} + +void +print_R_Digs(Real x, int digitsNeeded) +{ + force_R_Digs(x, digitsNeeded); + print_R(x); +} + +/* + * The following two functions are pretty much the same and the common + * parts should be reconciled into a single function. The argument must + * have been forced so that it dereferences to a stream. + */ +void +print_R(Real x) +{ + SmallMatrix smallAccumMat; + int tmp; + mpf_t a, b, c, d, diff, mid; + int count; + Sign sign; + DigsX *digsX; + Real derefToStrm(Real); + + x = derefToStrm(x); + + if (x == NULL) { + printf("[-inf,+inf]"); + return; + } + + if (x->gen.tag.type == SIGNX) { + sign = x->signX.tag.value; + digsX = (DigsX *) x->signX.x; + } + else { + sign = SPOS; + digsX = (DigsX *) x; + } + + if (digsX->tag.type != DIGSX) + Error(FATAL, E_INT, "print_R", "real argument not a stream"); + + mpf_set_default_prec(digsX->count); + mpf_init(a); + mpf_init(b); + mpf_init(c); + mpf_init(d); + mpf_init(diff); + mpf_init(mid); + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + makeSmallMatrixFromDigits(smallAccumMat, digsX); + switch (sign) { + case SIGN_UNKN : + Error(FATAL, E_INT, "print_R", "sign not valid (1)\n"); + case SPOS : + break; + case SNEG : + tmp = smallAccumMat[0][0]; + smallAccumMat[0][0] = -smallAccumMat[0][1]; + smallAccumMat[0][1] = tmp; + tmp = smallAccumMat[1][0]; + smallAccumMat[1][0] = -smallAccumMat[1][1]; + smallAccumMat[1][1] = tmp; + break; + case SINF : + tmp = smallAccumMat[0][0]; + smallAccumMat[0][0] = smallAccumMat[0][0] + smallAccumMat[0][1]; + smallAccumMat[0][1] = smallAccumMat[0][1] - tmp; + tmp = smallAccumMat[1][0]; + smallAccumMat[1][0] = smallAccumMat[1][0] + smallAccumMat[1][1]; + smallAccumMat[1][1] = smallAccumMat[1][1] - tmp; + break; + case SZERO : + tmp = smallAccumMat[0][0]; + smallAccumMat[0][0] = smallAccumMat[0][0] - smallAccumMat[0][1]; + smallAccumMat[0][1] = smallAccumMat[0][1] + tmp; + tmp = smallAccumMat[1][0]; + smallAccumMat[1][0] = smallAccumMat[1][0] - smallAccumMat[1][1]; + smallAccumMat[1][1] = smallAccumMat[1][1] + tmp; + break; + } +/* + printf("a=%d\n", smallAccumMat[0][0]); + printf("b=%d\n", smallAccumMat[0][1]); + printf("c=%d\n", smallAccumMat[1][0]); + printf("d=%d\n", smallAccumMat[1][1]); +*/ + mpf_set_si(a, smallAccumMat[0][0]); + mpf_set_si(b, smallAccumMat[0][1]); + mpf_set_si(c, smallAccumMat[1][0]); + mpf_set_si(d, smallAccumMat[1][1]); + } + else { +#endif + makeMatrixFromDigits(bigTmpMat, digsX); + switch (sign) { + case SIGN_UNKN : + Error(FATAL, E_INT, "print_R", "sign not valid (2)\n"); + case SPOS : + break; + case SNEG : + MPZ_SWAP(bigTmpMat[0][0], bigTmpMat[0][1]); + mpz_neg(bigTmpMat[0][0], bigTmpMat[0][0]); + MPZ_SWAP(bigTmpMat[1][0], bigTmpMat[1][1]); + mpz_neg(bigTmpMat[1][0], bigTmpMat[1][0]); + break; + case SINF : + mpz_set(tmpa_z, bigTmpMat[0][0]); + mpz_add(bigTmpMat[0][0], bigTmpMat[0][0], bigTmpMat[0][1]); + mpz_sub(bigTmpMat[0][1], bigTmpMat[0][1], tmpa_z); + mpz_set(tmpa_z, bigTmpMat[1][0]); + mpz_add(bigTmpMat[1][0], bigTmpMat[1][0], bigTmpMat[1][1]); + mpz_sub(bigTmpMat[1][1], bigTmpMat[1][1], tmpa_z); + break; + case SZERO : + mpz_set(tmpa_z, bigTmpMat[0][0]); + mpz_sub(bigTmpMat[0][0], bigTmpMat[0][0], bigTmpMat[0][1]); + mpz_add(bigTmpMat[0][1], bigTmpMat[0][1], tmpa_z); + mpz_set(tmpa_z, bigTmpMat[1][0]); + mpz_sub(bigTmpMat[1][0], bigTmpMat[1][0], bigTmpMat[1][1]); + mpz_add(bigTmpMat[1][1], bigTmpMat[1][1], tmpa_z); + break; + } +/* + dumpMatrix(bigTmpMat); +*/ + mpf_set_z(a, bigTmpMat[0][0]); + mpf_set_z(b, bigTmpMat[0][1]); + mpf_set_z(c, bigTmpMat[1][0]); + mpf_set_z(d, bigTmpMat[1][1]); +#ifdef PACK_DIGITS + } +#endif + + count = floor(digsX->count * log10(2.0)); + + if (mpf_cmp_ui(d,0) != 0 && mpf_cmp_ui(b,0) != 0) { + mpf_div(c, c, d); + mpf_div(a, a, b); + mpf_add(mid, c, a); + mpf_div_ui(mid, mid, 2); + mpf_sub(diff, mid, a); + mpf_abs(diff, diff); + mpf_out_str(stdout, 10, count + 2, mid); + printf(" +-"); + mpf_out_str(stdout, 10, 2, diff); + } + else { + printf("["); + if (mpf_cmp_ui(d,0) == 0) + printf("NaN,"); + else { + mpf_div(c, c, d); + mpf_out_str(stdout, 10, count + 2, c); + printf(","); + } + + if (mpf_cmp_ui(b,0) == 0) + printf("NaN]"); + else { + mpf_div(a, a, b); + mpf_out_str(stdout, 10, count + 2, a); + } + } + + mpf_clear(a); + mpf_clear(b); + mpf_clear(c); + mpf_clear(d); + mpf_clear(diff); + mpf_clear(mid); +} + +double +realToDouble(Real x) +{ + SmallMatrix smallAccumMat; + int tmp; + mpf_t a, b, c, d, diff; + double f; + Sign sign; + DigsX *digsX; + Real derefToStrm(Real); + + x = derefToStrm(x); + + if (x == NULL) + Error(FATAL, E_INT, "realToDouble", "real argument not a stream"); + + if (x->gen.tag.type == SIGNX) { + sign = x->signX.tag.value; + digsX = (DigsX *) x->signX.x; + } + else { + sign = SPOS; + digsX = (DigsX *) x; + } + + if (digsX->tag.type != DIGSX) + Error(FATAL, E_INT, "realToDouble", "real argument not a stream"); + + mpf_set_default_prec(digsX->count); + mpf_init(a); + mpf_init(b); + mpf_init(c); + mpf_init(d); + mpf_init(diff); + +#ifdef PACK_DIGITS + if (digsX->count <= DIGITS_PER_WORD) { + makeSmallMatrixFromDigits(smallAccumMat, digsX); + switch (sign) { + case SIGN_UNKN : + Error(FATAL, E_INT, "realToDouble", "sign not valid (1)\n"); + case SPOS : + break; + case SNEG : + tmp = smallAccumMat[0][0]; + smallAccumMat[0][0] = -smallAccumMat[0][1]; + smallAccumMat[0][1] = tmp; + tmp = smallAccumMat[1][0]; + smallAccumMat[1][0] = -smallAccumMat[1][1]; + smallAccumMat[1][1] = tmp; + break; + case SINF : + tmp = smallAccumMat[0][0]; + smallAccumMat[0][0] = smallAccumMat[0][0] + smallAccumMat[0][1]; + smallAccumMat[0][1] = smallAccumMat[0][1] - tmp; + tmp = smallAccumMat[1][0]; + smallAccumMat[1][0] = smallAccumMat[1][0] + smallAccumMat[1][1]; + smallAccumMat[1][1] = smallAccumMat[1][1] - tmp; + break; + case SZERO : + tmp = smallAccumMat[0][0]; + smallAccumMat[0][0] = smallAccumMat[0][0] - smallAccumMat[0][1]; + smallAccumMat[0][1] = smallAccumMat[0][1] + tmp; + tmp = smallAccumMat[1][0]; + smallAccumMat[1][0] = smallAccumMat[1][0] - smallAccumMat[1][1]; + smallAccumMat[1][1] = smallAccumMat[1][1] + tmp; + break; + } + mpf_set_si(a, smallAccumMat[0][0]); + mpf_set_si(b, smallAccumMat[0][1]); + mpf_set_si(c, smallAccumMat[1][0]); + mpf_set_si(d, smallAccumMat[1][1]); + } + else { +#endif + makeMatrixFromDigits(bigTmpMat, digsX); + switch (sign) { + case SIGN_UNKN : + Error(FATAL, E_INT, "realToDouble", "sign not valid (2)\n"); + case SPOS : + break; + case SNEG : + MPZ_SWAP(bigTmpMat[0][0], bigTmpMat[0][1]); + mpz_neg(bigTmpMat[0][0], bigTmpMat[0][0]); + MPZ_SWAP(bigTmpMat[1][0], bigTmpMat[1][1]); + mpz_neg(bigTmpMat[1][0], bigTmpMat[1][0]); + break; + case SINF : + mpz_set(tmpa_z, bigTmpMat[0][0]); + mpz_add(bigTmpMat[0][0], bigTmpMat[0][0], bigTmpMat[0][1]); + mpz_sub(bigTmpMat[0][1], bigTmpMat[0][1], tmpa_z); + mpz_set(tmpa_z, bigTmpMat[1][0]); + mpz_add(bigTmpMat[1][0], bigTmpMat[1][0], bigTmpMat[1][1]); + mpz_sub(bigTmpMat[1][1], bigTmpMat[1][1], tmpa_z); + break; + case SZERO : + mpz_set(tmpa_z, bigTmpMat[0][0]); + mpz_sub(bigTmpMat[0][0], bigTmpMat[0][0], bigTmpMat[0][1]); + mpz_add(bigTmpMat[0][1], bigTmpMat[0][1], tmpa_z); + mpz_set(tmpa_z, bigTmpMat[1][0]); + mpz_sub(bigTmpMat[1][0], bigTmpMat[1][0], bigTmpMat[1][1]); + mpz_add(bigTmpMat[1][1], bigTmpMat[1][1], tmpa_z); + break; + } + mpf_set_z(a, bigTmpMat[0][0]); + mpf_set_z(b, bigTmpMat[0][1]); + mpf_set_z(c, bigTmpMat[1][0]); + mpf_set_z(d, bigTmpMat[1][1]); +#ifdef PACK_DIGITS + } +#endif + if (mpf_cmp_ui(b,0) == 0 || mpf_cmp_ui(d,0) == 0) { + Error(FATAL, E_INT, "realToDouble", "NaN"); + f = 0; + } else { + mpf_div(a, a, b); + f = mpf_get_d(a); + } + mpf_clear(a); + mpf_clear(b); + mpf_clear(c); + mpf_clear(d); + mpf_clear(diff); + return f; +} + diff --git a/ic-reals-6.3/base/realLib.c b/ic-reals-6.3/base/realLib.c new file mode 100644 index 0000000..15da22a --- /dev/null +++ b/ic-reals-6.3/base/realLib.c @@ -0,0 +1,486 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "real.h" +#include "real-impl.h" + +void initEmitDigit(void); +void initEmitSign(void); +void initEpsDel(); +void initTmp(); +void initStack(); +void initForceMethodLookupTable(); +void initStrategy(); + +int defaultForceCount = DEFAULT_FORCE_COUNT; +int forceDecUpperBound = FORCE_DEC_UPPER_BOUND; +int stackSize = STACK_SIZE * 1024; + +/* + * Initialization of the real library + */ +void +initRealBase() +{ + char *p; + + if ((p = getenv("ICR_DEFAULT_FORCE_COUNT")) != NULL) + defaultForceCount = atoi(p); + + if ((p = getenv("ICR_FORCE_DEC_UPPER_BOUND")) != NULL) + forceDecUpperBound = atoi(p); + + if ((p = getenv("ICR_STACK_SIZE")) != NULL) + stackSize = atoi(p) * 1024; + +#ifdef DAVINCI + initDaVinci(); +#endif + + initStack(); + initForceMethodLookupTable(); + initEmitDigit(); + initEmitSign(); + initTmp(); + initEpsDel(); + initStrategy(); +} + +/* + * For a real x, this returns a new real which denotes the same value as + * x, but where the new real is a stream (ie prefixed by a SignX or DigsX). + * The only interesting cases are when the expression rooted at x is an + * lft. In this case we create a new real object but also record in x + * a link to the new real to avoid doing it again. + */ +Real +makeStream(Real x) +{ + Real r; + DigsX *digsX; + void force_To_DigsX_From_Vec(); + void force_To_DigsX_From_MatX_Entry(); + void force_To_DigsX_From_TenXY_Entry(); + void force_To_DigsX_From_Cls_Entry(); + void force_To_DigsX_From_Alt_Entry(); + + /* + * When we want to make a stream from a vector or matrix, we + * must make a copy of the lft first since the LFT might be shared + * and emitting a sign or digit changes the lft. For tensors, + * this is unnecessary as, while the tensor might be shared, + * any consumer of the tensor can consume only the stream + * and changes to the original tensor are acceptable. + */ + switch (x->gen.tag.type) { + case VECTOR : + /* + * Check that we haven't already made a stream for this lft + */ + if (x->vec.strm == NULL) { + + /* create a copy of the lft */ + r = vector_Z(x->vec.vec[0], x->vec.vec[1]); + + /* to make a signed lft into a stream, we prefix it by a SignX */ + if (r->gen.tag.isSigned) + x->vec.strm = (Real) allocSignX(r, SIGN_UNKN); + + /* for an unsigned lft, we prefix it by a DigsX */ + else { + digsX = allocDigsX(); + digsX->force = force_To_DigsX_From_Vec; + digsX->x = r; +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, r); + endGraphUpdate(); +#endif + x->vec.strm = (Real) digsX; + } + } + + /* + * If daVinci is running then we draw a double line from the original + * real and its stream version to indicate that there are two + * expressions in the heap which point denote the same real value. + */ +#ifdef DAVINCI + beginGraphUpdate(); + drawEqEdge(x, x->vec.strm); + endGraphUpdate(); +#endif + return x->vec.strm; + break; + + /* this case is exactly the same as the above */ + case MATX : + if (x->matX.strm == NULL) { + r = matrix_Z(x->matX.x, x->matX.mat[0][0], x->matX.mat[0][1], + x->matX.mat[1][0], x->matX.mat[1][1]); + if (r->gen.tag.isSigned) + x->matX.strm = (Real) allocSignX(r, SIGN_UNKN); + else { + digsX = allocDigsX(); + digsX->force = force_To_DigsX_From_MatX_Entry; + digsX->x = r; +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, r); + endGraphUpdate(); +#endif + x->matX.strm = (Real) digsX; + } + } +#ifdef DAVINCI + beginGraphUpdate(); + drawEqEdge(x, x->matX.strm); + endGraphUpdate(); +#endif + return x->matX.strm; + break; + + /* same as for vectors */ + case TENXY : + if (x->tenXY.strm == NULL) { + r = tensor_Z(x->tenXY.x, x->tenXY.y, + x->tenXY.ten[0][0], x->tenXY.ten[0][1], + x->tenXY.ten[1][0], x->tenXY.ten[1][1], + x->tenXY.ten[2][0], x->tenXY.ten[2][1], + x->tenXY.ten[3][0], x->tenXY.ten[3][1]); + if (r->gen.tag.isSigned) + x->tenXY.strm = (Real) allocSignX(r, SIGN_UNKN); + else { + digsX = allocDigsX(); + digsX->force = force_To_DigsX_From_TenXY_Entry; + digsX->x = r; +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, r); + endGraphUpdate(); +#endif + x->tenXY.strm = (Real) digsX; + } +#ifdef DAVINCI + beginGraphUpdate(); + drawEqEdge(x, x->tenXY.strm); + endGraphUpdate(); +#endif + } + return x->tenXY.strm; + break; + + case ALT : + if (x->alt.tag.isSigned) + r = (Real) allocSignX(x, SIGN_UNKN); + else { + r = (Real) allocDigsX(); + r->digsX.force = force_To_DigsX_From_Alt_Entry; + r->digsX.x = x; +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(r, x); + endGraphUpdate(); +#endif + } + return r; + break; + + case CLOSURE : + if (x->cls.tag.isSigned) + r = (Real) allocSignX(x, SIGN_UNKN); + else { + r = (Real) allocDigsX(); + r->digsX.force = force_To_DigsX_From_Cls_Entry; + r->digsX.x = x; +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(r, x); + endGraphUpdate(); +#endif + } + return r; + break; + + case DIGSX : + case SIGNX : + return x; + + default : + Error(FATAL, E_INT, "makeStream", + "trying to make a stream from a non-real"); + return NULL; + } +} + +/* + * This creates a closure (typically a function which unfolds a tensor + * chain). + */ +Cls * +allocCls(void (*force)(), void *userData) +{ + Cls *cls; + + if ((cls = (Cls *) malloc (sizeof(Cls))) == NULL) + Error(FATAL, E_INT, "allocCls", "malloc failed"); + +#ifdef DAVINCI + newNodeId(cls); +#else +#ifdef TRACE + newNodeId(cls); +#endif +#endif + + cls->tag.type = CLOSURE; + cls->tag.dumped = FALSE; + cls->tag.isSigned = FALSE; + cls->force = force; + cls->userData = userData; + cls->redirect = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + newNode(cls, CLOSURE); + endGraphUpdate(); +#endif + + return cls; +} + +/* + * The next family of functions are simple arithmetic operations. + */ +Real +add_R_R(Real x, Real y) +{ + return tensor_Int(x, y, 0, 0, 1, 0, 1, 0, 0, 1); +} + +Real +add_R_Int(Real x, int y) +{ + return matrix_Int(x, 1, 0, y, 1); +} + +Real +add_R_QInt(Real x, int a, int b) +{ + return matrix_Int(x, b, 0, a, b); +} + +Real +sub_R_R(Real x, Real y) +{ + return tensor_Int(x, y, 0, 0, 1, 0, -1, 0, 0, 1); +} + +Real +sub_R_Int(Real x, int y) +{ + return matrix_Int(x, 1, 0, -y, 1); +} + +Real +sub_R_QInt(Real x, int a, int b) +{ + return matrix_Int(x, b, 0, -a, b); +} + +Real +sub_Int_R(int x, Real y) +{ + return matrix_Int(y, -1, 0, x, 1); +} + +Real +sub_QInt_R(int a, int b, Real y) +{ + return matrix_Int(y, -b, 0, a, b); +} + +Real +mul_R_R(Real x, Real y) +{ + return tensor_Int(x, y, 1, 0, 0, 0, 0, 0, 0, 1); +} + +Real +mul_R_Int(Real x, int y) +{ + return matrix_Int(x, y, 0, 0, 1); +} + +Real +mul_R_QInt(Real x, int a, int b) +{ + return matrix_Int(x, a, 0, 0, b); +} + +Real +div_R_R(Real x, Real y) +{ + return tensor_Int(x, y, 0, 0, 1, 0, 0, 1, 0, 0); +} + +Real +div_R_Int(Real x, int y) +{ + return matrix_Int(x, 1, 0, 0, y); +} + +Real +div_Int_R(int x, Real y) +{ + return matrix_Int(y, 0, 1, x, 0); +} + +Real +div_R_QInt(Real x, int a, int b) +{ + return matrix_Int(x, b, 0, 0, a); +} + +Real +div_QInt_R(int a, int b, Real x) +{ + return matrix_Int(x, 0, b, a, 0); +} + + +/* + * This creates a vector (a,b) and then prepends it by the characteristic + * pair (c,n) and finally sets the sign to sign. This is used only for + * debugging .. to set up a real argument for a function. + */ +Real +makeRealSignCNQInt(Sign sign, char *c, int n, int a, int b) +{ + DigsX *digsX; + Real y; + void force_To_DigsX_From_Vec(); + void force_To_DigsX_From_DigsX_Entry(); + + y = (Real) vector_Int(a, b); + + if (n > 0) { + digsX = allocDigsX(); + digsX->x = y; + digsX->force = force_To_DigsX_From_Vec; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, y); + endGraphUpdate(); +#endif + + y = (Real) digsX; + + digsX = allocDigsX(); + digsX->x = y; + digsX->force = force_To_DigsX_From_DigsX_Entry; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, y); + endGraphUpdate(); +#endif + + digsX->count = n; +#ifdef PACK_DIGITS + if (n <= DIGITS_PER_WORD) + digsX->word.small = atoi(c); + else + mpz_init_set_str(digsX->word.big, c, 10); +#else + mpz_set_str(digsX->word.big, c, 10); +#endif + return (Real) allocSignX((Real) digsX, sign); + } + else { + switch (sign) { + case SZERO : + case SPOS : + case SNEG : + case SINF : + digsX = allocDigsX(); + digsX->x = y; + digsX->force = force_To_DigsX_From_Vec; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, y); + endGraphUpdate(); +#endif + + digsX->count = 0; + return (Real) allocSignX((Real) digsX, sign); + + case SIGN_UNKN : + return (Real) allocSignX(y, sign); + + default : + Error(FATAL, E_INT, "makeRealSignCNQInt", "invalid sign"); + return NULL; + } + } +} + +/* + * These are the new preferred names for the basic lft functions. + * The other names will disappear in a future release. + */ +Real +real_QInt(int a, int b) +{ + return vector_Int(a, b); +} + +Real +real_QZ(mpz_t a, mpz_t b) +{ + return vector_Z(a, b); +} + +/* + * These are the same as matrix_ functions but take their arguments + * in a different order (row order rather than column order). + */ +Real +lft_R_Int(Real x, int a, int b, int c, int d) +{ + return matrix_Int(x, a, c, b, d); +} + +Real +lft_R_Z(Real x, mpz_t a, mpz_t b, mpz_t c, mpz_t d) +{ + return matrix_Z(x, a, c, b, d); +} + +/* + * These are the same as tensor_ functions but take their arguments + * in a different order (row order rather than column order). + */ +Real +lft_R_R_Int(Real x, Real y, int a, int b, int c, int d, + int e, int f, int g, int h) +{ + return tensor_Int(x, y, a, e, b, f, c, g, d, h); +} + +Real +lft_R_R_Z(Real x, Real y, mpz_t a, mpz_t b, mpz_t c, mpz_t d, + mpz_t e, mpz_t f, mpz_t g, mpz_t h) +{ + return tensor_Z(x, y, a, e, b, f, c, g, d, h); +} diff --git a/ic-reals-6.3/base/stack.c b/ic-reals-6.3/base/stack.c new file mode 100644 index 0000000..14376d9 --- /dev/null +++ b/ic-reals-6.3/base/stack.c @@ -0,0 +1,244 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * The ``abstract machine'' uses a single stack to record what work needs + * to be done. Each frame is consists of a pointer to a force function + * and the arguments to the force function. + */ + +unsigned *stack; +unsigned *stackBound; +unsigned *sp; + +void +initStack() +{ + if ((stack = (unsigned *) malloc(stackSize * sizeof(unsigned))) == NULL) + Error(FATAL, E_INT, "initStack", "malloc failed"); + sp = stack - 1; + stackBound = stack + stackSize; +} + +void +runStack() +{ + void (*f)(); + void dumpTopOfStack(); + +#ifdef DAVINCI + runStackViaDaVinci(); +#else + while (sp >= stack) { +#ifdef TRACE + if (TRACE) + dumpTopOfStack(); +#endif + f = (void (*)()) POP; + (*f)(); + } +#endif +} + +/* + * Retrieves the descriptor for the top of the stack. + */ +ForceFuncDesc * +getDescForTOS() +{ + ForceFuncDesc *p; + + p = getDescForForceFunc((void (*)()) *sp); + + if (p == NULL) { + debugp("", "tos = %x\n", (unsigned) *sp); + Error(FATAL, E_INT, "getDescForTOS", "failed to find %x", (void *) *sp); + } + return p; +} + +void +dumpStack() +{ + unsigned *p; + ForceFuncDesc *d; + + for (p = sp; p >= stack; p--) { + fprintf(stderr, "%x %d", *p, *p); + d = getDescForForceFunc((void (*)()) *p); + if (d != NULL) + fprintf(stderr, " %s", d->funcName); + fprintf(stderr, "\n"); + } + +} + +void +dumpTopOfStack() +{ + ForceFuncDesc *q; + unsigned *sp1; + + if (sp >= stack) { + q = getDescForTOS(); + + /* + * If there are not the expected number of arguments on the stack + * then we dump what we can and then bail out. + */ + if (sp - stack < q->nArgs - 1) { + fprintf(stderr, "%s ", q->funcName); + for (sp1 = sp - 1; sp1 >= stack; sp1--) + fprintf(stderr, "%x ", *sp1); + fprintf(stderr, "\n"); + Error(FATAL, E_INT, "dumpTopOfStack", "stack underflow"); + } + + switch (q->nArgs) { + case 2 : + debugp(q->funcName, "%x", (unsigned) *(sp - 1)); + break; + case 3 : + debugp(q->funcName, "%x %d", (unsigned) *(sp - 1), + (unsigned) *(sp - 2)); + break; + case 4 : + debugp(q->funcName, "%x %x %d", (unsigned) *(sp - 1), + (unsigned) *(sp - 2), + (unsigned) *(sp - 3)); + break; + default : + break; + } + fprintf(stderr, "\n"); + } +} + +/* + * The following function will highlight the edge in the daVinci + * window associated with the frame at the top of the stack. This is + * called after a new frame is pushed. + */ +void +highlightTOS() +{ + ForceFuncDesc *p; + Real x; + + p = getDescForTOS(); + x = (Real) (*(sp - 1)); + + switch (x->gen.tag.type) { + case ALT : + break; + case VECTOR : + break; + case MATX : + highlightEdge(&x->gen, &((MatX *) x)->x->gen, 0); + break; + case TENXY : + if (isLeftFunc(p)) + highlightEdge(&x->gen, &((TenXY *) x)->x->gen, 0); + else { + if (isRightFunc(p)) + highlightEdge(&x->gen, &((TenXY *) x)->y->gen, 1); + } + break; + case DIGSX : + highlightEdge(&x->gen, &((DigsX *) x)->x->gen, 0); + break; + case SIGNX : + highlightEdge(&x->gen, &((SignX *) x)->x->gen, 0); + break; + case CLOSURE : + break; + case BOOLX : + highlightEdge(&x->gen, (Generic *)&((BoolX *) x)->x->gen, 0); + break; + case BOOLXY : + if (isLeftFunc(p)) + highlightEdge(&x->gen, (Generic *)&((BoolXY *) x)->x->gen, 0); + else { + if (isRightFunc(p)) + highlightEdge(&x->gen, (Generic *)&((BoolXY *) x)->y->gen, 1); + } + break; + case PREDX : + highlightEdge(&x->gen, &((PredX *) x)->x->gen, 0); + break; + default : + Error(FATAL, E_INT, "highlightTOS", "object has unknown type"); + } +} + +void +unhighlightTOS() +{ + ForceFuncDesc *p; + Real x; + + p = getDescForTOS(); + x = (Real) (*(sp - 1)); + + switch (x->gen.tag.type) { + case ALT : + break; + case VECTOR : + break; + case MATX : + unhighlightEdge(&x->gen, &((MatX *) x)->x->gen, 0); + break; + case TENXY : + if (isLeftFunc(p)) + unhighlightEdge(&x->gen, &((TenXY *) x)->x->gen, 0); + else { + if (isRightFunc(p)) + unhighlightEdge(&x->gen, &((TenXY *) x)->y->gen, 1); + } + break; + case DIGSX : + unhighlightEdge(&x->gen, &((DigsX *) x)->x->gen, 0); + break; + case SIGNX : + unhighlightEdge(&x->gen, &((SignX *) x)->x->gen, 0); + break; + case CLOSURE : + break; + case BOOLX : + unhighlightEdge(&x->gen, (Generic *)&((BoolX *) x)->x->gen, 0); + break; + case BOOLXY : + if (isLeftFunc(p)) + unhighlightEdge(&x->gen, (Generic *)&((BoolXY *) x)->x->gen, 0); + else + if (isRightFunc(p)) + unhighlightEdge(&x->gen, (Generic *)&((BoolXY *) x)->y->gen, 1); + break; + case PREDX : + unhighlightEdge(&x->gen, &((PredX *) x)->x->gen, 0); + break; + default : + Error(FATAL, E_INT, "unhighlightTOS", "object has unknown type"); + } +} + +int +isLeftFunc(ForceFuncDesc *p) +{ + return (p->argXOrY == ARG_X); +} + +int +isRightFunc(ForceFuncDesc *p) +{ + return (p->argXOrY == ARG_Y); +} diff --git a/ic-reals-6.3/base/strategy.c b/ic-reals-6.3/base/strategy.c new file mode 100644 index 0000000..d1c8e35 --- /dev/null +++ b/ic-reals-6.3/base/strategy.c @@ -0,0 +1,87 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * Functions related to ``information overlap'' tensor strategy. Can + * probably be dropped and reky soley on epsilon-delta stuff. + */ +static mpz_t a_times_d, c_times_b; + +void +initStrategy() +{ + mpz_init(a_times_d); + mpz_init(c_times_b); +} + +/* + * Given vectors (a,b) and (c,d), this returns + * -1 if (a,b) < (c,d) + * =0 if (a,b) = (c,d) + * +1 if (a,b) > (c,d) + */ +static int +compareVectors(Vector v0, Vector v1) +{ + int tmp; + + mpz_mul(a_times_d, v0[0], v1[1]); + mpz_mul(c_times_b, v1[0], v0[1]); + tmp = mpz_cmp(a_times_d, c_times_b); + return MPZ_SIGN(tmp); +} + +/* + * This is Peter's ``information overlap'' strategy. + * + * If the structure of the code seems odd, it is because we want to avoid + * doing the same operations more than once. C guarantees that when evaluating + * a conjunction, if the first conjunct is false, then the second is + * not evaluated. + * + * This returns 1 to select y (right) and 0 to select x (left). + */ +int +tensorStrategy(Tensor t) +{ + int v0cv1; + + /* + * we compare: + * v0 <> v1 + * v0 <> v3 + * v2 <> v1 + * v2 <> v3 + */ + v0cv1 = compareVectors(t[0], t[1]); + if (v0cv1 > 0) { + if ((compareVectors(t[0], t[3]) > 0) + && (compareVectors(t[2], t[1]) > 0) + && (compareVectors(t[2], t[3]) > 0)) { + return 1; + } + else + return 0; + } + else { + if (v0cv1 < 0) { + if ((compareVectors(t[0], t[3]) < 0) + && (compareVectors(t[2], t[1]) < 0) + && (compareVectors(t[2], t[3]) < 0)) { + return 1; + } + else + return 0; + } + } + return 0; +} diff --git a/ic-reals-6.3/base/strictAlt.c b/ic-reals-6.3/base/strictAlt.c new file mode 100644 index 0000000..9ae4434 --- /dev/null +++ b/ic-reals-6.3/base/strictAlt.c @@ -0,0 +1,129 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * The conditional is implemented as a function: + * + * void * realAlt(Bool, *void, ...) + * + * where the arguments are a list of guard/value pairs. This is implemented + * using stdarg(3). The last guard must be the constant DEFAULT_GUARD. + */ + +typedef struct ALT_CELL { + Bool guard; + void *value; + struct ALT_CELL *next; +} AltCell; + +#include <stdarg.h> + +/* + * ### A better scheme would be to put the alt in the heap as well. Perhaps + * later. + */ +void * +realAlt(Bool guard, void *value, ...) +{ + va_list ap; + AltCell *head, *ptr; + AltCell **prev; + void *defaultValue; + void runStack(); + + /* + * The caller is a wally if the first argument is the default guard. + * But we accept it. + */ + if ((unsigned) guard == DEFAULT_GUARD) + return value; + + if (guard->gen.tag.value == LAZY_TRUE) + return value; + + if ((head = (AltCell *) alloca(sizeof(AltCell))) == NULL) + Error(FATAL, E_INT, "realAlt", "alloca failed"); + + head->guard = guard; + head->value = value; + head->next = NULL; + ptr = head; + + /* + * Now we consume the arguments. Each is a guard/value pair. If + * the guard is true, then we just return the value. If not then + * we allocate a cell with the guard and value and add it to + * the list of cells. + */ + va_start(ap, value); + while ((unsigned) (guard = va_arg(ap, Bool)) != DEFAULT_GUARD) { + value = va_arg(ap, void *); + + if (guard->gen.tag.value == LAZY_TRUE) + return value; + + if ((ptr->next = (AltCell *) alloca(sizeof(AltCell))) == NULL) + Error(FATAL, E_INT, "realAlt", "alloca failed"); + + ptr = ptr->next; + ptr->guard = guard; + ptr->value = value; + ptr->next = NULL; + } + defaultValue = va_arg(ap, void *); + va_end(ap); + + /* + * If we reach here, then we have a list of AltCells which + * have guards having value LAZY_UNKNOWN. We now walk down this + * list repeatedly. For each alternative, we force the next value + * in the boolean stream. If any guard becomes true, then we + * return the corresponding value. If something becomes false, + * it gets removed from the list. The loop ends when the list + * becomes empty whereupon we return the default value provided + * at the end of the argument list. + */ + ptr = head; + prev = &head; + while (ptr != NULL) { + if (ptr->guard->gen.tag.value == LAZY_UNKNOWN) { + PUSH_2(ptr->guard->gen.force, ptr->guard); + runStack(); + } + switch (ptr->guard->gen.tag.value) { + case LAZY_TRUE : + return ptr->value; + break; + case LAZY_FALSE : + *prev = ptr->next; /* unlink the cell */ + ptr = ptr->next; + break; + case LAZY_UNKNOWN : + prev = &(ptr->next); + ptr = ptr->next; + break; + default : + Error(FATAL, E_INT, "realAlt", + "invalid boolean value encountered"); + break; + } + + /* + * Reached the end of the list so start from the beginning again. + */ + if (ptr == NULL) { + ptr = head; + prev = &head; + } + } + return defaultValue; +} diff --git a/ic-reals-6.3/base/strsep.c b/ic-reals-6.3/base/strsep.c new file mode 100644 index 0000000..1191f33 --- /dev/null +++ b/ic-reals-6.3/base/strsep.c @@ -0,0 +1,25 @@ +/* + * Some UNIX distributions don't come with strsep. + */ +#include <stdio.h> +#include <string.h> + +char * +strsep(char **str_p, char *delim) +{ + char *start, *end; + + start = *str_p; + if (start == NULL) + return NULL; + + end = strpbrk(start, delim); + if (end) { + *end++ = '\0'; + *str_p = end; + } + else + *str_p = NULL; + + return start; +} diff --git a/ic-reals-6.3/base/util.c b/ic-reals-6.3/base/util.c new file mode 100644 index 0000000..f523cd8 --- /dev/null +++ b/ic-reals-6.3/base/util.c @@ -0,0 +1,858 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include <gmp-impl.h> +#include <longlong.h> +#include "real-impl.h" + +/* + * Utilities used internally by the library + */ +/* + * This is used only when compiled with -DTRACE=traceOn. + */ +int traceOn = 0; + +/* + * Some temporary big numbers which are shared + */ +mpz_t tmpa_z, tmpb_z, tmpc_z, tmpd_z, tmpe_z, tmpf_z; +mpz_t zero_z; + +Matrix bigTmpMat; +Tensor bigTmpTen; + +void +debugTrace(int b) +{ + traceOn = b; +} + +/* + * The library shares bignum temporart storage. This needs to change + * when garbage collection goes back in. + */ +void +initTmp() +{ + mpz_init(tmpa_z); + mpz_init(tmpb_z); + mpz_init(tmpc_z); + mpz_init(tmpd_z); + mpz_init(tmpe_z); + mpz_init(tmpf_z); + + mpz_init_set_ui(zero_z, 0); + + mpz_init(bigTmpMat[0][0]); + mpz_init(bigTmpMat[0][1]); + mpz_init(bigTmpMat[1][0]); + mpz_init(bigTmpMat[1][1]); + + mpz_init(bigTmpTen[0][0]); + mpz_init(bigTmpTen[0][1]); + mpz_init(bigTmpTen[1][0]); + mpz_init(bigTmpTen[1][1]); + mpz_init(bigTmpTen[2][0]); + mpz_init(bigTmpTen[2][1]); + mpz_init(bigTmpTen[3][0]); + mpz_init(bigTmpTen[3][1]); +} + +void +multVectorPairTimesVector(Vector vec0, Vector vec1, Vector vec) +{ + /* ae + cf */ + mpz_mul(tmpa_z, vec0[0], vec[0]); + mpz_mul(tmpe_z, vec1[0], vec[1]); + mpz_add(tmpa_z, tmpa_z, tmpe_z); + + /* be + df */ + mpz_mul(tmpb_z, vec0[1], vec[0]); + mpz_mul(tmpe_z, vec1[1], vec[1]); + mpz_add(tmpb_z, tmpb_z, tmpe_z); + + /* + * Computed the product, now replace with the original matrix + * with a vector. + */ + MPZ_SWAP(tmpa_z, vec0[0]); + MPZ_SWAP(tmpb_z, vec0[1]); + + mpz_set_ui(vec1[0], 0); + mpz_set_ui(vec1[1], 0); +} + +/* + * Given vectors (a,b) and (c,d) and the matrix is ((e,f), (g,h)). This + * computes the product as if the first two vectors are the columns of a + * matrix. The result is a pair of vectors: + * + * (ae + cf, be + df) and (ag + ch, bg + dh) + * + * It is important to note that the result overwrites the original vectors + * using the SWAP macro. + */ +void +multVectorPairTimesMatrix(Vector vec0, Vector vec1, Matrix mat) +{ + /* ae + cf */ + mpz_mul(tmpa_z, vec0[0], mat[0][0]); + mpz_mul(tmpe_z, vec1[0], mat[0][1]); + mpz_add(tmpa_z, tmpa_z, tmpe_z); + + /* be + df */ + mpz_mul(tmpb_z, vec0[1], mat[0][0]); + mpz_mul(tmpe_z, vec1[1], mat[0][1]); + mpz_add(tmpb_z, tmpb_z, tmpe_z); + + /* ag + ch */ + mpz_mul(tmpc_z, vec0[0], mat[1][0]); + mpz_mul(tmpe_z, vec1[0], mat[1][1]); + mpz_add(tmpc_z, tmpc_z, tmpe_z); + + /* bg + dh */ + mpz_mul(tmpd_z, vec0[1], mat[1][0]); + mpz_mul(tmpe_z, vec1[1], mat[1][1]); + mpz_add(tmpd_z, tmpd_z, tmpe_z); + + /* + * Computed the product, now replace with the original vectors + */ + MPZ_SWAP(tmpa_z, vec0[0]); + MPZ_SWAP(tmpb_z, vec0[1]); + MPZ_SWAP(tmpc_z, vec1[0]); + MPZ_SWAP(tmpd_z, vec1[1]); +} + +/* + * Same as the above except the columns of the matrix are (e,f) and (g,h) + */ +void +multVectorPairTimesMatrix_Z(Vector vec0, Vector vec1, + mpz_t e, mpz_t f, mpz_t g, mpz_t h) +{ + /* ae + cf */ + mpz_mul(tmpa_z, vec0[0], e); + mpz_mul(tmpe_z, vec1[0], f); + mpz_add(tmpa_z, tmpa_z, tmpe_z); + + /* be + df */ + mpz_mul(tmpb_z, vec0[1], e); + mpz_mul(tmpe_z, vec1[1], f); + mpz_add(tmpb_z, tmpb_z, tmpe_z); + + /* ag + ch */ + mpz_mul(tmpc_z, vec0[0], g); + mpz_mul(tmpe_z, vec1[0], h); + mpz_add(tmpc_z, tmpc_z, tmpe_z); + + /* bg + dh */ + mpz_mul(tmpd_z, vec0[1], g); + mpz_mul(tmpe_z, vec1[1], h); + mpz_add(tmpd_z, tmpd_z, tmpe_z); + + /* + * Computed the product, now replace with the original vectors + */ + MPZ_SWAP(tmpa_z, vec0[0]); + MPZ_SWAP(tmpb_z, vec0[1]); + MPZ_SWAP(tmpc_z, vec1[0]); + MPZ_SWAP(tmpd_z, vec1[1]); +} + +/* + * Not needed for GMP 3.1 +inline void +mpz_mul_si(mpz_t x, mpz_t y, int z) +{ + if (z >= 0) + mpz_mul_ui(x, y, (unsigned) z); + else { + mpz_mul_ui(x, y, (unsigned) (-z)); + mpz_neg(x, x); + } +} +*/ + +/* + * This is the same as above except the entries in the matrix all + * fit in a machine word. + */ +void +multVectorPairTimesSmallMatrix(Vector vec0, Vector vec1, SmallMatrix mat) +{ + /* ae + cf */ + mpz_mul_si(tmpa_z, vec0[0], mat[0][0]); + mpz_mul_si(tmpe_z, vec1[0], mat[0][1]); + mpz_add(tmpa_z, tmpa_z, tmpe_z); + + /* be + df */ + mpz_mul_si(tmpb_z, vec0[1], mat[0][0]); + mpz_mul_si(tmpe_z, vec1[1], mat[0][1]); + mpz_add(tmpb_z, tmpb_z, tmpe_z); + + /* ag + ch */ + mpz_mul_si(tmpc_z, vec0[0], mat[1][0]); + mpz_mul_si(tmpe_z, vec1[0], mat[1][1]); + mpz_add(tmpc_z, tmpc_z, tmpe_z); + + /* bg + dh */ + mpz_mul_si(tmpd_z, vec0[1], mat[1][0]); + mpz_mul_si(tmpe_z, vec1[1], mat[1][1]); + mpz_add(tmpd_z, tmpd_z, tmpe_z); + + /* + * Computed the product, now replace with the original vectors + */ + MPZ_SWAP(tmpa_z, vec0[0]); + MPZ_SWAP(tmpb_z, vec0[1]); + MPZ_SWAP(tmpc_z, vec1[0]); + MPZ_SWAP(tmpd_z, vec1[1]); +} + +/* + * This does the work of taking some number of digits from something bearing + * information such as an LFT. There are however, possibilities other than + * LFTs. See realSqrt for another example of the use of this function. + * The digits are deposited in a digsX structure augmenting any digits + * already in the structure. + * + * The arguments are as follows: + * + * digsX - the place where the digits are to be deposited + * + * emitDigit - this is a pointer to a function which is used to + * obtain a single digit from the object and compute the residual of + * that object once than digits is emitted. + * + * info - this is the object which holds informations such as a vector, + * matrix or tensor and from which we are taking digits. This function + * does not inspect ``info'' directly. It doesn't care what ``info'' is + * and only passes it to emitDigit + * + * digitsNeeded - this is what is says - the number of digits we should try + * to emit. Often this is chosen to be MAXINT, or in other words take + * all the digits possible. + * + * The function returns the number of digits it has managed to emit (which may + * be and is often less than we asked for). + */ +int +emitDigits(DigsX *digsX, edf emitDigit, void *info, int digitsNeeded) +{ + Digit d; + int word; + unsigned char count; + int total; + bool ok; + + total = 0; + ok = TRUE; + while (digitsNeeded > 0 && ok) { + /* + * We now extract digits from info until we have filled + * a machine word or until no digit can be extracted. + */ + word = 0; + count = 0; + while (count < DIGITS_PER_WORD && digitsNeeded > 0 && ok) { + ok = (*emitDigit)(info, &d); + if (ok) { + count++; + digitsNeeded--; + word = (word << 1) + d; + } + } + + /* + * If we get here and count > 0, then we need to augment the + * word stored in the DigsX. + */ + if (count > 0) { + total += count; + + /* + * First check to see if we are already dealing with a large word. + */ +#ifdef PACK_DIGITS + if (digsX->count > DIGITS_PER_WORD) { +#endif + mpz_mul_2exp(digsX->word.big, digsX->word.big, count); + if (word >= 0) { /* there is no mpz_add_si function */ + mpz_add_ui(digsX->word.big, digsX->word.big, word); + } + else { + mpz_sub_ui(digsX->word.big, digsX->word.big, -word); + } + digsX->count += count; +#ifdef PACK_DIGITS + } + else { + digsX->count += count; + + /* + * Now see if we are about to overflow the machine word. + */ + if (digsX->count > DIGITS_PER_WORD) { + mpz_init_set_si(digsX->word.big, digsX->word.small); + mpz_mul_2exp(digsX->word.big, digsX->word.big, count); + if (word >= 0) { /* there is no mpz_add_si function */ + mpz_add_ui(digsX->word.big, digsX->word.big, word); + } + else { + mpz_sub_ui(digsX->word.big, digsX->word.big, -word); + } + } + else + digsX->word.small = (digsX->word.small << count) + word; + } +#endif + } + } + return total; +} + +/* + * The assumption here is that the number of digits in digsX <= DIGITS_PER_WORD. */ +void +makeSmallMatrixFromDigits(SmallMatrix mat, DigsX *digsX) +{ + int twoPowN; + + if (digsX->count <= 0) { + mat[0][0] = 1; + mat[0][1] = 0; + mat[1][0] = 0; + mat[1][1] = 1; + } + else { + twoPowN = 1 << digsX->count; + mat[0][0] = twoPowN + digsX->word.small + 1; + mat[0][1] = twoPowN - digsX->word.small - 1; + mat[1][0] = twoPowN + digsX->word.small - 1; + mat[1][1] = twoPowN - digsX->word.small + 1; + } +} + +/* + * Same as the function above except for big integers. + * In this case we assume that the number of digits with which to form + * the matrix is > DIGITS_PER_WORD so be warned. + */ +void +makeMatrixFromDigits(Matrix mat, DigsX *digsX) +{ + mpz_set_ui(tmpe_z, (unsigned long) 1); + mpz_mul_2exp(tmpe_z, tmpe_z, (unsigned long) digsX->count); /* 2^n */ + switch (mpz_sgn(digsX->word.big)) { + case 0 : /* not sure I should bother making this a special case */ + mpz_add_ui(mat[0][0], tmpe_z, (unsigned long) 1); + mpz_sub_ui(mat[0][1], tmpe_z, (unsigned long) 1); + mpz_sub_ui(mat[1][0], tmpe_z, (unsigned long) 1); + mpz_add_ui(mat[1][1], tmpe_z, (unsigned long) 1); + break; + case 1 : + case -1 : + mpz_add(mat[0][0], tmpe_z, digsX->word.big); + mpz_set(mat[1][0], mat[0][0]); + mpz_sub(mat[0][1], tmpe_z, digsX->word.big); + mpz_set(mat[1][1], mat[0][1]); + mpz_add_ui(mat[0][0], mat[0][0], (unsigned long) 1); + mpz_sub_ui(mat[0][1], mat[0][1], (unsigned long) 1); + mpz_sub_ui(mat[1][0], mat[1][0], (unsigned long) 1); + mpz_add_ui(mat[1][1], mat[1][1], (unsigned long) 1); + break; + default : + Error(FATAL, E_INT, "makeMatrixFromDigits", + "bad value from mpz_sign"); + break; + } +} + +/* + * This makes a vector ``canonical'' by removing common factors from the + * numerator and denominator. + */ +void +canonVector(Vector vec) +{ + mpz_gcd(tmpa_z, vec[0], vec[1]); + if (mpz_sgn(tmpa_z) != 0) { + mpz_divexact(vec[0], vec[0], tmpa_z); + mpz_divexact(vec[1], vec[1], tmpa_z); + } +} +#define MIN_AB(a,b) ((a)>0 ? ((a)>(b) ? (a) : (b)) : ((b)>0 ? (b) : MAXINT)) +#define SIZE_GT_ZERO(size, w) ((size) > 0 ? (w) : 0) + +/* + * A vector, matrix or tensor is normalized when there are no negative + * entries and there are no common factors. In practice, ensuring that + * there are no negative entries is dealt with by the functions which + * emit signs and digits. Also, rather than looking for gcd's for all the + * entries, we only look for exponents of 2. See Reinhold Heckman's + * notes for a justification of this. + */ +int +normalizeVector(Vector vec) +{ + mp_limb_t word; + mp_size_t size_a, size_b, min_size; + int count; + int i; + + size_a = ABS(vec[0][0]._mp_size); + size_b = ABS(vec[1][0]._mp_size); + min_size = MIN_AB(size_a, size_b); + + if (min_size == MAXINT) + return 0; + + /* + * The trick with normalization is to find the largest + * exponent of 2 which divides all four entries in the matrix. + * When looking for the least significant bit which is set, + * we ignore those vector entries which are 0. + */ + for (i = 0; i < min_size; i++) { + word = SIZE_GT_ZERO(size_a, vec[0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_b, vec[1][0]._mp_d[i]); + if (word != 0) { + count_trailing_zeros(count, word); + count = count + (i * mp_bits_per_limb); + if (count > 0) { + if (size_a > 0) + mpz_tdiv_q_2exp(vec[0], vec[0], count); + if (size_b > 0) + mpz_tdiv_q_2exp(vec[1], vec[1], count); + } + return count; + } + } + Error(FATAL, E_INT, "normalizeVector", "zero entry with non-zero size"); + return 0; +} + +int +normalizeMatrix(Matrix mat) +{ + mp_limb_t word; + mp_size_t size_a, size_b, size_c, size_d, min_ab, min_cd, min_size; + int count; + int i; + + size_a = ABS(mat[0][0][0]._mp_size); + size_b = ABS(mat[0][1][0]._mp_size); + size_c = ABS(mat[1][0][0]._mp_size); + size_d = ABS(mat[1][1][0]._mp_size); + + /* + * GMP respresents zero as _mp_size = 0. Such matrix entries + * can be ignored for the purposes of normalization. + */ + min_ab = MIN_AB(size_a, size_b); + min_cd = MIN_AB(size_c, size_d); + min_size = MIN(min_ab, min_cd); + + if (min_size == MAXINT) + return 0; + + /* + * The trick with normalization is to find the largest + * exponent of 2 which divides all four entries in the matrix. + * When looking for the least significant bit which is set, + * we ignore those matrix entries which are 0. + */ + for (i = 0; i < min_size; i++) { + word = SIZE_GT_ZERO(size_a, mat[0][0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_b, mat[0][1][0]._mp_d[i]) + | SIZE_GT_ZERO(size_c, mat[1][0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_d, mat[1][1][0]._mp_d[i]); + if (word != 0) { + count_trailing_zeros(count, word); + count = count + (i * mp_bits_per_limb); + if (count > 0) { + if (size_a > 0) + mpz_tdiv_q_2exp(mat[0][0], mat[0][0], count); + if (size_b > 0) + mpz_tdiv_q_2exp(mat[0][1], mat[0][1], count); + if (size_c > 0) + mpz_tdiv_q_2exp(mat[1][0], mat[1][0], count); + if (size_d > 0) + mpz_tdiv_q_2exp(mat[1][1], mat[1][1], count); + } + return count; + } + } + Error(FATAL, E_INT, "normalizeMatrix", "zero entry with non-zero size"); + return 0; +} + +int +normalizeTensor(Tensor ten) +{ + mp_limb_t word; + mp_size_t size_a, size_b, size_c, size_d, min_ab, min_cd, min_size; + mp_size_t size_e, size_f, size_g, size_h, min_ef, min_gh; + mp_size_t min_abcd, min_efgh; + int count; + int i; + + size_a = ABS(ten[0][0][0]._mp_size); + size_b = ABS(ten[0][1][0]._mp_size); + size_c = ABS(ten[1][0][0]._mp_size); + size_d = ABS(ten[1][1][0]._mp_size); + size_e = ABS(ten[2][0][0]._mp_size); + size_f = ABS(ten[2][1][0]._mp_size); + size_g = ABS(ten[3][0][0]._mp_size); + size_h = ABS(ten[3][1][0]._mp_size); + + /* + * GMP respresents zero as _mp_size = 0. Such matrix entries + * can be ignored for the purposes of normalization. + * + * The following are macros and hence we prefer not to nest them. + */ + min_ab = MIN_AB(size_a, size_b); + min_cd = MIN_AB(size_c, size_d); + min_ef = MIN_AB(size_e, size_f); + min_gh = MIN_AB(size_g, size_h); + min_abcd = MIN(min_ab, min_cd); + min_efgh = MIN(min_ef, min_gh); + min_size = MIN(min_abcd, min_efgh); + + if (min_size == MAXINT) + return 0; + + /* + * The trick with normalization is to find the largest + * exponent of 2 which divides all four entries in the tensor. + * When looking for the least significant bit which is set, + * we ignore those tensor entries which are 0. + */ + for (i = 0; i < min_size; i++) { + word = SIZE_GT_ZERO(size_a, ten[0][0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_b, ten[0][1][0]._mp_d[i]) + | SIZE_GT_ZERO(size_c, ten[1][0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_d, ten[1][1][0]._mp_d[i]) + | SIZE_GT_ZERO(size_e, ten[2][0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_f, ten[2][1][0]._mp_d[i]) + | SIZE_GT_ZERO(size_g, ten[3][0][0]._mp_d[i]) + | SIZE_GT_ZERO(size_h, ten[3][1][0]._mp_d[i]); + if (word != 0) { + count_trailing_zeros(count, word); + count = count + (i * mp_bits_per_limb); + if (count > 0) { + if (size_a > 0) + mpz_tdiv_q_2exp(ten[0][0], ten[0][0], count); + if (size_b > 0) + mpz_tdiv_q_2exp(ten[0][1], ten[0][1], count); + if (size_c > 0) + mpz_tdiv_q_2exp(ten[1][0], ten[1][0], count); + if (size_d > 0) + mpz_tdiv_q_2exp(ten[1][1], ten[1][1], count); + if (size_e > 0) + mpz_tdiv_q_2exp(ten[2][0], ten[2][0], count); + if (size_f > 0) + mpz_tdiv_q_2exp(ten[2][1], ten[2][1], count); + if (size_g > 0) + mpz_tdiv_q_2exp(ten[3][0], ten[3][0], count); + if (size_h > 0) + mpz_tdiv_q_2exp(ten[3][1], ten[3][1], count); + } + return count; + } + } + Error(FATAL, E_INT, "normalizeTensor", "zero entry with non-zero size"); + return 0; +} + +int +vectorSign(Vector v) +{ + int sum; + + sum = mpz_sgn(v[0]) + mpz_sgn(v[1]); + if (sum > 0) + return 1; + else + if (sum < 0) + return -1; + else + return 0; +} + +/* + * This function returns 1 if there are no 0 columns and all entries + * are >= 0, -1 if there are no 0 columns and all entries are <= 0 and + * 0 otherwise (ie when the signs are mixed or there are 0 columns). + */ +int +matrixSign(Matrix m) +{ + int vecSign; + + if (((vecSign = vectorSign(m[0])) != 0) && (vectorSign(m[1]) == vecSign)) + return vecSign; + else + return 0; +} + +/* + * This function returns 1 if there are no 0 columns and all entries + * are >= 0, -1 if there are no 0 columns and all entries are <= 0 and + * 0 otherwise (ie when the signs are mixed and/or there are 0 columns). + */ +int +tensorSign(Tensor t) +{ + int vecSign; + + if (((vecSign = vectorSign(t[0])) != 0) + && (vectorSign(t[1]) == vecSign) + && (vectorSign(t[2]) == vecSign) + && (vectorSign(t[3]) == vecSign)) + return vecSign; + else + return 0; +} + +/* + * A vector is positive when at least one value is not 0 and both + * are greater than or equal to zero + */ +bool +vectorIsPositive(Vector v) +{ + return vectorSign(v) == 1; +} + +/* + * A matrix is ``positive'' when it contains no zero columns and + * all the entries are >= 0 + */ +bool +matrixIsPositive(Matrix m) +{ + return matrixSign(m) == 1; +} + +/* + * A matrix is ``positive'' when it contains no zero columns and + * all the entries are >= 0 + */ +bool +tensorIsPositive(Tensor t) +{ + return tensorSign(t) == 1; +} + +#define NEG_MPZ(x) ((x)->_mp_size = -((x)->_mp_size)) + +void +negateMatrix(Matrix m) +{ + NEG_MPZ(m[0][0]); + NEG_MPZ(m[0][1]); + NEG_MPZ(m[1][0]); + NEG_MPZ(m[1][1]); +} + +void +negateTensor(Tensor t) +{ + NEG_MPZ(t[0][0]); + NEG_MPZ(t[0][1]); + NEG_MPZ(t[1][0]); + NEG_MPZ(t[1][1]); + NEG_MPZ(t[2][0]); + NEG_MPZ(t[2][1]); + NEG_MPZ(t[3][0]); + NEG_MPZ(t[3][1]); +} + +/* + * A tensor is refining when it has no zero columns + * (where both entries 0) and all non-zero entries have the same sign. + */ +bool +tensorIsRefining(Tensor t) +{ + return (tensorSign(t) != 0); +} + +void +absorbSignIntoVectorPair(Vector vec0, Vector vec1, Sign sign) +{ + switch (sign) { + case SPOS : + break; + case SNEG : /* ((c, d), (-a, -b)) */ + mpz_neg(vec0[0], vec0[0]); + mpz_neg(vec0[1], vec0[1]); + MPZ_SWAP(vec0[0], vec1[0]); + MPZ_SWAP(vec0[1], vec1[1]); + break; + case SINF : /* ((a-c,b-d), (a+c,b+d)) */ + mpz_set(tmpa_z, vec0[0]); /* tmp = a */ + mpz_sub(vec0[0], tmpa_z, vec1[0]); /* a = tmp - c */ + mpz_add(vec1[0], tmpa_z, vec1[0]); /* c = tmp + c */ + mpz_set(tmpa_z, vec0[1]); /* tmp = b */ + mpz_sub(vec0[1], tmpa_z, vec1[1]); /* b = tmp - d */ + mpz_add(vec1[1], tmpa_z, vec1[1]); /* d = tmp + d */ + break; + case SZERO : /* ((a+c,b+d), (c-a,d-b)) */ + mpz_set(tmpa_z, vec0[0]); /* tmp = a */ + mpz_add(vec0[0], tmpa_z, vec1[0]); /* a = tmp + c */ + mpz_sub(vec1[0], vec1[0], tmpa_z); /* c = c - tmp */ + mpz_set(tmpa_z, vec0[1]); /* tmp = b */ + mpz_add(vec0[1], tmpa_z, vec1[1]); /* b = tmp + d */ + mpz_sub(vec1[1], vec1[1], tmpa_z); /* d = d - tmp */ + break; + default : + Error(FATAL, E_INT, "absorbSignIntoVectorPair", "bad sign"); + } +} + +Real +derefToStrm(Real x) +{ + if (x != NULL) { + switch (x->gen.tag.type) { + case DIGSX : + case SIGNX : + break; + case VECTOR : + return derefToStrm(x->vec.strm); + case MATX : + return derefToStrm(x->matX.strm); + case TENXY : + return derefToStrm(x->tenXY.strm); + case ALT : + return derefToStrm(x->alt.redirect); + case CLOSURE : + return derefToStrm(x->cls.redirect); + default : + Error(FATAL, E_INT, "derefToStrm", "invalid real"); + } + } + return x; +} + +char * +comparisonToString(Comparison d) +{ + switch (d) { + case LT : + return "lt"; + break; + case GT : + return "gt"; + break; + case EQ : + return "eq"; + break; + default : + return NULL; + break; + } +} + +char * +signToString(Sign s) +{ + switch (s) { + case SIGN_UNKN : + return "unkn"; + case SPOS : + return "spos"; + break; + case SNEG : + return "sneg"; + break; + case SZERO : + return "szer"; + break; + case SINF : + return "sinf"; + break; + default : + return NULL; + break; + } +} + +char * +digitToString(Digit d) +{ + switch (d) { + case DPOS : + return "dpos"; + break; + case DNEG : + return "dneg"; + break; + case DZERO : + return "dzer"; + break; + default : + return NULL; + break; + } +} + +char * +typeToString(unsigned type) +{ + switch (type) { + case ALT : + return "alt "; + case VECTOR : + return "vector"; + case MATX : + return "matrix"; + case TENXY : + return "tensor"; + case SIGNX : + return "sign "; + case DIGSX : + return "digits"; + case CLOSURE : + return "closure"; + case BOOLX : + return "boolx"; + case BOOLXY : + return "boolxy"; + case PREDX : + return "predx"; + default : + Error(FATAL, E_INT, "typeToString", "bad type: %d", type); + return NULL; + break; + } +} + +char * +boolValToString(unsigned boolVal) +{ + switch (boolVal) { + case LAZY_TRUE : + return "true "; + case LAZY_FALSE : + return "false"; + case LAZY_UNKNOWN : + return "unkn "; + default : + return NULL; + Error(FATAL, E_INT, "boolValToString", "bad boolean value"); + } +} + diff --git a/ic-reals-6.3/doc/implementation-notes/README b/ic-reals-6.3/doc/implementation-notes/README new file mode 100644 index 0000000..b70ba06 --- /dev/null +++ b/ic-reals-6.3/doc/implementation-notes/README @@ -0,0 +1,2 @@ +This directory will eventually contain documents describing the +implementation. Regretfully, most are incomplete at present. diff --git a/ic-reals-6.3/doc/implementation-notes/decimal_precision.tex b/ic-reals-6.3/doc/implementation-notes/decimal_precision.tex new file mode 100644 index 0000000..7d8d14d --- /dev/null +++ b/ic-reals-6.3/doc/implementation-notes/decimal_precision.tex @@ -0,0 +1,704 @@ +\documentclass[11pt,a4paper]{article} + +\usepackage{amsfonts} +\usepackage{amsmath} + +\newtheorem{tm}{Theorem} +\newtheorem{df}[tm]{Def{i}nition} +\newtheorem{lemma}[tm]{Lemma} +\newtheorem{prop}[tm]{Proposition} +\newtheorem{cor}[tm]{Corollary} + +%\newenvironment{proof}{\textbf{Proof:} \footnotesize}{} +\newenvironment{proof} + { \begin{description} \item[Proof:] \footnotesize } + { \end{description} } + + +\begin{document} + +\title{Obtaining a Required Absolute Precision from an Exact Floating Point + Number} +\author{Marko Krznari\'{c}} +\date{\today} %\date{21 March 2000} +\maketitle + + +\section{Introduction} +A real number may be represented as a shrinking sequence of nested, + closed intervals with rational end--points whose length tends to + zero. We will work in the one--point compactification $\mathbb{R}^* + = \mathbb{R} \cup \{ \infty \}$ of the real line, which is usually + represented by the unit circle and the stereographic projection. In + the LFT approach to Exact Real Arithmetic the sequence of intervals + is generated by a sequence of one--dimensional linear fractional + transformations (LFTs) applied to a base interval, \cite{vui90, + niekor95, edapot97, pot98, hec99}. + +These intervals (LFTs applied to the base interval) are better and + better approximations to the real number. Knowing the length of the + interval we may tell how good the approximations are. Except of + one proposition in \cite{pot98} (Proposition 40, page 129), there + are no other references which tell us how to calculate the length + of the intervals. Here, we show how to determine the length of the + intervals and especially, how to obtain a required decimal + precision of a real number. + + +\section{Representation of Real Numbers} +Let us denote the set of matrices with integer coefficients by: + \[ \mathbb{M} = + \left\{ \left( \begin{array}{cc} a&c\\b&d \end{array} + \right)\ |\ a,b,c,d \in \mathbb{Z} \right\}. \] + A matrix induces an 1--dimensional LFT (a function from + $\mathbb{R}^*$ to $\mathbb{R}^*$) which is given by: + \[ \Theta \left( \begin{array}{cc} a&c\\b&d \end{array} + \right)(x) = \displaystyle { \frac{ax+c}{bx+d} }. \] + We can identify an LFT $\Theta(M)$ with the matrix $M$ and this + identification is unique up to scaling by a non--zero + integer. The composition of two 1--dimensional LFTs correspond + to matrix multiplication. A non--singular matrix $M$ maps an + interval to an interval: the interval $[p,q]$ is mapped to + $[Mp, Mq]$ for $\det M > 0$ and $[Mq,Mp]$ for $\det M < 0$. + In $\mathbb{R}^*$, the interval $[p,q]$ is the set of all of + the points which belong to the arc starting from $p$ and going + anti--clockwise to $q$ on the unit circle. For example, $[1,-1] = + \{ x\ |\ |x| \ge 1 \}$. + +One can easily verify that for any two intervals I and J with rational + end--points, there exists an LFT $M$ such that $M(I) = J$. This implies + that all rational intervals can be encoded as an LFT applied to a + fixed interval, which is called the \textsc{base interval}. Although + the choice of the base interval is essentially not relevant (whatever + holds for one, will hold, with minor adjustments, for any other + base interval), we should choose it in a way to make computations + as efficient as possible. There are two base intervals which have + been used, namely $[-1,1]$ and $[0,\infty]$. Check \cite{eda97, + edapot97, pot98, hec99} for more details. + +For a base interval $[a,b]$, we say that a matrix $M$ is \textsc{refining} + if $M[a,b] \subseteq [a,b]$. The set of all refining matrices is + denoted by $\mathbb{M}^+$. We also define the \textsc{information} of + an LFT $M$ by $\textbf{Info}_{[a,b]}(M) = {\bf Info}(M)=M[a,b]$. + +As we mentioned earlier, a real number can be represented as a + shrinking sequence of nested, closed intervals with rational + end--points whose length tends to zero. Or, using the facts given + above, as a sequence of 1--dimensional LFTs: + \[ \begin{array}{rccl} + & \{ x \} &=& \displaystyle{ \bigcap_n [p_n,q_n], + \qquad p_n,q_n \in \mathbb{Q}, } \vspace{1em} \\ + & [p_n,q_n] &=& \displaystyle{ M_0 M_1 \ldots M_n [a,b], + \qquad \forall n, } \vspace{1em} \\ + \Rightarrow & \{ x \} &=& \displaystyle{ \bigcap_n M_0 M_1 + \ldots M_n [a,b], } + \end{array} \] + where $[a,b]$ is the base interval, $M_0 \in \mathbb{M}$, and + $M_n \in \mathbb{M}^+,\ n>0$. This representation is called + \textsc{normal product}. The first matrix, $M_0$, determines an + interval which contains the real number $x$, while all other matrices + refine that interval more and more. By analogy with the usual + representation of the real numbers, the first matrix of the normal + product, $M_0 \in \mathbb{M}$, is called a \textsc{sign} matrix, + while the matrices $M_n \in \mathbb{M}^+$ are called \textsc{digit} + matrices. + + Edalat and Potts in~\cite{eda97,edapot97} proposed a standard form, + called \textsc{exact floating point}, EFP, where both, sign and digit + matrices, belong to predetermined finite sets of matrices. The + information in the sign matrices should overlap and cover + $\mathbb{R}^*$. The four sign matrices proposed by Edalat and Potts + correspond to rotations of the unit circle by $0^\circ$ (i.e identity), + $90^\circ, \ 180^\circ$ and $270^\circ$, and form a cyclic group. + Digit matrices should overlap, cover the base interval $[a,b]$, and + contract distances in $[a,b]$. + + +\section{The Base Interval $[0,\infty]$} +The main reason to choose $[0,\infty]$ as a base interval is that it is + very easy to calculate the information of a matrix $M=\begin{pmatrix} + a&c\\b&d \end{pmatrix}$: ${\bf Info}M=[\frac{c}{d},\frac{a}{b}]$ if + $\det M > 0$ or ${\bf Info}M=[\frac{a}{b},\frac{c}{d}]$ if $\det M < 0$. + In the base interval $[0,\infty]$, the four sign matrices are named + as follows: + \[ \begin{array}{rccclcrcl} + S_+ &=& \begin{pmatrix} 1&0 \\ 0&1 \end{pmatrix} &=& + S_\infty^{4k} = \textrm{Id}, &\qquad& + \textbf{Info}(S_+) &=& [0,\infty], \vspace{0.5em} \\ + S_{\infty} &=& \begin{pmatrix} 1&1 \\ -1&1 \end{pmatrix} &=& + S_\infty^{4k+1}, &\qquad& + \textbf{Info}(S_\infty) &=& [1,-1], \vspace{0.5em} \\ + S_- &=& \begin{pmatrix} 0&-1 \\ 1&0 \end{pmatrix} &=& + S_\infty^{4k+2}, &\qquad& + \textbf{Info}(S_-) &=& [\infty,0], \vspace{0.5em} \\ + S_0 &=& \begin{pmatrix} 1&-1 \\ 1&1 \end{pmatrix} &=& + S_\infty^{4k+3}, &\qquad& + \textbf{Info}(S_0) &=& [-1,1]. + \end{array} \] + It is easy to check that, for example, $S_0 S_\infty = + S_\infty S_0 = S_+ = \textrm{Id}$. + + For an integer $b \ge 2$ we define digit matrices in base $b$ by: + \[ D_k = \begin{pmatrix} b+k+1 & b+k-1 \\ b-k-1 & b-k+1 \end{pmatrix} + = S_\infty \begin{pmatrix} 1&k\\0&b \end{pmatrix} S_0, \] + where $k$ is an integer with $ |k| < b$. Products of digit matrices + can be obtained as follows: + \[ D_{d_1} D_{d_2} \ldots D_{d_n} = \begin{pmatrix} + b^n+c+1 & b^n+c-1 \\ b^n-c-1 & b^n-c+1 \end{pmatrix} =: + \mathfrak{D}_c^n, \] + where + \[ c = c(d_1,d_2,\ldots,d_n) = \sum_{i=1}^n d_i b^{n-i}. \] + Furthermore, $\mathfrak{D}_c^n D_d = \mathfrak{D}_{bc+d}^{n+1}$. The + number $c$ provides a compressed representation for this product + of digit matrices. However, the original sequence of digits usually + cannot be recovered from $\mathfrak{D}_c^n$. + +The most used base $b$ in both, theory and practise, is the base $b=2$. + In that case, we get the following three digit matrices: + \[ \begin{array}{rccclcrcl} + D_{-1} &=& \begin{pmatrix} 1&0 \\ 1&2 \end{pmatrix} &=& + S_\infty \begin{pmatrix} 1&-1 \\0&2 \end{pmatrix} S_0, &\qquad& + \textbf{Info}(D_{-1}) &=& [0,1], \vspace{0.5em} \\ + D_0 &=& \begin{pmatrix} 3&1 \\ 1&3 \end{pmatrix} &=& + S_\infty \begin{pmatrix} 1&0\\0&2 \end{pmatrix} S_0, &\qquad& + \textbf{Info}(D_0) &=& [\frac{1}{3},3], \vspace{0.5em} \\ + D_1 &=& \begin{pmatrix} 2&1 \\ 0&1 \end{pmatrix} &=& + S_\infty \begin{pmatrix} 1&1\\0&2 \end{pmatrix} S_0, &\qquad& + \textbf{Info}(D_1) &=& [1,\infty]. + \end{array} \] + Any sequence of $n$ digits in base $2$, $D_{d_1},\ D_{d_2},\ \ldots,\ + D_{d_n}$ can be compressed into the number $c(d_1,d_2,\ldots,d_n)$, + which can be represented in only $n+1$ bits of memory. + + +\subsection{$S_0 D_{d_1} D_{d_2} \ldots$} +The information of the sign matrix $S_0$ is the interval $[-1,1]$, + i.e. $\textbf{Info}(S_0) = [-1,1]$. Any digit in base $b$ will + contract distances on the real line by a factor $\frac{1}{b}$. + We have the following: + \begin{prop} \label{prop:Szero and width of information with base b} + \[ {\sf width} ( {\bf Info} ( S_0 D_{d_1} D_{d_2} + \ldots D_{d_n} ) ) = \frac{2}{b^n}, \] + where $D_{d_i},\ i=1 \ldots n$, are digits in the base $b$. + \end{prop} + \begin{proof} As $D_i = S_\infty \begin{pmatrix} 1&d\\0&b \end{pmatrix} + S_0$ and $S_\infty S_0 = \textrm{Id}$ we have: + \[ \begin{array}{rcl} + S_0 D_{d_1} D_{d_2} \ldots D_{d_n} &=& S_0 S_\infty + \begin{pmatrix} 1&d_1\\0&b \end{pmatrix} S_0 S_\infty + \begin{pmatrix} 1&d_2\\0&b \end{pmatrix} S_0 \ldots S_\infty + \begin{pmatrix} 1&d_n\\0&b \end{pmatrix} S_0 \\ + &=& \begin{pmatrix} 1&d_1\\0&b \end{pmatrix} + \begin{pmatrix} 1&d_2\\0&b \end{pmatrix} \ldots + \begin{pmatrix} 1&d_n\\0&b \end{pmatrix} S_0 \\ + &=& \begin{pmatrix} 1&c\\0&b^n \end{pmatrix} S_0, + \end{array} \] + where $c = \sum_{i=1}^n d_i b^{n-i}$. + Then, + \[ \begin{array}{rcl} + \textsf{width} (\textbf{Info}(S_0 D_{d_1} D_{d_2}\ldots D_{d_n})) + &=& \textsf{width} \left( \begin{pmatrix} 1&c\\0&b^n + \end{pmatrix} S_0 [0,\infty] \right) \\ + &=& \textsf{width} \left( + \begin{pmatrix} 1&c\\0&b^n \end{pmatrix} [-1,1] \right) \\ + &=& \displaystyle{ \textsf{width} \left( + \left[ \frac{-1+c}{b^n}, \frac{1+c}{b^n} \right] \right) } \\ + &=& \displaystyle{ \frac{2}{b^n} }. + \end{array} \] + \end{proof} + Knowing that, it is easy to calculate a sufficient number of digits + which will achieve any required accuracy. + + +\subsection{$S_+ D_{d_1} D_{d_2} \ldots$} \label{subsection spos} +Real numbers which can be represented by the product $S_+ D_{d_1} + D_{d_2} \ldots = D_{d_1} D_{d_2} \ldots$ are points of the + interval $[0,\infty]$. An infinite product of digits $D_{b-1}$ in + base $b$ represents $\infty$. Any other infinite product + can be written as a finite product of $D_{b-1}$ (exponent), followed + by an infinite product of digits starting with $D_k$ where $-(b-1) + \le k \le (b-2)$ (mantissa). Any such product represents a + non--negative real number $x \in [0,\infty)$. + +If the product represents $\infty$, as it happens with $\frac{1}{0}$, the + computation of the interval lengths will not finish in finite + time (unless we put a time limit). In all other cases, using + Proposition~\ref{prop:Spos and width of information with base b}, we + will be able to determine how many digit matrices will be sufficient + to satisfy the required accuracy. Proposition~\ref{prop:Spos and + width of information with base b} is a generalisation of Potts's + Proposition~\ref{prop:width of information with base 2}, + \cite{pot98}, which we present later. + \begin{prop} \label{prop:Spos and width of information with base b} + Let $D_{b-1}^e D_{d_1} D_{d_2} \ldots D_{d_n}$ be a finite product + of digits in base $b$ with $d_1 \ne (b-1)$. + Then: + \[ b^{e-n} < {\sf width} ( {\bf Info} ( D_{b-1}^e D_{d_1} + D_{d_2} \ldots D_{d_n} ) ) < 4 b^{e-n+2}. \] + \end{prop} + \begin{proof} + The product $D_{b-1}^e D_{d_1} D_{d_2} \ldots D_{d_n} = D_{b-1}^e + \mathfrak{D}_c^n$ can be compressed into $\mathfrak{D}_{c'}^{n'}$ where + \[ \begin{array}{rcl} + n' &=& e+n, \\ + c' &=& \left[ (b-1)b^{e+n-1} + \ldots + (b-1)b^n \right] + \left[ + d_1 b^{n-1} + \ldots + d_{n-1} b + d_n \right] \\ + &=& \displaystyle{ b^n (b-1) \frac{b^e-1}{b-1} + c } \\ + &=& b^{e+n} - b^n + c + \end{array} \] + Information of $D_{b-1}^e \mathfrak{D}_c^n$ is given by: + \[ \begin{array}{rcl} + {\bf Info} (D_{b-1}^e \mathfrak{D}_c^n) &=& \begin{pmatrix} + b^{n'}+c'+1 & b^{n'}+c'-1 \\ b^{n'}-c'-1 & b^{n'}-c'+1 + \end{pmatrix} [0,\infty] \\ + &=& \begin{pmatrix} 2b^{e+n}-(b^n-c-1) & 2b^{e+n}-(b^n-c+1) + \\ b^n-c-1 & b^n-c+1 \end{pmatrix} [0,\infty] \\ + &=& \left[ \displaystyle{ \frac{2b^{e+n}}{b^n-c+1} - 1, + \frac{2b^{e+n}}{b^n-c-1} - 1 } \right]. + \end{array} \] + Therefore, + \[ \begin{array}{rcl} + {\sf width} ( {\bf Info} ( D_{b-1}^e \mathfrak{D}_c^n ) ) &=& + \displaystyle{ \frac{2b^{e+n}}{b^n-c-1} - + \frac{2b^{e+n}}{b^n-c+1} } \\ + &=& \displaystyle{ \frac{4b^{e+n}}{(b^n-c)^2-1}. } + \end{array} \] + This holds for any sequence of digits. If, for example, all of the + $n$ digits compressed into $\mathfrak{D}_c^n$ are digits $D_{b-1}$, + then, + \[ \begin{array}{rcl} + \displaystyle{ \frac{4b^{e+n}}{(b^n-c)^2-1} } &=& + \displaystyle{ \frac{4b^{e+n}}{(b^n-(b^n-1))^2-1} } \\ + &=& \displaystyle{ \frac{4b^{e+n}}{0} } \\ + &=& \infty, + \end{array} \] + which corresponds to the length of the interval: + \[ \begin{array}{rcl} + {\bf Info} ( D_{b-1}^e \mathfrak{D}_{b^n-1}^n ) &=& + \displaystyle{ \left[ \frac{2b^{e+n}}{b^n-c+1} - 1, + \frac{2b^{e+n}}{b^n-c-1} -1 \right] } \\ + &=& [b^{e+n}-1, \infty]. + \end{array} \] + If $d_1 \ne b-1$, i.e. $-(b-1) \le d_1 < (b-1)$, we have: + \[ \begin{array}{rcl} + c &\ge& -(b-1) b^{n-1} - (b-1) b^{n-2} - \ldots - (b-1) b^0 \\ + &=& -b^n + 1 \vspace{1em} \\ + c &\le& (b-2) b^{n-1} + (b-1) b^{n-2} + (b-1) b^{n-3} + + \ldots + (b-1) b^0 \\ + &=& (b-2) b^{n-1} + (b^{n-1}-1) \\ + &=& (b-1) b^{n-1} - 1. + \end{array} \] + Therefore, + \[ \begin{array}{rcl} + {\sf width} ( {\bf Info} ( D_{b-1}^e \mathfrak{D}_c^n ) ) &=& + \displaystyle{ \frac{4b^{e+n}}{(b^n-c)^2-1} } \\ + &\le& \displaystyle{ \frac{4b^{e+n}}{(b^n-(b-1)b^{n-1}+1)^2 - 1} } \\ + &=& \displaystyle{ \frac{4b^{e+n}}{b^{2(n-1)}+2b^{n-1}} } \\ + &=& \displaystyle{ \frac{4b^{e+1}}{b^{n-1}+2} } \\ + &<& 4b^{e-n+2} \vspace{1em} \\ + {\sf width} ( {\bf Info} ( D_{b-1}^e \mathfrak{D}_c^n ) ) &\ge& + \displaystyle{ \frac{4b^{e+n}}{(b^n+b^n-1)^2-1} } \\ + &=& \displaystyle{ \frac{4b^{e+n}}{4b^{2n}-4b^n} } \\ + &=& \displaystyle{ \frac{b^e}{b^n-1} } \\ + &>& b^{e-n}. + \end{array} \] + \end{proof} + +Therefore, as soon as we get a digit in base $b$ which is not $D_{b-1}$, + i.e. when we determine a natural number $e$, we may use the formula + above to calculate the total number of digit matrices which will + guarantee the absolute tolerance we wish to achieve. + + +\subsection{$S_- D_{d_1} D_{d_2} \ldots$} \label{subsection sneg} +This case is basically the same as in the previous section. In the base + $b$, the sequence $S_- D_{-(b-1)} D_{-(b-1)} D_{-(b-1)} \ldots$ will + represent $\infty$. Hence, any attempt to obtain an absolute + precision will be futile. For any other sequence we can use a + variation of Proposition~\ref{prop:Spos and width of information with + base b}, in which $D_{-(b-1)}$ takes the position of $D_{b-1}$. + + +\subsection{$S_\infty D_{d_1} D_{d_2} \ldots$} +As we have seen earlier in Sections \ref{subsection spos} and + \ref{subsection sneg} the information of an EFP may contain $\infty$. + Of course, that will prevent us obtaining any absolute precision. That + is also the case when the sign digit of an EFP is $S_\infty$. We have + the following: + \begin{prop} \label{prop:the information containing infty} + The information of an EFP $S_\infty \mathfrak{D}_c^n$ will contain + $\infty$ if and only if $|c| \le 1$, i.e. $c=-1,0,1$. + \end{prop} + \begin{proof} + We have: + \[ \begin{array}{rcl} + {\bf Info} (S_\infty \mathfrak{D}_c^n) &=& \begin{pmatrix} 1&1\\-1&1 + \end{pmatrix} \begin{pmatrix} b^n+c+1 & b^n+c-1\\ b^n-c-1 & b^n-c+1 + \end{pmatrix} [0,\infty] \\ + &=& \begin{pmatrix} b^n & b^n \\ -1-c & 1-c \end{pmatrix} [0,\infty] \\ + &=& \displaystyle{ \left[ \frac{b^n}{1-c}, \frac{b^n}{-1-c} \right] }. + \end{array} \] + If $c \ge 2$ then $-1-c < 1-c <0$ which implies + \[ -\infty < \frac{b^n}{1-c} < \frac{b^n}{-1-c} < 0. \] + Similarly, if $c \le -2$ the interval ${\bf Info} (S_\infty + \mathfrak{D}_c^n )$ does not contain $\infty$. On the other hand, each + of the three intervals below: + \[ \begin{array}{rcl} + {\bf Info} (S_\infty \mathfrak{D}_{-1}^n) &=& \displaystyle{ \left[ + \frac{b^n}{2}, \infty \right] }, \\ + {\bf Info} (S_\infty \mathfrak{D}_0^n) &=& [b^n,-b^n], \\ + {\bf Info} (S_\infty \mathfrak{D}_1^n) &=& \displaystyle{ \left[ + \infty, -\frac{b^n}{2} \right] }, + \end{array} \] + contain $\infty$. This completes the proof. + \end{proof} + Note that $c(d_1,d_2,\ldots,d_n)=0$ iff $d_1=d_2=\ldots=d_n=0$. + Furthermore, $c(d_1,d_2,\ldots,d_n)$ is $1$, respectively $-1$, iff the + product of digit matrices $D_{d_1} D_{d_2} \ldots D_{d_n}$ is of the form + $D_0^e D_1 D_{-(b-1)}^{n-e-1}$, respectively $D_0^e D_{-1} D_{b-1}^{n-e-1}$, + for some $e \in \mathbb{N},\ e < n$. + \begin{prop} \label{prop:dneg db-1 = dzer dneg} + The following holds: + \[ \begin{array}{c} + D_{-1} D_{b-1} = D_0 D_{-1} \\ + D_1 D_{-(b-1)} = D_0 D_1 + \end{array} \] + \end{prop} + \begin{proof} + As $-1 \cdot b + (b-1) = -1$ we have that $D_{-1} D_{b-1} = + \mathfrak{D}_{-1}^2$. Similarly, $D_0 D_{-1} = \mathfrak{D}_{-1}^2$. + \end{proof} + +When the information of $S_\infty D_{d_1} D_{d_2} \ldots$ becomes bounded + ($|c|>1$) we can calculate the number of digits which will guarantee + any required absolute precision. We can do that with the help of the + following two propositions: + \begin{prop} \label{prop:Sinf and width of information with base b 1} + Let $S_\infty D_0^e D_{-1} D_{b-1}^f D_{d_1} D_{d_2} \ldots D_{d_n}$ + be a finite product of matrices in base $b$ with $d_1 \ne (b-1)$ + (that is, the information of such a product is a bounded interval). Then: + \[ \frac{1}{2} b^{e+f-n+1} < {\sf width} ( {\bf Info} ( S_\infty + D_0^e D_{-1} D_{b-1}^f \mathfrak{D}_c^n ) ) < 2b^{e+f-n+3}, \] + where $\mathfrak{D}_c^n = D_{d_1} D_{d_2} \ldots D_{d_n}$. + \end{prop} + \begin{proof} + Because of Proposition \ref{prop:dneg db-1 = dzer dneg} we have + $D_{-1} D_{b-1}^f = D_0^f D_{-1}$ and hence we can assume $f=0$ + and at the end, replace $e$ by $e+f$. We have: + \[ \begin{array}{rcl} + {\bf Info} (S_\infty D_0^e D_{-1} \mathfrak{D}_c^n) &=& + \begin{pmatrix} b^{e+n+1} & b^{e+n+1} \\ b^n-c-1 & b^n-c+1 + \end{pmatrix} [0,\infty] \\ + &=& \displaystyle{ \left[ \frac{b^{e+n+1}}{b^n-c+1}, + \frac{b^{e+n+1}}{b^n-c-1} \right]. } + \end{array} \] + Therefore, + \[ \begin{array}{rcl} + {\sf width} ( {\bf Info} ( S_\infty D_0^e D_{-1} + \mathfrak{D}_c^n ) ) &=& \displaystyle{ \frac{b^{e+n+1}}{b^n-c-1} + - \frac{b^{e+n+1}}{b^n-c+1} } \\ + &=& \displaystyle{ \frac{2b^{e+n+1}}{(b^n-c)^2-1}. } + \end{array} \] + As in the proof of the Proposition \ref{prop:Spos and width of + information with base b} we show that $-(b^n-1) \le c \le + (b-1)b^{n-1}-1$, which implies: + \[ \begin{array}{rcl} + {\sf width} ( {\bf Info} ( S_\infty D_0^e D_{-1} + \mathfrak{D}_c^n ) ) &=& \displaystyle{ + \frac{2b^{e+n+1}}{(b^n-c)^2-1} } \\ + &\le& \displaystyle{ \frac{2b^{e+n+1}}{(b^n-(b-1)b^{n-1}+1)^2 - 1} } \\ + &=& \displaystyle{ \frac{2b^{e+n+1}}{b^{2(n-1)}+2b^{n-1}} } \\ + &=& \displaystyle{ \frac{2b^{e+2}}{b^{n-1}+2} } \\ + &<& 2b^{e-n+3} \vspace{1em} \\ + {\sf width} ( {\bf Info} ( S_\infty D_0^e D_{-1} + \mathfrak{D}_c^n ) ) &\ge& \displaystyle{ + \frac{2b^{e+n+1}}{(b^n+b^n-1)^2-1} } \\ + &=& \displaystyle{ \frac{2b^{e+n+1}}{4b^{2n}-4b^n} } \\ + &=& \displaystyle{ \frac{b^{e+1}}{2(b^n-1)} } \\ + &>& \displaystyle{ \frac{1}{2} b^{e-n+1}. } + \end{array} \] + \end{proof} + \begin{prop} \label{prop:Sinf and width of information with base b 2} + Let $S_\infty D_0^e D_1 D_{-(b-1)}^f D_{d_1} D_{d_2} \ldots D_{d_n}$ + be a finite product of matrices in base $b$ with $d_1 \ne + -(b-1)$ (that is, the information of such a product is a + bounded interval). Then: + \[ \frac{1}{2} b^{e+f-n+1} < {\sf width} ( {\bf Info} ( S_\infty + D_0^e D_1 D_{-(b-1)}^f \mathfrak{D}_c^n ) ) < 2b^{e+f-n+3}, \] + where $\mathfrak{D}_c^n = D_{d_1} D_{d_2} \ldots D_{d_n}$. + \end{prop} + + +\subsection{Absolute Decimal Precision in Base $b=2$} +Usually we want to obtain the decimal precision of a given number. + In addition, base $b=2$ is the most used base in both theory + and practise. Therefore, the issue of obtaining the absolute decimal + precision in base $b=2$ is of a great importance \cite{errhec00}. + +Of course, we can use the propositions proved above, but we will use, + for performance reasons, better bounds, which we can obtain + because we take more digits in base $b=2$ into account. + + +\subsubsection{$S_0 D_{d_1} D_{d_2} \ldots$} +This case is quite easy. If we choose + \begin{equation} + n=\lceil 1 + 3.322 k \rceil, + \end{equation} + where $k$ is the required number of correct decimal digits, we have: + \[ \begin{array}{lrl} + & n & = \lceil 1 + 3.322 k \rceil, \\ + \Rightarrow & n & > 1 + k \log_2 10, \\ + \Rightarrow & -k \log_2 10 & > 1 - n, \\ + \Rightarrow & 10^{-k} & > 2^{1-n} \\ + && = {\sf width} ( {\bf Info} (S_0 D_{d_1} D_{d_2} \ldots D_{d_n} ) ). + \end{array} \] + + +\subsubsection{$S_+ D_{d_1} D_{d_2} \ldots,\ S_- D_{d_1} D_{d_2} \ldots$} +The following proposition is given in \cite{pot98}, page 129. ??????? + Check if it is correct or not ????????? + \begin{prop} \label{prop:width of information with base 2} + For any $e \in \mathbb{N},\ \alpha \in \{-1,0\},\ \beta \in + \{-1,0,1\}$ and $\gamma \in \mathbb{Z}$, if + \[ n = e - 1 - \gamma + (1+\alpha)(1+\beta) \] + then + \[ 2^{\gamma-1} < {\sf width} ( {\bf Info} (D_1^e D_\alpha + D_\beta \mathfrak{D}_c^n )) < 2^{\gamma+1} \] + for all $c \in \mathbb{Z}(2^n)$. + \end{prop} + +Suppose that we have a real number whose EFP represenation is given by + $S_+ D_{d_1} D_{d_2} \ldots$. Provided that $e$, the number of leading + digit matrices $D_1$ is finite (i.e. the number is not $\infty$), we + will calculate correctly the number up to $k$ decimal digits by + emitting not more than $e+2+n$ digit matrices, where + \begin{equation} + n = \lceil e + 3.322 k + 2 \rceil. + \end{equation} + We use $3.322$ as an upper bound for $\log_2 10$. The reasoning is + as follows: + \[ \begin{array}{lrl} + & n & = \lceil e + 3.322 k + 2 \rceil, \\ + \Rightarrow & n & > e + k \log_2 10 + 2, \\ + \Rightarrow & -k \log_2 10 & > e - n + 2, \\ + \Rightarrow & 10^{-k} & > 2^{e-n+2} \\ + && \ge 2^{e-n+(1+\alpha)(1+\beta)} \\ + && = 2^{\gamma + 1}, + \end{array} \] + where $\gamma = e-n-1+(1+\alpha)(1+\beta)$. By Proposition + \ref{prop:width of information with base 2}: + \[ {\sf width} ( {\bf Info} (D_1^e D_\alpha D_\beta + \mathfrak{D}_c^n )) < 2^{\gamma+1} < 10^{-k} \] + for all $c \in \mathbb{Z}(2^n)$. + +The same conclusion can be used in the case $S_- D_{d_1} D_{d_2} \ldots$. + The only difference is that $e$ is the number of leading digit matrices + $D_{-1}$. + + +\subsubsection{$S_\infty D_{d_1} D_{d_2} \ldots$} +If the sign digit is $S_0$, we do not have problems to yield any required + absolute precision. The information of $S_0$ is bounded interval and + every digit matrix will half the previous interval. In the case when + the sign digit is $S_+$ any conclusion is postponed until we get one + {\sc good} digit. By {\em good} digit in this case we mean a digit which + is not $D_1$ (recall that $S_+ D_1 D_1 \ldots$ represents $\infty$). + Then we will get a bounded interval (one which does not contain + $\infty$) and every subsequent digit will refine that interval. + Basically, we require that $e$, the number of leading digits $D_1$, is + finite. Similarly, if the sign is $S_-$ a {\em good} digit is a digit + which is not $D_{-1}$. + +Using Proposition \ref{prop:the information containing infty} is easy to + check that in the case when the leading matrix is $S_\infty$, we need two + {\em good} digits. The first {\em good} digit is $D_{-1}$, respectively + $D_1$, while the second one is either $D_{-1}$ or $D_0$, respectively + $D_0$ or $D_1$. The reason is that all of the sequences: + \[ \begin{array}{ll} + S_\infty D_0 D_0 \ldots &(\Leftrightarrow c=0) \\ + S_\infty D_0^e D_{-1} D_1 D_1 \ldots &(\Leftrightarrow c=-1) \\ + S_\infty D_0^e D_1 D_{-1} D_{-1} \ldots &(\Leftrightarrow c=1) + \end{array} \] + represent $\infty$. + +Once the information of $S_\infty D_{d_1} D_{d_2} \ldots$ is either + positive or negative (we got the first {\em good} digit) we can make + use of the proposition below. + \begin{prop} For $e,f \in \mathbb{N}$ we have: + \[ \begin{array}{c} + {\sf width} ( {\bf Info} ( S_\infty D_0^e D_{-1} D_1^f + \mathfrak{D}_c^n ) ) = {\sf width} ( {\bf Info} ( S_+ D_1^{e+f} + \mathfrak{D}_c^n ) ), \\ + {\sf width} ( {\bf Info} ( S_\infty D_0^e D_1 D_{-1}^f + \mathfrak{D}_c^n ) ) = {\sf width} ( {\bf Info} ( S_- D_{-1}^{e+f} + \mathfrak{D}_c^n ) ). + \end{array} \] + \end{prop} + \begin{proof} + Let us first prove the first equality. From proofs of + Proposition~\ref{prop:Spos and width of information with base b} and + Proposition~\ref{prop:Sinf and width of information with base b 1} we get: + \[ \begin{array}{rcl} + {\bf Info} (S_+ D_1^{e+f} \mathfrak{D}_c^n) &=& [A-1,B-1], \\ + {\bf Info} (S_\infty D_0^{e+f} D_{-1} \mathfrak{D}_c^n ) + &=& [A,B] + \end{array} \] + where + \[ A=\frac{2^{n+e+f+1}}{2^n-c+1} \qquad B=\frac{2^{n+e+f+1}}{2^n-c-1}. \] + This implies the first equality. Similarly, we prove the second one. + \end{proof} + The proposition above enables us to use Proposition \ref{prop:width of + information with base 2} in order to determine the number of necessary + digits which will produce required absolute decimal precision. + Provided that $e$ and $f$ are finite numbers, i.e. we got two {\em good} + digits, in order to achieve absolute decimal precision of $10^{-k},\ k + \in \mathbb{N}$ we need not more than $e+f+2+n$ digit matrices, where + \[ n = \lceil e+f+ 3.322k + 2 \rceil. \] + + +\section{The Base Interval $[-1,1]$} +Comparing with $[0,\infty]$, the base interval $[-1,1]$ has an obvious + disadvantage in amount of effort required to calculate the information + of a matrix $M=\begin{pmatrix} a&c\\b&d \end{pmatrix}$: ${\bf Info}M= + [\frac{c-a}{d-b},\frac{c+a}{d+b}]$ if $\det M > 0$ or ${\bf Info}M= + [\frac{c+a}{d+b}, \frac{c-a}{d-b}]$ if $\det M < 0$. Furthermore, + testing the refining property is more complex with $[-1,1]$ as the + base interval ($|M(-1)| = |\frac{c-a}{d-b}| \le 1$ and $|M(1)| = + |\frac{c+a}{d+b}| \le 1$), comparing it with $[0,\infty]$ as the base + interval ($a,b,c$ and $d$ are of the same sign). + +Despite drawbacks above, it seems that $[-1,1]$ as the base interval + pays off at later stages, since digit matrices, which are given below, + the representation of the functions by tensors, emission and absorbtion, + \cite{edapot97, pot98}, are simpler due to more zeros which appear in + such representations. Pros and cons are discussed in more details in + \cite{hec99}. + +The four possible sign matrices are given as follows: + \[ \begin{array}{rclcrcl} + S^0 &=& \begin{pmatrix} 1&0 \\ 0&1 \end{pmatrix} = \textrm{Id}, &\qquad& + \textbf{Info}(S^0) &=& [-1,1], \vspace{0.5em} \\ + S^1 &=& \begin{pmatrix} 1&1 \\ -1&1 \end{pmatrix}, &\qquad& + \textbf{Info}(S^1) &=& [0,\infty], \vspace{0.5em} \\ + S^2 &=& \begin{pmatrix} 0&-1 \\ 1&0 \end{pmatrix}, &\qquad& + \textbf{Info}(S^2) &=& [1,-1], \vspace{0.5em} \\ + S^3 &=& \begin{pmatrix} 1&-1 \\ 1&1 \end{pmatrix}, &\qquad& + \textbf{Info}(S^3) &=& [\infty,0]. + \end{array} \] + The indices may be observed as exponents as $S^i S^j = S^{(i+j) \mod 4}$. + Digit matrices in base $b$ are given by: + \[ A_k = \begin{pmatrix} 1&k\\ 0&b \end{pmatrix}, \] + for integer $k$ such that $|k| < b$. $A_k$ maps $[-1,1]$ into + the interval$[\frac{k-1}{b},\frac{k+1}{b}]$, whose length is $2/b$. + A product $A_{d_1} A_{d_2} \ldots A_{d_n}$ corresponds to a real number + $r = \sum_{i=1}^n d_i b^{-i} \in [-1,1]$. + +When $b=2$ we get three matrices ($k=-1,0,1$): + \[ \begin{array}{rclcl} + A_{-1} &=& \begin{pmatrix} 1&-1 \\0&2 \end{pmatrix}, &\qquad& + \textbf{Info}(A_{-1}) = [-1,0], \vspace{0.5em} \\ + A_0 &=& \begin{pmatrix} 1&0\\0&2 \end{pmatrix}, &\qquad& + \textbf{Info}(A_0) = [-\frac{1}{2},-\frac{1}{2}], \vspace{0.5em} \\ + A_1 &=& \begin{pmatrix} 1&1\\0&2 \end{pmatrix}, &\qquad& + \textbf{Info}(A_1) = [0,1]. + \end{array} \] + Then, the product of digits $A_{d_1} A_{d_2} \ldots A_{d_n}$ corresponds + to well--known signed binary representation of a number from $[-1,1]$. + +It is easy to check that there exists isomorphism between representations + with base intervals $[0,\infty$ and $[-1,1]$. Every EFP with base + interval $[-1,1]$ can be easily translated into EFP with base $[0,\infty]$: + \[ \begin{array}{rcl} + S^i A_{d_1} \ldots A_{d_n} &=& S^i A_{d_1} \ldots A_{d_n} \\ + &=& S^i (S^3 S^1) A_{d_1} (S^3 S^1) \ldots (S^3 S^1) A_{d_n} (S^3 S^1) \\ + &=& (S^i S^3) (S^1 A_{d_1} S^3) (S^1 \ldots S^3) (S^1 A_{d_n} S^3) S^1 \\ + &=& S^{i+3} D_{d_1} \ldots D_{d_n} S^1. + \end{array} \] + We used the facts that $S^3 S^1 = S^0 = {\textrm Id}$, $D_{d_i} = + S^1 A_{d_i} S^3$. As $S^1 [-1,1] = [0,\infty]$ we have that + \[ \begin{array}{rcl} + {\bf Info}_{[-1,1]} (S^i A_{d_1} \ldots A_{d_n}) &=& + (S^i A_{d_1} \ldots A_{d_n}) [-1,1] \\ + &=& S^{i+3} D_{d_1} \ldots D_{d_n} S^1 [-1,1] \\ + &=& {\bf Info}_{[0,\infty]} (S^{i+3} D_{d_1} \ldots D_{d_n}). + \end{array} \] + +Therefore, trying to obtain any absolute accuracy from EFP which is given + by $S^i A_{d_1} A_{d_2} \ldots$ with the base interval $[-1,1]$ is + equivalent to problem of obtaining the same absolute accuracy from + $S^{i+3} D_{d_1} D_{d_2} \ldots$ with $[0,\infty]$ as the base interval. + We have: + \[ \begin{array}{ccc} + S^0 A_{d_1} A_{d_2} \ldots A_{d_n} [-1,1] &\Longleftrightarrow& + S_0 D_{d_1} D_{d_2} \ldots D_{d_n} [0,\infty], \vspace{0.5em} \\ + S^1 A_{d_1} A_{d_2} \ldots A_{d_n} [-1,1] &\Longleftrightarrow& + S_+ D_{d_1} D_{d_2} \ldots D_{d_n} [0,\infty], \vspace{0.5em} \\ + S^2 A_{d_1} A_{d_2} \ldots A_{d_n} [-1,1] &\Longleftrightarrow& + S_\infty D_{d_1} D_{d_2} \ldots D_{d_n} [0,\infty], \vspace{0.5em} \\ + S^3 A_{d_1} A_{d_2} \ldots A_{d_n} [-1,1] &\Longleftrightarrow& + S_- D_{d_1} D_{d_2} \ldots D_{d_n} [0,\infty]. + \end{array} \] + + +\subsection{Alternative Approaches with Base Interval $[-1,1]$} +We will mention another two approaches, namely {\sc mantissa--exponent + approach} and {\sc integer part--fractional part approach}. In the + former, any real number $x \in \mathbb{R}$ can be represented in base + $b$ as $x=b^e u$, where $e$ is a non--negative integer and $u = + \sum d_i b^{-i} \in [-1,1]$. This corresponds to the product of matrices + $\begin{pmatrix} b^e&0 \\ 0&1 \end{pmatrix} A_{d_1} A_{d_2} \ldots$. + Obtaining any required absolute precision in this approach is + straightforward. As each of digit matrices in base $b$, $A_{d_i}$, + contracts distances by $1/b$, the product: + \[ \begin{pmatrix} b^e&0 \\ 0&1 \end{pmatrix} A_{d_1} A_{d_2} \ldots + A_{d_{e+k}} \] + will induce an interval whose length is $2b^{-k}$, for any $k \in + \mathbb{N}$. + +In the integer part--fractional part approach, a real number $x \in + \mathbb{R}$ is represented as $x=e+u$, where $e$ is an integer and + $u = \sum d_i b^{-i} \in [-1,1]$. Obtaining an absolute precision for $x$ + is even simpler. Calculating $u$ within the same absolute precision will + solve the problem. The product of $k$ digit matrices, $A_{d_1} A_{d_2} + \ldots A_{d_k}$ will induce an interval of the length $2b^{-k}$. Hence, + $x=e+u$ will be calculated with error not greater than $2b^{-k}$. + + +\section*{Acknowledgements} +I would like to thank Reinhold Heckmann for all his help. + + +\begin{thebibliography}{99} + \bibitem{eda97} Edalat, A.: + Domains for Computation in Mathemetics, Physics and Exact + Real Arithmetic. + Bulletin of Symbolic Logic, Vol.~3 (1997). + + \bibitem{edapot97} Edalat, A., Potts, P.~J.: + A New Representation for Exact Real Numbers. + Electronic Notes in Theoretical Computer Science, Vol.~6 (1997). + + \bibitem{errhec00} Errington, L., Heckmann, R.: + Using the C--LFT Library (2000). + + \bibitem{hec99} Heckmann, R.: + How Many Argument Digits are Needed to Produce $n$ + Result Digits? Electronic Notes in Theoretical Computer Science, + Vol.~24 (2000). + + \bibitem{niekor95} Nielsen, A., Kornerup P.: + MSB--First Digit Serial Arithmetic. + Journal of Univ. Comp. Science, 1(7):523--543 (1995). + + \bibitem{pot98} Potts, P.~J.: + Exact Real Arithmetic Using M\"obius Transformations. + PhD Thesis, University of London, Imperial College (1998). + + \bibitem{vui90} Vuillemin, J.~E.: + Exact Real Computer Arithmetic with Continued Fractions. + IEEE Transactions on Computers, 39(8):1087--1105 (1990). +\end{thebibliography} + + +\end{document}
\ No newline at end of file diff --git a/ic-reals-6.3/doc/manual/collect-eps-converted-to.pdf b/ic-reals-6.3/doc/manual/collect-eps-converted-to.pdf Binary files differnew file mode 100644 index 0000000..93ebb2e --- /dev/null +++ b/ic-reals-6.3/doc/manual/collect-eps-converted-to.pdf diff --git a/ic-reals-6.3/doc/manual/collect.eps b/ic-reals-6.3/doc/manual/collect.eps new file mode 100644 index 0000000..bc82e8e --- /dev/null +++ b/ic-reals-6.3/doc/manual/collect.eps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/collect.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +c3f0ff +81e07f +18c63f +3ccf3f +3fcfff +3fcfff +3fcfff +30cfff +30cfff +3ccfff +3ccf3f +18c63f +81e07f +c3f0ff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/doc/manual/continue-eps-converted-to.pdf b/ic-reals-6.3/doc/manual/continue-eps-converted-to.pdf Binary files differnew file mode 100644 index 0000000..7b413ff --- /dev/null +++ b/ic-reals-6.3/doc/manual/continue-eps-converted-to.pdf diff --git a/ic-reals-6.3/doc/manual/continue.eps b/ic-reals-6.3/doc/manual/continue.eps new file mode 100644 index 0000000..da762ab --- /dev/null +++ b/ic-reals-6.3/doc/manual/continue.eps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/continue.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +c000ff +c000ff +ffffff +ffffff +c000ff +e001ff +e001ff +f003ff +f807ff +f807ff +fc0fff +fe1fff +fe1fff +ff3fff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/doc/manual/go-eps-converted-to.pdf b/ic-reals-6.3/doc/manual/go-eps-converted-to.pdf Binary files differnew file mode 100644 index 0000000..ea22606 --- /dev/null +++ b/ic-reals-6.3/doc/manual/go-eps-converted-to.pdf diff --git a/ic-reals-6.3/doc/manual/go.eps b/ic-reals-6.3/doc/manual/go.eps new file mode 100644 index 0000000..454833b --- /dev/null +++ b/ic-reals-6.3/doc/manual/go.eps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/go.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +cfffff +c3ffff +c0ffff +c03fff +c00fff +c003ff +c000ff +c000ff +c003ff +c00fff +c03fff +c0ffff +c3ffff +cfffff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/doc/manual/manual.aux b/ic-reals-6.3/doc/manual/manual.aux new file mode 100644 index 0000000..3514aca --- /dev/null +++ b/ic-reals-6.3/doc/manual/manual.aux @@ -0,0 +1,30 @@ +\relax +\@writefile{toc}{\contentsline {section}{\numberline {1}Introduction}{1}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {2}Copyright}{2}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {3}Installation}{2}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {4}Using the library}{3}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {5}Types}{3}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {6}Arithmetic}{4}{}\protected@file@percent } +\@writefile{lot}{\contentsline {table}{\numberline {1}{\ignorespaces Primitive arithmetic functions}}{4}{}\protected@file@percent } +\newlabel{arith-table}{{1}{4}} +\@writefile{toc}{\contentsline {section}{\numberline {7}Special functions}{5}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {8}Forcing, printing and conversion}{6}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {9}Predicates, Boolean operations and conditionals}{8}{}\protected@file@percent } +\@writefile{lot}{\contentsline {table}{\numberline {2}{\ignorespaces Predicates on reals}}{8}{}\protected@file@percent } +\newlabel{pred}{{2}{8}} +\@writefile{lot}{\contentsline {table}{\numberline {3}{\ignorespaces Boolean operators}}{9}{}\protected@file@percent } +\newlabel{Bool-Ops}{{3}{9}} +\@writefile{lot}{\contentsline {table}{\numberline {4}{\ignorespaces Action of the predicate \texttt {gtEq{\_}R{\_}0}}}{9}{}\protected@file@percent } +\newlabel{Truth-values}{{4}{9}} +\@writefile{lot}{\contentsline {table}{\numberline {5}{\ignorespaces Action of the Boolean operators}}{10}{}\protected@file@percent } +\newlabel{op-action}{{5}{10}} +\@writefile{lof}{\contentsline {figure}{\numberline {1}{\ignorespaces Example of conditional with delays.}}{12}{}\protected@file@percent } +\newlabel{fig:conditionals}{{1}{12}} +\@writefile{toc}{\contentsline {section}{\numberline {10}Extracting digits following forcing}{13}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {11}Environment variables}{13}{}\protected@file@percent } +\@writefile{lof}{\contentsline {figure}{\numberline {2}{\ignorespaces Taking digits one-by-one.}}{14}{}\protected@file@percent } +\newlabel{fig:digits-info}{{2}{14}} +\@writefile{toc}{\contentsline {section}{\numberline {12}The daVinci interface}{15}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {13}Compilation flags}{16}{}\protected@file@percent } +\@writefile{toc}{\contentsline {section}{\numberline {14}Problems}{16}{}\protected@file@percent } +\gdef \@abspage@last{16} diff --git a/ic-reals-6.3/doc/manual/manual.log b/ic-reals-6.3/doc/manual/manual.log new file mode 100644 index 0000000..40fe007 --- /dev/null +++ b/ic-reals-6.3/doc/manual/manual.log @@ -0,0 +1,324 @@ +This is pdfTeX, Version 3.141592653-2.6-1.40.25 (TeX Live 2023/Parabola GNU/Linux-libre) (preloaded format=pdflatex 2023.10.5) 11 NOV 2023 09:14 +entering extended mode + \write18 enabled. + file:line:error style messages enabled. + %&-line parsing enabled. +**manual.tex +(./manual.tex +LaTeX2e <2022-11-01> patch level 1 +L3 programming layer <2023-02-22> +(/usr/share/texmf-dist/tex/latex/base/article.cls +Document Class: article 2022/07/02 v1.4n Standard LaTeX document class +(/usr/share/texmf-dist/tex/latex/base/size12.clo +File: size12.clo 2022/07/02 v1.4n Standard LaTeX file (size option) +) +\c@part=\count185 +\c@section=\count186 +\c@subsection=\count187 +\c@subsubsection=\count188 +\c@paragraph=\count189 +\c@subparagraph=\count190 +\c@figure=\count191 +\c@table=\count192 +\abovecaptionskip=\skip48 +\belowcaptionskip=\skip49 +\bibindent=\dimen140 +) +(/usr/share/texmf-dist/tex/latex/amsmath/amsmath.sty +Package: amsmath 2022/04/08 v2.17n AMS math features +\@mathmargin=\skip50 + +For additional information on amsmath, use the `?' option. +(/usr/share/texmf-dist/tex/latex/amsmath/amstext.sty +Package: amstext 2021/08/26 v2.01 AMS text + +(/usr/share/texmf-dist/tex/latex/amsmath/amsgen.sty +File: amsgen.sty 1999/11/30 v2.0 generic functions +\@emptytoks=\toks16 +\ex@=\dimen141 +)) +(/usr/share/texmf-dist/tex/latex/amsmath/amsbsy.sty +Package: amsbsy 1999/11/29 v1.2d Bold Symbols +\pmbraise@=\dimen142 +) +(/usr/share/texmf-dist/tex/latex/amsmath/amsopn.sty +Package: amsopn 2022/04/08 v2.04 operator names +) +\inf@bad=\count193 +LaTeX Info: Redefining \frac on input line 234. +\uproot@=\count194 +\leftroot@=\count195 +LaTeX Info: Redefining \overline on input line 399. +LaTeX Info: Redefining \colon on input line 410. +\classnum@=\count196 +\DOTSCASE@=\count197 +LaTeX Info: Redefining \ldots on input line 496. +LaTeX Info: Redefining \dots on input line 499. +LaTeX Info: Redefining \cdots on input line 620. +\Mathstrutbox@=\box51 +\strutbox@=\box52 +LaTeX Info: Redefining \big on input line 722. +LaTeX Info: Redefining \Big on input line 723. +LaTeX Info: Redefining \bigg on input line 724. +LaTeX Info: Redefining \Bigg on input line 725. +\big@size=\dimen143 +LaTeX Font Info: Redeclaring font encoding OML on input line 743. +LaTeX Font Info: Redeclaring font encoding OMS on input line 744. +\macc@depth=\count198 +LaTeX Info: Redefining \bmod on input line 905. +LaTeX Info: Redefining \pmod on input line 910. +LaTeX Info: Redefining \smash on input line 940. +LaTeX Info: Redefining \relbar on input line 970. +LaTeX Info: Redefining \Relbar on input line 971. +\c@MaxMatrixCols=\count199 +\dotsspace@=\muskip16 +\c@parentequation=\count266 +\dspbrk@lvl=\count267 +\tag@help=\toks17 +\row@=\count268 +\column@=\count269 +\maxfields@=\count270 +\andhelp@=\toks18 +\eqnshift@=\dimen144 +\alignsep@=\dimen145 +\tagshift@=\dimen146 +\tagwidth@=\dimen147 +\totwidth@=\dimen148 +\lineht@=\dimen149 +\@envbody=\toks19 +\multlinegap=\skip51 +\multlinetaggap=\skip52 +\mathdisplay@stack=\toks20 +LaTeX Info: Redefining \[ on input line 2953. +LaTeX Info: Redefining \] on input line 2954. +) +(/usr/share/texmf-dist/tex/latex/amsfonts/amsfonts.sty +Package: amsfonts 2013/01/14 v3.01 Basic AMSFonts support +\symAMSa=\mathgroup4 +\symAMSb=\mathgroup5 +LaTeX Font Info: Redeclaring math symbol \hbar on input line 98. +LaTeX Font Info: Overwriting math alphabet `\mathfrak' in version `bold' +(Font) U/euf/m/n --> U/euf/b/n on input line 106. +) +(/usr/share/texmf-dist/tex/latex/graphics/graphicx.sty +Package: graphicx 2021/09/16 v1.2d Enhanced LaTeX Graphics (DPC,SPQR) + +(/usr/share/texmf-dist/tex/latex/graphics/keyval.sty +Package: keyval 2022/05/29 v1.15 key=value parser (DPC) +\KV@toks@=\toks21 +) +(/usr/share/texmf-dist/tex/latex/graphics/graphics.sty +Package: graphics 2022/03/10 v1.4e Standard LaTeX Graphics (DPC,SPQR) + +(/usr/share/texmf-dist/tex/latex/graphics/trig.sty +Package: trig 2021/08/11 v1.11 sin cos tan (DPC) +) +(/usr/share/texmf-dist/tex/latex/graphics-cfg/graphics.cfg +File: graphics.cfg 2016/06/04 v1.11 sample graphics configuration +) +Package graphics Info: Driver file: pdftex.def on input line 107. + +(/usr/share/texmf-dist/tex/latex/graphics-def/pdftex.def +File: pdftex.def 2022/09/22 v1.2b Graphics/color driver for pdftex +)) +\Gin@req@height=\dimen150 +\Gin@req@width=\dimen151 +) +(/usr/share/texmf-dist/tex/latex/l3backend/l3backend-pdftex.def +File: l3backend-pdftex.def 2023-01-16 L3 backend support: PDF output (pdfTeX) +\l__color_backend_stack_int=\count271 +\l__pdf_internal_box=\box53 +) (./manual.aux) +\openout1 = `manual.aux'. + +LaTeX Font Info: Checking defaults for OML/cmm/m/it on input line 20. +LaTeX Font Info: ... okay on input line 20. +LaTeX Font Info: Checking defaults for OMS/cmsy/m/n on input line 20. +LaTeX Font Info: ... okay on input line 20. +LaTeX Font Info: Checking defaults for OT1/cmr/m/n on input line 20. +LaTeX Font Info: ... okay on input line 20. +LaTeX Font Info: Checking defaults for T1/cmr/m/n on input line 20. +LaTeX Font Info: ... okay on input line 20. +LaTeX Font Info: Checking defaults for TS1/cmr/m/n on input line 20. +LaTeX Font Info: ... okay on input line 20. +LaTeX Font Info: Checking defaults for OMX/cmex/m/n on input line 20. +LaTeX Font Info: ... okay on input line 20. +LaTeX Font Info: Checking defaults for U/cmr/m/n on input line 20. +LaTeX Font Info: ... okay on input line 20. +(/usr/share/texmf-dist/tex/context/base/mkii/supp-pdf.mkii +[Loading MPS to PDF converter (version 2006.09.02).] +\scratchcounter=\count272 +\scratchdimen=\dimen152 +\scratchbox=\box54 +\nofMPsegments=\count273 +\nofMParguments=\count274 +\everyMPshowfont=\toks22 +\MPscratchCnt=\count275 +\MPscratchDim=\dimen153 +\MPnumerator=\count276 +\makeMPintoPDFobject=\count277 +\everyMPtoPDFconversion=\toks23 +) (/usr/share/texmf-dist/tex/latex/epstopdf-pkg/epstopdf-base.sty +Package: epstopdf-base 2020-01-24 v2.11 Base part for package epstopdf +Package epstopdf-base Info: Redefining graphics rule for `.eps' on input line 4 +85. + +(/usr/share/texmf-dist/tex/latex/latexconfig/epstopdf-sys.cfg +File: epstopdf-sys.cfg 2010/07/13 v1.3 Configuration of (r)epstopdf for TeX Liv +e +)) +LaTeX Font Info: Trying to load font information for U+msa on input line 21. + + +(/usr/share/texmf-dist/tex/latex/amsfonts/umsa.fd +File: umsa.fd 2013/01/14 v3.01 AMS symbols A +) +LaTeX Font Info: Trying to load font information for U+msb on input line 21. + + +(/usr/share/texmf-dist/tex/latex/amsfonts/umsb.fd +File: umsb.fd 2013/01/14 v3.01 AMS symbols B +) [1 + +{/var/lib/texmf/fonts/map/pdftex/updmap/pdftex.map}] [2{/usr/share/texmf-dist/f +onts/enc/dvips/cm-super/cm-super-ts1.enc}] [3] [4] +Overfull \hbox (9.20828pt too wide) in paragraph at lines 336--338 +\OT1/cmr/m/n/12 The next two func-tions yield the even more com-pli-cated ex-pr +es-sion $[]$: + [] + +[5] +Overfull \hbox (11.72748pt too wide) in paragraph at lines 483--491 +[]\OT1/cmr/m/n/12 There are two ways to spec-ify the amount of forc-ing: the fi +rst, \OT1/cmtt/m/n/12 force[]R[]Digs\OT1/cmr/m/n/12 , + [] + +[6] [7] [8] +Overfull \hbox (0.7466pt too wide) in paragraph at lines 676--682 +[]\OT1/cmr/m/n/12 Roughly spo-ken, the func-tion eval-u-ates the guards $\OML/c +mm/m/it/12 b[]$\OT1/cmr/m/n/12 , ..., $\OML/cmm/m/it/12 b[]$\OT1/cmr/m/n/12 , t +hen chooses + [] + +[9] [10] [11] [12] +Overfull \hbox (1.67105pt too wide) in paragraph at lines 893--895 +[]\OT1/cmr/m/n/12 From a com-pressed digit rep-re-sen-ta-tion as it is pro-vide +d by \OT1/cmtt/m/n/12 retrieveInfo\OT1/cmr/m/n/12 , + [] + +LaTeX Font Info: Font shape `OT1/cmtt/bx/n' in size <12> not available +(Font) Font shape `OT1/cmtt/m/n' tried instead on input line 941. + +Overfull \hbox (9.85213pt too wide) in paragraph at lines 942--951 +\OT1/cmr/m/n/12 than 1, try set-ting the en-vi-ron-ment vari-able \OT1/cmtt/m/n +/12 ICR[]DEFAULT[]FORCE[]COUNT=1 + [] + +[13] [14] +Package epstopdf Info: Source file: <stop.eps> +(epstopdf) date: 2000-07-24 21:06:57 +(epstopdf) size: 990 bytes +(epstopdf) Output file: <stop-eps-converted-to.pdf> +(epstopdf) date: 2023-11-11 09:14:32 +(epstopdf) size: 2598 bytes +(epstopdf) Command: <repstopdf --outfile=stop-eps-converted-to.pdf +stop.eps> +(epstopdf) \includegraphics on input line 998. +Package epstopdf Info: Output file is already uptodate. +<stop-eps-converted-to.pdf, id=60, 12.045pt x 12.045pt> +File: stop-eps-converted-to.pdf Graphic file (type pdf) +<use stop-eps-converted-to.pdf> +Package pdftex.def Info: stop-eps-converted-to.pdf used on input line 998. +(pdftex.def) Requested size: 12.04495pt x 12.04495pt. +Package epstopdf Info: Source file: <go.eps> +(epstopdf) date: 2000-07-24 21:06:57 +(epstopdf) size: 988 bytes +(epstopdf) Output file: <go-eps-converted-to.pdf> +(epstopdf) date: 2023-11-11 09:14:33 +(epstopdf) size: 2599 bytes +(epstopdf) Command: <repstopdf --outfile=go-eps-converted-to.pdf go +.eps> +(epstopdf) \includegraphics on input line 999. +Package epstopdf Info: Output file is already uptodate. +<go-eps-converted-to.pdf, id=61, 12.045pt x 12.045pt> +File: go-eps-converted-to.pdf Graphic file (type pdf) +<use go-eps-converted-to.pdf> +Package pdftex.def Info: go-eps-converted-to.pdf used on input line 999. +(pdftex.def) Requested size: 12.04495pt x 12.04495pt. +Package epstopdf Info: Source file: <step.eps> +(epstopdf) date: 2000-07-24 21:06:57 +(epstopdf) size: 990 bytes +(epstopdf) Output file: <step-eps-converted-to.pdf> +(epstopdf) date: 2023-11-11 09:14:33 +(epstopdf) size: 2603 bytes +(epstopdf) Command: <repstopdf --outfile=step-eps-converted-to.pdf +step.eps> +(epstopdf) \includegraphics on input line 1001. +Package epstopdf Info: Output file is already uptodate. +<step-eps-converted-to.pdf, id=62, 12.045pt x 12.045pt> +File: step-eps-converted-to.pdf Graphic file (type pdf) +<use step-eps-converted-to.pdf> +Package pdftex.def Info: step-eps-converted-to.pdf used on input line 1001. +(pdftex.def) Requested size: 12.04495pt x 12.04495pt. +Package epstopdf Info: Source file: <continue.eps> +(epstopdf) date: 2000-07-24 21:06:57 +(epstopdf) size: 994 bytes +(epstopdf) Output file: <continue-eps-converted-to.pdf> +(epstopdf) date: 2023-11-11 09:14:34 +(epstopdf) size: 2614 bytes +(epstopdf) Command: <repstopdf --outfile=continue-eps-converted-to. +pdf continue.eps> +(epstopdf) \includegraphics on input line 1003. +Package epstopdf Info: Output file is already uptodate. +<continue-eps-converted-to.pdf, id=63, 12.045pt x 12.045pt> +File: continue-eps-converted-to.pdf Graphic file (type pdf) +<use continue-eps-converted-to.pdf> +Package pdftex.def Info: continue-eps-converted-to.pdf used on input line 1003 +. +(pdftex.def) Requested size: 12.04495pt x 12.04495pt. +Package epstopdf Info: Source file: <collect.eps> +(epstopdf) date: 2000-07-24 21:06:57 +(epstopdf) size: 993 bytes +(epstopdf) Output file: <collect-eps-converted-to.pdf> +(epstopdf) date: 2023-11-11 09:14:34 +(epstopdf) size: 2628 bytes +(epstopdf) Command: <repstopdf --outfile=collect-eps-converted-to.p +df collect.eps> +(epstopdf) \includegraphics on input line 1005. +Package epstopdf Info: Output file is already uptodate. +<collect-eps-converted-to.pdf, id=64, 12.045pt x 12.045pt> +File: collect-eps-converted-to.pdf Graphic file (type pdf) +<use collect-eps-converted-to.pdf> +Package pdftex.def Info: collect-eps-converted-to.pdf used on input line 1005. + +(pdftex.def) Requested size: 12.04495pt x 12.04495pt. + [15 <./stop-eps-converted-to.pdf> <./go-eps-converted-to.pdf> <./step-eps-conv +erted-to.pdf> <./continue-eps-converted-to.pdf> <./collect-eps-converted-to.pdf +>] [16] (./manual.aux) ) +Here is how much of TeX's memory you used: + 2206 strings out of 476025 + 33817 string characters out of 5796518 + 1866388 words of memory out of 5000000 + 22652 multiletter control sequences out of 15000+600000 + 522992 words of font info for 73 fonts, out of 8000000 for 9000 + 1141 hyphenation exceptions out of 8191 + 57i,15n,62p,223b,363s stack positions out of 5000i,500n,10000p,200000b,80000s +</usr/share/texmf-dist/fonts/type1/public/amsfonts/cm/c +mbx12.pfb></usr/share/texmf-dist/fonts/type1/public/amsfonts/cm/cmbxti10.pfb></ +usr/share/texmf-dist/fonts/type1/public/amsfonts/cm/cmex10.pfb></usr/share/texm +f-dist/fonts/type1/public/amsfonts/cm/cmmi12.pfb></usr/share/texmf-dist/fonts/t +ype1/public/amsfonts/cm/cmmi8.pfb></usr/share/texmf-dist/fonts/type1/public/ams +fonts/cm/cmr12.pfb></usr/share/texmf-dist/fonts/type1/public/amsfonts/cm/cmr17. +pfb></usr/share/texmf-dist/fonts/type1/public/amsfonts/cm/cmr8.pfb></usr/share/ +texmf-dist/fonts/type1/public/amsfonts/cm/cmsy10.pfb></usr/share/texmf-dist/fon +ts/type1/public/amsfonts/cm/cmsy8.pfb></usr/share/texmf-dist/fonts/type1/public +/amsfonts/cm/cmti12.pfb></usr/share/texmf-dist/fonts/type1/public/amsfonts/cm/c +mtt12.pfb></usr/share/texmf-dist/fonts/type1/public/amsfonts/symbols/msbm10.pfb +></usr/share/texmf-dist/fonts/type1/public/cm-super/sfrm1200.pfb> +Output written on manual.pdf (16 pages, 191783 bytes). +PDF statistics: + 137 PDF objects out of 1000 (max. 8388607) + 85 compressed objects within 1 object stream + 0 named destinations out of 1000 (max. 500000) + 26 words of extra memory for PDF output out of 10000 (max. 10000000) + diff --git a/ic-reals-6.3/doc/manual/manual.pdf b/ic-reals-6.3/doc/manual/manual.pdf Binary files differnew file mode 100644 index 0000000..79c12b7 --- /dev/null +++ b/ic-reals-6.3/doc/manual/manual.pdf diff --git a/ic-reals-6.3/doc/manual/manual.tex b/ic-reals-6.3/doc/manual/manual.tex new file mode 100644 index 0000000..db3a1c5 --- /dev/null +++ b/ic-reals-6.3/doc/manual/manual.tex @@ -0,0 +1,1057 @@ +\documentclass[a4paper,12pt]{article} +\usepackage{amsmath} +\usepackage{amsfonts} +\usepackage{graphicx} +\parskip=10pt% +\newcommand{\vdist}{\vrule width0pt height2.5ex depth1.0ex\relax} +\title{Using the IC Reals Library} +\author{Lindsay Errington and Reinhold Heckmann} +\newenvironment{funlist}{\begin{list}% + {}% + {\topsep=0pt% + \leftmargin=0cm% + \rightmargin=0cm% + \listparindent=0cm% + \parskip=10pt% + \partopsep=0pt% + \itemsep=0pt% + \parsep=0pt}}% + {\end{list}} +\begin{document} +\maketitle +\newcommand{\Type}[1]{\texttt{#1}} +\newcommand{\Name}[1]{\texttt{#1}} +\newcommand{\Var}[1]{\textit{#1}} +\newcommand{\File}[1]{\textsf{#1}} + +\section{Introduction} +The Imperial College Exact Real Arithmetic Library +is a collection of C types and functions +which implement exact real arithmetic. The functions +allow one to construct objects representing real numbers +and then to demand information, for example some number +of decimal digits, from those objects. The user need not specify a precision +in advance. All the digits retrieved are correct and further digits +can be demanded. + +The library includes arithmetic operations as +well as a suite of analytic functions on reals. +In addition to a real type, the library also includes a lazy boolean +type and a collection of predicates on reals, boolean operations +and a conditional construct. + +The representation of reals is based on \emph{linear fractional +transformations} (LFTs). The underlying theory was developed by +Abbas Edalat, Martin Escardo, Reinhold Heckmann, Peter Potts, Philipp +S\"{u}nderhauf and Lindsay Errington (lazy booleans). + +The library was written by Lindsay Errington with contributions from Marko +Krznaric and Reinhold Heckmann. + +% \cite{}. + +This document describes the types and functions provided by the +library. It is not an introduction to +exact real arithmetic nor does it describe the details of +the LFT approach. + +\section{Copyright} + +All software in this distribution comes under the following copyright notice: + +Copyright \copyright\ 1998-2000 by Imperial College of Science, Technology +and Medicine + +Permission to use, copy, modify, and distribute this software and its +documentation for any non-commercial purpose and without fee is hereby +granted, provided that this copyright notice appears in all copies. +The library cannot be used directly or indirectly for any commercial +application without a licence from Imperial College. + +Neither Imperial College nor Lindsay Errington make representations about +the suitability of this software for any purpose. It is provided ``as is'' +without express or implied warranty. + +\section{Installation} + +To install the library it is necessary to +edit the Makefile and change \texttt{REALDIR} to point to the +root of the Real Library source tree. + +Also, the library requires the GNU Multiple Precision Arithmetic Library +(GMP) (Version 3.1). The Makefile defines a variable +\texttt{GMPDIR} which is assumed to be the root directory of the +GMP installation. + +Assuming the Makefile has been edited such that \texttt{REALDIR} +and \texttt{GMPDIR} point to the respective directories, +then the command +\begin{quote} +\texttt{make} +\end{quote} +will create the real library. To remove the library +and all binaries, type: +\begin{quote} +\texttt{make clean} +\end{quote} + +\section{Using the library} + +All applications which call functions in the library must include +the file \texttt{real.h}. This file defines all the types +and prototypes for all functions exported from the library. +In particular +the file defines the types \Type{Real} and \Type{Bool} corresponding +to lazy reals and lazy booleans. The file \texttt{real.h} includes +\texttt{gmp.h}. + +The user must call the function +\begin{quote} +\texttt{initReals();} +\end{quote} +before invoking any other functions in the library. +This function should be called only once. + +\section{Types} + +The main purpose of the library is to provide +a type \Type{Real} of real numbers. +Since it requires +the GNU Multiple Precision Arithmetic Library (GMP) as well, +it also provides GMP's big integer type \Type{mpz{\_}t} as a byproduct. +Most of the functions defined by the library come in +a number of instances for different types. +These instances are named using suffixes +abbreviating type names; e.g.\ the suffix \Name{R} +indicates the type \Type{Real}. +The full list is given by the following table. + +\begin{tabular}{|l|l|l|} +\hline +\vdist Abbreviation & Prototype & Denotation \\ +\hline +\hline +\vdist \Name{R} + & \Type{Real} \Var{x} + & $\mbox{\Var{x}} : \mathbb{R}$ \\ +\hline +\vdist \Name{Int} + & \Type{int} \Var{x} + & $x : \mathbb{Z}$, $x$ machine integer \\ +\hline +\vdist \Name{Z} + & \Type{mpz{\_}t} \Var{x} + & $x : \mathbb{Z}$, $x$ GMP integer \\ +\hline +\vdist \Name{QInt} + & \Type{int} \Var{a}, \Type{int} \Var{b} + & $\frac{a}{b} : \mathbb{Q}$, $a$, $b$ machine integers \\ +\hline +\vdist \Name{QZ} + & \Type{mpz{\_}t} \Var{a}, \Type{mpz{\_}t} \Var{b} + & $\frac{a}{b} : \mathbb{Q}$, $a$, $b$ GMP integers \\ +\hline +\end{tabular} + +Usually, the specialised functions are more efficient +than the general ones. +The possibility of using machine integers +is particularly useful +since these integers are readily available +and need not be set up specially. +\vspace{-2ex} + +\section{Arithmetic} +\vspace{-2ex} +The basic functions for addition, subtraction, +multiplication and division occur in a general form +operating on two reals, and in various specialised forms +involving integers. +The available functions are listed in Table~\ref{arith-table}. + +\begin{table}[htp] +\begin{center} +\begin{tabular}{|l|c|} +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{neg{\_}R}(% + \Type{Real} \Var{x}) +\end{tabular} +& $-x$ \\ +\begin{tabular}{l} +\vdist\Type{Real} \Name{abs{\_}R}(% + \Type{Real} \Var{x}) +\end{tabular} +& $|x|$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{add{\_}R{\_}R}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}) \\ +\vdist\Type{Real} \Name{add{\_}R{\_}Int}(% + \Type{Real} \Var{x}, + \Type{int} \Var{y}) \\ +\vdist\Type{Real} \Name{add{\_}R{\_}Z}(% + \Type{Real} \Var{x}, + \Type{mpz{\_}t} \Var{y}) +\end{tabular} +& $x + y$ \\ +\hline +\begin{tabular}{l} + \vdist\Type{Real} \Name{add{\_}R{\_}QInt}(% + \Type{Real} \Var{x}, + \Type{int} \Var{a}, + \Type{int} \Var{b}) \\ + \vdist\Type{Real} \Name{add{\_}R{\_}QZ}(% + \Type{Real} \Var{x}, + \Type{mpz{\_}t} \Var{a}, + \Type{mpz{\_}t} \Var{b}) \\ +\end{tabular} +& $x + \frac{a}{b}$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{sub{\_}R{\_}R}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}) \\ +\vdist\Type{Real} \Name{sub{\_}R{\_}Int}(% + \Type{Real} \Var{x}, + \Type{int} \Var{y}) \\ +\vdist\Type{Real} \Name{sub{\_}Int{\_}R}(% + \Type{int} \Var{x}, + \Type{Real} \Var{y}) +\end{tabular} +& $x - y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{sub{\_}R{\_}QInt}(% + \Type{Real} \Var{x}, + \Type{int} \Var{a}, + \Type{int} \Var{b}) +\end{tabular} +& $x - \frac{a}{b}$ \\ +\begin{tabular}{l} +\vdist\Type{Real} \Name{sub{\_}QInt{\_}R}(% + \Type{int} \Var{a}, + \Type{int} \Var{b}, + \Type{Real} \Var{x}) +\end{tabular} +& $\frac{a}{b} - x$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{mul{\_}R{\_}R}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}) \\ +\vdist\Type{Real} \Name{mul{\_}R{\_}Int}(% + \Type{Real} \Var{x}, + \Type{int} \Var{y}) \\ +\vdist\Type{Real} \Name{mul{\_}R{\_}Z}(% + \Type{Real} \Var{x}, + \Type{mpz{\_}t} \Var{y}) \\ +\end{tabular} +& $x \times y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{mul{\_}R{\_}QInt}(% + \Type{Real} \Var{x}, + \Type{int} \Var{a}, + \Type{int} \Var{b}) \\ +\vdist\Type{Real} \Name{mul{\_}R{\_}QZ}(% + \Type{Real} \Var{x}, + \Type{mpz{\_}t} \Var{a}, + \Type{mpz{\_}t} \Var{b}) \\ +\end{tabular} +& $x \times \frac{a}{b}$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{div{\_}R{\_}R}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}) \\ +\vdist\Type{Real} \Name{div{\_}R{\_}Int}(% + \Type{Real} \Var{x}, + \Type{int} \Var{y}) \\ +\vdist\Type{Real} \Name{div{\_}Int{\_}R}(% + \Type{int} \Var{x}, + \Type{Real} \Var{y}) +\end{tabular} +& $\frac{x}{y}$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{div{\_}R{\_}QInt}(% + \Type{Real} \Var{x}, + \Type{int} \Var{a}, + \Type{int} \Var{b}) +\end{tabular} +& $x / \frac{a}{b} = \frac{b x}{a}$ \\[0.5ex] +\begin{tabular}{l} +\vdist\Type{Real} \Name{div{\_}QInt{\_}R}(% + \Type{int} \Var{a}, + \Type{int} \Var{b}, + \Type{Real} \Var{x}) +\end{tabular} +& $\frac{a}{b} / x = \frac{a}{bx}$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Real} \Name{pow{\_}R{\_}R}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}) +\end{tabular} +& $x^y$ \\ +\hline +\end{tabular} +\end{center} +\caption{Primitive arithmetic functions}\label{arith-table} +\end{table} + +The following two functions define the rational number $\frac{a}{b}$, +considered as a real: +\begin{funlist} +\item \Type{Real} \Name{real{\_}QInt}(% + \Type{int} \Var{a}, + \Type{int} \Var{b}) +\item \Type{Real} \Name{real{\_}QZ}(% + \Type{mpz{\_}t} \Var{a}, + \Type{mpz{\_}t} \Var{b}) +\end{funlist} + +Real numbers are implemented using \emph{linear fractional +transformations} (LFTs). Users can construct +LFT functions explicitly. +The following two functions compute the expression +$\frac{ax+b}{cx+d}$: +\begin{funlist} +\item \Type{Real} \Name{lft{\_}R{\_}Int}(% + \Type{Real} \Var{x}, + \Type{int} \Var{a}, + \Type{int} \Var{b}, + \Type{int} \Var{c}, + \Type{int} \Var{d}) +\item \Type{Real} \Name{lft{\_}R{\_}Z}(% + \Type{Real} \Var{x}, + \Type{mpz{\_}t} \Var{a}, + \Type{mpz{\_}t} \Var{b}, + \Type{mpz{\_}t} \Var{c}, + \Type{mpz{\_}t} \Var{d}) +\end{funlist} + +\noindent The next two functions yield the even more complicated expression +$\frac{axy + bx + cy + d}{exy + fx + gy + h}$: +\begin{funlist} +\item \Type{Real} \Name{lft{\_}R{\_}R{\_}Int}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}, + \Type{int} \Var{a}, + \Type{int} \Var{b}, +\ldots, + % \Type{int} \Var{c}, + % \Type{int} \Var{d}, + % \Type{int} \Var{e}, + % \Type{int} \Var{f}, + % \Type{int} \Var{g}, + \Type{int} \Var{h}) +\item \Type{Real} \Name{lft{\_}R{\_}R{\_}Z}(% + \Type{Real} \Var{x}, + \Type{Real} \Var{y}, + \Type{mpz{\_}t} \Var{a}, + \Type{mpz{\_}t} \Var{b}, +\ldots, + % \Type{mpz{\_}t} \Var{c}, + % \Type{mpz{\_}t} \Var{d}, + % \Type{mpz{\_}t} \Var{e}, + % \Type{mpz{\_}t} \Var{f}, + % \Type{mpz{\_}t} \Var{g}, + \Type{mpz{\_}t} \Var{h}) +\end{funlist} + +\noindent \textbf{Examples:} +\vspace{-1.0ex} +\begin{itemize} +\item To compute $y = x+1$ ($x$ real), use\quad + \verb| y = add_R_Int (x, 1);|\\[0.5ex] + This is both simpler and more efficient than to use\\[0.5ex] + \verb| one = real_QInt (1, 1); y = add_R_R (x, one);| +\item To compute $y = \frac{x+1}{x-1}$, use\\[0.5ex] + \verb| y = lft_R_Int (x, 1, 1, 1, -1);|\\[0.5ex] + This is both simpler and more efficient than to use\\[0.5ex] + \verb| y = div_R_R (add_R_Int (x, 1), sub_R_Int (x, 1));| +\item To compute $z = \frac{2x+y}{xy-1}$, use\\[0.5ex] + \verb| z = lft_R_R_Int (x, y, 0, 2, 1, 0,|\\ + \verb| 1, 0, 0, -1);|\\[0.5ex] + This is both shorter and more efficient than to use\\[0.5ex] + \verb| num = add_R_R (mul_R_Int (x, 2), y);|\\ + \verb| den = sub_R_Int (mul_R_R (x, y), 1);|\\ + \verb| z = div_R_R (num, den);|\\[0.5ex] + (We admit that both versions are not quite readable.) +\end{itemize} + +\section{Special functions} + +There are the usual standard functions, +each existing in three versions, +one for a real argument, one for a rational argument made from machine integers, +and one for a rational argument made from GMP integers. +Often, the rational version will be more efficient +(sometimes, it is just mapped to the real version, + but it is offered anyway for uniformity and convenience). +The general pattern is illustrated at the square root function: + +\begin{funlist} +\item \makebox[6.2cm][l]{\Type{Real} \Name{sqrt{\_}R}(% + \Type{Real} \Var{x})} + to compute $\sqrt{x}$; +\item \makebox[6.2cm][l]{\Type{Real} \Name{sqrt{\_}QInt}(% + \Type{int} \Var{a}, + \Type{int} \Var{b})} + to compute $\sqrt{\frac{a}{b}}$; +\item \makebox[6.2cm][l]{\Type{Real} \Name{sqrt{\_}QZ}(% + \Type{mpz{\_}t} \Var{a}, + \Type{mpz{\_}t} \Var{b})} + to compute $\sqrt{\frac{a}{b}}$. +\end{funlist} +\vspace{-1ex} + +\begin{tabbing} +In the following list of functions, +we enumerate only the `R' versions.\\[0.5ex] +Basic:\quad \Name{sqrt{\_}R} for $\sqrt{x}$,\quad + \Name{exp{\_}R} for $e^x$,\quad + \Name{log{\_}R} for natural logarithm;\\[0.5ex] +Inverse trigonometric: +M \= \Name{asinh{\_}R}, + \= \Name{acosh{\_}R}, + \= \Name{atanh{\_}R}, + \= \Name{asech{\_}R}, + \= \Name{acosech{\_}R}, + \= \Name{acotanh{\_}R} \kill +Trigonometric: + \> \Name{sin{\_}R}, + \> \Name{cos{\_}R}, + \> \Name{tan{\_}R}, + \> \Name{sec{\_}R}, + \> \Name{cosec{\_}R}, + \> \Name{cotan{\_}R} + \\[0.5ex] +Inverse trigonometric: + \> \Name{asin{\_}R}, + \> \Name{acos{\_}R}, + \> \Name{atan{\_}R}, + \> \Name{asec{\_}R}, + \> \Name{acosec{\_}R}, + \> \Name{acotan{\_}R} + \\[0.5ex] +Hyperbolic: + \> \Name{sinh{\_}R}, + \> \Name{cosh{\_}R}, + \> \Name{tanh{\_}R}, + \> \Name{sech{\_}R}, + \> \Name{cosech{\_}R}, + \> \Name{cotanh{\_}R} + \\[0.5ex] +Inverse hyperbolic: + \> \Name{asinh{\_}R}, + \> \Name{acosh{\_}R}, + \> \Name{atanh{\_}R}, + \> \Name{asech{\_}R}, + \> \Name{acosech{\_}R}, + \> \Name{acotanh{\_}R} + \\[0.5ex] +\end{tabbing} +\vspace{-1ex} + +\noindent In addition, there are the two predefined constants +\Type{Real} \Name{Pi} and \Type{Real} \Name{E}. + +\section{Forcing, printing and conversion} + +When working with the library, +it is best to think of real numbers as infinite digit streams +(but these digit expansions do not correspond directly + to any familiar binary or decimal system). +Each finite prefix corresponds to a rational interval +(much as the finite prefix 3.14 of 3.14159\ldots\ +corresponds to the interval [3.14, 3.15]). +Thus, if more and more digits of the stream are computed, +the result is a nested sequence of intervals +$[a_1, b_1] \supseteq [a_2, b_2] \supseteq \cdots$ +which provide increasingly better approximations to the real number. + +If a real number is set up and assigned to a variable, +an object is created which records the way the number was constructed, +but no digits are actually calculated. +It is only when the number is ``forced'' +that a finite prefix of the digit stream is computed. + +There are two ways to specify the amount of forcing: +the first, \Name{force{\_}R{\_}Digs}, +is by indicating the number of digits to be computed. +Unfortunately, there is no simple rule telling +the size of the resulting interval. +This is the reason why there is a second force function, \Name{force{\_}R{\_}Dec}, +which forces a real number until an interval is obtained +which guarantees a certain decimal precision. + +\begin{funlist} +\item \Type{void} \Name{force{\_}R{\_}Digs}(% +\Type{Real} \Var{x}, \Type{int} \Var{n})\\ +This computes at least the first $n$ digits +of the digit stream describing the value of the argument \Var{x}. +\vspace{1ex} +% +\item \Type{void} \Name{force{\_}R{\_}Dec}(% +\Type{Real} \Var{x}, \Type{int} \Var{n})\\ +This computes an approximating interval for $x$ +whose size is at most $10^{-n}$. +\vspace{1ex} +% +\item \Type{void} \Name{print{\_}R}(\Type{Real} \Var{x})\\ +This takes whatever information about the value of \Var{x} +is currently available and prints it as an interval (no forcing). +\vspace{1ex} +% +\item \Type{void} \Name{print{\_}R{\_}Digs}(\Type{Real} \Var{x}, \Type{int} \Var{n})\\ +This first calls \Name{force{\_}R{\_}Digs}(\Var{x}, \Var{n}) +and prints the interval which results from this forcing. +\vspace{1ex} +% +\item \Type{void} \Name{print{\_}R{\_}Dec}(\Type{Real} \Var{x}, \Type{int} \Var{n})\\ +This first calls \Name{force{\_}R{\_}Dec}(\Var{x}, \Var{n}) +and prints the resulting interval. +\vspace{1ex} +% +\item \Type{double} \Name{realToDouble}(\Type{Real} \Var{x})\\ +This takes whatever information about the value of \Var{x} is currently available, +and converts one of the end-points of this interval +to a double precision floating point value. +\vspace{1ex} +% +\item \Type{void} \Name{force{\_}B}(% +\Type{Bool} \Var{b}, \Type{int} \Var{n})\\ +This can be called to force the evaluation of a boolean. When $b$ +is viewed as a stream, the argument $n$ indicates the maximum depth in the +stream to examine to determine the value of the boolean. +\vspace{1ex} +\item \Type{Boolean} \Name{boolValue}(\Type{Bool} \Var{b}) \\ +This is a macro which returns the value of a boolean. This may be +one of three constants: +\Name{LAZY{\_}TRUE}, +\Name{LAZY{\_}FALSE} or +\Name{LAZY{\_}UNKNOWN} +\vspace{1ex} +\item \Type{Real} \Name{realError}(\Type{char}\verb|*| \Var{string})\\ +This function ``computes'' and returns a kind of placeholder +for a real number which is fine as long as it is not forced. +But if this placeholder is forced to produce some digits, +then it causes the program to be aborted. +The argument string provided in the call of \Name{realError} +is printed as an error message. +\item \Type{Real} \Name{realDelay}(\Type{Delay{\_}Fun} \Var{f}, +\Type{Delay{\_}Arg} \Var{x})\\ +This function yields a \emph{closure} for the function +\Var{f} applied to \Var{x}. In other words, it denotes the real +\Var{f}(\Var{x}) but the function call is not made until +the closure is forced. An example of its use is given +in the next section. +\end{funlist} + +\section{Predicates, Boolean operations and conditionals} + +The library introduces a new type \Type{Bool} for Boolean values +which serves as the result type of predicates. +Therefore, it must also introduce its own versions +of Boolean operations and its own conditional, +which is a function reminiscent of Dijkstra's guarded commands. +We shall shortly see why this was done, +but first we introduce the corresponding functions. + +Table~\ref{pred} shows the available predicates: + +\begin{table}[htp] +\begin{center} +\begin{tabular}{|l|l|} +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{lt{\_}R{\_}0}(\Type{Real} \Var{x}) +\end{tabular} +& $x < 0$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{lt{\_}R{\_}QInt}(\Type{Real} \Var{x}, + \Type{int} \Var{a}, \Type{int} \Var{b}) +\end{tabular} +& $x < \frac{a}{b}$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{lt{\_}R{\_}R}(\Type{Real} \Var{x}, \Type{Real} \Var{y}) +\end{tabular} +& $x < y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{ltEq{\_}R{\_}0}(\Type{Real} \Var{x}) +\end{tabular} +& $x \leq 0$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{ltEq{\_}R{\_}QInt}(\Type{Real} \Var{x}, + \Type{int} \Var{a}, \Type{int} \Var{b}) +\end{tabular} +& $x \leq \frac{a}{b}$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{ltEq{\_}R{\_}R}(\Type{Real} \Var{x}, \Type{Real} \Var{y}) +\end{tabular} +& $x \leq y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{gt{\_}R{\_}0}(\Type{Real} \Var{x}) +\end{tabular} +& $x > 0$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{gt{\_}R{\_}QInt}(\Type{Real} \Var{x}, + \Type{int} \Var{a}, \Type{int} \Var{b}) +\end{tabular} +& $x > \frac{a}{b}$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{gt{\_}R{\_}R}(\Type{Real} \Var{x}, \Type{Real} \Var{y}) +\end{tabular} +& $x > y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{gtEq{\_}R{\_}0}(\Type{Real} \Var{x}) +\end{tabular} +& $x \geq 0$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{gtEq{\_}R{\_}QInt}(\Type{Real} \Var{x}, + \Type{int} \Var{a}, \Type{int} \Var{b}) +\end{tabular} +& $x \geq \frac{a}{b}$ \\ +\begin{tabular}{l} +\vdist\Type{Bool} \Name{gtEq{\_}R{\_}R}(\Type{Real} \Var{x}, \Type{Real} \Var{y}) +\end{tabular} +& $x \geq y$ \\ +\hline +\end{tabular} +\end{center} +\caption{Predicates on reals}\label{pred} +\end{table} + +Boolean values may be combined with the operators presented in Table~\ref{Bool-Ops}: +\newpage + +\begin{table}[htp] +\begin{center} +\begin{tabular}{|l|l|} +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{and{\_}B{\_}B}(\Type{Bool} \Var{x}, Bool \Var{y}) +\end{tabular} +& $x \wedge y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{or{\_}B{\_}B}(\Type{Bool} \Var{x}, Bool \Var{y}) +\end{tabular} +& $x \vee y$ \\ +\hline +\begin{tabular}{l} +\vdist\Type{Bool} \Name{not{\_}B}(\Type{Bool} \Var{x}) +\end{tabular} +& $\neg x$ \\ +\hline +\end{tabular} +\end{center} +\caption{Boolean operators}\label{Bool-Ops} +\end{table} + +Finally, the conditional is a function with a variable number of arguments: + +\begin{funlist} +\item \Type{Real} \Name{realIf}(% +\Type{int} \Var{n}, +\Type{Bool} $b_1$, +\Type{Real} $x_1$, +\ldots, +\Type{Bool} $b_n$, +\Type{Real} $x_n$) +\end{funlist} + +This function takes an integer as its first argument, +followed by a variable number of guard/value pairs. +The integer argument should tell the number of these pairs. +The variable argument list is implemented with stdarg(3). + +Roughly spoken, the function evaluates the guards $b_1$, \ldots, $b_n$, +then chooses non-deterministically one of the guards which happened to be true, +and returns the corresponding value. +Before we can provide a more detailed description, +we must say more about the type \Type{Bool} +and the behaviour of the predicates. + +Recall that an element of \Type{Real} is implemented as a digit stream, +whose initial prefixes provide a shrinking sequence of intervals +approximating a real number. +Correspondingly, the elements of type \Type{Bool} are implemented +as sequences of ``truth intervals''. +These sequences usually start out with the interval +\Name{Unknown} = [\Name{False}, \Name{True}], +which may at some later stage be refined to either \Name{False} or \Name{True}.\\[0.5ex] +\textbf{Example:} +Table~\ref{Truth-values} shows how nested sequences of intervals +are mapped to sequences of truth values by the predicate \Name{gtEq{\_}R{\_}0}. + +\begin{table}[htp] +\begin{center} +\begin{tabular}{|c|c||c|c|} +\hline +\vdist$[-3,2]$ & \Name{Unknown} & $[-2,3]$ & \Name{Unknown} \\ +\vdist$[-2,1]$ & \Name{Unknown} & $[-1,2]$ & \Name{Unknown} \\ +\vdist$[-1.5,0.5]$ & \Name{Unknown} & $[-0.5, 1.5]$ & \Name{Unknown} \\ +\vdist$[-1,0]$ & \Name{Unknown} & $[0, 1]$ & \Name{True} \\ +\vdist$[-0.8,-0.2]$ & \Name{False} & $[0.2, 0.8]$ & \Name{True} \\ +\vdist$[-0.7,-0.3]$ & \Name{False} & $[0.3, 0.7]$ & \Name{True} \\ +\vdist$\vdots$ & $\vdots$ & $\vdots$ & $\vdots$ \\ +\hline +\end{tabular} +\end{center} +\caption{Action of the predicate \Name{gtEq{\_}R{\_}0}}\label{Truth-values} +\end{table} + +Thus, the sequence of truth values computed by \Name{gtEq{\_}R{\_}0}(\Var{x}) +will eventually reach \Name{True} if $x > 0$, +and will eventually reach \Name{False} if $x < 0$. +If the exact value of $x$ happens to be 0, +it is possible that the sequence of truth values +remains \Name{Unknown} for ever---% +this happens if all the intervals $[a,b]$ approximating $x$ +have the property $a < 0 < b$. +Yet it is also possible that the sequence switches to \Name{True}---% +this happens if there is an approximating interval $[a,b]$ with $a = 0$. +Which of these two possibilities occur depends on the way +how $x$ was set up, and on implementation details. +But it should be remembered that \Name{gtEq{\_}R{\_}0} +may remain undecided for ever when applied to $0$. + +The Boolean operations produce their output stream by acting +on their input stream(s) element by element, +i.e.\ to produce the $n$th element of the output stream, +the $n$th input element(s) of the input stream(s) are combined +according to Table~\ref{op-action}, +where the truth values have been abbreviated by U, F, and T, +and the operations by logical symbols. + +\begin{table}[htp] +\begin{center} +\begin{tabular}{c|ccc} +$x$ & T & F & U \\ +\hline +$\neg x$ & F & T & U +\end{tabular}\hspace{2em} +\begin{tabular}{c|ccc} +$\land$ & T & F & U \\ +\hline + T & T & F & U \\ + F & F & F & F \\ + U & U & F & U +\end{tabular}\hspace{2em} +\begin{tabular}{c|ccc} +$\lor$ & T & F & U \\ +\hline + T & T & T & T \\ + F & T & F & U \\ + U & T & U & U +\end{tabular} +\end{center} +\caption{Action of the Boolean operators}\label{op-action} +\end{table} + +Now, we can return to the conditional +\begin{funlist} +\item \Type{Real} \Name{realIf}(% +\Type{int} $n$, +\Type{Bool} $b_1$, +\Type{Real} $x_1$, +\ldots, +\Type{Bool} $b_n$, +\Type{Real} $x_n$) +\end{funlist} +This function behaves as follows: +It constructs a cyclic list of guard/value pairs. +Starting with the first pair, \Name{realIf} forces the guard +to compute an element of the resulting Boolean stream. +If the value of this element is \Name{True}, +the real number associated with this guard is returned. +If the value is \Name{False}, the pair is removed from the list. +If the value remains \Name{Unknown}, then \Name{realIf} tries the next pair. +In this way, the function cycles through the list forcing each guard in turn +until a guard becomes \Name{True}. +If the list becomes empty (all the guards are \Name{False}), +then \Name{realIf} issues an error message. +If some guards are remaining \Name{Unknown} for ever, +\Name{realIf} will not terminate. +Some examples will clarify the situation. + +\verb|realIf (2, lt_R_QInt (x, 1, 1), 0, gt_R_0(x), 1)|\\[0.3ex] +means $x < 1 \to 0 \;[\!]\; x > 0 \to 1$. +For $x = \frac12$, the result is unpredictable; +it depends on the actual sequence of intervals +which approximate $\frac12$. +On the other hand, there is no risk of non-termination or error +since at least one guard will eventually yield \Name{True} +for any $x$. + +\verb|realIf (2, ltEq_R_0(x), neg_R(x), gtEq_R_0(x), x)|\\[0.3ex] +means $x \leq 0 \to -x \;[\!]\; x \geq 0 \to x$. +As an implementation of $|x|$, this works well for all $x \neq 0$, +while there is a considerable risk of non-termination for $x = 0$. +(Fortunately, there is the predefined function \Name{abs{\_}R}). + +Suppose you have an implementation \Name{sqrt1} for square root +which works only for arguments in the interval $(\frac14,4)$, +but not for arguments near 0 or very big arguments. +With this knowledge, you can set up the following function: +\[ \begin{array}{ r l @{\;\;\to\;\;} l l } + \sqrt{x} \;=\; (\! & x > \frac14 \land x < 4 & \Name{sqrt1}(x) & \;[\!] \\[0.5ex] + & x \geq 0 \land x < \frac12 & \frac12 \sqrt{4x} & \;[\!] \\[0.5ex] + & x > 2 & 2 \sqrt{x/4} & \;[\!] \\[0.5ex] + & x < 0 & ??? & \;) + \end{array} +\] +Notice how the guards overlap: +if the second guard were $x \geq 0 \land x \leq \frac14$, +then there would be a considerable risk of non-termination +for $x = \frac14$. +By the overlap, this non-termination is prevented---% +without introducing non-determinism +since the values following these guards +are semantically equal in the overlap region. +Similarly, the first and third guard overlap +to prevent non-termination for $x = 4$. +Yet notice that the function does not terminate for $x = 0$ \ldots\\[0.5ex] +As a C program, the above function appears in figure \ref{fig:conditionals}. +Note the use of delays to prevent endless eager recursion. + +\begin{figure}[htp] +\begin{verbatim} + Real sqrt (Real x) { + return realIf (4, + and_B_B (gt_R_QInt (x, 1, 4), lt_R_QInt (x, 4, 1)), + sqrt1 (x), + and_B_B (gtEq_R_0, lt_R_QInt (x, 1, 2)), + div_R_Int ( + realDelay( + (Delay_Fun) sqrt, + (Delay_Arg) mul_R_Int (x, 4)), + 2), + gt_R_QInt (x, 2, 1), + mul_R_Int ( + realDelay( + (Delay_Fun) sqrt, + (Delay_Arg) div_R_Int (x, 4)), + 2), + lt_R_0 (x), + realError ("Square root of negative number") + ); + } +\end{verbatim} +\caption{Example of conditional with delays.}\label{fig:conditionals} +\end{figure} + +As the last example, +suppose you want to iterate a function \Name{f} +until the difference between two consecutive values in the iteration +is smaller than some threshold \Var{eps}. +This can be done by the following recursive function: +\begin{verbatim} + Real iter (Real x) { + Real y = f(x); + Real d = abs_R (sub_R_R (x, y)); /* d = |x - y| */ + return realIf (2, + lt_R_R (d, eps), + y, + gt_R_R (d, eps2), + realDelay((Delay_Fun) iter, (Delay_Arg) y)); + } +\end{verbatim} +where \Var{eps2} is $\Var{eps}/2$. +By using \Var{eps2}, the two guards overlap non-trivially, +and non-termination at \Var{d} = \Var{eps} is prevented +(of course, the iteration still fails to terminate + if \Var{d} never gets small). + +\section{Extracting digits following forcing} + +The functions in this section provide access to the internal representation +of real numbers. +They are not very useful for ordinary users of the library. + +\begin{funlist} +\item \Type{void} \Name{retrieveInfo}(% +\Type{Real} \Var{x}, \Type{Sign} $\ast$\Var{sign}, \Type{int} $\ast$\Var{count}, + \Type{mpz{\_}t} digits) +\end{funlist} +This function retrieves the information that is currently available on \Var{x}. +The sign of \Var{x} is stored in \Var{sign}, +the number of digits calculated so far is stored in \Var{count}, +and a compressed representation of all these digits is deposited in \Var{digits}. +The variable \Var{digits} must be initialised +with the GMP function \Name{mpz{\_}init} prior to calling \Name{retrieveInfo}. +The real argument \Var{x} is unchanged by the call. + +From a compressed digit representation as it is provided by \Name{retrieveInfo}, +the individual digits can be extracted by means of +\begin{funlist} +\item \Type{Digit} \Name{takeDigit}(\Type{int} $\ast$\Var{count}, + \Type{mpz{\_}t} \Var{digits}) +\end{funlist} +This function should only be called if \Var{digits} +contains at least one digit. +It returns the most significant digit contained in \Var{digits}, +removes this digit from \Var{digits}, +and decreases the counter \Var{count} by 1. +Thus, successive calls yield successive digits. + +\noindent An example of the use of these two functions is given in Figure +\ref{fig:digits-info}. + +\begin{figure}[htp] +\begin{verbatim} + Real x; + mpz_t digits; + Sign sign; + Digit digit; + int count; + ... + x = tan_R(y); + force_R_Digs(x, 20); + mpz_init(digits); + retrieveInfo(x, &sign, &count, digits); + printf("%s ", signToString(sign)); + while (count > 0) { + digit = takeDigit(&count, digits); + printf("%s ", digitToString(digit)); + } + printf("\n"); +\end{verbatim} +\caption{Taking digits one-by-one.} +\label{fig:digits-info} +\end{figure} + +Note the two functions \Name{signToString} and \Name{digitToString} +which convert signs and digits to strings for output. + +\section{Environment variables} + +The library uses three environment variables to control its runtime behaviour. +These variables are as follows: + +\begin{description} +\item[\texttt{ICR{\_}STACK{\_}SIZE}=$n$] +\quad This sets the runtime stack to +$n \times k$ words. The default is $n = 20$ for $20k$ words. +It is unlikely that the stack size needs to be adjusted. +If you get a ``stack overflow'' at runtime, it is more likely that the +algorithm for some function is not sufficiently converging for a given +argument. Assuming the default has been set to something other than 1, +try setting the +environment variable \texttt{ICR{\_}DEFAULT{\_}FORCE{\_}COUNT=1} and executing +your program again. +\item[\texttt{ICR{\_}DEFAULT{\_}FORCE{\_}COUNT}=$n$] +\quad Sometimes it +is necessary to force +an arbitrary number of digits from an LFT. This can happen, for example, +when a predicate is forced which in turn must force some number of digits +from its real argument. In theory, one would always want to force as +few digits as possible (i.e.\ 1 digit) +to avoid unnecessary computation. In practice, it +is more efficient to demand more than one digit. The value +of \texttt{ICR{\_}DEFAULT{\_}FORCE{\_}COUNT} +is the number of digits forced in such +circumstances. It is also the number of digits forced from an argument +to a linear fractional transformation when $\epsilon-\delta$ analysis +for the transformation yields a value $\leq 0$. The default is $n = 1$. +The maximum reasonable value is $n = 4$. +\item[\texttt{ICR{\_}FORCE{\_}DEC{\_}UPPER{\_}BOUND}=$n$] +\quad +When extracting information from reals, the library works with +``digits''. Each digit gives a fixed amount of information. Usually, however, +a user wishes to extract enough information to ensure some decimal precision. +The functions \Name{force{\_}R{\_}Dec} and \Name{print{\_}R{\_}Dec} +are provided to +retrieve information from a real to a specified decimal precision. +Unfortunately, there is not always a direct correspondence between a number of +digits and a decimal precision. As a number approaches infinity, more +digits are needed to bound it above. This variable sets a bound +on the number of digits to retrieve from a real to bound it above before +giving up. +The default is $n = 10000$. +\end{description} + +\section{The daVinci interface} + +For debugging and instruction, the library is instrumented to +work with the graph visualisation tool daVinci. +But be warned that much of this visualisation +is only comprehensible to insiders. +When a program has been compiled with daVinci enabled, +a separate daVinci window will be created +when \Name{init\-Reals} is called. +Thereafter, any calls to \Name{force{\_}R{\_}Digs} or \Name{force{\_}R{\_}Dec} +will lead to control being transferred to the daVinci window. + +Once started the daVinci window provides a collection of buttons +to control the execution of a real program. The buttons are as follows: + +\begin{description} +\item[\includegraphics{stop.eps}] Stops execution. +\item[\includegraphics{go.eps}] Enabled when there is work on the +stack. This button starts execution. +\item[\includegraphics{step.eps}] Enabled when there is work on the stack. This +single steps execution. +\item[\includegraphics{continue.eps}] When enabled, it means the stack +is empty. This button returns control to the C program. +\item[\includegraphics{collect.eps}] This button is not implemented. +Ultimately it will be used to invoke the garbage collector. +\end{description} + +In addition, when the program is stopped, the user can click the right +button over any object in the heap. This gives a popup menu +of which only the first entry is implemented. It can be used +to print (in the main program window) the contents of the selected +heap object. This is typically a linear fractional transformation +(nearly all functions in the library are implemented + as compositions of linear fractional transformations). + +\section{Compilation flags} + +There are a number of compilation flags in the Makefile. With the exception +of those listed below, it is unwise to change these flags. + +\begin{description} +\item[\texttt{-DDAVINCI}]\quad When set, the library will connect to the daVinci +graph visualisation tool. In this mode, all objects in the heap and +all information flow is displayed in a separate daVinci window. +Computation is controlled from the daVinci window. The user can run, stop +and single-step the activities of the program, +which mainly consist of emission and absorption of LFTs, +and examine the contents of objects in the heap. +\item[\texttt{-DDEFAULT{\_}FORCE{\_}COUNT}=$n$] +\quad This sets the default force count to use when it is not given by +the environment variable +\texttt{ICR{\_}DEFAULT{\_}FORCE{\_}COUNT}. +\item[\texttt{-DTRACE}=\textit{val}]\quad This enables tracing of force methods. +When set to $0$, tracing is disabled. When set to $1$, tracing is enabled. +Finally, when set to \texttt{traceOn}, tracing can be enabled +and disabled at runtime under software control via the function +\Name{debugTrace}(\Type{int} \Var{b}) where \Var{b} is $1$ to enable +tracing and $0$ to stop tracing. +\item[\texttt{-DSTACK{\_}SIZE=$n$}] +\quad This sets stack size to use when it is not given by +the environment variable +\texttt{ICR{\_}STACK{\_}SIZE}. +\item[\texttt{-DFORCE{\_}DEC{\_}UPPER{\_}BOUND=$n$}] +\quad This is the default value used when the environment variable +\texttt{ICR{\_}FORCE{\_}DEC{\_}UPPER{\_}BOUND} is absent. +\end{description} + +\section{Problems} + +The library is still under development. Future versions of the library +will have specialized versions of the analytic functions +for rational arguments. A document describing the implementation +is also planned. The most serious omission from the present +version of the library is a garbage collector. + +\end{document} diff --git a/ic-reals-6.3/doc/manual/step-eps-converted-to.pdf b/ic-reals-6.3/doc/manual/step-eps-converted-to.pdf Binary files differnew file mode 100644 index 0000000..df2ccb4 --- /dev/null +++ b/ic-reals-6.3/doc/manual/step-eps-converted-to.pdf diff --git a/ic-reals-6.3/doc/manual/step.eps b/ic-reals-6.3/doc/manual/step.eps new file mode 100644 index 0000000..2f9f0ff --- /dev/null +++ b/ic-reals-6.3/doc/manual/step.eps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/step.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +ff3fff +fe3fff +fc3fff +fc3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +fc0fff +fc0fff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/doc/manual/stop-eps-converted-to.pdf b/ic-reals-6.3/doc/manual/stop-eps-converted-to.pdf Binary files differnew file mode 100644 index 0000000..93b7331 --- /dev/null +++ b/ic-reals-6.3/doc/manual/stop-eps-converted-to.pdf diff --git a/ic-reals-6.3/doc/manual/stop.eps b/ic-reals-6.3/doc/manual/stop.eps new file mode 100644 index 0000000..7419b6c --- /dev/null +++ b/ic-reals-6.3/doc/manual/stop.eps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/stop.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/icons/collect.ps b/ic-reals-6.3/icons/collect.ps new file mode 100644 index 0000000..bc82e8e --- /dev/null +++ b/ic-reals-6.3/icons/collect.ps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/collect.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +c3f0ff +81e07f +18c63f +3ccf3f +3fcfff +3fcfff +3fcfff +30cfff +30cfff +3ccfff +3ccf3f +18c63f +81e07f +c3f0ff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/icons/collect.xbm b/ic-reals-6.3/icons/collect.xbm new file mode 100644 index 0000000..7e1d0ae --- /dev/null +++ b/ic-reals-6.3/icons/collect.xbm @@ -0,0 +1,8 @@ +#define collect_width 18 +#define collect_height 18 +static unsigned char collect_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0xf0, 0x00, 0x7e, 0xf8, 0x01, + 0xe7, 0x9c, 0x03, 0xc3, 0x0c, 0x03, 0x03, 0x0c, 0x00, 0x03, 0x0c, 0x00, + 0x03, 0x0c, 0x00, 0xf3, 0x0c, 0x00, 0xf3, 0x0c, 0x00, 0xc3, 0x0c, 0x00, + 0xc3, 0x0c, 0x03, 0xe7, 0x9c, 0x03, 0x7e, 0xf8, 0x01, 0x3c, 0xf0, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/ic-reals-6.3/icons/continue.ps b/ic-reals-6.3/icons/continue.ps new file mode 100644 index 0000000..da762ab --- /dev/null +++ b/ic-reals-6.3/icons/continue.ps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/continue.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +c000ff +c000ff +ffffff +ffffff +c000ff +e001ff +e001ff +f003ff +f807ff +f807ff +fc0fff +fe1fff +fe1fff +ff3fff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/icons/continue.xbm b/ic-reals-6.3/icons/continue.xbm new file mode 100644 index 0000000..52aaba9 --- /dev/null +++ b/ic-reals-6.3/icons/continue.xbm @@ -0,0 +1,8 @@ +#define continue_width 18 +#define continue_height 18 +static unsigned char continue_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00, 0xf8, 0x7f, 0x00, + 0xf8, 0x7f, 0x00, 0xf0, 0x3f, 0x00, 0xe0, 0x1f, 0x00, 0xe0, 0x1f, 0x00, + 0xc0, 0x0f, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00, 0x00, 0x03, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/ic-reals-6.3/icons/continue.xpm b/ic-reals-6.3/icons/continue.xpm new file mode 100644 index 0000000..922075b --- /dev/null +++ b/ic-reals-6.3/icons/continue.xpm @@ -0,0 +1,27 @@ +/* XPM */ +static char *continue[] = { +/* width height num_colors chars_per_pixel */ +" 18 18 2 1", +/* colors */ +". c #ffffff", +"# c #000000", +/* pixels */ +"..................", +"..................", +"..##############..", +"..##############..", +"..................", +"..................", +"..##############..", +"...############...", +"...############...", +"....##########....", +".....########.....", +".....########.....", +"......######......", +".......####.......", +".......####.......", +"........##........", +"..................", +".................." +}; diff --git a/ic-reals-6.3/icons/go.ps b/ic-reals-6.3/icons/go.ps new file mode 100644 index 0000000..454833b --- /dev/null +++ b/ic-reals-6.3/icons/go.ps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/go.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +cfffff +c3ffff +c0ffff +c03fff +c00fff +c003ff +c000ff +c000ff +c003ff +c00fff +c03fff +c0ffff +c3ffff +cfffff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/icons/go.xbm b/ic-reals-6.3/icons/go.xbm new file mode 100644 index 0000000..0fdf6c1 --- /dev/null +++ b/ic-reals-6.3/icons/go.xbm @@ -0,0 +1,8 @@ +#define go_width 18 +#define go_height 18 +static unsigned char go_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x3c, 0x00, 0x00, + 0xfc, 0x00, 0x00, 0xfc, 0x03, 0x00, 0xfc, 0x0f, 0x00, 0xfc, 0x3f, 0x00, + 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0x3f, 0x00, 0xfc, 0x0f, 0x00, + 0xfc, 0x03, 0x00, 0xfc, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x0c, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/ic-reals-6.3/icons/node.xbm b/ic-reals-6.3/icons/node.xbm new file mode 100644 index 0000000..aa1ef20 --- /dev/null +++ b/ic-reals-6.3/icons/node.xbm @@ -0,0 +1,6 @@ +#define node_width 16 +#define node_height 16 +static unsigned char node_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x01, 0x0c, 0x06, 0xe4, 0x04, + 0xf2, 0x09, 0xfa, 0x0b, 0xfa, 0x0b, 0xfa, 0x0b, 0xf2, 0x09, 0xe4, 0x04, + 0x0c, 0x06, 0xf0, 0x01, 0x00, 0x00, 0x00, 0x00}; diff --git a/ic-reals-6.3/icons/step.ps b/ic-reals-6.3/icons/step.ps new file mode 100644 index 0000000..2f9f0ff --- /dev/null +++ b/ic-reals-6.3/icons/step.ps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/step.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +ff3fff +fe3fff +fc3fff +fc3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +ff3fff +fc0fff +fc0fff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/icons/step.xbm b/ic-reals-6.3/icons/step.xbm new file mode 100644 index 0000000..bb0a23d --- /dev/null +++ b/ic-reals-6.3/icons/step.xbm @@ -0,0 +1,8 @@ +#define step_width 18 +#define step_height 18 +static unsigned char step_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00, 0x80, 0x03, 0x00, + 0xc0, 0x03, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x03, 0x00, 0x00, 0x03, 0x00, + 0x00, 0x03, 0x00, 0x00, 0x03, 0x00, 0x00, 0x03, 0x00, 0x00, 0x03, 0x00, + 0x00, 0x03, 0x00, 0x00, 0x03, 0x00, 0xc0, 0x0f, 0x00, 0xc0, 0x0f, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/ic-reals-6.3/icons/stop.ps b/ic-reals-6.3/icons/stop.ps new file mode 100644 index 0000000..7419b6c --- /dev/null +++ b/ic-reals-6.3/icons/stop.ps @@ -0,0 +1,68 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: /home/le/Work/reals/blue/5-c-reals/icons/stop.ps +%%Creator: XV Version 3.10a Rev: 12/29/94 (PNG patch 1.2) - by John Bradley +%%BoundingBox: 289 418 301 430 +%%Pages: 1 +%%DocumentFonts: +%%EndComments +%%EndProlog + +%%Page: 1 1 + +% remember original state +/origstate save def + +% build a temporary dictionary +20 dict begin + +% define string to hold a scanline's worth of data +/pix 3 string def + +% define space for color conversions +/grays 18 string def % space for gray scale line +/npixls 0 def +/rgbindx 0 def + +% lower left corner +289 418 translate + +% size of image (on paper, in 1/72inch coords) +11.59200 11.59200 scale + +% dimensions of data +18 18 1 + +% mapping matrix +[18 0 0 -18 0 18] + +{currentfile pix readhexstring pop} +image +ffffff +ffffff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +c000ff +ffffff +ffffff + + +showpage + +% stop using temporary dictionary +end + +% restore original state +origstate restore + +%%Trailer diff --git a/ic-reals-6.3/icons/stop.xbm b/ic-reals-6.3/icons/stop.xbm new file mode 100644 index 0000000..5bb7517 --- /dev/null +++ b/ic-reals-6.3/icons/stop.xbm @@ -0,0 +1,8 @@ +#define stop_width 18 +#define stop_height 18 +static unsigned char stop_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, + 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, + 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, + 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/ic-reals-6.3/math-lib/Makefile b/ic-reals-6.3/math-lib/Makefile new file mode 100644 index 0000000..b370191 --- /dev/null +++ b/ic-reals-6.3/math-lib/Makefile @@ -0,0 +1,51 @@ +OBJS = init.o \ + tan_R.o \ + tan_Q.o \ + atan_R.o \ + atan_Q.o \ + tanh_R.o \ + tanh_Q.o \ + atanh_R.o \ + atanh_Q.o \ + sin_R.o \ + sin_Q.o \ + asin_R.o \ + asin_Q.o \ + sinh_R.o \ + sinh_Q.o \ + asinh_R.o \ + asinh_Q.o \ + cos_R.o \ + cos_Q.o \ + acos_R.o \ + acos_Q.o \ + cosh_R.o \ + cosh_Q.o \ + acosh_R.o \ + acosh_Q.o \ + secant.o \ + cosecant.o \ + cotangent.o \ + log_R.o \ + log_Q.o \ + exp_R.o \ + exp_Q.o \ + sqrt_R.o \ + sqrt_Q.o \ + pow_R_R.o \ + pi.o \ + abs_R.o \ + neg_R.o \ + stdTensorCont.o + +force: $(OBJS) +$(OBJS): ../real.h ../real-impl.h + +stdTensor.o : math-lib.h +tan_R.o : math-lib.h +atan_R.o : math-lib.h +exp_R.o : math-lib.h +log_R.o : math-lib.h + +clean: + rm -f $(OBJS) diff --git a/ic-reals-6.3/math-lib/abs_R.c b/ic-reals-6.3/math-lib/abs_R.c new file mode 100644 index 0000000..cc2507d --- /dev/null +++ b/ic-reals-6.3/math-lib/abs_R.c @@ -0,0 +1,467 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This computes the absolute value of a real. For now the argument + * must be either a vector or a stream. + */ +Real +abs_R(Real x) +{ + Real r; + Cls *cls; + SignX *signX; + int sign_a, sign_b; + void force_To_SignX_From_Abs_Entry(); + void force_To_SignX_From_Abs_Cont(); + void force_To_DigsX_From_Abs_Entry(); + void force_To_DigsX_From_Abs_Cont(); + void force_To_DigsX_From_Abs_Copy_Entry(); + void force_To_DigsX_From_Abs_Copy_Cont(); + void force_To_DigsX_From_Abs_Copy_and_Negate(); + void force_To_DigsX_From_Abs_Copy_and_Negate_Entry(); + void force_To_DigsX_From_Abs_Copy_and_Negate_Cont(); + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(force_To_SignX_From_Abs_Entry, + "force_To_SignX_From_Abs_Entry", 2); + registerForceFunc(force_To_SignX_From_Abs_Cont, + "force_To_SignX_From_Abs_Cont", 2); + registerForceFunc(force_To_DigsX_From_Abs_Entry, + "force_To_DigsX_From_Abs_Entry", 3); + registerForceFunc(force_To_DigsX_From_Abs_Cont, + "force_To_DigsX_From_Abs_Cont", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_Entry, + "force_To_DigsX_From_Abs_Copy_Entry", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_Cont, + "force_To_DigsX_From_Abs_Copy_Cont", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_and_Negate_Entry, + "force_To_DigsX_From_Abs_Copy_and_Negate_Entry", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_and_Negate_Cont, + "force_To_DigsX_From_Abs_Copy_and_Negate_Cont", 3); + doneInit++; + } + + /* + * A slight optimization. In the case of a vector we just inspect the + * entries and then make them both the same sign (in a copy of the vector). + */ + if (x->gen.tag.type == VECTOR) { + sign_a = mpz_sgn(x->vec.vec[0]); + sign_b = mpz_sgn(x->vec.vec[1]); + if (sign_a * sign_b < 0) { + r = vector_Z(x->vec.vec[0], x->vec.vec[1]); + mpz_neg(r->vec.vec[0], r->vec.vec[0]); + return r; + } + else + return x; + } + + /* + * For all other argument types, we simply work with the stream + * representation of the argument. + */ + if (x->gen.tag.isSigned) { + r = makeStream(x); /* this will make a signed stream */ + + /* + * All the work is done in the closure. + */ + cls = allocCls(force_To_SignX_From_Abs_Entry, (void *) r); +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(cls, r); + endGraphUpdate(); +#endif + signX = allocSignX((Real) cls, SIGN_UNKN); + signX->force = force_To_SignX_From_Abs_Entry; + } + else + return x; + return NULL; +} + +/* + * In spite of the fact that the output is positive, we don't + * really know the sign of abs_R(x) until we get the sign of x. + */ +void +force_To_SignX_From_Abs_Entry() +{ + SignX *signX, *source; + Cls *cls; + void force_To_SignX_From_Abs_Cont(); + + signX = (SignX *) POP; + cls = (Cls *) signX->x; + source = (SignX *) cls->userData; + + PUSH_2(force_To_SignX_From_Abs_Cont, signX); + + if (source->tag.value == SIGN_UNKN) + PUSH_2(source->force, source); +} + +/* + * When this gets activated, then we know the sign of the argument + * has been determined. The sign of the output is the same as the argument + * unless the argument is SNEG in which case we switch to SPOS. + */ +void +force_To_SignX_From_Abs_Cont() +{ + SignX *signX; + Cls *cls; + SignX *source; + void force_To_DigsX_From_Abs_Entry(); + + signX = (SignX *) POP; + cls = (Cls *) signX->x; + source = (SignX *) cls->userData; + + /* + * This allocates an empty DigsX structure between the sign and the + * closure. That's where we will copy digits to eventually. + */ + introDigsX(signX); + signX->x->digsX.force = force_To_DigsX_From_Abs_Entry; + + switch (source->tag.value) { + case SPOS : + case SZERO : + case SINF : + signX->tag.value = source->tag.value; + break; + case SNEG : + signX->tag.value = SPOS; /* the only case where sign is changed */ + break; + case SIGN_UNKN : + Error(FATAL, E_INT, "force_To_SignX_From_Abs_Cont", "sign not set"); + return; + default : + Error(FATAL, E_INT, "force_To_SignX_From_Abs_Cont", "bad sign"); + return; + } + + /* + * Now we skip over the sign of the argument. It has been ``absorbed''. + * But we keep a copy of the value for future use. + */ + cls->tag.value = source->tag.value; + cls->userData = (void *) source->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, source); + newEdgeToOnlyChild(cls, source->x); + endGraphUpdate(); +#endif +} + +void +force_To_DigsX_From_Abs_Entry() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + PUSH_3(force_To_DigsX_From_Abs_Cont, target, digitsNeeded); + + /* + * Now see if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < (unsigned int)digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +/* + * The is the function which translates one stream of digits into + * another. The rewrite rules are as follows depending on the sign of + * the argument x. + * SZERO : if the word in the characteristic pair is negative, then + * the argument is negative and we must negate the word and every + * word in subsequent characteristic pairs. + * SINF : if the word in the characteristic pair is positive, then + * the argument is negative and we must negate the word and every + * word in subsequent characteristic pairs. + * SNEG : the number is negative, so we must negate the word of every + * characteristic pair. + * SPOS : just copy characteristic pairs from the source to the target. + * There *might* be an opportunity to optimize things by just + * short circuiting around the closure. Needs thought. + * The code is more or less copied from the force methods for DigsX structures + * with the negation stuff thrown in along the way. + */ +void +force_To_DigsX_From_Abs_Cont() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Copy_Entry(); + void force_To_DigsX_From_Abs_Copy_and_Negate_Entry(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + if (source->count > 0) { + switch (cls->tag.value) { + case SZERO : +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small < 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; + } + else { +#endif + if (mpz_sgn(source->word.big) < 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; +#ifdef OPTIM + } +#endif + break; + + case SINF: +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small > 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; + } + else { +#endif + if (mpz_sgn(source->word.big) > 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; +#ifdef OPTIM + } +#endif + break; + + case SNEG: + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + break; + + case SPOS: + cls->force = force_To_DigsX_From_Abs_Copy_Entry; + break; + + default : + Error(FATAL, E_INT, "force_To_DigsX_From_Abs_Cont", + "bad sign"); + } + target->force = cls->force; + PUSH_3(target->force, target, digitsNeeded); + } +} + +void +force_To_DigsX_From_Abs_Copy_and_Negate_Entry() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Copy_and_Negate_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + PUSH_3(force_To_DigsX_From_Abs_Copy_and_Negate_Cont, target, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < (unsigned int)digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +void +force_To_DigsX_From_Abs_Copy_and_Negate_Cont() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + +#ifdef OPTIM + if (target->count + source->count <= DIGITS_PER_WORD) + target->word.small = (target->word.small << source->count) + - source->word.small; + else { + if (target->count <= DIGITS_PER_WORD) + mpz_init_set_si(target->word.big, target->word.small); +#endif + mpz_mul_2exp(target->word.big, target->word.big, source->count); +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small >= 0) + mpz_sub_ui(target->word.big, target->word.big, + source->word.small); + else + mpz_add_ui(target->word.big, target->word.big, + -(source->word.small)); + } + else +#endif + mpz_sub(target->word.big, target->word.big, source->word.big); +#ifdef OPTIM + } +#endif + + target->count += source->count; + +#ifdef TRACE + if (TRACE) { + debugp("force_To_DigsX_From_Abs_Copy_and_Negate", + "%x %x emitted=%d\n", + (unsigned) target, + (unsigned) source, + source->count); + } +#endif + /* + * We've consumed the source so advance to the next possible source + * of information + */ + cls->userData = (void *) source->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, source); + newEdgeToOnlyChild(cls, source->x); + endGraphUpdate(); +#endif + newDigsX(target); +} + +void +force_To_DigsX_From_Abs_Copy_Entry() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Copy_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + PUSH_3(force_To_DigsX_From_Abs_Copy_Cont, target, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < (unsigned int)digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +void +force_To_DigsX_From_Abs_Copy_Cont() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + +#ifdef OPTIM + if (target->count + source->count <= DIGITS_PER_WORD) + target->word.small = (target->word.small << source->count) + + source->word.small; + else { + if (target->count <= DIGITS_PER_WORD) + mpz_init_set_si(target->word.big, target->word.small); +#endif + mpz_mul_2exp(target->word.big, target->word.big, source->count); +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small >= 0) { + mpz_add_ui(target->word.big, target->word.big, + source->word.small); + } + else { + mpz_sub_ui(target->word.big, target->word.big, + -(source->word.small)); + } + } + else +#endif + mpz_add(target->word.big, target->word.big, source->word.big); +#ifdef OPTIM + } +#endif + + target->count += source->count; + +#ifdef TRACE + if (TRACE) { + debugp("force_To_DigsX_From_Abs_Copy", + "%x %x emitted=%d\n", + (unsigned) target, + (unsigned) source, + source->count); + } +#endif + /* + * We've consumed the source so advance to the next possible source + * of information + */ + cls->userData = (void *) source->x; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, source); + newEdgeToOnlyChild(cls, source->x); + endGraphUpdate(); +#endif + newDigsX(target); +} + +#ifdef JUNK +In some cases it would be better to use the matices to +negate things. But to do this for absolute value +we must know the sign of the argument. + +As a rule we want to use a matrix for reciprocal and negation +except at the top level when we might prefer to use algorithms +in Peters thesis. This is also the case when we real is +the argument to a predicate. +#endif diff --git a/ic-reals-6.3/math-lib/abs_R.c~ b/ic-reals-6.3/math-lib/abs_R.c~ new file mode 100644 index 0000000..e9a7fad --- /dev/null +++ b/ic-reals-6.3/math-lib/abs_R.c~ @@ -0,0 +1,462 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * This computes the absolute value of a real. For now the argument + * must be either a vector or a stream. + */ +Real +abs_R(Real x) +{ + Real r; + Cls *cls; + SignX *signX; + int sign_a, sign_b; + void force_To_SignX_From_Abs_Entry(); + void force_To_SignX_From_Abs_Cont(); + void force_To_DigsX_From_Abs_Entry(); + void force_To_DigsX_From_Abs_Cont(); + void force_To_DigsX_From_Abs_Copy_Entry(); + void force_To_DigsX_From_Abs_Copy_Cont(); + void force_To_DigsX_From_Abs_Copy_and_Negate(); + void force_To_DigsX_From_Abs_Copy_and_Negate_Entry(); + void force_To_DigsX_From_Abs_Copy_and_Negate_Cont(); + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(force_To_SignX_From_Abs_Entry, + "force_To_SignX_From_Abs_Entry", 2); + registerForceFunc(force_To_SignX_From_Abs_Cont, + "force_To_SignX_From_Abs_Cont", 2); + registerForceFunc(force_To_DigsX_From_Abs_Entry, + "force_To_DigsX_From_Abs_Entry", 3); + registerForceFunc(force_To_DigsX_From_Abs_Cont, + "force_To_DigsX_From_Abs_Cont", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_Entry, + "force_To_DigsX_From_Abs_Copy_Entry", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_Cont, + "force_To_DigsX_From_Abs_Copy_Cont", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_and_Negate_Entry, + "force_To_DigsX_From_Abs_Copy_and_Negate_Entry", 3); + registerForceFunc(force_To_DigsX_From_Abs_Copy_and_Negate_Cont, + "force_To_DigsX_From_Abs_Copy_and_Negate_Cont", 3); + doneInit++; + } + + /* + * A slight optimization. In the case of a vector we just inspect the + * entries and then make them both the same sign (in a copy of the vector). + */ + if (x->gen.tag.type == VECTOR) { + sign_a = mpz_sgn(x->vec.vec[0]); + sign_b = mpz_sgn(x->vec.vec[1]); + if (sign_a * sign_b < 0) { + r = vector_Z(x->vec.vec[0], x->vec.vec[1]); + mpz_neg(r->vec.vec[0], r->vec.vec[0]); + return r; + } + else + return x; + } + + /* + * For all other argument types, we simply work with the stream + * representation of the argument. + */ + if (x->gen.tag.isSigned) { + r = makeStream(x); /* this will make a signed stream */ + + /* + * All the work is done in the closure. + */ + cls = allocCls(force_To_SignX_From_Abs_Entry, (void *) r); + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(cls, r); + endGraphUpdate(); + } + signX = allocSignX((Real) cls, SIGN_UNKN); + signX->force = force_To_SignX_From_Abs_Entry; + } + else + return x; +} + +/* + * In spite of the fact that the output is positive, we don't + * really know the sign of abs_R(x) until we get the sign of x. + */ +void +force_To_SignX_From_Abs_Entry() +{ + SignX *signX, *source; + Cls *cls; + void force_To_SignX_From_Abs_Cont(); + + signX = (SignX *) POP; + cls = (Cls *) signX->x; + source = (SignX *) cls->userData; + + PUSH_2(force_To_SignX_From_Abs_Cont, signX); + + if (source->tag.value == SIGN_UNKN) + PUSH_2(source->force, source); +} + +/* + * When this gets activated, then we know the sign of the argument + * has been determined. The sign of the output is the same as the argument + * unless the argument is SNEG in which case we switch to SPOS. + */ +void +force_To_SignX_From_Abs_Cont() +{ + SignX *signX; + Cls *cls; + SignX *source; + void force_To_DigsX_From_Abs_Entry(); + + signX = (SignX *) POP; + cls = (Cls *) signX->x; + source = (SignX *) cls->userData; + + /* + * This allocates an empty DigsX structure between the sign and the + * closure. That's where we will copy digits to eventually. + */ + introDigsX(signX); + signX->x->digsX.force = force_To_DigsX_From_Abs_Entry; + + switch (source->tag.value) { + case SPOS : + case SZERO : + case SINF : + signX->tag.value = source->tag.value; + break; + case SNEG : + signX->tag.value = SPOS; /* the only case where sign is changed */ + break; + case SIGN_UNKN : + Error(FATAL, E_INT, "force_To_SignX_From_Abs_Cont", "sign not set"); + default : + Error(FATAL, E_INT, "force_To_SignX_From_Abs_Cont", "bad sign"); + } + + /* + * Now we skip over the sign of the argument. It has been ``absorbed''. + * But we keep a copy of the value for future use. + */ + cls->tag.value = source->tag.value; + cls->userData = (void *) source->x; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, source); + newEdgeToOnlyChild(cls, source->x); + endGraphUpdate(); + } +} + +void +force_To_DigsX_From_Abs_Entry() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + PUSH_3(force_To_DigsX_From_Abs_Cont, target, digitsNeeded); + + /* + * Now see if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +/* + * The is the function which translates one stream of digits into + * another. The rewrite rules are as follows depending on the sign of + * the argument x. + * SZERO : if the word in the characteristic pair is negative, then + * the argument is negative and we must negate the word and every + * word in subsequent characteristic pairs. + * SINF : if the word in the characteristic pair is positive, then + * the argument is negative and we must negate the word and every + * word in subsequent characteristic pairs. + * SNEG : the number is negative, so we must negate the word of every + * characteristic pair. + * SPOS : just copy characteristic pairs from the source to the target. + * There *might* be an opportunity to optimize things by just + * short circuiting around the closure. Needs thought. + * The code is more or less copied from the force methods for DigsX structures + * with the negation stuff thrown in along the way. + */ +void +force_To_DigsX_From_Abs_Cont() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Copy_Entry(); + void force_To_DigsX_From_Abs_Copy_and_Negate_Entry(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + if (source->count > 0) { + switch (cls->tag.value) { + case SZERO : +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small < 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; + } + else { +#endif + if (mpz_sgn(source->word.big) < 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; +#ifdef OPTIM + } +#endif + break; + + case SINF: +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small > 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; + } + else { +#endif + if (mpz_sgn(source->word.big) > 0) + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + else + cls->force = force_To_DigsX_From_Abs_Copy_Entry; +#ifdef OPTIM + } +#endif + break; + + case SNEG: + cls->force = force_To_DigsX_From_Abs_Copy_and_Negate_Entry; + break; + + case SPOS: + cls->force = force_To_DigsX_From_Abs_Copy_Entry; + break; + + default : + Error(FATAL, E_INT, "force_To_DigsX_From_Abs_Cont", + "bad sign"); + } + target->force = cls->force; + PUSH_3(target->force, target, digitsNeeded); + } +} + +void +force_To_DigsX_From_Abs_Copy_and_Negate_Entry() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Copy_and_Negate_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + PUSH_3(force_To_DigsX_From_Abs_Copy_and_Negate_Cont, target, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +void +force_To_DigsX_From_Abs_Copy_and_Negate_Cont() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + +#ifdef OPTIM + if (target->count + source->count <= DIGITS_PER_WORD) + target->word.small = (target->word.small << source->count) + - source->word.small; + else { + if (target->count <= DIGITS_PER_WORD) + mpz_init_set_si(target->word.big, target->word.small); +#endif + mpz_mul_2exp(target->word.big, target->word.big, source->count); +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small >= 0) + mpz_sub_ui(target->word.big, target->word.big, + source->word.small); + else + mpz_add_ui(target->word.big, target->word.big, + -(source->word.small)); + } + else +#endif + mpz_sub(target->word.big, target->word.big, source->word.big); +#ifdef OPTIM + } +#endif + + target->count += source->count; + + if (TRACE) { + debugp("force_To_DigsX_From_Abs_Copy_and_Negate", + "%x %x emitted=%d\n", + (unsigned) target, + (unsigned) source, + source->count); + } + + /* + * We've consumed the source so advance to the next possible source + * of information + */ + cls->userData = (void *) source->x; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, source); + newEdgeToOnlyChild(cls, source->x); + endGraphUpdate(); + } + newDigsX(target); +} + +void +force_To_DigsX_From_Abs_Copy_Entry() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + void force_To_DigsX_From_Abs_Copy_Cont(); + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + + PUSH_3(force_To_DigsX_From_Abs_Copy_Cont, target, digitsNeeded); + + /* + * See if the source has the number of digits we need. If not, + * then force the remaining. + */ + if (source->count < digitsNeeded) + PUSH_3(source->force, source, digitsNeeded - source->count); +} + +void +force_To_DigsX_From_Abs_Copy_Cont() +{ + DigsX *target, *source; + Cls *cls; + int digitsNeeded; + + target = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) target->x; + source = (DigsX *) cls->userData; + +#ifdef OPTIM + if (target->count + source->count <= DIGITS_PER_WORD) + target->word.small = (target->word.small << source->count) + + source->word.small; + else { + if (target->count <= DIGITS_PER_WORD) + mpz_init_set_si(target->word.big, target->word.small); +#endif + mpz_mul_2exp(target->word.big, target->word.big, source->count); +#ifdef OPTIM + if (source->count <= DIGITS_PER_WORD) { + if (source->word.small >= 0) { + mpz_add_ui(target->word.big, target->word.big, + source->word.small); + } + else { + mpz_sub_ui(target->word.big, target->word.big, + -(source->word.small)); + } + } + else +#endif + mpz_add(target->word.big, target->word.big, source->word.big); +#ifdef OPTIM + } +#endif + + target->count += source->count; + + if (TRACE) { + debugp("force_To_DigsX_From_Abs_Copy", + "%x %x emitted=%d\n", + (unsigned) target, + (unsigned) source, + source->count); + } + + /* + * We've consumed the source so advance to the next possible source + * of information + */ + cls->userData = (void *) source->x; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, source); + newEdgeToOnlyChild(cls, source->x); + endGraphUpdate(); + } + newDigsX(target); +} + +#ifdef JUNK +In some cases it would be better to use the matices to +negate things. But to do this for absolute value +we must know the sign of the argument. + +As a rule we want to use a matrix for reciprocal and negation +except at the top level when we might prefer to use algorithms +in Peters thesis. This is also the case when we real is +the argument to a predicate. +#endif diff --git a/ic-reals-6.3/math-lib/acos_Q.c b/ic-reals-6.3/math-lib/acos_Q.c new file mode 100644 index 0000000..f584c93 --- /dev/null +++ b/ic-reals-6.3/math-lib/acos_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +acos_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return acos_R(r); +} + +Real +acos_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return acos_R(r); +} diff --git a/ic-reals-6.3/math-lib/acos_R.c b/ic-reals-6.3/math-lib/acos_R.c new file mode 100644 index 0000000..0f62f41 --- /dev/null +++ b/ic-reals-6.3/math-lib/acos_R.c @@ -0,0 +1,26 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * acos(x) = atan((sqrt(1-x^2))/x) + */ +Real +acos_R(Real x) +{ + Real r; + + r = mul_R_R(x, x); + r = sub_Int_R(1, r); + r = sqrt_R(r); + r = div_R_R(r, x); + r = atan_R(r); + return r; +} diff --git a/ic-reals-6.3/math-lib/acos_R.c~ b/ic-reals-6.3/math-lib/acos_R.c~ new file mode 100644 index 0000000..4de1e7a --- /dev/null +++ b/ic-reals-6.3/math-lib/acos_R.c~ @@ -0,0 +1,26 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * acos(x) = atan((sqrt(1-x^2))/x) + */ +Real +acos_R(Real x) +{ + Real r, s; + + r = mul_R_R(x, x); + r = sub_Int_R(1, r); + r = sqrt_R(r); + r = div_R_R(r, x); + r = atan_R(r); + return r; +} diff --git a/ic-reals-6.3/math-lib/acosh_Q.c b/ic-reals-6.3/math-lib/acosh_Q.c new file mode 100644 index 0000000..9f0846f --- /dev/null +++ b/ic-reals-6.3/math-lib/acosh_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +acosh_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return acosh_R(r); +} + +Real +acosh_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return acosh_R(r); +} diff --git a/ic-reals-6.3/math-lib/acosh_R.c b/ic-reals-6.3/math-lib/acosh_R.c new file mode 100644 index 0000000..467539b --- /dev/null +++ b/ic-reals-6.3/math-lib/acosh_R.c @@ -0,0 +1,22 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +acosh_R(Real x) +{ + Real r; + + r = tensor_Int(x, x, 1, 0, 0, 0, 0, 0, -1, 1); + r = sqrt_R(r); + r = add_R_R(x, r); + r = log_R(r); + return r; +} diff --git a/ic-reals-6.3/math-lib/asin_Q.c b/ic-reals-6.3/math-lib/asin_Q.c new file mode 100644 index 0000000..b51eeaf --- /dev/null +++ b/ic-reals-6.3/math-lib/asin_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +asin_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return asin_R(r); +} + +Real +asin_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return asin_R(r); +} diff --git a/ic-reals-6.3/math-lib/asin_R.c b/ic-reals-6.3/math-lib/asin_R.c new file mode 100644 index 0000000..c12b7c4 --- /dev/null +++ b/ic-reals-6.3/math-lib/asin_R.c @@ -0,0 +1,26 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * asin(x) = atan(x/sqrt(1-x^2)) + */ +Real +asin_R(Real x) +{ + Real r; + + r = mul_R_R(x, x); + r = sub_Int_R(1, r); + r = sqrt_R(r); + r = div_R_R(x, r); + r = atan_R(r); + return r; +} diff --git a/ic-reals-6.3/math-lib/asin_R.c~ b/ic-reals-6.3/math-lib/asin_R.c~ new file mode 100644 index 0000000..009bcf2 --- /dev/null +++ b/ic-reals-6.3/math-lib/asin_R.c~ @@ -0,0 +1,26 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * asin(x) = atan(x/sqrt(1-x^2)) + */ +Real +asin_R(Real x) +{ + Real r, s; + + r = mul_R_R(x, x); + r = sub_Int_R(1, r); + r = sqrt_R(r); + r = div_R_R(x, r); + r = atan_R(r); + return r; +} diff --git a/ic-reals-6.3/math-lib/asinh_Q.c b/ic-reals-6.3/math-lib/asinh_Q.c new file mode 100644 index 0000000..4200b8d --- /dev/null +++ b/ic-reals-6.3/math-lib/asinh_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +asinh_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return asinh_R(r); +} + +Real +asinh_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return asinh_R(r); +} diff --git a/ic-reals-6.3/math-lib/asinh_R.c b/ic-reals-6.3/math-lib/asinh_R.c new file mode 100644 index 0000000..7c20839 --- /dev/null +++ b/ic-reals-6.3/math-lib/asinh_R.c @@ -0,0 +1,22 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +asinh_R(Real x) +{ + Real r; + + r = tensor_Int(x, x, 1, 0, 0, 0, 0, 0, 1, 1); + r = sqrt_R(r); + r = add_R_R(x, r); + r = log_R(r); + return r; +} diff --git a/ic-reals-6.3/math-lib/atan_Q.c b/ic-reals-6.3/math-lib/atan_Q.c new file mode 100644 index 0000000..f23a945 --- /dev/null +++ b/ic-reals-6.3/math-lib/atan_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +atan_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return atan_R(r); +} + +Real +atan_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return atan_R(r); +} diff --git a/ic-reals-6.3/math-lib/atan_R.c b/ic-reals-6.3/math-lib/atan_R.c new file mode 100644 index 0000000..c79efab --- /dev/null +++ b/ic-reals-6.3/math-lib/atan_R.c @@ -0,0 +1,135 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +static TenXY *nextTensor(Real, Real, int); +static void atanInside(); +static void atanPositive(); +static void atanNegative(); + +Real +atan_R(Real x) +{ + Real u, v, w; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(atanInside, "atanInside", 2); + registerForceFunc(atanPositive, "atanPositive", 2); + registerForceFunc(atanNegative, "atanNegative", 2); + doneInit++; + } + + xLtEq1 = ltEq_R_QInt(x, 1, 1); + xGtEqNeg1 = gtEq_R_QInt(x, -1, 1); + xLtEq1_and_GtEqNeg1 = and_B_B(xLtEq1, xGtEqNeg1); + + u = (Real) allocCls(atanInside, (void *) x); + u->cls.tag.isSigned = TRUE; + v = (Real) allocCls(atanPositive, (void *) x); + v->cls.tag.isSigned = TRUE; + w = (Real) allocCls(atanNegative, (void *) x); + w->cls.tag.isSigned = TRUE; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(u, x); + newEdgeToOnlyChild(v, x); + newEdgeToOnlyChild(w, x); + endGraphUpdate(); +#endif + + /* + * The order of the tests in the alt is not semantically + * significant. The tests are applied in order, so there is a + * very modest performance improvement by putting the -1,1 tests + * before the 999/1000,-999/1000 tests. Also there is a very + * small win by doing the negative test before the positive test. + */ + return realIf(3, + xLtEq1_and_GtEqNeg1, u, + gtEq_R_QInt(x, 999, 1000), v, + ltEq_R_QInt(x, -999, 1000), w); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, 2*n+1, 1, -1, -(2*n+1), + 2*n+1, 2*n+1, 2*n+1, 2*n+1); +} + +static void +atanInside() +{ + Cls *cls, *newCls; + Real x; + ClsData *data; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "atan_R", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 1, 1, 1, -1, 0, 1, 0, 1); + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +/* + * This implements the identity: + * x > 0 implies atan(x) = atan(szero * x) + \pi/4 + */ +static void +atanPositive() +{ + Cls *cls; + Real x, y; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + y = atan_R(matrix_Int(x, 1, 1, -1, 1)); + cls->redirect = add_R_R(y, div_R_Int(Pi, 4)); +} + +/* + * This implements the identity: + * x < 0 implies atan(x) = atan(szero * (sneg^(-1) * x) - \pi/4 + */ +static void +atanNegative() +{ + Cls *cls; + Real x, y; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + y = atan_R(matrix_Int(x, 1, -1, 1, 1)); + cls->redirect = sub_R_R(y, div_R_Int(Pi, 4)); +} diff --git a/ic-reals-6.3/math-lib/atan_R.c~ b/ic-reals-6.3/math-lib/atan_R.c~ new file mode 100644 index 0000000..a6c1154 --- /dev/null +++ b/ic-reals-6.3/math-lib/atan_R.c~ @@ -0,0 +1,135 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +static TenXY *nextTensor(Real, Real, int); +static void atanInside(); +static void atanPositive(); +static void atanNegative(); + +Real +atan_R(Real x) +{ + Real u, v, w; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(atanInside, "atanInside", 2); + registerForceFunc(atanPositive, "atanPositive", 2); + registerForceFunc(atanNegative, "atanNegative", 2); + doneInit++; + } + + xLtEq1 = ltEq_R_QInt(x, 1, 1); + xGtEqNeg1 = gtEq_R_QInt(x, -1, 1); + xLtEq1_and_GtEqNeg1 = and_B_B(xLtEq1, xGtEqNeg1); + + u = (Real) allocCls(atanInside, (void *) x); + u->cls.tag.isSigned = TRUE; + v = (Real) allocCls(atanPositive, (void *) x); + v->cls.tag.isSigned = TRUE; + w = (Real) allocCls(atanNegative, (void *) x); + w->cls.tag.isSigned = TRUE; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(u, x); + newEdgeToOnlyChild(v, x); + newEdgeToOnlyChild(w, x); + endGraphUpdate(); + } + + /* + * The order of the tests in the alt is not semantically + * significant. The tests are applied in order, so there is a + * very modest performance improvement by putting the -1,1 tests + * before the 999/1000,-999/1000 tests. Also there is a very + * small win by doing the negative test before the positive test. + */ + return realIf(3, + xLtEq1_and_GtEqNeg1, u, + gtEq_R_QInt(x, 999, 1000), v, + ltEq_R_QInt(x, -999, 1000), w); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, 2*n+1, 1, -1, -(2*n+1), + 2*n+1, 2*n+1, 2*n+1, 2*n+1); +} + +static void +atanInside() +{ + Cls *cls, *newCls; + Real x, atan_x; + ClsData *data; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "atan_R", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 1, 1, 1, -1, 0, 1, 0, 1); + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +/* + * This implements the identity: + * x > 0 implies atan(x) = atan(szero * x) + \pi/4 + */ +static void +atanPositive() +{ + Cls *cls, *newCls; + Real x, y; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + y = atan_R(matrix_Int(x, 1, 1, -1, 1)); + cls->redirect = add_R_R(y, div_R_Int(Pi, 4)); +} + +/* + * This implements the identity: + * x < 0 implies atan(x) = atan(szero * (sneg^(-1) * x) - \pi/4 + */ +static void +atanNegative() +{ + Cls *cls, *newCls; + Real x, y; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + y = atan_R(matrix_Int(x, 1, -1, 1, 1)); + cls->redirect = sub_R_R(y, div_R_Int(Pi, 4)); +} diff --git a/ic-reals-6.3/math-lib/atanh_Q.c b/ic-reals-6.3/math-lib/atanh_Q.c new file mode 100644 index 0000000..d66cf14 --- /dev/null +++ b/ic-reals-6.3/math-lib/atanh_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +atanh_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return atanh_R(r); +} + +Real +atanh_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return atanh_R(r); +} diff --git a/ic-reals-6.3/math-lib/atanh_R.c b/ic-reals-6.3/math-lib/atanh_R.c new file mode 100644 index 0000000..c88e2d4 --- /dev/null +++ b/ic-reals-6.3/math-lib/atanh_R.c @@ -0,0 +1,24 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * One could do this more efficiently, but it will have to wait. + */ +Real +atanh_R(Real x) +{ + Real r; + + r = matrix_Int(x, 1, -1, 1, 1); + r = log_R(r); + r = div_R_Int(r, 2); + return r; +} diff --git a/ic-reals-6.3/math-lib/cos_Q.c b/ic-reals-6.3/math-lib/cos_Q.c new file mode 100644 index 0000000..b2c472a --- /dev/null +++ b/ic-reals-6.3/math-lib/cos_Q.c @@ -0,0 +1,46 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +cos_QZ(mpz_t a, mpz_t b) +{ + mpz_t x; + Real r; + + mpz_init(x); + mpz_mul_ui(x, b, 2); + r = tan_QZ(a, x); + mpz_clear(x); + r = tensor_Int(r, r, -1, 1, 0, 0, 0, 0, 1, 1); + return r; +} + +Real +cos_QInt(int a, int b) +{ + Real r; + mpz_t ap, bp; + + /* check for overflow */ + if ((unsigned int)b > 0x3FFFFFFF || (unsigned int)b < 0xC0000000) { + mpz_init_set_si(ap, a); + mpz_init_set_si(bp, b); + mpz_mul_ui(bp, bp, 2); + r = tan_QZ(ap, bp); + mpz_clear(ap); + mpz_clear(bp); + } + else + r = tan_QInt(a, b * 2); + + r = tensor_Int(r, r, -1, 1, 0, 0, 0, 0, 1, 1); + return r; +} diff --git a/ic-reals-6.3/math-lib/cos_Q.c~ b/ic-reals-6.3/math-lib/cos_Q.c~ new file mode 100644 index 0000000..b1a4a69 --- /dev/null +++ b/ic-reals-6.3/math-lib/cos_Q.c~ @@ -0,0 +1,46 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +cos_QZ(mpz_t a, mpz_t b) +{ + mpz_t x; + Real r; + + mpz_init(x); + mpz_mul_ui(x, b, 2); + r = tan_QZ(a, x); + mpz_clear(x); + r = tensor_Int(r, r, -1, 1, 0, 0, 0, 0, 1, 1); + return r; +} + +Real +cos_QInt(int a, int b) +{ + Real r; + mpz_t ap, bp; + + /* check for overflow */ + if (b > 0x3FFFFFFF || b < 0xC0000000) { + mpz_init_set_si(ap, a); + mpz_init_set_si(bp, b); + mpz_mul_ui(bp, bp, 2); + r = tan_QZ(ap, bp); + mpz_clear(ap); + mpz_clear(bp); + } + else + r = tan_QInt(a, b * 2); + + r = tensor_Int(r, r, -1, 1, 0, 0, 0, 0, 1, 1); + return r; +} diff --git a/ic-reals-6.3/math-lib/cos_R.c b/ic-reals-6.3/math-lib/cos_R.c new file mode 100644 index 0000000..9eafe58 --- /dev/null +++ b/ic-reals-6.3/math-lib/cos_R.c @@ -0,0 +1,21 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +cos_R(Real x) +{ + Real r; + + r = div_R_Int(x, 2); + r = tan_R(r); + r = tensor_Int(r, r, -1, 1, 0, 0, 0, 0, 1, 1); + return r; +} diff --git a/ic-reals-6.3/math-lib/cosecant.c b/ic-reals-6.3/math-lib/cosecant.c new file mode 100644 index 0000000..207974b --- /dev/null +++ b/ic-reals-6.3/math-lib/cosecant.c @@ -0,0 +1,98 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These functions should probably be broken into separate files. + */ + +/* + * cosec x = 1 / (sin x) + */ +Real +cosec_R(Real x) +{ + return div_Int_R(1, sin_R(x)); +} + +Real +cosec_QInt(int a, int b) +{ + return div_Int_R(1, sin_QInt(a, b)); +} + +Real +cosec_QZ(mpz_t a, mpz_t b) +{ + return div_Int_R(1, sin_QZ(a, b)); +} + +/* + * acosec x = asin (1/x) + */ +Real +acosec_R(Real x) +{ + return asin_R(div_Int_R(1, x)); +} + +Real +acosec_QInt(int a, int b) +{ + return asin_QInt(b, a); +} + +Real +acosec_QZ(mpz_t a, mpz_t b) +{ + return asin_QZ(b, a); +} + +/* + * cosech x = 1 / (sinh x) + */ +Real +cosech_R(Real x) +{ + return div_Int_R(1, sinh_R(x)); +} + +Real +cosech_QInt(int a, int b) +{ + return div_Int_R(1, sinh_QInt(a, b)); +} + +Real +cosech_QZ(mpz_t a, mpz_t b) +{ + return div_Int_R(1, sinh_QZ(a, b)); +} + +/* + * acosech x = asinh (1/x) + */ +Real +acosech_R(Real x) +{ + return asinh_R(div_Int_R(1, x)); +} + +Real +acosech_QInt(int a, int b) +{ + return asinh_QInt(b, a); +} + +Real +acosech_QZ(mpz_t a, mpz_t b) +{ + return asinh_QZ(b, a); +} diff --git a/ic-reals-6.3/math-lib/cosh_Q.c b/ic-reals-6.3/math-lib/cosh_Q.c new file mode 100644 index 0000000..53ea74d --- /dev/null +++ b/ic-reals-6.3/math-lib/cosh_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +cosh_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return cosh_R(r); +} + +Real +cosh_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return cosh_R(r); +} diff --git a/ic-reals-6.3/math-lib/cosh_R.c b/ic-reals-6.3/math-lib/cosh_R.c new file mode 100644 index 0000000..6dd28b1 --- /dev/null +++ b/ic-reals-6.3/math-lib/cosh_R.c @@ -0,0 +1,19 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +cosh_R(Real x) +{ + Real r; + + r = exp_R(x); + return tensor_Int(r, r, 1, 0, 0, 1, 0, 1, 1, 0); +} diff --git a/ic-reals-6.3/math-lib/cotangent.c b/ic-reals-6.3/math-lib/cotangent.c new file mode 100644 index 0000000..de6ec44 --- /dev/null +++ b/ic-reals-6.3/math-lib/cotangent.c @@ -0,0 +1,98 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These functions should probably be broken into separate files. + */ + +/* + * cotan x = 1 / (tan x) + */ +Real +cotan_R(Real x) +{ + return div_Int_R(1, tan_R(x)); +} + +Real +cotan_QInt(int a, int b) +{ + return div_Int_R(1, tan_QInt(a, b)); +} + +Real +cotan_QZ(mpz_t a, mpz_t b) +{ + return div_Int_R(1, tan_QZ(a, b)); +} + +/* + * acotan x = atan (1/x) + */ +Real +acotan_R(Real x) +{ + return atan_R(div_Int_R(1, x)); +} + +Real +acotan_QInt(int a, int b) +{ + return atan_QInt(b, a); +} + +Real +acotan_QZ(mpz_t a, mpz_t b) +{ + return atan_QZ(b, a); +} + +/* + * cotanh x = 1 / (tanh x) + */ +Real +cotanh_R(Real x) +{ + return div_Int_R(1, tanh_R(x)); +} + +Real +cotanh_QInt(int a, int b) +{ + return div_Int_R(1, tanh_QInt(a, b)); +} + +Real +cotanh_QZ(mpz_t a, mpz_t b) +{ + return div_Int_R(1, tanh_QZ(a, b)); +} + +/* + * acotanh x = atanh (1/x) + */ +Real +acotanh_R(Real x) +{ + return atanh_R(div_Int_R(1, x)); +} + +Real +acotanh_QInt(int a, int b) +{ + return atanh_QInt(b, a); +} + +Real +acotanh_QZ(mpz_t a, mpz_t b) +{ + return atanh_QZ(b, a); +} diff --git a/ic-reals-6.3/math-lib/exp_Q.c b/ic-reals-6.3/math-lib/exp_Q.c new file mode 100644 index 0000000..2e7e183 --- /dev/null +++ b/ic-reals-6.3/math-lib/exp_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +exp_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return exp_R(r); +} + +Real +exp_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return exp_R(r); +} diff --git a/ic-reals-6.3/math-lib/exp_R.c b/ic-reals-6.3/math-lib/exp_R.c new file mode 100644 index 0000000..2a0d9ac --- /dev/null +++ b/ic-reals-6.3/math-lib/exp_R.c @@ -0,0 +1,122 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +static TenXY *nextTensor(Real, Real, int); +static void expInside(); +static void expOutside(); + +Real +exp_R(Real x) +{ + Real u, v; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(expInside, "expInside", 2); + registerForceFunc(expOutside, "expOutside", 2); + doneInit++; + } + + /* + if (x->gen.tag.type == VECTOR) + return exp_QZ(x->vec.vec[0], x->vec.vec[1]); + */ + + xLtEq1 = ltEq_R_QInt(x, 1, 1); + xGtEqNeg1 = gtEq_R_QInt(x, -1, 1); + xLtEq1_and_GtEqNeg1 = and_B_B(xLtEq1, xGtEqNeg1); + + u = (Real) allocCls(expInside, (void *) x); + u->cls.tag.isSigned = TRUE; + v = (Real) allocCls(expOutside, (void *) x); + v->cls.tag.isSigned = TRUE; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(u, x); + newEdgeToOnlyChild(v, x); + endGraphUpdate(); +#endif + + /* + * The order of the tests in the alt is not semantically + * significant. The tests are applied in order, so there is a + * very modest performance improvement by putting the -1,1 tests + * before the 999/1000,-999/1000 tests. Also there is a very + * small win by doing the negative test before the positive test. + */ + return realIf(4, + not_B(xLtEq1_and_GtEqNeg1), v, + xLtEq1_and_GtEqNeg1, u, + gtEq_R_QInt(x, 999, 1000), v, + ltEq_R_QInt(x, -999, 1000), v); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, -1, 0, 0, 1, 2*n+1, 2*n+1, 2*n+1, 2*n+1); +} + +static void +expInside() +{ + Cls *cls, *newCls; + Real x; + ClsData *data; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "exp_R", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 0, -1, 1, 0, 1, 1, 1, 1); + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +static void +expOutside() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + x = div_R_Int(x, 2); + + w = exp_R(x); + + cls->redirect = mul_R_R(w, w); + +#ifdef DAVINCI + beginGraphUpdate(); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} diff --git a/ic-reals-6.3/math-lib/exp_R.c~ b/ic-reals-6.3/math-lib/exp_R.c~ new file mode 100644 index 0000000..9723dec --- /dev/null +++ b/ic-reals-6.3/math-lib/exp_R.c~ @@ -0,0 +1,123 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +static TenXY *nextTensor(Real, Real, int); +static void expInside(); +static void expOutside(); + +Real +exp_R(Real x) +{ + Real u, v; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(expInside, "expInside", 2); + registerForceFunc(expOutside, "expOutside", 2); + doneInit++; + } + + /* + if (x->gen.tag.type == VECTOR) + return exp_QZ(x->vec.vec[0], x->vec.vec[1]); + */ + + xLtEq1 = ltEq_R_QInt(x, 1, 1); + xGtEqNeg1 = gtEq_R_QInt(x, -1, 1); + xLtEq1_and_GtEqNeg1 = and_B_B(xLtEq1, xGtEqNeg1); + + u = (Real) allocCls(expInside, (void *) x); + u->cls.tag.isSigned = TRUE; + v = (Real) allocCls(expOutside, (void *) x); + v->cls.tag.isSigned = TRUE; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(u, x); + newEdgeToOnlyChild(v, x); + endGraphUpdate(); + } + + /* + * The order of the tests in the alt is not semantically + * significant. The tests are applied in order, so there is a + * very modest performance improvement by putting the -1,1 tests + * before the 999/1000,-999/1000 tests. Also there is a very + * small win by doing the negative test before the positive test. + */ + return realIf(4, + not_B(xLtEq1_and_GtEqNeg1), v, + xLtEq1_and_GtEqNeg1, u, + gtEq_R_QInt(x, 999, 1000), v, + ltEq_R_QInt(x, -999, 1000), v); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, -1, 0, 0, 1, 2*n+1, 2*n+1, 2*n+1, 2*n+1); +} + +static void +expInside() +{ + Cls *cls, *newCls; + Real x, exp_x; + ClsData *data; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "exp_R", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 0, -1, 1, 0, 1, 1, 1, 1); + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +static void +expOutside() +{ + Cls *cls; + Real u, v, w, x; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + + cls = (Cls *) POP; + x = (Real) cls->userData; + x = div_R_Int(x, 2); + + w = exp_R(x); + + cls->redirect = mul_R_R(w, w); + + if (DAVINCI) { + beginGraphUpdate(); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} diff --git a/ic-reals-6.3/math-lib/init.c b/ic-reals-6.3/math-lib/init.c new file mode 100644 index 0000000..be3e6ec --- /dev/null +++ b/ic-reals-6.3/math-lib/init.c @@ -0,0 +1,67 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +/* + * Temporary storage for use in the math library + */ +mpz_t tmpw_z, tmpx_z, tmpy_z, tmpz_z; + +Real E; + +void +initReals() +{ + void initRealBase(); + void stdTensorCont(); + void failCls(); + + initRealBase(); + + mpz_init(tmpw_z); + mpz_init(tmpx_z); + mpz_init(tmpy_z); + mpz_init(tmpz_z); + + registerForceFunc(stdTensorCont, "stdTensorCont", 2); + registerForceFunc(failCls, "failCls", 2); + + initPi(); + E = exp_QInt(1, 1); /* there is better way but this will come later */ +} + +Real +realError(char *p) +{ + void failCls(); + Cls *cls; + + cls = allocCls(failCls, (void *) p); + cls->tag.isSigned = FALSE; + + return (Real) cls; +} + +void +failCls() +{ + Cls *cls; + char *p; + + cls = (Cls *) POP; + p = (char *) cls->userData; + + if (p != NULL) + Error(FATAL, E_INT, "failCls", p); + else + Error(FATAL, E_INT, "failCls", "failure closure activated"); +} diff --git a/ic-reals-6.3/math-lib/log_Q.c b/ic-reals-6.3/math-lib/log_Q.c new file mode 100644 index 0000000..0e8d1b7 --- /dev/null +++ b/ic-reals-6.3/math-lib/log_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +log_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return log_R(r); +} + +Real +log_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return log_R(r); +} diff --git a/ic-reals-6.3/math-lib/log_R.c b/ic-reals-6.3/math-lib/log_R.c new file mode 100644 index 0000000..d7266a9 --- /dev/null +++ b/ic-reals-6.3/math-lib/log_R.c @@ -0,0 +1,227 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +void log2Cont(); +void logInside(); +void logLow(); +void logHigh(); + +/* + * This diverges when the argument is zero. + */ +Real +log_R(Real x) +{ + Bool xGtEq0, xLtEq2, xGtEqOneHalf, xLtEq2_and_GtEqOneHalf; + Bool xLtEqOverOneHalf_and_GtEq0; + Real in, low, high, ltZero; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(logInside, "logInside", 2); + registerForceFunc(logLow, "logLow", 2); + registerForceFunc(logHigh, "logHigh", 2); + registerForceFunc(log2Cont, "log2Cont", 3); + doneInit++; + } + + xGtEq0 = gtEq_R_0(x); + xLtEq2 = ltEq_R_QInt(x, 2, 1); + xGtEqOneHalf = gtEq_R_QInt(x, 1, 2); + xLtEq2_and_GtEqOneHalf = and_B_B(xLtEq2, xGtEqOneHalf); + xLtEqOverOneHalf_and_GtEq0 = and_B_B(ltEq_R_QInt(x, 1001, 2000), xGtEq0); + + in = (Real) allocCls(logInside, (void *) x); + in->cls.tag.isSigned = TRUE; + low = (Real) allocCls(logLow, (void *) x); + low->cls.tag.isSigned = TRUE; + high = (Real) allocCls(logHigh, (void *) x); + high->cls.tag.isSigned = TRUE; + ltZero = realError("(log_R x) and x < 0"); + + return realIf(4, + xLtEq2_and_GtEqOneHalf, in, + gtEq_R_QInt(x, 1999, 1000), high, + xLtEqOverOneHalf_and_GtEq0, low, + not_B(xGtEq0), ltZero); +} + +static TenXY *nextTensor(Real, Real, int); + +void +logInside() +{ + Cls *cls, *newCls; + ClsData *data; + Real x; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "logInside", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 1, 0, 1, 1, -1, 1, -1, 0); + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +void +logHigh() +{ + Cls *cls, *newCls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = div_R_Int(x, 2); + w = log_R(w); + newCls = allocCls(log2Cont, (void *) 0); + newCls->tag.isSigned = FALSE; + w = add_R_R(w, (Real) newCls); + w->tenXY.forceY = log2Cont; /* see the note below */ + + /* now guard tensor to prevent it being copied */ + cls->redirect = (Real) allocSignX(w, SIGN_UNKN); +} + +void +logLow() +{ + Cls *cls, *newCls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = mul_R_Int(x, 2); + w = log_R(w); + newCls = allocCls(log2Cont, (void *) 0); + newCls->tag.isSigned = FALSE; + w = sub_R_R(w, (Real) newCls); + w->tenXY.forceY = log2Cont; /* see the note below */ + + /* now guard tensor to prevent it being copied */ + cls->redirect = (Real) allocSignX(w, SIGN_UNKN); +} + +/* + * This closure works a little different from most. Most simply create + * an lft and set the redirect field of the closure to point to the new + * heap object. In this case, we can do a bit better. This continuation + * represents (log 2). One option would be to follow the usual strategy + * and to arrange for (log 2) to be shared whenever possible. However, + * we know that this is used internally to log_R only and only in + * those circumstances when the argument falls outside the working range + * of the log tensor chain. Moreover, we know that the consumer of this + * real is either an addition or substraction tensor. Whatever it is, + * it is certain to be a tensor. The other argument of the tensor will + * reduce at most to a matrix and hence the tensor itself will never + * reduce. + * + * This property allows us to adopt a different strategy. Rather than create + * the next matrix in the (log 2) chain, we put the matrix directly into + * the consuming tensor. This avoids creating garbage in the stack and + * avoids a separate reduction step. + * + * There is a slighlt better scheme than this. Rather than plunk in + * each successive + * matrix into the tensor (each providing 4 digits), it would be better + * to accumulate a sequence of matrices (up to the capacity of a small matrix) + * and then plunk it into the tensor. This would avoid using bignum stuff until + * it becomes necessary. Perhaps I'll do this later. + * + * For this it is useful to bear in mind that when a sequence of matrices + * starts from n = 0, then the largest entry is always d. When the sequence + * starts with n > 0, then the largest entry is c. To decide if there + * is going to be an overflow, it suffices to check if c (for example) + * will overflow. + */ +static void nextMatrix(Tensor, int); + +void +log2Cont() +{ + TenXY *tenXY; + Cls *cls; + int digitsNeeded; + int n; + + tenXY = (TenXY *) POP; + digitsNeeded = POP; + cls = (Cls *) tenXY->y; + + n = (int) cls->userData; + + while (digitsNeeded > 0) { + nextMatrix(tenXY->ten, n); + if (n == 0) + digitsNeeded -= 2; + else + digitsNeeded -= 4; + n += 1; + } + cls->userData = (void *) n; +} + +/* + * We set a rather arbitrary (but large) limit on the value of n + * for log 2. On a 32 bit machine it is 536,870,911. + * Larger than this and the matrix entries are no longer small. + */ +static void +nextMatrix(Tensor ten, int n) +{ + SmallMatrix smallMat; + + if (n == 0) { + smallMat[0][0] = 1; + smallMat[0][1] = 1; + smallMat[1][0] = 1; + smallMat[1][1] = 2; + } + else { + if (n <= (MAXINT - 2) / 4) { + smallMat[0][0] = 3 * n + 1; + smallMat[0][1] = 2 * n + 1; + smallMat[1][0] = 4 * n + 2; + smallMat[1][1] = 3 * n + 2; + } + else + Error(FATAL, E_INT, "nextMatrix (log2)", + "n > %d", (MAXINT - 2) / 4); + } + multVectorPairTimesSmallMatrix(ten[0], ten[1], smallMat); + multVectorPairTimesSmallMatrix(ten[2], ten[3], smallMat); + normalizeTensor(ten); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, n, 0, 2*n+1, n+1, n+1, 2*n+1, 0, n); +} diff --git a/ic-reals-6.3/math-lib/log_R.c~ b/ic-reals-6.3/math-lib/log_R.c~ new file mode 100644 index 0000000..bc66045 --- /dev/null +++ b/ic-reals-6.3/math-lib/log_R.c~ @@ -0,0 +1,227 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +void log2Cont(); +void logInside(); +void logLow(); +void logHigh(); + +/* + * This diverges when the argument is zero. + */ +Real +log_R(Real x) +{ + Bool xGtEq0, xLtEq2, xGtEqOneHalf, xLtEq2_and_GtEqOneHalf; + Bool xLtEqOverOneHalf_and_GtEq0; + Real in, low, high, ltZero; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(logInside, "logInside", 2); + registerForceFunc(logLow, "logLow", 2); + registerForceFunc(logHigh, "logHigh", 2); + registerForceFunc(log2Cont, "log2Cont", 3); + doneInit++; + } + + xGtEq0 = gtEq_R_0(x); + xLtEq2 = ltEq_R_QInt(x, 2, 1); + xGtEqOneHalf = gtEq_R_QInt(x, 1, 2); + xLtEq2_and_GtEqOneHalf = and_B_B(xLtEq2, xGtEqOneHalf); + xLtEqOverOneHalf_and_GtEq0 = and_B_B(ltEq_R_QInt(x, 1001, 2000), xGtEq0); + + in = (Real) allocCls(logInside, (void *) x); + in->cls.tag.isSigned = TRUE; + low = (Real) allocCls(logLow, (void *) x); + low->cls.tag.isSigned = TRUE; + high = (Real) allocCls(logHigh, (void *) x); + high->cls.tag.isSigned = TRUE; + ltZero = realError("(log_R x) and x < 0"); + + return realIf(4, + xLtEq2_and_GtEqOneHalf, in, + gtEq_R_QInt(x, 1999, 1000), high, + xLtEqOverOneHalf_and_GtEq0, low, + not_B(xGtEq0), ltZero); +} + +static TenXY *nextTensor(Real, Real, int); + +void +logInside() +{ + Cls *cls, *newCls; + ClsData *data; + Real x; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "logInside", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 1, 0, 1, 1, -1, 1, -1, 0); + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +void +logHigh() +{ + Cls *cls, *newCls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = div_R_Int(x, 2); + w = log_R(w); + newCls = allocCls(log2Cont, (void *) 0); + newCls->tag.isSigned = FALSE; + w = add_R_R(w, (Real) newCls); + w->tenXY.forceY = log2Cont; /* see the note below */ + + /* now guard tensor to prevent it being copied */ + cls->redirect = (Real) allocSignX(w, SIGN_UNKN); +} + +void +logLow() +{ + Cls *cls, *newCls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = mul_R_Int(x, 2); + w = log_R(w); + newCls = allocCls(log2Cont, (void *) 0); + newCls->tag.isSigned = FALSE; + w = sub_R_R(w, (Real) newCls); + w->tenXY.forceY = log2Cont; /* see the note below */ + + /* now guard tensor to prevent it being copied */ + cls->redirect = (Real) allocSignX(w, SIGN_UNKN); +} + +/* + * This closure works a little different from most. Most simply create + * an lft and set the redirect field of the closure to point to the new + * heap object. In this case, we can do a bit better. This continuation + * represents (log 2). One option would be to follow the usual strategy + * and to arrange for (log 2) to be shared whenever possible. However, + * we know that this is used internally to log_R only and only in + * those circumstances when the argument falls outside the working range + * of the log tensor chain. Moreover, we know that the consumer of this + * real is either an addition or substraction tensor. Whatever it is, + * it is certain to be a tensor. The other argument of the tensor will + * reduce at most to a matrix and hence the tensor itself will never + * reduce. + * + * This property allows us to adopt a different strategy. Rather than create + * the next matrix in the (log 2) chain, we put the matrix directly into + * the consuming tensor. This avoids creating garbage in the stack and + * avoids a separate reduction step. + * + * There is a slighlt better scheme than this. Rather than plunk in + * each successive + * matrix into the tensor (each providing 4 digits), it would be better + * to accumulate a sequence of matrices (up to the capacity of a small matrix) + * and then plunk it into the tensor. This would avoid using bignum stuff until + * it becomes necessary. Perhaps I'll do this later. + * + * For this it is useful to bear in mind that when a sequence of matrices + * starts from n = 0, then the largest entry is always d. When the sequence + * starts with n > 0, then the largest entry is c. To decide if there + * is going to be an overflow, it suffices to check if c (for example) + * will overflow. + */ +static void nextMatrix(Tensor, int); + +void +log2Cont() +{ + TenXY *tenXY; + Cls *cls; + int digitsNeeded; + int n; + + tenXY = (TenXY *) POP; + digitsNeeded = POP; + cls = (Cls *) tenXY->y; + + n = (int) cls->userData; + + while (digitsNeeded > 0) { + nextMatrix(tenXY->ten, n); + if (n == 0) + digitsNeeded -= 2; + else + digitsNeeded -= 4; + n += 1; + } + cls->userData = (void *) n; +} + +/* + * We set a rather arbitrary (but large) limit on the value of n + * for log 2. On a 32 bit machine it is 536,870,911. + * Larger than this and the matrix entries are no longer small. + */ +static void +nextMatrix(Tensor ten, int n) +{ + SmallMatrix smallMat; + + if (n == 0) { + smallMat[0][0] = 1; + smallMat[0][1] = 1; + smallMat[1][0] = 1; + smallMat[1][1] = 2; + } + else { + if (n <= (MAXINT - 2) / 4) { + smallMat[0][0] = 3 * n + 1; + smallMat[0][1] = 2 * n + 1; + smallMat[1][0] = 4 * n + 2; + smallMat[1][1] = 3 * n + 2; + } + else + Error(FATAL, E_INT, "nextMatrix (log2)", + "n > %d", (MAXINT - 2) / 4); + } + multVectorPairTimesSmallMatrix(ten[0], ten[1], smallMat); + multVectorPairTimesSmallMatrix(ten[2], ten[3], smallMat); + normalizeTensor(ten); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, n, 0, 2*n+1, n+1, n+1, 2*n+1, 0, n); +} diff --git a/ic-reals-6.3/math-lib/math-lib.h b/ic-reals-6.3/math-lib/math-lib.h new file mode 100644 index 0000000..51c25be --- /dev/null +++ b/ic-reals-6.3/math-lib/math-lib.h @@ -0,0 +1,18 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +/* + * This is the structure holding the closure data for those functions + * which use the standard tensor continuation. + */ + +typedef struct { + int n; + Real x; + TenXY *(*nextTensor)(Real, Real, int); +} ClsData; diff --git a/ic-reals-6.3/math-lib/neg_R.c b/ic-reals-6.3/math-lib/neg_R.c new file mode 100644 index 0000000..3ae644c --- /dev/null +++ b/ic-reals-6.3/math-lib/neg_R.c @@ -0,0 +1,16 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +neg_R(Real x) +{ + return mul_R_Int(x, -1); +} diff --git a/ic-reals-6.3/math-lib/pi.c b/ic-reals-6.3/math-lib/pi.c new file mode 100644 index 0000000..15c32d2 --- /dev/null +++ b/ic-reals-6.3/math-lib/pi.c @@ -0,0 +1,151 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +static mpz_t k; + +Real Pi; + +static void piCont(); +static void nextMatrix(Tensor, int); + +void +initPi() +{ + Real sq, cls; + DigsX *digsX; + TenXY *tenXY; + static int doneInit; + void force_To_DigsX_From_TenXY_Entry(); + + if (!doneInit) { + registerForceFunc(piCont, "piCont", 2); + doneInit++; + } + + mpz_init_set_str(k, "10939058860032000", 10); + + sq = sqrt_QInt(10005, 1); + cls = (Real) allocCls(piCont, (void *) 0); + cls->gen.tag.isSigned = FALSE; + + tenXY = (TenXY *) div_R_R(sq, cls); + tenXY->forceY = piCont; + + digsX = allocDigsX(); + digsX->x = (Real) tenXY; + digsX->force = force_To_DigsX_From_TenXY_Entry; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, tenXY); + endGraphUpdate(); +#endif + + Pi = (Real) digsX; +} + +/* + * It might be possible compute the next matrix in the sequence + * in terms of the previous matrix. This would mean having much more + * state but presumably much quicker. + */ +static void +piCont() +{ + TenXY *tenXY; + Cls *cls; + int digitsNeeded; + int n; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + cls = (Cls *) tenXY->y; + n = (int) cls->userData; + + /* + * The two constants below have been determined empirically. The second + * may be off by one (ie 47) in some circumstances. + */ + while (digitsNeeded > 0) { + nextMatrix(tenXY->ten, n); + if (n == 0) + digitsNeeded -= 27; + else + digitsNeeded -= 46; + n +=1; + } + cls->userData = (void *) n; +} + +static void +nextMatrix(Tensor ten, int n) +{ + SmallMatrix smallMat; + + if (n == 0) { + smallMat[0][0] = 6795705; + smallMat[0][1] = 213440; + smallMat[1][0] = 6795704; + smallMat[1][1] = 213440; + multVectorPairTimesSmallMatrix(ten[0], ten[1], smallMat); + multVectorPairTimesSmallMatrix(ten[2], ten[3], smallMat); + } + else { + /* b = 2n - 1 */ + mpz_set_ui(tmpb_z, n); + mpz_mul_2exp(tmpb_z, tmpb_z, 1); + mpz_sub_ui(tmpb_z, tmpb_z, 1); + + /* tmp = 6n - 5, tmpf_z = 6n */ + mpz_set_ui(tmpa_z, n); + mpz_mul_ui(tmpa_z, tmpa_z, 6); + mpz_set(tmpf_z, tmpa_z); + mpz_sub_ui(tmpa_z, tmpa_z, 5); + + /* tmpf_z = 6n - 1 */ + mpz_sub_ui(tmpf_z, tmpf_z, 1); + + /* b = (2n - 1) * (6n - 5) * (6n - 1) */ + mpz_mul(tmpb_z, tmpb_z, tmpa_z); + mpz_mul(tmpb_z, tmpb_z, tmpf_z); + + /* c = b*(545140134n + 13591409) */ + mpz_set_ui(tmpa_z, 545140134); + mpz_mul_ui(tmpa_z, tmpa_z, n); + mpz_add_ui(tmpa_z, tmpa_z, 13591409); + mpz_mul(tmpc_z, tmpb_z, tmpa_z); + + /* d = b * (n + 1) */ + mpz_set_ui(tmpd_z, n + 1); + mpz_mul(tmpd_z, tmpd_z, tmpb_z); + + /* e = 10939058860032000*n^4 */ + mpz_set_ui(tmpe_z, n); + mpz_mul(tmpe_z, tmpe_z, tmpe_z); + mpz_mul(tmpe_z, tmpe_z, tmpe_z); + mpz_mul(tmpe_z, tmpe_z, k); + + mpz_sub(bigTmpMat[0][0], tmpe_z, tmpd_z); + mpz_set(bigTmpMat[1][1], bigTmpMat[0][0]); + mpz_add(bigTmpMat[0][1], tmpe_z, tmpd_z); + mpz_set(bigTmpMat[1][0], bigTmpMat[0][1]); + + mpz_sub(bigTmpMat[0][0], bigTmpMat[0][0], tmpc_z); + mpz_add(bigTmpMat[0][1], bigTmpMat[0][1], tmpc_z); + mpz_sub(bigTmpMat[1][0], bigTmpMat[1][0], tmpc_z); + mpz_add(bigTmpMat[1][1], bigTmpMat[1][1], tmpc_z); + + multVectorPairTimesMatrix(ten[0], ten[1], bigTmpMat); + multVectorPairTimesMatrix(ten[2], ten[3], bigTmpMat); + } +} diff --git a/ic-reals-6.3/math-lib/pi.c~ b/ic-reals-6.3/math-lib/pi.c~ new file mode 100644 index 0000000..a95eef5 --- /dev/null +++ b/ic-reals-6.3/math-lib/pi.c~ @@ -0,0 +1,151 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +static mpz_t k; + +Real Pi; + +static void piCont(); +static void nextMatrix(Tensor, int); + +void +initPi() +{ + Real sq, cls; + DigsX *digsX; + TenXY *tenXY; + static int doneInit; + void force_To_DigsX_From_TenXY_Entry(); + + if (!doneInit) { + registerForceFunc(piCont, "piCont", 2); + doneInit++; + } + + mpz_init_set_str(k, "10939058860032000", 10); + + sq = sqrt_QInt(10005, 1); + cls = (Real) allocCls(piCont, (void *) 0); + cls->gen.tag.isSigned = FALSE; + + tenXY = (TenXY *) div_R_R(sq, cls); + tenXY->forceY = piCont; + + digsX = allocDigsX(); + digsX->x = (Real) tenXY; + digsX->force = force_To_DigsX_From_TenXY_Entry; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, tenXY); + endGraphUpdate(); + } + + Pi = (Real) digsX; +} + +/* + * It might be possible compute the next matrix in the sequence + * in terms of the previous matrix. This would mean having much more + * state but presumably much quicker. + */ +static void +piCont() +{ + TenXY *tenXY; + Cls *cls; + int digitsNeeded; + int n; + + tenXY = (TenXY *) POP; + digitsNeeded = (int) POP; + + cls = (Cls *) tenXY->y; + n = (int) cls->userData; + + /* + * The two constants below have been determined empirically. The second + * may be off by one (ie 47) in some circumstances. + */ + while (digitsNeeded > 0) { + nextMatrix(tenXY->ten, n); + if (n == 0) + digitsNeeded -= 27; + else + digitsNeeded -= 46; + n +=1; + } + cls->userData = (void *) n; +} + +static void +nextMatrix(Tensor ten, int n) +{ + SmallMatrix smallMat; + + if (n == 0) { + smallMat[0][0] = 6795705; + smallMat[0][1] = 213440; + smallMat[1][0] = 6795704; + smallMat[1][1] = 213440; + multVectorPairTimesSmallMatrix(ten[0], ten[1], smallMat); + multVectorPairTimesSmallMatrix(ten[2], ten[3], smallMat); + } + else { + /* b = 2n - 1 */ + mpz_set_ui(tmpb_z, n); + mpz_mul_2exp(tmpb_z, tmpb_z, 1); + mpz_sub_ui(tmpb_z, tmpb_z, 1); + + /* tmp = 6n - 5, tmpf_z = 6n */ + mpz_set_ui(tmpa_z, n); + mpz_mul_ui(tmpa_z, tmpa_z, 6); + mpz_set(tmpf_z, tmpa_z); + mpz_sub_ui(tmpa_z, tmpa_z, 5); + + /* tmpf_z = 6n - 1 */ + mpz_sub_ui(tmpf_z, tmpf_z, 1); + + /* b = (2n - 1) * (6n - 5) * (6n - 1) */ + mpz_mul(tmpb_z, tmpb_z, tmpa_z); + mpz_mul(tmpb_z, tmpb_z, tmpf_z); + + /* c = b*(545140134n + 13591409) */ + mpz_set_ui(tmpa_z, 545140134); + mpz_mul_ui(tmpa_z, tmpa_z, n); + mpz_add_ui(tmpa_z, tmpa_z, 13591409); + mpz_mul(tmpc_z, tmpb_z, tmpa_z); + + /* d = b * (n + 1) */ + mpz_set_ui(tmpd_z, n + 1); + mpz_mul(tmpd_z, tmpd_z, tmpb_z); + + /* e = 10939058860032000*n^4 */ + mpz_set_ui(tmpe_z, n); + mpz_mul(tmpe_z, tmpe_z, tmpe_z); + mpz_mul(tmpe_z, tmpe_z, tmpe_z); + mpz_mul(tmpe_z, tmpe_z, k); + + mpz_sub(bigTmpMat[0][0], tmpe_z, tmpd_z); + mpz_set(bigTmpMat[1][1], bigTmpMat[0][0]); + mpz_add(bigTmpMat[0][1], tmpe_z, tmpd_z); + mpz_set(bigTmpMat[1][0], bigTmpMat[0][1]); + + mpz_sub(bigTmpMat[0][0], bigTmpMat[0][0], tmpc_z); + mpz_add(bigTmpMat[0][1], bigTmpMat[0][1], tmpc_z); + mpz_sub(bigTmpMat[1][0], bigTmpMat[1][0], tmpc_z); + mpz_add(bigTmpMat[1][1], bigTmpMat[1][1], tmpc_z); + + multVectorPairTimesMatrix(ten[0], ten[1], bigTmpMat); + multVectorPairTimesMatrix(ten[2], ten[3], bigTmpMat); + } +} diff --git a/ic-reals-6.3/math-lib/pow_R_R.c b/ic-reals-6.3/math-lib/pow_R_R.c new file mode 100644 index 0000000..9da7446 --- /dev/null +++ b/ic-reals-6.3/math-lib/pow_R_R.c @@ -0,0 +1,20 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +pow_R_R(Real x, Real y) +{ + Real r; + + r = log_R(x); + r = mul_R_R(y, r); + return exp_R(r); +} diff --git a/ic-reals-6.3/math-lib/secant.c b/ic-reals-6.3/math-lib/secant.c new file mode 100644 index 0000000..7261546 --- /dev/null +++ b/ic-reals-6.3/math-lib/secant.c @@ -0,0 +1,98 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These functions should probably be broken into separate files. + */ + +/* + * sec x = 1 / (cos x) + */ +Real +sec_R(Real x) +{ + return div_Int_R(1, cos_R(x)); +} + +Real +sec_QInt(int a, int b) +{ + return div_Int_R(1, cos_QInt(a, b)); +} + +Real +sec_QZ(mpz_t a, mpz_t b) +{ + return div_Int_R(1, cos_QZ(a, b)); +} + +/* + * asec x = acos (1/x) + */ +Real +asec_R(Real x) +{ + return acos_R(div_Int_R(1, x)); +} + +Real +asec_QInt(int a, int b) +{ + return acos_QInt(b, a); +} + +Real +asec_QZ(mpz_t a, mpz_t b) +{ + return acos_QZ(b, a); +} + +/* + * sech x = 1 / (cosh x) + */ +Real +sech_R(Real x) +{ + return div_Int_R(1, cosh_R(x)); +} + +Real +sech_QInt(int a, int b) +{ + return div_Int_R(1, cosh_QInt(a, b)); +} + +Real +sech_QZ(mpz_t a, mpz_t b) +{ + return div_Int_R(1, cosh_QZ(a, b)); +} + +/* + * asech x = acosh (1/x) + */ +Real +asech_R(Real x) +{ + return acosh_R(div_Int_R(1, x)); +} + +Real +asech_QInt(int a, int b) +{ + return acosh_QInt(b, a); +} + +Real +asech_QZ(mpz_t a, mpz_t b) +{ + return acosh_QZ(b, a); +} diff --git a/ic-reals-6.3/math-lib/sin_Q.c b/ic-reals-6.3/math-lib/sin_Q.c new file mode 100644 index 0000000..3e40ee7 --- /dev/null +++ b/ic-reals-6.3/math-lib/sin_Q.c @@ -0,0 +1,46 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +sin_QZ(mpz_t a, mpz_t b) +{ + mpz_t x; + Real r; + + mpz_init(x); + mpz_mul_ui(x, b, 2); + r = tan_QZ(a, x); + mpz_clear(x); + r = tensor_Int(r, r, 0, 1, 1, 0, 1, 0, 0, 1); + return r; +} + +Real +sin_QInt(int a, int b) +{ + Real r; + mpz_t ap, bp; + + /* check for overflow */ + if ((unsigned int)b > 0x3FFFFFFF || (unsigned int)b < 0xC0000000) { + mpz_init_set_si(ap, a); + mpz_init_set_si(bp, b); + mpz_mul_ui(bp, bp, 2); + r = tan_QZ(ap, bp); + mpz_clear(ap); + mpz_clear(bp); + } + else + r = tan_QInt(a, b * 2); + + r = tensor_Int(r, r, 0, 1, 1, 0, 1, 0, 0, 1); + return r; +} diff --git a/ic-reals-6.3/math-lib/sin_Q.c~ b/ic-reals-6.3/math-lib/sin_Q.c~ new file mode 100644 index 0000000..171c641 --- /dev/null +++ b/ic-reals-6.3/math-lib/sin_Q.c~ @@ -0,0 +1,46 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +sin_QZ(mpz_t a, mpz_t b) +{ + mpz_t x; + Real r; + + mpz_init(x); + mpz_mul_ui(x, b, 2); + r = tan_QZ(a, x); + mpz_clear(x); + r = tensor_Int(r, r, 0, 1, 1, 0, 1, 0, 0, 1); + return r; +} + +Real +sin_QInt(int a, int b) +{ + Real r; + mpz_t ap, bp; + + /* check for overflow */ + if (b > 0x3FFFFFFF || b < 0xC0000000) { + mpz_init_set_si(ap, a); + mpz_init_set_si(bp, b); + mpz_mul_ui(bp, bp, 2); + r = tan_QZ(ap, bp); + mpz_clear(ap); + mpz_clear(bp); + } + else + r = tan_QInt(a, b * 2); + + r = tensor_Int(r, r, 0, 1, 1, 0, 1, 0, 0, 1); + return r; +} diff --git a/ic-reals-6.3/math-lib/sin_R.c b/ic-reals-6.3/math-lib/sin_R.c new file mode 100644 index 0000000..6b68c6d --- /dev/null +++ b/ic-reals-6.3/math-lib/sin_R.c @@ -0,0 +1,21 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +sin_R(Real x) +{ + Real r; + + r = div_R_Int(x, 2); + r = tan_R(r); + r = tensor_Int(r, r, 0, 1, 1, 0, 1, 0, 0, 1); + return r; +} diff --git a/ic-reals-6.3/math-lib/sinh_Q.c b/ic-reals-6.3/math-lib/sinh_Q.c new file mode 100644 index 0000000..3870b80 --- /dev/null +++ b/ic-reals-6.3/math-lib/sinh_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +sinh_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return sinh_R(r); +} + +Real +sinh_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return sinh_R(r); +} diff --git a/ic-reals-6.3/math-lib/sinh_R.c b/ic-reals-6.3/math-lib/sinh_R.c new file mode 100644 index 0000000..c5198f1 --- /dev/null +++ b/ic-reals-6.3/math-lib/sinh_R.c @@ -0,0 +1,19 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +sinh_R(Real x) +{ + Real r; + + r = exp_R(x); + return tensor_Int(r, r, 1, 0, 0, 1, 0, 1, -1, 0); +} diff --git a/ic-reals-6.3/math-lib/sqrt_Q.c b/ic-reals-6.3/math-lib/sqrt_Q.c new file mode 100644 index 0000000..688e146 --- /dev/null +++ b/ic-reals-6.3/math-lib/sqrt_Q.c @@ -0,0 +1,140 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * It would be better to use a union of three int's and three mpz_t's and + * then go to the bignumns when we overflow a machine word. + */ +typedef struct { + mpz_t a, b, c; +} RatSqrtData; + +static int doneInit = 0; + +static void ratSqrtCont(); +static bool emitDigitFromRatSqrt(RatSqrtData *, Digit *); + +Real +sqrt_QInt(int a, int b) +{ + RatSqrtData *rsd; + Cls *cls; + DigsX *digsX; + + if (!doneInit) { + registerForceFunc(ratSqrtCont, "ratSqrtCont", 3); + doneInit++; + } + + if ((rsd = (RatSqrtData *) malloc(sizeof(RatSqrtData))) == NULL) + Error(FATAL, E_INT, "sqrt_QInt", "malloc failed"); + + mpz_init_set_ui(rsd->a, a); + mpz_init_set_ui(rsd->b, b); + mpz_init_set_ui(rsd->c, a - b); + + cls = allocCls(ratSqrtCont, (void *) rsd); + cls->tag.isSigned = FALSE; + + digsX = allocDigsX(); + digsX->x = (Real) cls; + digsX->force = ratSqrtCont; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, cls); + endGraphUpdate(); +#endif + + return (Real) digsX; +} + +Real +sqrt_QZ(mpz_t a, mpz_t b) +{ + RatSqrtData *rsd; + Cls *cls; + DigsX *digsX; + + if (!doneInit) { + registerForceFunc(ratSqrtCont, "ratSqrtCont", 3); + doneInit++; + } + + if ((rsd = (RatSqrtData *) malloc(sizeof(RatSqrtData))) == NULL) + Error(FATAL, E_INT, "sqrt_QZ", "malloc failed"); + + mpz_init_set(rsd->a, a); + mpz_init_set(rsd->b, b); + mpz_init(rsd->c); + mpz_sub(rsd->c, rsd->a, rsd->b); + + cls = allocCls(ratSqrtCont, (void *) rsd); + cls->tag.isSigned = FALSE; + + digsX = allocDigsX(); + digsX->x = (Real) cls; + digsX->force = ratSqrtCont; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, cls); + endGraphUpdate(); +#endif + + return (Real) digsX; +} + +static void +ratSqrtCont() +{ + DigsX *digsX; + Cls *cls; + int digitsNeeded; + RatSqrtData *rsd; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) digsX->x; + + rsd = (RatSqrtData *) cls->userData; + + emitDigits(digsX, (edf) emitDigitFromRatSqrt, (void *) rsd, digitsNeeded); + newDigsX(digsX); +} + +static bool +emitDigitFromRatSqrt(RatSqrtData *rsd, Digit *d) +{ + mpz_sub(tmpd_z, rsd->b, rsd->a); + mpz_mul_2exp(tmpd_z, tmpd_z, 1); + mpz_add(tmpd_z, tmpd_z, rsd->c); + + switch (mpz_sgn(tmpd_z)) { + case 0 : + case 1 : + *d = DNEG; + mpz_mul_2exp(rsd->a, rsd->a, 2); /* a = 4a */ + mpz_set(rsd->b, tmpd_z); + break; + case -1 : + *d = DPOS; + mpz_neg(rsd->a, tmpd_z); + mpz_mul_2exp(rsd->b, rsd->b, 2); /* b = 4b */ + break; + default : + Error(FATAL, E_INT, "emitDigitFromRatSqrt", + "bad value returned by mpz_sgn"); + break; + } + return TRUE; +} diff --git a/ic-reals-6.3/math-lib/sqrt_Q.c~ b/ic-reals-6.3/math-lib/sqrt_Q.c~ new file mode 100644 index 0000000..0a59773 --- /dev/null +++ b/ic-reals-6.3/math-lib/sqrt_Q.c~ @@ -0,0 +1,140 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +/* + * It would be better to use a union of three int's and three mpz_t's and + * then go to the bignumns when we overflow a machine word. + */ +typedef struct { + mpz_t a, b, c; +} RatSqrtData; + +static int doneInit = 0; + +static void ratSqrtCont(); +static bool emitDigitFromRatSqrt(RatSqrtData *, Digit *); + +Real +sqrt_QInt(int a, int b) +{ + RatSqrtData *rsd; + Cls *cls; + DigsX *digsX; + + if (!doneInit) { + registerForceFunc(ratSqrtCont, "ratSqrtCont", 3); + doneInit++; + } + + if ((rsd = (RatSqrtData *) malloc(sizeof(RatSqrtData))) == NULL) + Error(FATAL, E_INT, "sqrt_QInt", "malloc failed"); + + mpz_init_set_ui(rsd->a, a); + mpz_init_set_ui(rsd->b, b); + mpz_init_set_ui(rsd->c, a - b); + + cls = allocCls(ratSqrtCont, (void *) rsd); + cls->tag.isSigned = FALSE; + + digsX = allocDigsX(); + digsX->x = (Real) cls; + digsX->force = ratSqrtCont; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, cls); + endGraphUpdate(); + } + + return (Real) digsX; +} + +Real +sqrt_QZ(mpz_t a, mpz_t b) +{ + RatSqrtData *rsd; + Cls *cls; + DigsX *digsX; + + if (!doneInit) { + registerForceFunc(ratSqrtCont, "ratSqrtCont", 3); + doneInit++; + } + + if ((rsd = (RatSqrtData *) malloc(sizeof(RatSqrtData))) == NULL) + Error(FATAL, E_INT, "sqrt_QZ", "malloc failed"); + + mpz_init_set(rsd->a, a); + mpz_init_set(rsd->b, b); + mpz_init(rsd->c); + mpz_sub(rsd->c, rsd->a, rsd->b); + + cls = allocCls(ratSqrtCont, (void *) rsd); + cls->tag.isSigned = FALSE; + + digsX = allocDigsX(); + digsX->x = (Real) cls; + digsX->force = ratSqrtCont; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, cls); + endGraphUpdate(); + } + + return (Real) digsX; +} + +static void +ratSqrtCont() +{ + DigsX *digsX; + Cls *cls; + int digitsNeeded; + RatSqrtData *rsd; + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + cls = (Cls *) digsX->x; + + rsd = (RatSqrtData *) cls->userData; + + emitDigits(digsX, (edf) emitDigitFromRatSqrt, (void *) rsd, digitsNeeded); + newDigsX(digsX); +} + +static bool +emitDigitFromRatSqrt(RatSqrtData *rsd, Digit *d) +{ + mpz_sub(tmpd_z, rsd->b, rsd->a); + mpz_mul_2exp(tmpd_z, tmpd_z, 1); + mpz_add(tmpd_z, tmpd_z, rsd->c); + + switch (mpz_sgn(tmpd_z)) { + case 0 : + case 1 : + *d = DNEG; + mpz_mul_2exp(rsd->a, rsd->a, 2); /* a = 4a */ + mpz_set(rsd->b, tmpd_z); + break; + case -1 : + *d = DPOS; + mpz_neg(rsd->a, tmpd_z); + mpz_mul_2exp(rsd->b, rsd->b, 2); /* b = 4b */ + break; + default : + Error(FATAL, E_INT, "emitDigitFromRatSqrt", + "bad value returned by mpz_sgn"); + break; + } + return TRUE; +} diff --git a/ic-reals-6.3/math-lib/sqrt_R.c b/ic-reals-6.3/math-lib/sqrt_R.c new file mode 100644 index 0000000..3333949 --- /dev/null +++ b/ic-reals-6.3/math-lib/sqrt_R.c @@ -0,0 +1,469 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +Real +sqrt_R(Real x) +{ + Bool xLtEq4, xGtEqOneFifth; + Cls *in, *gtEq3, *ltEqOneQuarter; + Real lt0; + void force_To_DigsX_From_Sqrt_TenXY_Entry(); + void sqrtInside(); + void sqrtGtEq3(); + void sqrtLtEqOneQuarter(); + void sqrtLtEqOneQuarterCont(); + void force_To_DigsX_From_Sqrt_TenXY_Entry(); + void force_To_DigsX_From_Sqrt_TenXY_Cont(); + void force_To_DigsX_From_Sqrt_MatX_Entry(); + void force_To_DigsX_From_Sqrt_MatX_Cont(); + void force_To_DigsX_From_Sqrt_Reduce(); + void force_To_MatX_Until_Refining(); + static int doneInit = 0; + Real sqrt_QZ(mpz_t, mpz_t); + + if (!doneInit) { + registerForceFunc(force_To_DigsX_From_Sqrt_TenXY_Entry, + "force_To_DigsX_From_Sqrt_TenXY_Entry", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_TenXY_Cont, + "force_To_DigsX_From_Sqrt_TenXY_Cont", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_MatX_Entry, + "force_To_DigsX_From_Sqrt_MatX_Entry", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_MatX_Cont, + "force_To_DigsX_From_Sqrt_MatX_Cont", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_Reduce, + "force_To_DigsX_From_Sqrt_Reduce", 2); + registerForceFunc(force_To_MatX_Until_Refining, + "force_To_MatX_Until_Refining", 2); + registerForceFunc(sqrtInside, "sqrtInside", 2); + registerForceFunc(sqrtGtEq3, "sqrtGtEq3", 2); + registerForceFunc(sqrtLtEqOneQuarter, "sqrtLtEqOneQuarter", 2); + registerForceFunc(sqrtLtEqOneQuarterCont, "sqrtLtEqOneQuarterCont", 2); + doneInit++; + } + + if (x->gen.tag.type == VECTOR) + return sqrt_QZ(x->vec.vec[0], x->vec.vec[1]); + + xLtEq4 = ltEq_R_QInt(x, 4, 1); + xGtEqOneFifth = gtEq_R_QInt(x, 1, 5); + + in = allocCls(sqrtInside, (void *) x); + in->tag.isSigned = FALSE; + + gtEq3 = allocCls(sqrtGtEq3, (void *) x); + gtEq3->tag.isSigned = FALSE; + + ltEqOneQuarter = allocCls(sqrtLtEqOneQuarter, (void *) x); + ltEqOneQuarter->tag.isSigned = FALSE; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(in, x); + newEdgeToOnlyChild(gtEq3, x); + newEdgeToOnlyChild(ltEqOneQuarter, x); + endGraphUpdate(); +#endif + + lt0 = realError("(sqrt_R x) and x < 0"); + + /* + * The order of the tests in the realAlt is not semantically + * significant. Note that the sqrt_R is always unsigned since + * each case is unsigned. + */ + return realIf(4, + and_B_B(xLtEq4, xGtEqOneFifth), (Real) in, + gtEq_R_QInt(x, 3, 1), (Real) gtEq3, + and_B_B(ltEq_R_QInt(x, 1, 4), gtEq_R_0(x)), (Real) ltEqOneQuarter, + lt_R_0(x), lt0); +} + +void +sqrtInside() +{ + Cls *cls; + TenXY *tenXY; + DigsX *digsX; + void force_To_TenXY_X_Until_Refining(); + void force_To_DigsX_From_Sqrt_TenXY_Entry(); + Real x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + digsX = allocDigsX(); + digsX->force = force_To_DigsX_From_Sqrt_TenXY_Entry; + + tenXY = (TenXY *) tensor_Int(x, (Real) digsX, 1, 0, 2, 1, 1, 2, 0, 1); + tenXY->tag.isSigned = FALSE; + + digsX->x = (Real) tenXY; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, tenXY); + endGraphUpdate(); +#endif + + /* + * We must still absorb the sign (if any) and enough information + * to ensure the tensor is refining. Note that, if we get to + * this point, then we know the argument is within the interval + * 1/5 >= x <= 4. I claim that the n'th tensor for n >= 2 + * can always be made refining by absorbing + * information from the left. + */ + PUSH_2(force_To_TenXY_X_Until_Refining, tenXY); + + if (tenXY->x->gen.tag.isSigned) + PUSH_2(tenXY->forceX, tenXY); + + cls->redirect = (Real) digsX; + cls->userData = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +void +sqrtGtEq3() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = div_R_Int(x, 4); + w = sqrt_R(w); + cls->redirect = mul_R_Int(w, 2); + cls->userData = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +void +sqrtLtEqOneQuarter() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = mul_R_Int(x, 4); + w = sqrt_R(w); + cls->redirect = div_R_Int(w, 2); + cls->userData = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +#ifdef LATER +void +sqrtLtEqOneQuarter() +{ + Cls *cls, *newCls; + void sqrtLtEqOneQuarterCont(); + Real x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + newCls = allocCls(sqrtLtEqOneQuarterCont, (void *) x); + newCls->tag.isSigned = FALSE; + cls->redirect = matrix_Int((Real) newCls, 0, 1, 1, 2); + cls->userData = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} +#endif + +void +sqrtLtEqOneQuarterCont() +{ + Cls *cls; + Real w, x; + void force_To_MatX_Until_Refining(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + /* w = matrix_Int(x, 0, 1, 1, 0); reciprocal of x */ + w = mul_R_Int(x, 4); + w = sqrt_R(w); + /* cls->redirect = matrix_Int(w, 1, 0, -2, 1); */ + cls->redirect = w; + cls->redirect->gen.tag.isSigned = FALSE; + cls->userData = NULL; + +#ifdef DAVINCI + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif + + PUSH_2(force_To_MatX_Until_Refining, cls->redirect); +} + +void +force_To_DigsX_From_Sqrt_TenXY_Entry() +{ + DigsX *digsX; + int digitsNeeded; + void force_To_DigsX_From_Sqrt_TenXY_Cont(); + void force_To_DigsX_From_DigsX_Entry(); + void force_To_DigsX_From_Sqrt_Reduce(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + + /* + * The current strategy is that when forced, we create a list + * of DigsX structures rather than a single struct with the + * requested number of digits. So, after we are done emitting, + * we arrange to reduce the list at the end. + * + * A better strategy would be to allocate two DigsX structures at the + * very start. The second one would be private and only visible to the sqrt + * closure. Then the cycle would be: + * emit from tensor into DigsX-2 + * absorb DigsX-2 digits into tensor + * absorb DigsX-2 digits into DigsX-1 + * clear DigsX-2 of all digits. + * + * This would avoid allocating a chain of DigsX structures and the + * need for reducing at the end. + PUSH_3(force_To_DigsX_From_DigsX_Entry, digsX, digitsNeeded); + */ + PUSH_2(force_To_DigsX_From_Sqrt_Reduce, digsX); + PUSH_3(force_To_DigsX_From_Sqrt_TenXY_Cont, digsX, digitsNeeded); +} + +void +force_To_DigsX_From_Sqrt_TenXY_Cont() +{ + DigsX *digsX; + TenXY *tenXY; + int digitsNeeded = 0; + int nX; + int digitsEmitted; + int epsDelTensorX(Tensor, int); + bool emitDigitFromTensor(Tensor, Digit *); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + tenXY = (TenXY *) digsX->x; + + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromTensor, + (void *) tenXY->ten, + digitsNeeded); + +#ifdef TRACE + int bitsShifted = 0; + if (digitsEmitted > 0) + bitsShifted = normalizeTensor(tenXY->ten); + + if (TRACE) { + debugp("force_To_DigsX_From_Sqrt_TenXY_Cont", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) tenXY, + digitsEmitted, + bitsShifted); + } +#endif + + digitsNeeded -= digitsEmitted; + + if (digsX->count > 0) + newDigsX(digsX); + + if (digitsNeeded <= 0) + return; + + /* + * So now we emitted what we can but still need more. First arrange + * to come back and try to emit again after forcing the necessary + * number of digits from the the argument. + */ + if (digsX->count > 0) + PUSH_3(force_To_DigsX_From_Sqrt_TenXY_Cont, digsX->x, digitsNeeded); + else + PUSH_3(force_To_DigsX_From_Sqrt_TenXY_Cont, digsX, digitsNeeded); + + /* + * Now absorb everything emitted into the tensor. + */ + absorbDigsXIntoTenXY_Y(tenXY); + + nX = epsDelTensorX(tenXY->ten, digitsNeeded); +#ifdef TRACE + if (TRACE) { + debugp("force_To_DigsX_From_Sqrt_TenXY_Cont", + "%x %x nX=%d\n", + (unsigned) digsX, + (unsigned) tenXY, + nX); + } +#endif + + if (nX > 0) + PUSH_3(tenXY->forceX, tenXY, nX); + else + PUSH_3(tenXY->forceX, tenXY, 1); +} + +void +force_To_DigsX_From_Sqrt_MatX_Entry() +{ + DigsX *digsX; + int digitsNeeded; + void force_To_DigsX_From_Sqrt_MatX_Cont(); + void force_To_DigsX_From_DigsX_Entry(); + void force_To_DigsX_From_Sqrt_Reduce(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + +/* + PUSH_3(force_To_DigsX_From_DigsX_Entry, digsX, digitsNeeded); +*/ + PUSH_2(force_To_DigsX_From_Sqrt_Reduce, digsX); + PUSH_3(force_To_DigsX_From_Sqrt_MatX_Cont, digsX, digitsNeeded); +} + +/* + * This is not used at this stage. This will be used when reduction is + * performed after the tensor is first allocated and when the tensor + * reduces to a matrix. + */ +void +force_To_DigsX_From_Sqrt_MatX_Cont() +{ + DigsX *digsX; + MatX *matX; + int digitsNeeded = 0; + int digitsEmitted; + bool emitDigitFromMatrix(Matrix, Digit *); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + matX = (MatX *) digsX->x; + + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromMatrix, + (void *) matX->mat, + digitsNeeded); + + +#ifdef TRACE + int bitsShifted = 0; + if (digitsEmitted > 0) + bitsShifted = normalizeMatrix(matX->mat); + + if (TRACE) { + debugp("force_To_DigsX_From_Sqrt_MatX_Cont", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) matX, + digitsEmitted, + bitsShifted); + } +#endif + + digitsNeeded -= digitsEmitted; + + if (digsX->count > 0) + newDigsX(digsX); + + if (digitsNeeded <= 0) + return; + + /* + * Now absorb everything emitted into the matrix. + */ + absorbDigsXIntoMatX(matX); + + /* + * So now we emitted what we can but still need more. First arrange + * to come back and try to emit again after forcing the necessary + * number of digits from the the argument. + */ + if (digsX->count > 0) + PUSH_3(force_To_DigsX_From_Sqrt_MatX_Cont, digsX->x, digitsNeeded); + else + PUSH_3(force_To_DigsX_From_Sqrt_MatX_Cont, digsX, digitsNeeded); +} + +/* + * In some cases when we generate a matrix which is not refining, but + * where we no that the argument of the matrix is constrained in such a + * way that after a finite amount of absorption, it will become refining. + * What we do is force information from the argument until the matrix is + * refining. + */ +void +force_To_MatX_Until_Refining() +{ + MatX *matX; + int sgn; + + matX = (MatX *) POP; + + if (matX->tag.type != MATX) + return; + + sgn = matrixSign(matX->mat); + + if (sgn > 0) /* matrix is refining and entries positive */ + return; + + if (sgn < 0) { /* matrix is refining and entries negative */ + negateMatrix(matX->mat); + return; + } + + PUSH_2(force_To_MatX_Until_Refining, matX); + PUSH_3(matX->force, matX, 1); +} + +void +force_To_DigsX_From_Sqrt_Reduce() +{ + DigsX *digsX; + + digsX = (DigsX *) POP; + reduceDigsXList(digsX); +} diff --git a/ic-reals-6.3/math-lib/sqrt_R.c~ b/ic-reals-6.3/math-lib/sqrt_R.c~ new file mode 100644 index 0000000..b4e3b18 --- /dev/null +++ b/ic-reals-6.3/math-lib/sqrt_R.c~ @@ -0,0 +1,466 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +Real +sqrt_R(Real x) +{ + Bool xLtEq4, xGtEqOneFifth; + Cls *in, *gtEq3, *ltEqOneQuarter; + Real lt0; + void force_To_DigsX_From_Sqrt_TenXY_Entry(); + void sqrtInside(); + void sqrtGtEq3(); + void sqrtLtEqOneQuarter(); + void sqrtLtEqOneQuarterCont(); + void force_To_DigsX_From_Sqrt_TenXY_Entry(); + void force_To_DigsX_From_Sqrt_TenXY_Cont(); + void force_To_DigsX_From_Sqrt_MatX_Entry(); + void force_To_DigsX_From_Sqrt_MatX_Cont(); + void force_To_DigsX_From_Sqrt_Reduce(); + void force_To_MatX_Until_Refining(); + static int doneInit = 0; + Real sqrt_QZ(mpz_t, mpz_t); + + if (!doneInit) { + registerForceFunc(force_To_DigsX_From_Sqrt_TenXY_Entry, + "force_To_DigsX_From_Sqrt_TenXY_Entry", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_TenXY_Cont, + "force_To_DigsX_From_Sqrt_TenXY_Cont", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_MatX_Entry, + "force_To_DigsX_From_Sqrt_MatX_Entry", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_MatX_Cont, + "force_To_DigsX_From_Sqrt_MatX_Cont", 3); + registerForceFunc(force_To_DigsX_From_Sqrt_Reduce, + "force_To_DigsX_From_Sqrt_Reduce", 2); + registerForceFunc(force_To_MatX_Until_Refining, + "force_To_MatX_Until_Refining", 2); + registerForceFunc(sqrtInside, "sqrtInside", 2); + registerForceFunc(sqrtGtEq3, "sqrtGtEq3", 2); + registerForceFunc(sqrtLtEqOneQuarter, "sqrtLtEqOneQuarter", 2); + registerForceFunc(sqrtLtEqOneQuarterCont, "sqrtLtEqOneQuarterCont", 2); + doneInit++; + } + + if (x->gen.tag.type == VECTOR) + return sqrt_QZ(x->vec.vec[0], x->vec.vec[1]); + + xLtEq4 = ltEq_R_QInt(x, 4, 1); + xGtEqOneFifth = gtEq_R_QInt(x, 1, 5); + + in = allocCls(sqrtInside, (void *) x); + in->tag.isSigned = FALSE; + + gtEq3 = allocCls(sqrtGtEq3, (void *) x); + gtEq3->tag.isSigned = FALSE; + + ltEqOneQuarter = allocCls(sqrtLtEqOneQuarter, (void *) x); + ltEqOneQuarter->tag.isSigned = FALSE; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(in, x); + newEdgeToOnlyChild(gtEq3, x); + newEdgeToOnlyChild(ltEqOneQuarter, x); + endGraphUpdate(); + } + + lt0 = realError("(sqrt_R x) and x < 0"); + + /* + * The order of the tests in the realAlt is not semantically + * significant. Note that the sqrt_R is always unsigned since + * each case is unsigned. + */ + return realIf(4, + and_B_B(xLtEq4, xGtEqOneFifth), (Real) in, + gtEq_R_QInt(x, 3, 1), (Real) gtEq3, + and_B_B(ltEq_R_QInt(x, 1, 4), gtEq_R_0(x)), (Real) ltEqOneQuarter, + lt_R_0(x), lt0); +} + +void +sqrtInside() +{ + Cls *cls; + TenXY *tenXY; + DigsX *digsX; + void force_To_TenXY_X_Until_Refining(); + void force_To_DigsX_From_Sqrt_TenXY_Entry(); + Real x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + digsX = allocDigsX(); + digsX->force = force_To_DigsX_From_Sqrt_TenXY_Entry; + + tenXY = (TenXY *) tensor_Int(x, (Real) digsX, 1, 0, 2, 1, 1, 2, 0, 1); + tenXY->tag.isSigned = FALSE; + + digsX->x = (Real) tenXY; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(digsX, tenXY); + endGraphUpdate(); + } + + /* + * We must still absorb the sign (if any) and enough information + * to ensure the tensor is refining. Note that, if we get to + * this point, then we know the argument is within the interval + * 1/5 >= x <= 4. I claim that the n'th tensor for n >= 2 + * can always be made refining by absorbing + * information from the left. + */ + PUSH_2(force_To_TenXY_X_Until_Refining, tenXY); + + if (tenXY->x->gen.tag.isSigned) + PUSH_2(tenXY->forceX, tenXY); + + cls->redirect = (Real) digsX; + cls->userData = NULL; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +void +sqrtGtEq3() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = div_R_Int(x, 4); + w = sqrt_R(w); + cls->redirect = mul_R_Int(w, 2); + cls->userData = NULL; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +void +sqrtLtEqOneQuarter() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + w = mul_R_Int(x, 4); + w = sqrt_R(w); + cls->redirect = div_R_Int(w, 2); + cls->userData = NULL; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +#ifdef LATER +void +sqrtLtEqOneQuarter() +{ + Cls *cls, *newCls; + void sqrtLtEqOneQuarterCont(); + Real x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + + newCls = allocCls(sqrtLtEqOneQuarterCont, (void *) x); + newCls->tag.isSigned = FALSE; + cls->redirect = matrix_Int((Real) newCls, 0, 1, 1, 2); + cls->userData = NULL; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} +#endif + +void +sqrtLtEqOneQuarterCont() +{ + Cls *cls; + Real w, x; + void force_To_MatX_Until_Refining(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + /* w = matrix_Int(x, 0, 1, 1, 0); reciprocal of x */ + w = mul_R_Int(x, 4); + w = sqrt_R(w); + /* cls->redirect = matrix_Int(w, 1, 0, -2, 1); */ + cls->redirect = w; + cls->redirect->gen.tag.isSigned = FALSE; + cls->userData = NULL; + + if (DAVINCI) { + beginGraphUpdate(); + deleteOnlyEdge(cls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } + + PUSH_2(force_To_MatX_Until_Refining, cls->redirect); +} + +void +force_To_DigsX_From_Sqrt_TenXY_Entry() +{ + DigsX *digsX; + TenXY *tenXY; + int digitsNeeded; + void force_To_DigsX_From_Sqrt_TenXY_Cont(); + void force_To_DigsX_From_DigsX_Entry(); + void force_To_DigsX_From_Sqrt_Reduce(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + tenXY = (TenXY *) digsX->x; + + /* + * The current strategy is that when forced, we create a list + * of DigsX structures rather than a single struct with the + * requested number of digits. So, after we are done emitting, + * we arrange to reduce the list at the end. + * + * A better strategy would be to allocate two DigsX structures at the + * very start. The second one would be private and only visible to the sqrt + * closure. Then the cycle would be: + * emit from tensor into DigsX-2 + * absorb DigsX-2 digits into tensor + * absorb DigsX-2 digits into DigsX-1 + * clear DigsX-2 of all digits. + * + * This would avoid allocating a chain of DigsX structures and the + * need for reducing at the end. + PUSH_3(force_To_DigsX_From_DigsX_Entry, digsX, digitsNeeded); + */ + PUSH_2(force_To_DigsX_From_Sqrt_Reduce, digsX); + PUSH_3(force_To_DigsX_From_Sqrt_TenXY_Cont, digsX, digitsNeeded); +} + +void +force_To_DigsX_From_Sqrt_TenXY_Cont() +{ + DigsX *digsX; + TenXY *tenXY; + int digitsNeeded; + int nX; + int digitsEmitted, bitsShifted; + int epsDelTensorX(Tensor, int); + bool emitDigitFromTensor(Tensor, Digit *); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + tenXY = (TenXY *) digsX->x; + + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromTensor, + (void *) tenXY->ten, + digitsNeeded); + + if (digitsEmitted > 0) + bitsShifted = normalizeTensor(tenXY->ten); + + if (TRACE) { + debugp("force_To_DigsX_From_Sqrt_TenXY_Cont", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) tenXY, + digitsEmitted, + bitsShifted); + } + + digitsNeeded -= digitsEmitted; + + if (digsX->count > 0) + newDigsX(digsX); + + if (digitsNeeded <= 0) + return; + + /* + * So now we emitted what we can but still need more. First arrange + * to come back and try to emit again after forcing the necessary + * number of digits from the the argument. + */ + if (digsX->count > 0) + PUSH_3(force_To_DigsX_From_Sqrt_TenXY_Cont, digsX->x, digitsNeeded); + else + PUSH_3(force_To_DigsX_From_Sqrt_TenXY_Cont, digsX, digitsNeeded); + + /* + * Now absorb everything emitted into the tensor. + */ + absorbDigsXIntoTenXY_Y(tenXY); + + nX = epsDelTensorX(tenXY->ten, digitsNeeded); + + if (TRACE) { + debugp("force_To_DigsX_From_Sqrt_TenXY_Cont", + "%x %x nX=%d\n", + (unsigned) digsX, + (unsigned) tenXY, + nX); + } + + if (nX > 0) + PUSH_3(tenXY->forceX, tenXY, nX); + else + PUSH_3(tenXY->forceX, tenXY, 1); +} + +void +force_To_DigsX_From_Sqrt_MatX_Entry() +{ + DigsX *digsX; + MatX *matX; + int digitsNeeded; + void force_To_DigsX_From_Sqrt_MatX_Cont(); + void force_To_DigsX_From_DigsX_Entry(); + void force_To_DigsX_From_Sqrt_Reduce(); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + matX = (MatX *) digsX->x; + +/* + PUSH_3(force_To_DigsX_From_DigsX_Entry, digsX, digitsNeeded); +*/ + PUSH_2(force_To_DigsX_From_Sqrt_Reduce, digsX); + PUSH_3(force_To_DigsX_From_Sqrt_MatX_Cont, digsX, digitsNeeded); +} + +/* + * This is not used at this stage. This will be used when reduction is + * performed after the tensor is first allocated and when the tensor + * reduces to a matrix. + */ +void +force_To_DigsX_From_Sqrt_MatX_Cont() +{ + DigsX *digsX; + MatX *matX; + int digitsNeeded; + int nX; + int digitsEmitted, bitsShifted; + bool emitDigitFromMatrix(Matrix, Digit *); + + digsX = (DigsX *) POP; + digitsNeeded = (int) POP; + matX = (MatX *) digsX->x; + + digitsEmitted = emitDigits(digsX, + (edf) emitDigitFromMatrix, + (void *) matX->mat, + digitsNeeded); + + if (digitsEmitted > 0) + bitsShifted = normalizeMatrix(matX->mat); + + if (TRACE) { + debugp("force_To_DigsX_From_Sqrt_MatX_Cont", + "%x %x emitted=%d shifted=%d\n", + (unsigned) digsX, + (unsigned) matX, + digitsEmitted, + bitsShifted); + } + + digitsNeeded -= digitsEmitted; + + if (digsX->count > 0) + newDigsX(digsX); + + if (digitsNeeded <= 0) + return; + + /* + * Now absorb everything emitted into the matrix. + */ + absorbDigsXIntoMatX(matX); + + /* + * So now we emitted what we can but still need more. First arrange + * to come back and try to emit again after forcing the necessary + * number of digits from the the argument. + */ + if (digsX->count > 0) + PUSH_3(force_To_DigsX_From_Sqrt_MatX_Cont, digsX->x, digitsNeeded); + else + PUSH_3(force_To_DigsX_From_Sqrt_MatX_Cont, digsX, digitsNeeded); +} + +/* + * In some cases when we generate a matrix which is not refining, but + * where we no that the argument of the matrix is constrained in such a + * way that after a finite amount of absorption, it will become refining. + * What we do is force information from the argument until the matrix is + * refining. + */ +void +force_To_MatX_Until_Refining() +{ + MatX *matX; + int sgn; + + matX = (MatX *) POP; + + if (matX->tag.type != MATX) + return; + + sgn = matrixSign(matX->mat); + + if (sgn > 0) /* matrix is refining and entries positive */ + return; + + if (sgn < 0) { /* matrix is refining and entries negative */ + negateMatrix(matX->mat); + return; + } + + PUSH_2(force_To_MatX_Until_Refining, matX); + PUSH_3(matX->force, matX, 1); +} + +void +force_To_DigsX_From_Sqrt_Reduce() +{ + DigsX *digsX; + + digsX = (DigsX *) POP; + reduceDigsXList(digsX); +} diff --git a/ic-reals-6.3/math-lib/stdTensorCont.c b/ic-reals-6.3/math-lib/stdTensorCont.c new file mode 100644 index 0000000..dcf9cd3 --- /dev/null +++ b/ic-reals-6.3/math-lib/stdTensorCont.c @@ -0,0 +1,59 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +/* + * A number of functions on reals behave in a uniform way in the sense + * that they create a chain of tensors lazily. The only difference are + * the tensors they create. This is the standard tensor continuation. + * It is the force method in a closure and the assumption is that + * the closure data contains a pointer to a function which when called + * produces the next tensor in the chain. + * + * If the argument is a stream terminated by a vector, then there is + * no reduction. As a rule, guarding a vector by a stream inhibits + * reduction of a matrix or tensor against the rational. + * + * When the tensor is created, there may be some information + * about the argument available. At present, we do not absorb this + * information. Perhaps we should. It is not clear what the best policy is. + * + * Note that in the code below, the closure (Cls) is never shared so + * we are free to clobber the data in it. + */ +void +stdTensorCont() +{ + Cls *cls, *newCls; + TenXY *newTenXY; + ClsData *data; + void force_To_TenXY_X_Until_Refining(); + + cls = (Cls *) POP; + + data = (ClsData *) cls->userData; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + newTenXY = (*(data->nextTensor))(data->x, (Real) newCls, data->n); + newTenXY->tag.isSigned = FALSE; + data->n++; + + PUSH_2(force_To_TenXY_X_Until_Refining, newTenXY); + + if (newTenXY->x->gen.tag.isSigned) + PUSH_2(newTenXY->forceX, newTenXY); + + cls->userData = NULL; + cls->redirect = (Real) newTenXY; +} diff --git a/ic-reals-6.3/math-lib/stdTensorCont.c~ b/ic-reals-6.3/math-lib/stdTensorCont.c~ new file mode 100644 index 0000000..3dc2443 --- /dev/null +++ b/ic-reals-6.3/math-lib/stdTensorCont.c~ @@ -0,0 +1,59 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +/* + * A number of functions on reals behave in a uniform way in the sense + * that they create a chain of tensors lazily. The only difference are + * the tensors they create. This is the standard tensor continuation. + * It is the force method in a closure and the assumption is that + * the closure data contains a pointer to a function which when called + * produces the next tensor in the chain. + * + * If the argument is a stream terminated by a vector, then there is + * no reduction. As a rule, guarding a vector by a stream inhibits + * reduction of a matrix or tensor against the rational. + * + * When the tensor is created, there may be some information + * about the argument available. At present, we do not absorb this + * information. Perhaps we should. It is not clear what the best policy is. + * + * Note that in the code below, the closure (Cls) is never shared so + * we are free to clobber the data in it. + */ +void +stdTensorCont() +{ + Cls *cls, *newCls; + TenXY *tenXY, *newTenXY; + ClsData *data; + void force_To_TenXY_X_Until_Refining(); + + cls = (Cls *) POP; + + data = (ClsData *) cls->userData; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + newTenXY = (*(data->nextTensor))(data->x, (Real) newCls, data->n); + newTenXY->tag.isSigned = FALSE; + data->n++; + + PUSH_2(force_To_TenXY_X_Until_Refining, newTenXY); + + if (newTenXY->x->gen.tag.isSigned) + PUSH_2(newTenXY->forceX, newTenXY); + + cls->userData = NULL; + cls->redirect = (Real) newTenXY; +} diff --git a/ic-reals-6.3/math-lib/tan_Q.c b/ic-reals-6.3/math-lib/tan_Q.c new file mode 100644 index 0000000..fe18828 --- /dev/null +++ b/ic-reals-6.3/math-lib/tan_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +tan_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return tan_R(r); +} + +Real +tan_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return tan_R(r); +} diff --git a/ic-reals-6.3/math-lib/tan_R.c b/ic-reals-6.3/math-lib/tan_R.c new file mode 100644 index 0000000..93e19ab --- /dev/null +++ b/ic-reals-6.3/math-lib/tan_R.c @@ -0,0 +1,122 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +static TenXY *nextTensor(Real, Real, int); +static void tanInside(); +static void tanOutside(); + +Real +tan_R(Real x) +{ + Real u, v; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(tanInside, "tanInside", 2); + registerForceFunc(tanOutside, "tanOutside", 2); + doneInit++; + } + + /* + if (x->gen.tag.type == VECTOR) + return tan_QZ(x->vec.vec[0], x->vec.vec[1]); + */ + + xLtEq1 = ltEq_R_QInt(x, 1, 1); + xGtEqNeg1 = gtEq_R_QInt(x, -1, 1); + xLtEq1_and_GtEqNeg1 = and_B_B(xLtEq1, xGtEqNeg1); + + u = (Real) allocCls(tanInside, (void *) x); + u->cls.tag.isSigned = TRUE; + v = (Real) allocCls(tanOutside, (void *) x); + v->cls.tag.isSigned = TRUE; + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(u, x); + newEdgeToOnlyChild(v, x); + endGraphUpdate(); +#endif + + /* + * The order of the tests in the alt is not semantically + * significant. The tests are applied in order, so there is a + * very modest performance improvement by putting the -1,1 tests + * before the 999/1000,-999/1000 tests. Also there is a very + * small win by doing the negative test before the positive test. + */ + return realIf(4, + not_B(xLtEq1_and_GtEqNeg1), v, + xLtEq1_and_GtEqNeg1, u, + gtEq_R_QInt(x, 999, 1000), v, + ltEq_R_QInt(x, -999, 1000), v); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, 0, 2, -2, 0, 2*n+1, 2*n+1, 2*n+1, 2*n+1); +} + +static void +tanInside() +{ + Cls *cls, *newCls; + Real x; + ClsData *data; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "tan_R", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 1, 1, 1, -1, 0, 1, 0, 1); + +#ifdef DAVINCI + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} + +static void +tanOutside() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + x = div_R_Int(x, 2); + + w = tan_R(x); + + cls->redirect = tensor_Int(w, w, 0, -1, 1, 0, 1, 0, 0, 1); + +#ifdef DAVINCI + beginGraphUpdate(); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); +#endif +} diff --git a/ic-reals-6.3/math-lib/tan_R.c~ b/ic-reals-6.3/math-lib/tan_R.c~ new file mode 100644 index 0000000..5969b00 --- /dev/null +++ b/ic-reals-6.3/math-lib/tan_R.c~ @@ -0,0 +1,122 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include "math-lib.h" + +static TenXY *nextTensor(Real, Real, int); +static void tanInside(); +static void tanOutside(); + +Real +tan_R(Real x) +{ + Real u, v; + Bool xLtEq1, xGtEqNeg1, xLtEq1_and_GtEqNeg1; + static int doneInit = 0; + + if (!doneInit) { + registerForceFunc(tanInside, "tanInside", 2); + registerForceFunc(tanOutside, "tanOutside", 2); + doneInit++; + } + + /* + if (x->gen.tag.type == VECTOR) + return tan_QZ(x->vec.vec[0], x->vec.vec[1]); + */ + + xLtEq1 = ltEq_R_QInt(x, 1, 1); + xGtEqNeg1 = gtEq_R_QInt(x, -1, 1); + xLtEq1_and_GtEqNeg1 = and_B_B(xLtEq1, xGtEqNeg1); + + u = (Real) allocCls(tanInside, (void *) x); + u->cls.tag.isSigned = TRUE; + v = (Real) allocCls(tanOutside, (void *) x); + v->cls.tag.isSigned = TRUE; + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(u, x); + newEdgeToOnlyChild(v, x); + endGraphUpdate(); + } + + /* + * The order of the tests in the alt is not semantically + * significant. The tests are applied in order, so there is a + * very modest performance improvement by putting the -1,1 tests + * before the 999/1000,-999/1000 tests. Also there is a very + * small win by doing the negative test before the positive test. + */ + return realIf(4, + not_B(xLtEq1_and_GtEqNeg1), v, + xLtEq1_and_GtEqNeg1, u, + gtEq_R_QInt(x, 999, 1000), v, + ltEq_R_QInt(x, -999, 1000), v); +} + +static TenXY * +nextTensor(Real x, Real y, int n) +{ + return (TenXY *) tensor_Int(x, y, 0, 2, -2, 0, 2*n+1, 2*n+1, 2*n+1, 2*n+1); +} + +static void +tanInside() +{ + Cls *cls, *newCls; + Real x, tan_x; + ClsData *data; + void stdTensorCont(); + + cls = (Cls *) POP; + x = (Real) cls->userData; + + if ((data = (ClsData *) malloc(sizeof(ClsData))) == NULL) + Error(FATAL, E_INT, "tan_R", "malloc failed"); + + data->n = 1; + data->x = x; + data->nextTensor = nextTensor; + + newCls = allocCls(stdTensorCont, (void *) data); + newCls->tag.isSigned = FALSE; + + cls->redirect = tensor_Int(x, (Real) newCls, 1, 1, 1, -1, 0, 1, 0, 1); + + if (DAVINCI) { + beginGraphUpdate(); + newEdgeToOnlyChild(newCls, x); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} + +static void +tanOutside() +{ + Cls *cls; + Real w, x; + + cls = (Cls *) POP; + x = (Real) cls->userData; + x = div_R_Int(x, 2); + + w = tan_R(x); + + cls->redirect = tensor_Int(w, w, 0, -1, 1, 0, 1, 0, 0, 1); + + if (DAVINCI) { + beginGraphUpdate(); + drawEqEdge(cls, cls->redirect); + endGraphUpdate(); + } +} diff --git a/ic-reals-6.3/math-lib/tanh_Q.c b/ic-reals-6.3/math-lib/tanh_Q.c new file mode 100644 index 0000000..159e3de --- /dev/null +++ b/ic-reals-6.3/math-lib/tanh_Q.c @@ -0,0 +1,31 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +/* + * These will be specialized in a later version. + */ +Real +tanh_QInt(int a, int b) +{ + Real r; + + r = vector_Int(a, b); + return tanh_R(r); +} + +Real +tanh_QZ(mpz_t a, mpz_t b) +{ + Real r; + + r = vector_Z(a, b); + return tanh_R(r); +} diff --git a/ic-reals-6.3/math-lib/tanh_R.c b/ic-reals-6.3/math-lib/tanh_R.c new file mode 100644 index 0000000..41be93b --- /dev/null +++ b/ic-reals-6.3/math-lib/tanh_R.c @@ -0,0 +1,19 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#include <stdio.h> +#include "real.h" + +Real +tanh_R(Real x) +{ + Real r; + + r = exp_R(x); + return tensor_Int(r, r, 1, 1, 0, 0, 0, 0, -1, 1); +} diff --git a/ic-reals-6.3/real-impl.h b/ic-reals-6.3/real-impl.h new file mode 100644 index 0000000..c3c25b3 --- /dev/null +++ b/ic-reals-6.3/real-impl.h @@ -0,0 +1,306 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#ifdef DAVINCI +#define DAVINCI 1 +#endif + +/* + * There are three choices for tracing. + * TRACE=0, off + * TRACE=1, on + * TRACE=traceOn, software controlled. + * + * The default, if not set when compiled (-DTRACE=<val>), is off. + */ +/* #ifndef TRACE */ +/* #define TRACE 0 */ +/* #endif */ + +int tensorStrategy(Tensor t); +bool tensorIsRefining(Tensor t); +int vectorSign(Vector v); +int matrixSign(Matrix m); +int tensorSign(Tensor t); +void negateMatrix(Matrix m); +void negateTensor(Tensor t); +void createSignedStreamForTenXY(TenXY *tenXY); +void createUnsignedStreamForTenXY(TenXY *tenXY); +void absorbSignIntoVectorPair(Vector v0, Vector v1, Sign sign); +void setMatXMethodSigned(MatX *); +void setMatXMethodUnsigned(MatX *); +bool tensorIsPositive(Tensor t); +bool matrixIsPositive(Matrix m); +bool vectorIsPositive(Vector v); +void setDigsXMethod(DigsX *); +int leadingOnes(mpz_t c); +void debugTrace(int); /* this function just sets traceOn to the argument */ +void runStack(); +void setBoolX(BoolX *boolX, BoolVal v); +void setBoolXY(BoolXY *boolXY, BoolVal v); +void setPredX(PredX *predX, BoolVal v); +void debugp(char *proc, char *fmt, ...); +void highlightEdge(Generic *node1, Generic *node2, int childIdx); +void unhighlightEdge(Generic *node1, Generic *node2, int childIdx); +void handleDaVinciMessages(int block); +char *typeToString(unsigned type); +void unhighlightTOS(); +void initPi(); +void absorbDigsXIntoTenXY_X(TenXY *); +void absorbDigsXIntoTenXY_Y(TenXY *); +void introDigsX(SignX *signX); +void absorbDigsXIntoMatX(MatX *); +extern int traceOn; + +/* + * The following are used in the routine + * Error(fatal_flag, error_type, proc, fmt, arg... ) + * + * When FATAL is used (rather than !FATAL), Error exists after + * printing a message. + */ +#define FATAL 1 + +/* + * Error types, E_SYS for system errors (eg opening files) and E_INT + * for internal errors not involving system calls. + */ +#define E_SYS 1 +#define E_INT 2 +void Error(int fatal_flag, int error_type, char *proc, char *fmt, ...); + +/* + * Macros and utilities not meant for the user. + */ +#ifndef MAX +#define MAX(a,b) ((a) >= (b) ? (a) : (b)) +#endif + +#ifndef MIN +#define MIN(a,b) ((a) <= (b) ? (a) : (b)) +#endif + +#ifdef USED_FOR_GMP_2 +/* + * This is a little hack to avoid assignment and storage allocation + * within gmp. This just swaps the fields describing an mpz_t and + * that way we can multiply two matrices and put the result in the + * first matrix without allocating temporary storage every time. + */ +#define MPZ_SWAP(a,b) \ + ({mpz_t localz; \ + localz[0] = (a)[0]; \ + (a)[0] = (b)[0]; \ + (b)[0] = localz[0];}) +#endif + +#define MPZ_SWAP(a,b) mpz_swap(a,b) + +/* + * This macro evaluates its argument more that once. It is applied to the output + * of some GMP comparison functions. Some comparisons return {-1,0,1} while + * others only specify a negative, zero or positive value. The former is + * slightly better since we can use a case statement. For the latter + * functions we wrap them in SIGN so we can uniformly use case statements. + */ +#define MPZ_SIGN(x) ((x > 0) ? 1 : ((x < 0) ? -1 : 0)) +#define MAXINT 0x7fffffff + +/* + * These are available for temporary storage. But one must + * be careful. They are used in the matrix multiplication operations + * amongst other places. + */ +extern mpz_t tmpa_z, tmpb_z, tmpc_z, tmpd_z, tmpe_z, tmpf_z; + +/* + * The constant zero as a big integer + */ +extern mpz_t zero_z; + +extern Matrix bigTmpMat; +extern Tensor bigTmpTen; + +extern int debug; + +void canonVector(Vector); +int normalizeVector(Vector); +int normalizeMatrix(Matrix); +int normalizeTensor(Tensor); + +void absorb_DigsX_Into_DigsX(DigsX *); +void absorb_DigsX_Into_MatX(MatX *); +void absorb_DigsX_Into_TenXY_X(TenXY *); +void absorb_DigsX_Into_TenXY_Y(TenXY *); +void reduceDigsXList(DigsX *); + +/* + * + * The entire computation is driven by a stack of frames which define + * the work to be done. The stack grows upward with sp pointing to the + * top of the stack. + */ +#ifndef STACK_SIZE +#define STACK_SIZE 8000 +#endif + +extern unsigned *stack; +extern unsigned *stackBound; +extern unsigned *sp; + +#define NEED_STACK(n) \ + do {if ((sp + n) >= stackBound) \ + Error(FATAL, E_INT, "push", "stack overflow");} while (0) + +#define PUSH(x) (*++sp = (unsigned) x) +#define POP (*sp--) + +#ifdef DAVINCI +void highlightTOS(); + +#define PUSH_4(func, dst, a, b) \ + push_4((unsigned) (func), (unsigned) (dst), (unsigned) (a), (unsigned) (b)) + +#define PUSH_3(func, dst, a) \ + push_3((unsigned) (func), (unsigned) (dst), (unsigned) (a)) + +#define PUSH_2(func, dst) \ + push_2((unsigned) (func), (unsigned) (dst)) + +/* + * This uses the GNU inline extension. Could be done with macros but + * inlines are nicer. + */ +static inline void +push_4(unsigned func, unsigned dst, unsigned a, unsigned b) +{ + NEED_STACK(4); + PUSH(b); + PUSH(a); + PUSH(dst); + PUSH(func); + highlightTOS(); +} + +static inline void +push_3(unsigned func, unsigned dst, unsigned a) +{ + NEED_STACK(3); + PUSH(a); + PUSH(dst); + PUSH(func); + highlightTOS(); +} + +static inline void +push_2(unsigned func, unsigned dst) +{ + NEED_STACK(2); + PUSH(dst); + PUSH(func); + highlightTOS(); +} + +#else +#define PUSH_4(func, dst, a, b) \ + do {NEED_STACK(4); \ + PUSH(b); \ + PUSH(a); \ + PUSH(dst); \ + PUSH(func);} while(0) +#define PUSH_3(func, dst, a) \ + do {NEED_STACK(3); \ + PUSH(a); \ + PUSH(dst); \ + PUSH(func);} while(0) +#define PUSH_2(func, dst) \ + do {NEED_STACK(2); \ + PUSH(dst); \ + PUSH(func);} while(0) +#endif + +/* + * this is used to force blocking when reading responses from + * daVinci. + */ +#define BLOCK 1 + +/* + * The following constant is the default number of digits forced from + * an LFT as demanded by predicates and when the epsilon-delta analysis + * doesn't tell us useful information. + */ +#ifndef DEFAULT_FORCE_COUNT +#define DEFAULT_FORCE_COUNT 1 +#endif + +Vec *allocVec(); +DigsX *allocDigsX(); +MatX *allocMatX(); +TenXY *allocTenXY(); + +SignX *allocSignX(Real, int); +Cls *allocCls(void (*)(), void *); + +/* + * This is the type of a function for emitting a digit from a vector, matrix + * or tensor. So "edf" means "emit digit function". The argument type is given + * as a (void *) rather than LFT because there are occasions when it is applied + * to things other than LFTs, for example in the square root of a rational. + */ +typedef bool (*edf)(void *, Digit *); +int emitDigits(DigsX *, edf, void *, int); + +void newDigsX(DigsX *); + +void multVectorPairTimesVector(Vector, Vector, Vector); +void multVectorPairTimesMatrix(Vector, Vector, Matrix); +void multVectorPairTimesSmallMatrix(Vector, Vector, SmallMatrix); +void makeSmallMatrixFromDigits(SmallMatrix, DigsX *); +void makeMatrixFromDigits(Matrix, DigsX *); + +/* + * Now we define the ``prototypes'' for all the functions available + * to applications. + */ +Digit intToDigit(int); +char *digitToString(Digit); +char *signToString(Sign); +char *comparisonToString(Comparison); + +/* + * For debugging purposes we provide a facility to map a force method to + * a descriptor which gives a printable string for the method, + * the number of arguments expected by the method and, in the case when the + * consumer is an element in the heap with 2 arguments, a constant indicating + * whether the information is coming from the x or y argument. + */ +#define ARG_X 0 +#define ARG_Y 1 +#define ARG_NEITHER 2 + +typedef struct { + void (*func)(); + char *funcName; + int nArgs; + int argXOrY; +} ForceFuncDesc; + +ForceFuncDesc *getDescForForceFunc(void (*)()); + +void registerForceFunc(void (*)(), char *, int); + +int isRightFunc(ForceFuncDesc *p); +int isLeftFunc(ForceFuncDesc *p); + + +extern int nodeId; + +extern int defaultForceCount; +extern int forceDecUpperBound; +extern int stackSize; diff --git a/ic-reals-6.3/real-impl.h~ b/ic-reals-6.3/real-impl.h~ new file mode 100644 index 0000000..4d202aa --- /dev/null +++ b/ic-reals-6.3/real-impl.h~ @@ -0,0 +1,272 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +#ifdef DAVINCI +#define DAVINCI 1 +#else +#define DAVINCI 0 +#endif + +/* + * There are three choices for tracing. + * TRACE=0, off + * TRACE=1, on + * TRACE=traceOn, software controlled. + * + * The default, if not set when compiled (-DTRACE=<val>), is off. + */ +#ifndef TRACE +#define TRACE 0 +#endif + +void debugTrace(int); /* this function just sets traceOn to the argument */ +extern int traceOn; + +/* + * The following are used in the routine + * Error(fatal_flag, error_type, proc, fmt, arg... ) + * + * When FATAL is used (rather than !FATAL), Error exists after + * printing a message. + */ +#define FATAL 1 + +/* + * Error types, E_SYS for system errors (eg opening files) and E_INT + * for internal errors not involving system calls. + */ +#define E_SYS 1 +#define E_INT 2 +void Error(int fatal_flag, int error_type, char *proc, char *fmt, ...); + +/* + * Macros and utilities not meant for the user. + */ +#ifndef MAX +#define MAX(a,b) ((a) >= (b) ? (a) : (b)) +#endif + +#ifndef MIN +#define MIN(a,b) ((a) <= (b) ? (a) : (b)) +#endif + +#ifdef USED_FOR_GMP_2 +/* + * This is a little hack to avoid assignment and storage allocation + * within gmp. This just swaps the fields describing an mpz_t and + * that way we can multiply two matrices and put the result in the + * first matrix without allocating temporary storage every time. + */ +#define MPZ_SWAP(a,b) \ + ({mpz_t localz; \ + localz[0] = (a)[0]; \ + (a)[0] = (b)[0]; \ + (b)[0] = localz[0];}) +#endif + +#define MPZ_SWAP(a,b) mpz_swap(a,b) + +/* + * This macro evaluates its argument more that once. It is applied to the output + * of some GMP comparison functions. Some comparisons return {-1,0,1} while + * others only specify a negative, zero or positive value. The former is + * slightly better since we can use a case statement. For the latter + * functions we wrap them in SIGN so we can uniformly use case statements. + */ +#define MPZ_SIGN(x) ((x > 0) ? 1 : ((x < 0) ? -1 : 0)) +#define MAXINT 0x7fffffff + +/* + * These are available for temporary storage. But one must + * be careful. They are used in the matrix multiplication operations + * amongst other places. + */ +extern mpz_t tmpa_z, tmpb_z, tmpc_z, tmpd_z, tmpe_z, tmpf_z; + +/* + * The constant zero as a big integer + */ +extern mpz_t zero_z; + +extern Matrix bigTmpMat; +extern Tensor bigTmpTen; + +extern int debug; + +void canonVector(Vector); +int normalizeVector(Vector); +int normalizeMatrix(Matrix); +int normalizeTensor(Tensor); + +void absorb_DigsX_Into_DigsX(DigsX *); +void absorb_DigsX_Into_MatX(MatX *); +void absorb_DigsX_Into_TenXY_X(TenXY *); +void absorb_DigsX_Into_TenXY_Y(TenXY *); +void reduceDigsXList(DigsX *); + +/* + * + * The entire computation is driven by a stack of frames which define + * the work to be done. The stack grows upward with sp pointing to the + * top of the stack. + */ +#ifndef STACK_SIZE +#define STACK_SIZE 8000 +#endif + +extern unsigned *stack; +extern unsigned *stackBound; +extern unsigned *sp; + +#define NEED_STACK(n) \ + ({if ((sp + n) >= stackBound) \ + Error(FATAL, E_INT, "push", "stack overflow");}) + +#define PUSH(x) (*++sp = (unsigned) x) +#define POP (*sp--) + +#if DAVINCI == 1 +void highlightTOS(); + +#define PUSH_4(func, dst, a, b) \ + push_4((unsigned) (func), (unsigned) (dst), (unsigned) (a), (unsigned) (b)) + +#define PUSH_3(func, dst, a) \ + push_3((unsigned) (func), (unsigned) (dst), (unsigned) (a)) + +#define PUSH_2(func, dst) \ + push_2((unsigned) (func), (unsigned) (dst)) + +/* + * This uses the GNU inline extension. Could be done with macros but + * inlines are nicer. + */ +static inline void +push_4(unsigned func, unsigned dst, unsigned a, unsigned b) +{ + NEED_STACK(4); + PUSH(b); + PUSH(a); + PUSH(dst); + PUSH(func); + highlightTOS(); +} + +static inline void +push_3(unsigned func, unsigned dst, unsigned a) +{ + NEED_STACK(3); + PUSH(a); + PUSH(dst); + PUSH(func); + highlightTOS(); +} + +static inline void +push_2(unsigned func, unsigned dst) +{ + NEED_STACK(2); + PUSH(dst); + PUSH(func); + highlightTOS(); +} + +#else +#define PUSH_4(func, dst, a, b) \ + ({NEED_STACK(4); \ + PUSH(b); \ + PUSH(a); \ + PUSH(dst); \ + PUSH(func);}) +#define PUSH_3(func, dst, a) \ + ({NEED_STACK(3); \ + PUSH(a); \ + PUSH(dst); \ + PUSH(func);}) +#define PUSH_2(func, dst) \ + ({NEED_STACK(2); \ + PUSH(dst); \ + PUSH(func);}) +#endif + +/* + * this is used to force blocking when reading responses from + * daVinci. + */ +#define BLOCK 1 + +/* + * The following constant is the default number of digits forced from + * an LFT as demanded by predicates and when the epsilon-delta analysis + * doesn't tell us useful information. + */ +#ifndef DEFAULT_FORCE_COUNT +#define DEFAULT_FORCE_COUNT 1 +#endif + +Vec *allocVec(); +DigsX *allocDigsX(); +MatX *allocMatX(); +TenXY *allocTenXY(); + +SignX *allocSignX(Real, int); +Cls *allocCls(void (*)(), void *); + +/* + * This is the type of a function for emitting a digit from a vector, matrix + * or tensor. So "edf" means "emit digit function". The argument type is given + * as a (void *) rather than LFT because there are occasions when it is applied + * to things other than LFTs, for example in the square root of a rational. + */ +typedef bool (*edf)(void *, Digit *); +int emitDigits(DigsX *, edf, void *, int); + +void newDigsX(DigsX *); + +void multVectorPairTimesVector(Vector, Vector, Vector); +void multVectorPairTimesMatrix(Vector, Vector, Matrix); +void multVectorPairTimesSmallMatrix(Vector, Vector, SmallMatrix); +void makeSmallMatrixFromDigits(SmallMatrix, DigsX *); +void makeMatrixFromDigits(Matrix, DigsX *); + +/* + * Now we define the ``prototypes'' for all the functions available + * to applications. + */ +Digit intToDigit(int); +char *digitToString(Digit); +char *signToString(Sign); +char *comparisonToString(Comparison); + +/* + * For debugging purposes we provide a facility to map a force method to + * a descriptor which gives a printable string for the method, + * the number of arguments expected by the method and, in the case when the + * consumer is an element in the heap with 2 arguments, a constant indicating + * whether the information is coming from the x or y argument. + */ +#define ARG_X 0 +#define ARG_Y 1 +#define ARG_NEITHER 2 + +typedef struct { + void (*func)(); + char *funcName; + int nArgs; + int argXOrY; +} ForceFuncDesc; + +ForceFuncDesc *getDescForForceFunc(void (*)()); + +void registerForceFunc(void (*)(), char *, int); + +extern int nodeId; + +extern int defaultForceCount; +extern int forceDecUpperBound; +extern int stackSize; diff --git a/ic-reals-6.3/real.a b/ic-reals-6.3/real.a Binary files differnew file mode 100644 index 0000000..fa0a301 --- /dev/null +++ b/ic-reals-6.3/real.a diff --git a/ic-reals-6.3/real.h b/ic-reals-6.3/real.h new file mode 100644 index 0000000..1bb760a --- /dev/null +++ b/ic-reals-6.3/real.h @@ -0,0 +1,511 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +/* + * This is the include for all applications using reals. It defines all + * the types the user sees, principally Real and Bool, and the prototypes + * functions which operate on these types. + * + * It also defines the various types of objects in the heap. Each is a + * structure, the first word of which is a tag, containing amongst other + * things a code to identify the type of object. + */ + +#ifndef REALH +#define REALH + +#include <gmp.h> +#include <stdlib.h> + +typedef union Real_ * Real; +typedef union Bool_ * Bool; + +/* + * Each object in the heap is assigned one of the following codes. + */ +typedef enum { + ALT, /* selects amongst boolean guarded expressions */ + VECTOR, /* a vector (ie rational) */ + MATX, /* a matrix (the X reflects that there is one argument) */ + TENXY, /* a tensor (with two arguments) */ + DIGSX, /* a string or sequence of digits */ + SIGNX, /* this holds one of the sign values */ + CLOSURE, /* usually used to lazily produce futher lfts in expressions */ + BOOLX, /* propositional operator with one argument, eg negation */ + BOOLXY, /* operator with two arguments, eg conjunction */ + PREDX /* predicate over reals with one argument, eg x > 0 */ +} ObjType; + +typedef enum {FALSE = 0, TRUE = 1} bool; +typedef enum {LT = -1, EQ = 0, GT = 1} Comparison; + +/* + * The first word of each structure in the heap is a tag word defined + * below. + */ +typedef struct { + unsigned type : 4; /* an ObjType as defined above */ + unsigned dumped : 1; /* for traversing recursively when printing */ + unsigned value : 3; /* sign or boolean value */ + unsigned isSigned : 1; /* true when a real must be signed */ + unsigned nodeId : 21; /* each node has a unique id for debugging */ +} Tag; + +/* + * The next segment of the file defines the structures and constants + * dealing with reals. + */ + +/* + * Next we define the possible sign constant which includes a constant + * indicating that the sign is unknown. + * The order of the entries in the enum which follows is significant. It + * reflects our preference for SZERO. However, note that changing the order of + * the constants below is not sufficient to change the preference. One + * must also modify emitSign.c. + */ +typedef enum {SZERO, SINF, SPOS, SNEG, SIGN_UNKN} Sign; +typedef enum {DPOS = 1, DNEG = -1, DZERO = 0} Digit; + +/* + * We define the LFTS: vector, matrix and tensor. There are two + * varieties of each: one in which the entries are machine sized integers + * and the other in which the entries are GMP large integers. + * + * Vectors, matrices and tensors are arrays rather than structs. That + * way they have size and yet are passed as pointers (lvalues). This + * avoids some referencing and dereferencing. It turns out to be more + * convenient to define tensors as arrays of vectors rather than pairs + * of matrices since often we need to pull out columns without respecting + * matrix boundaries. + */ +typedef mpz_t Vector[2]; +typedef Vector Matrix[2]; +typedef Vector Tensor[4]; + +typedef int SmallVector[2]; +typedef SmallVector SmallMatrix[2]; +typedef SmallVector SmallTensor[4]; + +typedef union { + Vector Vec; + Matrix Mat; + Tensor Ten; +} LFT; + +/* + * This defines the fields which are common to all real continuations. + */ +typedef struct { + Tag tag; +} Generic; + +typedef struct { + Bool guard; + Real x; +} GuardedExpr; + +typedef struct { + Tag tag; + void (*force)(); /* is this needed ? */ + Real redirect; /* this is the ultimate value of the conditional */ + int nextGE; /* index of next guarded expression to force */ + int numGE; /* number of guarded expressions in the list */ + GuardedExpr *GE; /* the list of guarded expressions */ +} Alt; + +/* + * The x field below is the alternative representation of the real the + * Closure denotes. That is, when the closure is forced, it struct points + * to the object it unfolds to. That way, any subsequent request to the + * closure, won't force a second distinct unfolding. + */ +typedef struct { + Tag tag; + void (*force)(); + void *userData; + Real redirect; +} Cls; + +/* +Heap elements which hold lfts have a strm field. This hold a real stream +(ie a list of DigsX structures possibly prefixed by a SignX). This real +denotes the same value as the expression rooted by the lft. In some cases +having both representations is necessary. For top level vectors and matrices, +having the stream representation allows us to extract information from +the lft when demanded for printing. At the same time, the vectors and +matrices are still available should they become the argument of another +lft whereupon we want to reduce. The strm field is used by tensors since +reduction against a tensor argument is not possible and we must emit +imformation. However, it is sometimes not possible to create the stream +in advance. If the tensor has an argument guarded by an alt, then the alt +might eventually reduce to a vector and the tensor reduce to a matrix. +*/ + +typedef struct { + Tag tag; + void (*force)(); + Real strm; + Vector vec; +} Vec; + +typedef struct { + Tag tag; + void (*force)(); + Real strm; + Real x; + int totalEmitted; + Matrix mat; +} MatX; + +typedef struct { + Tag tag; + void (*forceX)(); + void (*forceY)(); + Real strm; + Real x; + Real y; + signed short totalEmitted; + signed short tensorFairness; /* counts left vs right absorptions */ + int xDigitsNeeded; + Tensor ten; +} TenXY; + +typedef struct { + Tag tag; + void (*force)(); + Real x; +} SignX; + +/* + * Sequences of digits are represented by ``characteristic pairs''. + * This is a pair of integers (n,c) in which c is the coding of + * n digits. When n <= DIGITS_PER_WORD, then c can be represented in a + * machine word. Otherwise we need a big integer. + * + * Below we use the value 30. In fact it is possible to use 31. The problem + * is that we need DIGITS_PER_WORD + 1 bits when we form a matrix. + * Setting it to 30 ensures that it always yields a matrix which fits + * into a signed machine word. + */ +#define DIGITS_PER_WORD 29 + +typedef struct DigsX_ { + Tag tag; + void (*force)(); + Real x; + unsigned count; + union { + int small; + mpz_t big; + } word; +} DigsX; + +union Real_ { + Generic gen; + Alt alt; + Vec vec; + SignX signX; + MatX matX; + DigsX digsX; + TenXY tenXY; + Cls cls; +}; + +/* + * The next segment of the file defines the structures and constants + * dealing with the lazy boolean type. + * + * I'm not very happy with the names of things here. There is too much + * overloading of the term bool (in both upper and lower case). + * + * bool : this is the usual booleans (two-valued) and used internally + * instead of int (and 0/1) simply as a matter of style. + * BoolVal : this is three valued boolean type + * Bool : this is the lazy boolean type which takes on values from BoolVal. + * The type is a union of the various heap allocated structures + * relevant to lazy booleans. + */ +typedef enum {LAZY_TRUE, LAZY_FALSE, LAZY_UNKNOWN} BoolVal; + +/* + * This is the constant to flag the default case in the realAlt function. + * The second of these is for backwards compatibility. + */ +#define DEFAULT_GUARD ((unsigned) 0xffffffffL) +#define B_DEFAULT (DEFAULT_GUARD) + +typedef struct { + Tag tag; + void (*force)(); + Real x; +} PredX; + +typedef struct { + Tag tag; + void (*force)(); + Bool x; +} BoolX; + +typedef struct { + Tag tag; + void (*force)(); + Bool x; + Bool y; +} BoolXY; + +union Bool_ { + struct { + Tag tag; + void (*force)(); + } gen; + BoolX boolX; + BoolXY boolXY; + PredX predX; +}; + +void initReals(); + +Real consCN(Real, char *, int, int, int); + +void dumpReal(Real); +void dumpBool(Bool); +void dumpCell(void *); + +/* + * An application can set the following string to the name of the + * application, typically argv[0]. + */ +extern char *MyName; + +void force_R_Dec(Real, int); +void force_R_Digs(Real, int); + +void print_R_Dec(Real, int); +void print_R_Digs(Real, int); + +void print_R(Real); + +double realToDouble(Real); + +/* + * Basic LFT creation. This list includes the preferred names (real_*, lft_*) + * and the older names which may disappear in a future release. + */ +Real real_QInt(int, int); +Real real_QZ(mpz_t, mpz_t); + +Real lft_R_Int(Real, int, int, int, int); +Real lft_R_Z(Real, mpz_t, mpz_t, mpz_t, mpz_t); + +Real lft_R_R_Int(Real, Real, int, int, int, int, int, int, int, int); +Real lft_R_R_Z(Real, Real, mpz_t, mpz_t, mpz_t, mpz_t, + mpz_t, mpz_t, mpz_t, mpz_t); + +Real vector_Int(int, int); +Real vector_Z(mpz_t, mpz_t); + +Real matrix_Int(Real, int, int, int, int); +Real matrix_Z(Real, mpz_t, mpz_t, mpz_t, mpz_t); + +Real tensor_Int(Real, Real, int, int, int, int, int, int, int, int); +Real tensor_Z(Real, Real, mpz_t, mpz_t, mpz_t, mpz_t, + mpz_t, mpz_t, mpz_t, mpz_t); + +Real makeStream(Real); + +/* + * Basic arithmetic functions + */ +Real add_R_R(Real, Real); +Real add_R_Int(Real, int); +Real add_R_QInt(Real, int, int); +Real add_R_QZ(Real, mpz_t, mpz_t); + +Real sub_R_R(Real, Real); +Real sub_R_Int(Real, int); +Real sub_R_QInt(Real, int, int); +Real sub_Int_R(int, Real); +Real sub_QInt_R(int, int, Real); + +Real mul_R_R(Real, Real); +Real mul_R_Int(Real, int); +Real mul_R_QInt(Real, int, int); +Real mul_R_QZ(Real, mpz_t, mpz_t); + +Real div_R_R(Real, Real); +Real div_R_Int(Real, int); +Real div_R_QInt(Real, int, int); +Real div_Int_R(int, Real); +Real div_QInt_R(int, int, Real); + +Real pow_R_R(Real, Real); + +Real abs_R(Real); + +Real neg_R(Real); + +/* + * Analytic functions + */ +Real tan_R(Real); +Real tan_QZ(mpz_t, mpz_t); +Real tan_QInt(int, int); + +Real atan_R(Real); +Real atan_QZ(mpz_t, mpz_t); +Real atan_QInt(int, int); + +Real tanh_R(Real); +Real tanh_QZ(mpz_t, mpz_t); +Real tanh_QInt(int, int); + +Real atanh_R(Real); +Real atanh_QZ(mpz_t, mpz_t); +Real atanh_QInt(int, int); + +Real sin_R(Real); +Real sin_QZ(mpz_t, mpz_t); +Real sin_QInt(int, int); + +Real asin_R(Real); +Real asin_QZ(mpz_t, mpz_t); +Real asin_QInt(int, int); + +Real sinh_R(Real); +Real sinh_QZ(mpz_t, mpz_t); +Real sinh_QInt(int, int); + +Real asinh_R(Real); +Real asinh_QZ(mpz_t, mpz_t); +Real asinh_QInt(int, int); + +Real cos_R(Real); +Real cos_QZ(mpz_t, mpz_t); +Real cos_QInt(int, int); + +Real acos_R(Real); +Real acos_QZ(mpz_t, mpz_t); +Real acos_QInt(int, int); + +Real cosh_R(Real); +Real cosh_QZ(mpz_t, mpz_t); +Real cosh_QInt(int, int); + +Real acosh_R(Real); +Real acosh_QZ(mpz_t, mpz_t); +Real acosh_QInt(int, int); + +Real sec_R(Real); +Real sec_QInt(int, int); +Real sec_QZ(mpz_t, mpz_t); + +Real asec_R(Real); +Real asec_QInt(int, int); +Real asec_QZ(mpz_t, mpz_t); + +Real sech_R(Real); +Real sech_QInt(int, int); +Real sech_QZ(mpz_t, mpz_t); + +Real asech_R(Real); +Real asech_QInt(int, int); +Real asech_QZ(mpz_t, mpz_t); + +Real cosec_R(Real); +Real cosec_QInt(int, int); +Real cosec_QZ(mpz_t, mpz_t); + +Real acosec_R(Real); +Real acosec_QInt(int, int); +Real acosec_QZ(mpz_t, mpz_t); + +Real cosech_R(Real); +Real cosech_QInt(int, int); +Real cosech_QZ(mpz_t, mpz_t); + +Real acosech_R(Real); +Real acosech_QInt(int, int); +Real acosech_QZ(mpz_t, mpz_t); + +Real cotan_R(Real); +Real cotan_QInt(int, int); +Real cotan_QZ(mpz_t, mpz_t); + +Real acotan_R(Real); +Real acotan_QInt(int, int); +Real acotan_QZ(mpz_t, mpz_t); + +Real cotanh_R(Real); +Real cotanh_QInt(int, int); +Real cotanh_QZ(mpz_t, mpz_t); + +Real acotanh_R(Real); +Real acotanh_QInt(int, int); +Real acotanh_QZ(mpz_t, mpz_t); + +extern Real Pi; +extern Real E; + +Real sqrt_R(Real); +Real sqrt_QZ(mpz_t, mpz_t); +Real sqrt_QInt(int, int); + +Real exp_R(Real); +Real exp_QZ(mpz_t, mpz_t); +Real exp_QInt(int, int); + +Real log_R(Real); +Real log_QZ(mpz_t, mpz_t); +Real log_QInt(int, int); + +/* + * Predicates, boolean operators and the conditional. + */ +Bool ltEq_R_0(Real); +Bool lt_R_0(Real); + +Bool lt_R_R(Real, Real); +Bool ltEq_R_R(Real, Real); + +Bool ltEq_R_QInt(Real, int, int); +Bool lt_R_QInt(Real, int, int); + +Bool gtEq_R_0(Real); +Bool gt_R_0(Real); + +Bool gtEq_R_QInt(Real, int, int); +Bool gt_R_QInt(Real, int, int); + +Bool gt_R_R(Real, Real); +Bool gtEq_R_R(Real, Real); + +Bool and_B_B(Bool, Bool); +Bool or_B_B(Bool, Bool); +Bool not_B(Bool); + +void force_B(Bool b, int n); + +/* BoolVal boolValue(Bool b) */ + +#define boolValue(b) ((b)->gen.tag.value) + +Real realIf(int, ...); +Real realError(char *); + +typedef void * Delay_Arg; +typedef Real (*Delay_Fun)(Delay_Arg); + +char *digitToString(Digit); +char *signToString(Sign); + +void retrieveInfo(Real, Sign *, int *, mpz_t); +Digit takeDigit(int *, mpz_t); + + +#endif diff --git a/ic-reals-6.3/save-real.h b/ic-reals-6.3/save-real.h new file mode 100644 index 0000000..572b2d7 --- /dev/null +++ b/ic-reals-6.3/save-real.h @@ -0,0 +1,504 @@ +/* + * Copyright (C) 2000, Imperial College + * + * This file is part of the Imperial College Exact Real Arithmetic Library. + * See the copyright notice included in the distribution for conditions + * of use. + */ + +/* + * This is the include for all applications using reals. It defines all + * the types the user sees, principally Real and Bool, and the prototypes + * functions which operate on these types. + * + * It also defines the various types of objects in the heap. Each is a + * structure, the first word of which is a tag, containing amongst other + * things a code to identify the type of object. + */ + +#include <gmp.h> + +typedef union _Real * Real; +typedef union _Bool * Bool; + +/* + * Each object in the heap is assigned one of the following codes. + */ +typedef enum { + ALT, /* selects amongst boolean guarded expressions */ + VECTOR, /* a vector (ie rational) */ + MATX, /* a matrix (the X reflects that there is one argument) */ + TENXY, /* a tensor (with two arguments) */ + DIGSX, /* a string or sequence of digits */ + SIGNX, /* this holds one of the sign values */ + CLOSURE, /* usually used to lazily produce futher lfts in expressions */ + BOOLX, /* propositional operator with one argument, eg negation */ + BOOLXY, /* operator with two arguments, eg conjunction */ + PREDX /* predicate over reals with one argument, eg x > 0 */ +} ObjType; + +typedef enum {FALSE = 0, TRUE = 1} bool; +typedef enum {LT = -1, EQ = 0, GT = 1} Comparison; + +/* + * The first word of each structure in the heap is a tag word defined + * below. + */ +typedef struct { + unsigned type : 4; /* an ObjType as defined above */ + unsigned dumped : 1; /* for traversing recursively when printing */ + unsigned value : 3; /* sign or boolean value */ + unsigned isSigned : 1; /* true when a real must be signed */ + unsigned nodeId : 21; /* each node has a unique id for debugging */ +} Tag; + +/* + * The next segment of the file defines the structures and constants + * dealing with reals. + */ + +/* + * Next we define the possible sign constant which includes a constant + * indicating that the sign is unknown. + * The order of the entries in the enum which follows is significant. It + * reflects our preference for SZERO. However, note that changing the order of + * the constants below is not sufficient to change the preference. One + * must also modify emitSign.c. + */ +typedef enum {SZERO, SINF, SPOS, SNEG, SIGN_UNKN} Sign; +typedef enum {DPOS = 1, DNEG = -1, DZERO = 0} Digit; + +/* + * We define the LFTS: vector, matrix and tensor. There are two + * varieties of each: one in which the entries are machine sized integers + * and the other in which the entries are GMP large integers. + * + * Vectors, matrices and tensors are arrays rather than structs. That + * way they have size and yet are passed as pointers (lvalues). This + * avoids some referencing and dereferencing. It turns out to be more + * convenient to define tensors as arrays of vectors rather than pairs + * of matrices since often we need to pull out columns without respecting + * matrix boundaries. + */ +typedef mpz_t Vector[2]; +typedef Vector Matrix[2]; +typedef Vector Tensor[4]; + +typedef int SmallVector[2]; +typedef SmallVector SmallMatrix[2]; +typedef SmallVector SmallTensor[4]; + +typedef union { + Vector Vec; + Matrix Mat; + Tensor Ten; +} LFT; + +/* + * This defines the fields which are common to all real continuations. + */ +typedef struct { + Tag tag; +} Generic; + +typedef struct { + Bool guard; + Real x; +} GuardedExpr; + +typedef struct { + Tag tag; + void (*force)(); /* is this needed ? */ + Real redirect; /* this is the ultimate value of the conditional */ + int nextGE; /* index of next guarded expression to force */ + int numGE; /* number of guarded expressions in the list */ + GuardedExpr *GE; /* the list of guarded expressions */ +} Alt; + +/* + * The x field below is the alternative representation of the real the + * Closure denotes. That is, when the closure is forced, it struct points + * to the object it unfolds to. That way, any subsequent request to the + * closure, won't force a second distinct unfolding. + */ +typedef struct { + Tag tag; + void (*force)(); + void *userData; + Real redirect; +} Cls; + +/* +Heap elements which hold lfts have a strm field. This hold a real stream +(ie a list of DigsX structures possibly prefixed by a SignX). This real +denotes the same value as the expression rooted by the lft. In some cases +having both representations is necessary. For top level vectors and matrices, +having the stream representation allows us to extract information from +the lft when demanded for printing. At the same time, the vectors and +matrices are still available should they become the argument of another +lft whereupon we want to reduce. The strm field is used by tensors since +reduction against a tensor argument is not possible and we must emit +imformation. However, it is sometimes not possible to create the stream +in advance. If the tensor has an argument guarded by an alt, then the alt +might eventually reduce to a vector and the tensor reduce to a matrix. +*/ + +typedef struct { + Tag tag; + void (*force)(); + Real strm; + Vector vec; +} Vec; + +typedef struct { + Tag tag; + void (*force)(); + Real strm; + Real x; + int totalEmitted; + Matrix mat; +} MatX; + +typedef struct { + Tag tag; + void (*forceX)(); + void (*forceY)(); + Real strm; + Real x; + Real y; + signed short totalEmitted; + signed short tensorFairness; /* counts left vs right absorptions */ + int xDigitsNeeded; + Tensor ten; +} TenXY; + +typedef struct { + Tag tag; + void (*force)(); + Real x; +} SignX; + +/* + * Sequences of digits are represented by ``characteristic pairs''. + * This is a pair of integers (n,c) in which c is the coding of + * n digits. When n <= DIGITS_PER_WORD, then c can be represented in a + * machine word. Otherwise we need a big integer. + * + * Below we use the value 30. In fact it is possible to use 31. The problem + * is that we need DIGITS_PER_WORD + 1 bits when we form a matrix. + * Setting it to 30 ensures that it always yields a matrix which fits + * into a signed machine word. + */ +#define DIGITS_PER_WORD 29 + +typedef struct _DigsX { + Tag tag; + void (*force)(); + Real x; + unsigned count; + union { + int small; + mpz_t big; + } word; +} DigsX; + +union _Real { + Generic gen; + Alt alt; + Vec vec; + SignX signX; + MatX matX; + DigsX digsX; + TenXY tenXY; + Cls cls; +}; + +/* + * The next segment of the file defines the structures and constants + * dealing with the lazy boolean type. + * + * I'm not very happy with the names of things here. There is too much + * overloading of the term bool (in both upper and lower case). + * + * bool : this is the usual booleans (two-valued) and used internally + * instead of int (and 0/1) simply as a matter of style. + * BoolVal : this is three valued boolean type + * Bool : this is the lazy boolean type which takes on values from BoolVal. + * The type is a union of the various heap allocated structures + * relevant to lazy booleans. + */ +typedef enum {LAZY_TRUE, LAZY_FALSE, LAZY_UNKNOWN} BoolVal; + +/* + * This is the constant to flag the default case in the realAlt function. + * The second of these is for backwards compatibility. + */ +#define DEFAULT_GUARD ((unsigned) 0xffffffffL) +#define B_DEFAULT (DEFAULT_GUARD) + +typedef struct { + Tag tag; + void (*force)(); + Real x; +} PredX; + +typedef struct { + Tag tag; + void (*force)(); + Bool x; +} BoolX; + +typedef struct { + Tag tag; + void (*force)(); + Bool x; + Bool y; +} BoolXY; + +union _Bool { + struct { + Tag tag; + void (*force)(); + } gen; + BoolX boolX; + BoolXY boolXY; + PredX predX; +}; + +void initReals(); + +Real consCN(Real, char *, int, int, int); + +void dumpReal(Real); +void dumpBool(Bool); +void dumpCell(void *); + +/* + * An application can set the following string to the name of the + * application, typically argv[0]. + */ +extern char *MyName; + +void force_R_Dec(Real, int); +void force_R_Digs(Real, int); + +void print_R_Dec(Real, int); +void print_R_Digs(Real, int); + +void print_R(Real); + +double realToDouble(Real); + +/* + * Basic LFT creation. This list includes the preferred names (real_*, lft_*) + * and the older names which may disappear in a future release. + */ +Real real_QInt(int, int); +Real real_QZ(mpz_t, mpz_t); + +Real lft_R_Int(Real, int, int, int, int); +Real lft_R_Z(Real, mpz_t, mpz_t, mpz_t, mpz_t); + +Real lft_R_R_Int(Real, Real, int, int, int, int, int, int, int, int); +Real lft_R_R_Z(Real, Real, mpz_t, mpz_t, mpz_t, mpz_t, + mpz_t, mpz_t, mpz_t, mpz_t); + +Real vector_Int(int, int); +Real vector_Z(mpz_t, mpz_t); + +Real matrix_Int(Real, int, int, int, int); +Real matrix_Z(Real, mpz_t, mpz_t, mpz_t, mpz_t); + +Real tensor_Int(Real, Real, int, int, int, int, int, int, int, int); +Real tensor_Z(Real, Real, mpz_t, mpz_t, mpz_t, mpz_t, + mpz_t, mpz_t, mpz_t, mpz_t); + +Real makeStream(Real); + +/* + * Basic arithmetic functions + */ +Real add_R_R(Real, Real); +Real add_R_Int(Real, int); +Real add_R_QInt(Real, int, int); +Real add_R_QZ(Real, mpz_t, mpz_t); + +Real sub_R_R(Real, Real); +Real sub_R_Int(Real, int); +Real sub_R_QInt(Real, int, int); +Real sub_Int_R(int, Real); +Real sub_QInt_R(int, int, Real); + +Real mul_R_R(Real, Real); +Real mul_R_Int(Real, int); +Real mul_R_QInt(Real, int, int); +Real mul_R_QZ(Real, mpz_t, mpz_t); + +Real div_R_R(Real, Real); +Real div_R_Int(Real, int); +Real div_R_QInt(Real, int, int); +Real div_Int_R(int, Real); +Real div_QInt_R(int, int, Real); + +Real pow_R_R(Real, Real); + +Real abs_R(Real); + +Real neg_R(Real); + +/* + * Analytic functions + */ +Real tan_R(Real); +Real tan_QZ(mpz_t, mpz_t); +Real tan_QInt(int, int); + +Real atan_R(Real); +Real atan_QZ(mpz_t, mpz_t); +Real atan_QInt(int, int); + +Real tanh_R(Real); +Real tanh_QZ(mpz_t, mpz_t); +Real tanh_QInt(int, int); + +Real atanh_R(Real); +Real atanh_QZ(mpz_t, mpz_t); +Real atanh_QInt(int, int); + +Real sin_R(Real); +Real sin_QZ(mpz_t, mpz_t); +Real sin_QInt(int, int); + +Real asin_R(Real); +Real asin_QZ(mpz_t, mpz_t); +Real asin_QInt(int, int); + +Real sinh_R(Real); +Real sinh_QZ(mpz_t, mpz_t); +Real sinh_QInt(int, int); + +Real asinh_R(Real); +Real asinh_QZ(mpz_t, mpz_t); +Real asinh_QInt(int, int); + +Real cos_R(Real); +Real cos_QZ(mpz_t, mpz_t); +Real cos_QInt(int, int); + +Real acos_R(Real); +Real acos_QZ(mpz_t, mpz_t); +Real acos_QInt(int, int); + +Real cosh_R(Real); +Real cosh_QZ(mpz_t, mpz_t); +Real cosh_QInt(int, int); + +Real acosh_R(Real); +Real acosh_QZ(mpz_t, mpz_t); +Real acosh_QInt(int, int); + +Real sec_R(Real); +Real sec_QInt(int, int); +Real sec_QZ(mpz_t, mpz_t); + +Real asec_R(Real); +Real asec_QInt(int, int); +Real asec_QZ(mpz_t, mpz_t); + +Real sech_R(Real); +Real sech_QInt(int, int); +Real sech_QZ(mpz_t, mpz_t); + +Real asech_R(Real); +Real asech_QInt(int, int); +Real asech_QZ(mpz_t, mpz_t); + +Real cosec_R(Real); +Real cosec_QInt(int, int); +Real cosec_QZ(mpz_t, mpz_t); + +Real acosec_R(Real); +Real acosec_QInt(int, int); +Real acosec_QZ(mpz_t, mpz_t); + +Real cosech_R(Real); +Real cosech_QInt(int, int); +Real cosech_QZ(mpz_t, mpz_t); + +Real acosech_R(Real); +Real acosech_QInt(int, int); +Real acosech_QZ(mpz_t, mpz_t); + +Real cotan_R(Real); +Real cotan_QInt(int, int); +Real cotan_QZ(mpz_t, mpz_t); + +Real acotan_R(Real); +Real acotan_QInt(int, int); +Real acotan_QZ(mpz_t, mpz_t); + +Real cotanh_R(Real); +Real cotanh_QInt(int, int); +Real cotanh_QZ(mpz_t, mpz_t); + +Real acotanh_R(Real); +Real acotanh_QInt(int, int); +Real acotanh_QZ(mpz_t, mpz_t); + +Real Pi; +Real E; + +Real sqrt_R(Real); +Real sqrt_QZ(mpz_t, mpz_t); +Real sqrt_QInt(int, int); + +Real exp_R(Real); +Real exp_QZ(mpz_t, mpz_t); +Real exp_QInt(int, int); + +Real log_R(Real); +Real log_QZ(mpz_t, mpz_t); +Real log_QInt(int, int); + +/* + * Predicates, boolean operators and the conditional. + */ +Bool ltEq_R_0(Real); +Bool lt_R_0(Real); + +Bool lt_R_R(Real, Real); +Bool ltEq_R_R(Real, Real); + +Bool ltEq_R_QInt(Real, int, int); +Bool lt_R_QInt(Real, int, int); + +Bool gtEq_R_0(Real); +Bool gt_R_0(Real); + +Bool gtEq_R_QInt(Real, int, int); +Bool gt_R_QInt(Real, int, int); + +Bool gt_R_R(Real, Real); +Bool gtEq_R_R(Real, Real); + +Bool and_B_B(Bool, Bool); +Bool or_B_B(Bool, Bool); +Bool not_B(Bool); + +/* BoolVal boolValue(Bool b) */ + +#define boolValue(b) ((b)->gen.tag.value) + +Real realIf(int, ...); +Real realError(char *); + +typedef void * Delay_Arg; +typedef Real (*Delay_Fun)(Delay_Arg); + +char *digitToString(Digit); +char *signToString(Sign); + +void retrieveInfo(Real, Sign *, int *, mpz_t); +Digit takeDigit(int *, mpz_t); + + diff --git a/ic-reals-6.3/tests/Makefile b/ic-reals-6.3/tests/Makefile new file mode 100644 index 0000000..fb22742 --- /dev/null +++ b/ic-reals-6.3/tests/Makefile @@ -0,0 +1,170 @@ +GMPDIR=$(HOME)/Desktop/gmp-4.3.1 + +LIB = \ + ../real.a \ + $(GMPDIR)/.libs/libgmp.a \ + -lm + +INCLUDE = \ + -I$(GMPDIR) \ + -I$(GMPDIR)/mpn \ + -I.. + +# CFLAGS = $(INCLUDE) -g -pg +CFLAGS = $(INCLUDE) -g +CC = gcc + +tan_R : tan_R.o $(LIB) + $(CC) tan_R.o $(LIB) -o tan_R + +tan_R_digit : tan_R_digit.o $(LIB) + $(CC) tan_R_digit.o $(LIB) -o tan_R_digit + +asin_R : asin_R.o $(LIB) + $(CC) asin_R.o $(LIB) -o asin_R + +acos_R : acos_R.o $(LIB) + $(CC) acos_R.o $(LIB) -o acos_R + +atan_R : atan_R.o $(LIB) + $(CC) atan_R.o $(LIB) -o atan_R + +atanh_R : atanh_R.o $(LIB) + $(CC) atanh_R.o $(LIB) -o atanh_R + +acosh_R : acosh_R.o $(LIB) + $(CC) acosh_R.o $(LIB) -o acosh_R + +asinh_R : asinh_R.o $(LIB) + $(CC) asinh_R.o $(LIB) -o asinh_R + +pow_R_R : pow_R_R.o $(LIB) + $(CC) pow_R_R.o $(LIB) -o pow_R_R + +tan_QZ : tan_QZ.o $(LIB) + $(CC) tan_QZ.o $(LIB) -o tan_QZ + +cos_Q : cos_Q.o $(LIB) + $(CC) cos_Q.o $(LIB) -o cos_Q + +tanh_R : tanh_R.o $(LIB) + $(CC) tanh_R.o $(LIB) -o tanh_R + +sinh_R : sinh_R.o $(LIB) + $(CC) sinh_R.o $(LIB) -o sinh_R + +cosh_R : cosh_R.o $(LIB) + $(CC) cosh_R.o $(LIB) -o cosh_R + +sqrt_R : sqrt_R.o $(LIB) + $(CC) sqrt_R.o $(LIB) -o sqrt_R + +sqrt_QZ : sqrt_QZ.o $(LIB) + $(CC) sqrt_QZ.o $(LIB) -o sqrt_QZ + +abs_R : abs_R.o $(LIB) + $(CC) abs_R.o $(LIB) -o abs_R + +log_R : log_R.o $(LIB) + $(CC) log_R.o $(LIB) -o log_R + +exp_R : exp_R.o $(LIB) + $(CC) exp_R.o $(LIB) -o exp_R + +exp_QInt : exp_QInt.o $(LIB) + $(CC) exp_QInt.o $(LIB) -o exp_QInt + +sin_R : sin_R.o $(LIB) + $(CC) sin_R.o $(LIB) -o sin_R + +cos_R : cos_R.o $(LIB) + $(CC) cos_R.o $(LIB) -o cos_R + +pi : pi.o $(LIB) + $(CC) pi.o $(LIB) -o pi + +iter : iter.o $(LIB) + $(CC) iter.o $(LIB) -o iter + +t01 : t01.o $(LIB) + $(CC) t01.o $(LIB) -o t01 + +t0 : t0.o $(LIB) + $(CC) t0.o $(LIB) -o t0 + +t1 : t1.o $(LIB) + $(CC) t1.o $(LIB) -o t1 + +t2 : t2.o $(LIB) + $(CC) t2.o $(LIB) -o t2 + +t3 : t3.o $(LIB) + $(CC) t3.o $(LIB) -o t3 + +iterate : iterate.o $(LIB) + $(CC) iterate.o $(LIB) -o iterate + +$(OBJS): ../real.h ../real-impl.h + +TARGETS=\ + abs_R \ + acosh_R \ + asinh_R \ + acos_R \ + asin_R \ + atan_R \ + atanh_R \ + cos_Q \ + cos_R \ + cosh_R \ + exp_R \ + log_R \ + pi \ + pow_R_R \ + sin_R \ + sinh_R \ + sqrt_QZ \ + sqrt_R \ + tan_QZ \ + tan_R \ + tan_R_digit \ + tanh_R \ + t01 \ + t0 \ + t1 \ + t2 \ + iter \ + iterate + +all : $(TARGETS) + +clean: + rm -f abs_R abs_R.o + rm -f acosh_R acosh_R.o + rm -f asinh_R asinh_R.o + rm -f atan_R atan_R.o + rm -f acos_R acos_R.o + rm -f asin_R asin_R.o + rm -f atanh_R atanh_R.o + rm -f cos_Q cos_Q.o + rm -f cos_R cos_R.o + rm -f cosh_R cosh_R.o + rm -f exp_R exp_R.o + rm -f log_R log_R.o + rm -f pi pi.o + rm -f pow_R_R pow_R_R.o + rm -f sin_R sin_R.o + rm -f sinh_R sinh_R.o + rm -f sqrt_QZ sqrt_QZ.o + rm -f sqrt_R sqrt_R.o + rm -f tan_QZ tan_QZ.o + rm -f tan_R tan_R.o + rm -f tan_R_digit tan_R_digit.o + rm -f tanh_R tanh_R.o + rm -f t01 t01.o + rm -f t0 t0.o + rm -f t1 t1.o + rm -f t2 t2.o + rm -f iterate iterate.o + rm -f iter iter.o + rm -f gmon.out diff --git a/ic-reals-6.3/tests/README b/ic-reals-6.3/tests/README new file mode 100644 index 0000000..992cead --- /dev/null +++ b/ic-reals-6.3/tests/README @@ -0,0 +1,33 @@ +Oct 22 1999 + +This is a collection of programs which exercise portions of the library. +They should not necessarily been viewed as examples of good programming +style. + +To compile any one of these tests you will need to change the +variable GMPDIR in Makefile. + +In many, though not all cases, the arguments to the functions are as +follows: + +tan_R <sign> <c> <n> <a> <b> <ndigits> + +where the first 5 arguments define a real number which is passed to +tan_R and <ndigits> is the number of (binary) digits to be forced and +printed (base 10) from the resulting real. + +The real is the <sign> followed by the list of digits coded as a +characteristic pair <c> <n> (where <n>) is a number of digits followed +by the vector continuation <a>/<b>. The characteristic pair denotes the +number <c> base 2^<n>. + +The <sign> argument is as follows: + +0 -> SZERO +1 -> SINF +2 -> SPOS +3 -> SNEG +4 -> SIGN_UNKN + +Lindsay + diff --git a/ic-reals-6.3/tests/abs_R.c b/ic-reals-6.3/tests/abs_R.c new file mode 100644 index 0000000..eda26ba --- /dev/null +++ b/ic-reals-6.3/tests/abs_R.c @@ -0,0 +1,48 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the abs_R when applied to a rational a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = tan_R(y); + + y = abs_R(x); + + printf("tan x="); + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + + printf("abs (tan x)="); + print_R(y); + printf("\n"); + printf("tan(x)=%f\n", tan(f)); +} diff --git a/ic-reals-6.3/tests/acos_R.c b/ic-reals-6.3/tests/acos_R.c new file mode 100644 index 0000000..5059135 --- /dev/null +++ b/ic-reals-6.3/tests/acos_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the acos_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = acos_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("acos(x)=%f\n", acos(f)); +} diff --git a/ic-reals-6.3/tests/acosh_R.c b/ic-reals-6.3/tests/acosh_R.c new file mode 100644 index 0000000..f5ff9eb --- /dev/null +++ b/ic-reals-6.3/tests/acosh_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the arccosh_R when applied to a rational a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = acosh_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("acosh(x)=%f\n", acosh(f)); +} diff --git a/ic-reals-6.3/tests/asin_R.c b/ic-reals-6.3/tests/asin_R.c new file mode 100644 index 0000000..e980a84 --- /dev/null +++ b/ic-reals-6.3/tests/asin_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the asin_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = asin_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("asin(x)=%f\n", asin(f)); +} diff --git a/ic-reals-6.3/tests/asinh_R.c b/ic-reals-6.3/tests/asinh_R.c new file mode 100644 index 0000000..859c61e --- /dev/null +++ b/ic-reals-6.3/tests/asinh_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the asinh_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = asinh_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("asinh(x)=%f\n", asinh(f)); +} diff --git a/ic-reals-6.3/tests/atan_R.c b/ic-reals-6.3/tests/atan_R.c new file mode 100644 index 0000000..1d0dd09 --- /dev/null +++ b/ic-reals-6.3/tests/atan_R.c @@ -0,0 +1,42 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the atan_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + debugTrace(1); + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = atan_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("atan(x)=%f\n", atan(f)); +} diff --git a/ic-reals-6.3/tests/atanh_R.c b/ic-reals-6.3/tests/atanh_R.c new file mode 100644 index 0000000..8261029 --- /dev/null +++ b/ic-reals-6.3/tests/atanh_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests atanh_R when applied a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = atanh_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("atanh(x)=%f\n", atanh(f)); +} diff --git a/ic-reals-6.3/tests/cos_Q.c b/ic-reals-6.3/tests/cos_Q.c new file mode 100644 index 0000000..99d13c7 --- /dev/null +++ b/ic-reals-6.3/tests/cos_Q.c @@ -0,0 +1,30 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the cos_QZ when applied a rational + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + mpz_t a, b; + + MyName = argv[0]; + + if (argc != 4) { + fprintf(stderr, "%s <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + mpz_init_set_str(a, argv[1], 10); + mpz_init_set_str(b, argv[2], 10); + + x = cos_QZ(a, b); + + print_R_Dec(x, atoi(argv[3])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/cos_R.c b/ic-reals-6.3/tests/cos_R.c new file mode 100644 index 0000000..f6b28e5 --- /dev/null +++ b/ic-reals-6.3/tests/cos_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the cos_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = cos_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("cos(x)=%f\n", cos(f)); +} diff --git a/ic-reals-6.3/tests/cosh_R.c b/ic-reals-6.3/tests/cosh_R.c new file mode 100644 index 0000000..64dc1ba --- /dev/null +++ b/ic-reals-6.3/tests/cosh_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the cosh_R when applied a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = cosh_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("cosh(x)=%f\n", cosh(f)); +} diff --git a/ic-reals-6.3/tests/exp_QInt.c b/ic-reals-6.3/tests/exp_QInt.c new file mode 100644 index 0000000..3424a99 --- /dev/null +++ b/ic-reals-6.3/tests/exp_QInt.c @@ -0,0 +1,32 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the exp_QInt when applied to an int rational. + */ +main(int argc, char *argv[]) +{ + Real x, y; + int a, b; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 4) { + fprintf(stderr, "%s <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + a = atoi(argv[1]); + b = atoi(argv[2]); + + x = exp_QInt(a, b); + + print_R_Dec(x, atoi(argv[3])); + printf("\n"); + printf("exp(x)=%f\n", exp(f)); +} diff --git a/ic-reals-6.3/tests/exp_R.c b/ic-reals-6.3/tests/exp_R.c new file mode 100644 index 0000000..2d9a469 --- /dev/null +++ b/ic-reals-6.3/tests/exp_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the exp_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = exp_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("exp(x)=%f\n", exp(f)); +} diff --git a/ic-reals-6.3/tests/iter.c b/ic-reals-6.3/tests/iter.c new file mode 100644 index 0000000..2c4d295 --- /dev/null +++ b/ic-reals-6.3/tests/iter.c @@ -0,0 +1,60 @@ +#include <stdio.h> +#include "real.h" +#include "real-impl.h" +#include <math.h> + +/* + * Reinhold's iter example from the user manual. + */ +Real eps, eps2; +Real delay(Real (*)(Real), Real); + +main(int argc, char *argv[]) +{ + Real x, y, z; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + Real iter(Real); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + debugTrace(1); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + + eps = vector_Int(1, 100000000); + eps2 = vector_Int(1, 200000000); + + x = iter(y); + print_R_Dec(x, atoi(argv[6])); + printf("\n"); +} + +Real +iter(Real x) +{ + Real y, d; + static int doneInit = 0; + void delayCls(); + + y = div_R_Int(x, 2); + d = abs_R(sub_R_R(x, y)); + return realIf(2, + lt_R_R(d, eps), y, + gt_R_R(d, eps2), realDelay((Delay_Fun) iter, (Delay_Arg) y)); +} diff --git a/ic-reals-6.3/tests/iterate.c b/ic-reals-6.3/tests/iterate.c new file mode 100644 index 0000000..89c3f07 --- /dev/null +++ b/ic-reals-6.3/tests/iterate.c @@ -0,0 +1,60 @@ +#include <stdio.h> +#include "real.h" +#include "real-impl.h" + +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + Real iterate(Real, int); + int niters; + + MyName = argv[0]; + + if (argc != 8) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <n-iters> <ndigits>\n", + MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + niters = atoi(argv[6]); + + print_R_Dec(y, atoi(argv[7])); + printf("\n"); + + x = iterate(y, niters); + + print_R_Dec(x, atoi(argv[7])); + printf("\n"); +} + +/* + * Iterates the function f(x) = 4x(1-x) + */ +Real +iterate(Real x, int n) +{ + Real p, q, r; + + if (n > 0) { + r = iterate(x, n - 1); + p = mul_R_Int(r, 4); + q = sub_Int_R(1, r); + r = mul_R_R(p, q); + if (n > 15) + r = makeStream(r); + return r; + } + else + return x; +} diff --git a/ic-reals-6.3/tests/log_R.c b/ic-reals-6.3/tests/log_R.c new file mode 100644 index 0000000..5db96d9 --- /dev/null +++ b/ic-reals-6.3/tests/log_R.c @@ -0,0 +1,39 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the log_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + f = realToDouble(y); + printf("\nx=%f\n",f); + + x = log_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\nlog(x)=%f\n", log(f)); +} diff --git a/ic-reals-6.3/tests/pi.c b/ic-reals-6.3/tests/pi.c new file mode 100644 index 0000000..655e35c --- /dev/null +++ b/ic-reals-6.3/tests/pi.c @@ -0,0 +1,20 @@ +#include <stdio.h> +#include "real.h" + +/* + * Prints pi (in base 10) to the specified number of digits. + */ +main(int argc, char *argv[]) +{ + MyName = argv[0]; + + if (argc != 2) { + fprintf(stderr, "%s <n>\n", MyName); + exit(1); + } + + initReals(); + + print_R_Dec(Pi, atoi(argv[1])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/pow_R_R.c b/ic-reals-6.3/tests/pow_R_R.c new file mode 100644 index 0000000..a702c83 --- /dev/null +++ b/ic-reals-6.3/tests/pow_R_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the pow_R_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = pow_R_R(y, y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("pow(x,x)=%f\n", pow(f,f)); +} diff --git a/ic-reals-6.3/tests/sin_R.c b/ic-reals-6.3/tests/sin_R.c new file mode 100644 index 0000000..042784a --- /dev/null +++ b/ic-reals-6.3/tests/sin_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the sin_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = sin_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("sin(x)=%f\n", sin(f)); +} diff --git a/ic-reals-6.3/tests/sinh_R.c b/ic-reals-6.3/tests/sinh_R.c new file mode 100644 index 0000000..36f0a42 --- /dev/null +++ b/ic-reals-6.3/tests/sinh_R.c @@ -0,0 +1,46 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the sinh_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + +#ifdef LATER + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ +#endif + + y = vector_Int(atoi(argv[4]), atoi(argv[5])); + + print_R_Dec(y, atoi(argv[6])); + + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = sinh_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("sinh(x)=%f\n", sinh(f)); +} diff --git a/ic-reals-6.3/tests/sqrt_QZ.c b/ic-reals-6.3/tests/sqrt_QZ.c new file mode 100644 index 0000000..610d580 --- /dev/null +++ b/ic-reals-6.3/tests/sqrt_QZ.c @@ -0,0 +1,31 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the sqrt_QZ when applied to a rational. + */ +main(int argc, char *argv[]) +{ + Real x, y; + Real sqrt_QZ(mpz_t, mpz_t); + double f; + mpz_t a, b; + + MyName = argv[0]; + + if (argc != 4) { + fprintf(stderr, "%s <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + mpz_init_set_str(a, argv[1], 10); + mpz_init_set_str(b, argv[2], 10); + + x = sqrt_QZ(a, b); + + print_R_Dec(x, atoi(argv[3])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/sqrt_R.c b/ic-reals-6.3/tests/sqrt_R.c new file mode 100644 index 0000000..32361f8 --- /dev/null +++ b/ic-reals-6.3/tests/sqrt_R.c @@ -0,0 +1,42 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the sqrt_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + debugTrace(1); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = sqrt_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("sqrt(x)=%f\n", sqrt(fabs(f))); +} diff --git a/ic-reals-6.3/tests/t0.c b/ic-reals-6.3/tests/t0.c new file mode 100644 index 0000000..4b1ca8b --- /dev/null +++ b/ic-reals-6.3/tests/t0.c @@ -0,0 +1,37 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Random test + */ +main(int argc, char *argv[]) +{ + Real x, y, z; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + + x = matrix_Int(y, 1, 2, 3, 4); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/t01.c b/ic-reals-6.3/tests/t01.c new file mode 100644 index 0000000..e3cfd8e --- /dev/null +++ b/ic-reals-6.3/tests/t01.c @@ -0,0 +1,67 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Random test + */ +main(int argc, char *argv[]) +{ + Real u, v, w, x, y, z; + Bool a, b, c, d; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + +/* + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } +*/ + + if (argc != 4) { + fprintf(stderr, "%s <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + +#ifdef JUNK + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ +#endif + + y = makeStream(vector_Int(atoi(argv[1]), atoi(argv[2]))); + print_R_Dec(y, atoi(argv[3])); + printf("\n"); + + y = makeStream(y); + + u = makeStream(vector_Int(-1, 2)); + u = makeStream(mul_R_Int(u, 1)); + v = makeStream(vector_Int(1, 3)); + v = makeStream(mul_R_Int(v, 1)); + w = makeStream(vector_Int(1, 4)); + w = makeStream(mul_R_Int(w, 1)); + x = makeStream(vector_Int(1, 5)); + + a = and_B_B(gt_R_QInt(y, 0, 5), lt_R_QInt(y, 2, 5)); + b = and_B_B(gt_R_QInt(y, 1, 5), lt_R_QInt(y, 3, 5)); + c = and_B_B(gt_R_QInt(y, 2, 5), lt_R_QInt(y, 4, 5)); + d = and_B_B(gt_R_QInt(y, 3, 5), lt_R_QInt(y, 5, 5)); + + z = realIf(4, a, u, b, v, c, w, d, x); + print_R_Dec(z, atoi(argv[3])); + printf("\n"); + + z = add_R_R(z, z); + + print_R_Dec(z, atoi(argv[3])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/t1.c b/ic-reals-6.3/tests/t1.c new file mode 100644 index 0000000..6652c7f --- /dev/null +++ b/ic-reals-6.3/tests/t1.c @@ -0,0 +1,53 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the cos_R when applied to a rational a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y, z; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + +#ifdef NOT_NOW + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ +#endif + + y = vector_Int(atoi(argv[4]), atoi(argv[5])); + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + + f = realToDouble(y); + printf("x=%f\n",f); + + x = cos_R(y); + x = mul_R_R(x, x); + + z = sin_R(y); + z = mul_R_R(z, z); + + x = add_R_R(x, z); + x = sqrt_R(x); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("t1(x)=%f\n", sqrt(cos(f)*cos(f) + sin(f)*sin(f))); +} diff --git a/ic-reals-6.3/tests/t2.c b/ic-reals-6.3/tests/t2.c new file mode 100644 index 0000000..a41eed0 --- /dev/null +++ b/ic-reals-6.3/tests/t2.c @@ -0,0 +1,42 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * computes log(exp(x)) + */ +main(int argc, char *argv[]) +{ + Real x, y, z; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + + f = realToDouble(y); + printf("x=%f\n",f); + + x = exp_R(y); + x = log_R(x); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("t2(x)=%f\n", log(exp(f))); +} diff --git a/ic-reals-6.3/tests/t3.c b/ic-reals-6.3/tests/t3.c new file mode 100644 index 0000000..9d5dd26 --- /dev/null +++ b/ic-reals-6.3/tests/t3.c @@ -0,0 +1,26 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +main(int argc, char *argv[]) +{ + Real x, y, z; + int a, b; + double f; + + MyName = argv[0]; + + if (argc != 4) { + fprintf(stderr, "%s <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + a = atoi(argv[1]); + b = atoi(argv[2]); + x = real_QInt(a, b); + y = mul_R_R(x, x); + print_R_Dec(y, atoi(argv[3])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/tan_QZ.c b/ic-reals-6.3/tests/tan_QZ.c new file mode 100644 index 0000000..4fb1e6c --- /dev/null +++ b/ic-reals-6.3/tests/tan_QZ.c @@ -0,0 +1,30 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the tan_QZ when applied to a rational. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + mpz_t a, b; + + MyName = argv[0]; + + if (argc != 4) { + fprintf(stderr, "%s <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + mpz_init_set_str(a, argv[1], 10); + mpz_init_set_str(b, argv[2], 10); + + x = tan_QZ(a, b); + + print_R_Dec(x, atoi(argv[3])); + printf("\n"); +} diff --git a/ic-reals-6.3/tests/tan_R.c b/ic-reals-6.3/tests/tan_R.c new file mode 100644 index 0000000..fbe3b8d --- /dev/null +++ b/ic-reals-6.3/tests/tan_R.c @@ -0,0 +1,64 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the tan_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y, z; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + +/* + y = vector_Int(atoi(argv[4]), atoi(argv[5])); +*/ + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = tan_R(y); + printf("tan(x)="); + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + + z = atan_R(x); + printf("atan(tan(x))="); + print_R_Dec(z, atoi(argv[6])); + printf("\n"); + + z = div_R_R(y, z); + printf("x / atan(tan(x))="); + print_R_Dec(z, atoi(argv[6])); + printf("\n"); + + z = div_R_R(z, Pi); + printf("(x / atan(tan(x))) / Pi="); + print_R_Dec(z, atoi(argv[6])); + printf("\n"); + + printf("tan(x)=%f\n", tan(f)); + printf("atan(tan(x))=%f\nx / atan(tan(x))=%f\n(x / atan(tan(x)))/pi=%f\n", + atan(tan(f)), + f / atan(tan(f)), + (f / atan(tan(f))) / M_PI); +} diff --git a/ic-reals-6.3/tests/tan_R_digit.c b/ic-reals-6.3/tests/tan_R_digit.c new file mode 100644 index 0000000..18bdc2e --- /dev/null +++ b/ic-reals-6.3/tests/tan_R_digit.c @@ -0,0 +1,55 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * This is the same as the tan_R test but shows how to retrieve digits + * from a real incrementally. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + mpz_t digits; + Sign sign; + Digit digit; + int count; + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = tan_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("tan(x)=%f\n", tan(f)); + + mpz_init(digits); + retrieveInfo(x, &sign, &count, digits); + + printf("%s ", signToString(sign)); + while (count > 0) { + digit = takeDigit(&count, digits); + printf("%s ", digitToString(digit)); + } + printf("\n"); +} diff --git a/ic-reals-6.3/tests/tanh_R.c b/ic-reals-6.3/tests/tanh_R.c new file mode 100644 index 0000000..370e5b6 --- /dev/null +++ b/ic-reals-6.3/tests/tanh_R.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include "real.h" +#include <math.h> + +/* + * Tests the tanh_R when applied to a real expressed + * by a sign, a characteristic pair and a vector. + */ +main(int argc, char *argv[]) +{ + Real x, y; + double f; + Real makeRealSignCNQInt(Sign, char *, int, int, int); + + MyName = argv[0]; + + if (argc != 7) { + fprintf(stderr, "%s <sign> <c> <n> <a> <b> <ndigits>\n", MyName); + exit(1); + } + + initReals(); + + y = makeRealSignCNQInt( + atoi(argv[1]), /* sign */ + argv[2], /* c */ + atoi(argv[3]), /* n */ + atoi(argv[4]), /* a */ + atoi(argv[5])); /* b */ + + print_R_Dec(y, atoi(argv[6])); + printf("\n"); + f = realToDouble(y); + printf("x=%f\n",f); + + x = tanh_R(y); + + print_R_Dec(x, atoi(argv[6])); + printf("\n"); + printf("tanh(x)=%f\n", tanh(f)); +} |