From 11da511c784eca003deb90c23570f0873954e0de Mon Sep 17 00:00:00 2001 From: Duncan Wilkie Date: Sat, 18 Nov 2023 06:11:09 -0600 Subject: Initial commit. --- ic-reals-6.3/base/Alt.c | 285 +++++ ic-reals-6.3/base/DigsX.c | 850 +++++++++++++++ ic-reals-6.3/base/Makefile | 46 + ic-reals-6.3/base/MatX.c | 902 +++++++++++++++ ic-reals-6.3/base/SignX.c | 675 ++++++++++++ ic-reals-6.3/base/TenXY.c | 1752 ++++++++++++++++++++++++++++++ ic-reals-6.3/base/Vector.c | 99 ++ ic-reals-6.3/base/boolLib.c | 77 ++ ic-reals-6.3/base/boolOp.c | 397 +++++++ ic-reals-6.3/base/boolUtil.c | 405 +++++++ ic-reals-6.3/base/davinciInterface.c | 947 ++++++++++++++++ ic-reals-6.3/base/debug.c | 24 + ic-reals-6.3/base/delay.c | 49 + ic-reals-6.3/base/digitHandling.c | 78 ++ ic-reals-6.3/base/dump.c | 382 +++++++ ic-reals-6.3/base/emitDigit.c | 560 ++++++++++ ic-reals-6.3/base/emitSign.c | 618 +++++++++++ ic-reals-6.3/base/epsDel.c | 133 +++ ic-reals-6.3/base/error.c | 66 ++ ic-reals-6.3/base/forceFuncLookupTable.c | 399 +++++++ ic-reals-6.3/base/force_B.c | 23 + ic-reals-6.3/base/force_R.c | 231 ++++ ic-reals-6.3/base/garbage.c | 44 + ic-reals-6.3/base/gt0.c | 551 ++++++++++ ic-reals-6.3/base/gteq0.c | 676 ++++++++++++ ic-reals-6.3/base/nodeId.c | 81 ++ ic-reals-6.3/base/print.c | 321 ++++++ ic-reals-6.3/base/realLib.c | 486 +++++++++ ic-reals-6.3/base/stack.c | 244 +++++ ic-reals-6.3/base/strategy.c | 87 ++ ic-reals-6.3/base/strictAlt.c | 129 +++ ic-reals-6.3/base/strsep.c | 25 + ic-reals-6.3/base/util.c | 858 +++++++++++++++ 33 files changed, 12500 insertions(+) create mode 100644 ic-reals-6.3/base/Alt.c create mode 100644 ic-reals-6.3/base/DigsX.c create mode 100644 ic-reals-6.3/base/Makefile create mode 100644 ic-reals-6.3/base/MatX.c create mode 100644 ic-reals-6.3/base/SignX.c create mode 100644 ic-reals-6.3/base/TenXY.c create mode 100644 ic-reals-6.3/base/Vector.c create mode 100644 ic-reals-6.3/base/boolLib.c create mode 100644 ic-reals-6.3/base/boolOp.c create mode 100644 ic-reals-6.3/base/boolUtil.c create mode 100644 ic-reals-6.3/base/davinciInterface.c create mode 100644 ic-reals-6.3/base/debug.c create mode 100644 ic-reals-6.3/base/delay.c create mode 100644 ic-reals-6.3/base/digitHandling.c create mode 100644 ic-reals-6.3/base/dump.c create mode 100644 ic-reals-6.3/base/emitDigit.c create mode 100644 ic-reals-6.3/base/emitSign.c create mode 100644 ic-reals-6.3/base/epsDel.c create mode 100644 ic-reals-6.3/base/error.c create mode 100644 ic-reals-6.3/base/forceFuncLookupTable.c create mode 100644 ic-reals-6.3/base/force_B.c create mode 100644 ic-reals-6.3/base/force_R.c create mode 100644 ic-reals-6.3/base/garbage.c create mode 100644 ic-reals-6.3/base/gt0.c create mode 100644 ic-reals-6.3/base/gteq0.c create mode 100644 ic-reals-6.3/base/nodeId.c create mode 100644 ic-reals-6.3/base/print.c create mode 100644 ic-reals-6.3/base/realLib.c create mode 100644 ic-reals-6.3/base/stack.c create mode 100644 ic-reals-6.3/base/strategy.c create mode 100644 ic-reals-6.3/base/strictAlt.c create mode 100644 ic-reals-6.3/base/strsep.c create mode 100644 ic-reals-6.3/base/util.c (limited to 'ic-reals-6.3/base') 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 +#include "real.h" +#include "real-impl.h" + +/* + * This file contains support for realIf (aka alternation). + */ + +#include + +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 +#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 +#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 +#include "real.h" +#include +#include +#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 +#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 +#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 +#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 +#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 +#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 +#include "real.h" +#include "real-impl.h" +#include +#include +#include +#include + +/* + * 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 +#include + +/* + * 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 +#include + +/* + * 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 +#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 +#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 +#include "real.h" +#include "real-impl.h" +#include + +/* + * 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 +#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 +#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 +#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 +#include "real.h" +#include "real-impl.h" +#include +#include +#include + +/* + * 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 +#include +#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 +#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 +#include "real.h" +#include "real-impl.h" +#include + +/* + * 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 +#include "real.h" +#include +#include +#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 +#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 +#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 +#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 +#include "real.h" +#include "real-impl.h" +#include + +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 +#include +#include +#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 +#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 +#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 +#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 + +/* + * ### 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 +#include + +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 +#include "real.h" +#include +#include +#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"); + } +} + -- cgit v1.2.3