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/stack.c | 244 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 244 insertions(+) create mode 100644 ic-reals-6.3/base/stack.c (limited to 'ic-reals-6.3/base/stack.c') 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); +} -- cgit v1.2.3