1135 lines · c
1/*2 Name: imcalc.c3 Purpose: Simple RPN calculator based on IMath library.4 Author: M. J. Fromberger5 6 This is a very simplistic RPN calculator that will let you test the features7 of the IMath built-in functions.8 9 Copyright (C) 2002-2008 Michael J. Fromberger, All Rights Reserved.10 11 Permission is hereby granted, free of charge, to any person obtaining a copy12 of this software and associated documentation files (the "Software"), to deal13 in the Software without restriction, including without limitation the rights14 to use, copy, modify, merge, publish, distribute, sublicense, and/or sell15 copies of the Software, and to permit persons to whom the Software is16 furnished to do so, subject to the following conditions:17 18 The above copyright notice and this permission notice shall be included in19 all copies or substantial portions of the Software.20 21 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR22 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,23 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE24 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER25 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,26 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE27 SOFTWARE.28 */29 30#include <assert.h>31#include <ctype.h>32#include <errno.h>33#include <limits.h>34#include <stdio.h>35#include <stdlib.h>36#include <string.h>37#include <strings.h> /* for strcasecmp */38 39#include <getopt.h>40#include <unistd.h>41 42#include "imath.h"43#include "imrat.h"44#include "iprime.h"45 46/* A cstate_t represents a stack of operands; numeric operands are pushed on47 the stack, and commands cause them to be consumed in various ways.48 */49typedef struct {50 /* Operand stack */51 mp_int *elts;52 mp_size alloc; /* number of slots available */53 mp_size used; /* number of slots free */54 55 /* Named variables */56 mp_int *mem; /* named memory slots */57 char **names; /* names of memory slots */58 mp_size mslots; /* number of memory slots */59 mp_size mused; /* number of used memories */60 61 /* I/O components */62 FILE *ifp; /* input file handle */63 char *ibuf; /* input scratch buffer */64 int buflen; /* size of scratch buffer */65} cstate_t;66 67static mp_result state_init(cstate_t *sp, mp_size n_elts);68static void state_clear(cstate_t *sp);69static void stack_flush(cstate_t *sp);70static mp_result stack_push(cstate_t *sp, mp_int elt);71static mp_result stack_pop(cstate_t *sp);72static mp_result mem_insert(cstate_t *sp, const char *name, mp_int value);73static mp_result mem_recall(cstate_t *sp, const char *name, mp_int value);74static mp_result mem_clear(cstate_t *sp);75 76typedef mp_result (*op_func)(cstate_t *);77 78static mp_result cf_abs(cstate_t *sp);79static mp_result cf_neg(cstate_t *sp);80static mp_result cf_add(cstate_t *sp);81static mp_result cf_sub(cstate_t *sp);82static mp_result cf_mul(cstate_t *sp);83static mp_result cf_divmod(cstate_t *sp);84static mp_result cf_div(cstate_t *sp);85static mp_result cf_mod(cstate_t *sp);86static mp_result cf_expt(cstate_t *sp);87static mp_result cf_exptmod(cstate_t *sp);88static mp_result cf_square(cstate_t *sp);89static mp_result cf_invmod(cstate_t *sp);90static mp_result cf_gcd(cstate_t *sp);91static mp_result cf_xgcd(cstate_t *sp);92static mp_result cf_sqrt(cstate_t *sp);93static mp_result cf_root(cstate_t *sp);94static mp_result cf_cmplt(cstate_t *sp);95static mp_result cf_cmpgt(cstate_t *sp);96static mp_result cf_cmple(cstate_t *sp);97static mp_result cf_cmpge(cstate_t *sp);98static mp_result cf_cmpeq(cstate_t *sp);99static mp_result cf_cmpne(cstate_t *sp);100static mp_result cf_inc(cstate_t *sp);101static mp_result cf_dec(cstate_t *sp);102static mp_result cf_fact(cstate_t *sp);103static mp_result cf_pprint(cstate_t *sp);104static mp_result cf_print(cstate_t *sp);105static mp_result cf_pstack(cstate_t *sp);106static mp_result cf_clstk(cstate_t *sp);107static mp_result cf_pop(cstate_t *sp);108static mp_result cf_dup(cstate_t *sp);109static mp_result cf_copy(cstate_t *sp);110static mp_result cf_swap(cstate_t *sp);111static mp_result cf_rot(cstate_t *sp);112static mp_result cf_pick(cstate_t *sp);113static mp_result cf_setr(cstate_t *sp);114static mp_result cf_setbin(cstate_t *sp);115static mp_result cf_help(cstate_t *sp);116static mp_result cf_store(cstate_t *sp);117static mp_result cf_recall(cstate_t *sp);118static mp_result cf_cmem(cstate_t *sp);119static mp_result cf_pmem(cstate_t *sp);120static mp_result cf_qrecall(cstate_t *sp);121 122typedef struct {123 char *name; /* The name of the operator. */124 int stack_size; /* Number of stack arguments required. */125 op_func handler; /* Function implementing operation. */126 char *descript; /* Human-readable description. */127} calcop_t;128 129static calcop_t g_ops[] = {130 {"abs", 1, cf_abs, "x -- |x|"},131 {"neg", 1, cf_neg, "x -- (-x)"},132 {"+", 2, cf_add, "x y -- (x+y)"},133 {"add", 2, cf_add, "x y -- (x+y)"},134 {"-", 2, cf_sub, "x y -- (x-y)"},135 {"sub", 2, cf_sub, "x y -- (x-y)"},136 {"*", 2, cf_mul, "x y -- (x*y)"},137 {"mul", 2, cf_mul, "x y -- (x*y)"},138 {"/", 2, cf_divmod, "x y -- q r ; x = yq + r, 0 <= r < y"},139 {"//", 2, cf_div, "x y -- (x div y)"},140 {"div", 2, cf_div, "x y -- (x div y)"},141 {"%", 2, cf_mod, "x y -- (x mod y)"},142 {"mod", 2, cf_mod, "x y -- (x mod y)"},143 {"^", 2, cf_expt, "x y -- (x^y)"},144 {"expt", 2, cf_expt, "x y -- (x^y)"},145 {"^^", 3, cf_exptmod, "x y m -- (x^y mod m)"},146 {"emod", 3, cf_exptmod, "x y m -- (x^y mod m)"},147 {"sqr", 1, cf_square, "x -- (x*x)"},148 {"inv", 2, cf_invmod, "x m -- (1/x mod m)"},149 {"gcd", 2, cf_gcd, "x y -- gcd(x, y)"},150 {"xgcd", 2, cf_xgcd, "x y -- g u v ; g = ux + vy"},151 {"sqrt", 1, cf_sqrt, "x -- floor(sqrt(x))"},152 {"root", 2, cf_root, "x y -- floor(x^{1/y}) ; y > 0"},153 {"<", 2, cf_cmplt, "x y -- (x<y)"},154 {">", 2, cf_cmpgt, "x y -- (x>y)"},155 {"<=", 2, cf_cmple, "x y -- (x<=y)"},156 {">=", 2, cf_cmpge, "x y -- (x>=y)"},157 {"=", 2, cf_cmpeq, "x y -- (x=y)"},158 {"<>", 2, cf_cmpne, "x y -- (x<>y)"},159 {"inc", 1, cf_inc, "x -- (x+1)"},160 {"dec", 1, cf_dec, "x -- (x-1)"},161 {"!", 1, cf_fact, "x -- x!"},162 {"fact", 1, cf_fact, "x -- x!"},163 164 {".", 1, cf_pprint, "x -- ; print x in current output mode"},165 {";", 1, cf_print, "x -- x ; print x in current output mode"},166 {"?", 0, cf_pstack, "-- ; print stack"},167 {"cls", 0, cf_clstk, "... -- ; clear stack"},168 {"$", 1, cf_pop, "x --"},169 {"drop", 1, cf_pop, "x --"},170 {"dup", 1, cf_dup, "x -- x x"},171 {"copy", 2, cf_copy, "vn ... v1 v0 n -- vn ... v0 vn ... v0"},172 {"swap", 2, cf_swap, "x y -- y x"},173 {"rot", 3, cf_rot, "a b c -- b c a"},174 {"pick", 2, cf_pick, "... v2 v1 v0 n -- ... v2 v1 v0 vn"},175 176 {">>", 1, cf_store, "x -- ; save in named variable"},177 {"<<", 0, cf_recall, "-- x ; recall from named variable"},178 {"clm", 0, cf_cmem, "-- ; clear memory"},179 {"??", 0, cf_pmem, "-- ; print memory"},180 181 {"out", 1, cf_setr, "r -- ; set output radix to r"},182 {"bin", 0, cf_setbin, "-- ; set output format to binary"},183 {"help", 0, cf_help, "-- ; print help message"},184 185 /* This is the end-marker, but it is also used to catch implicit186 variable lookups from memory.187 */188 {NULL, 0, cf_qrecall, "-- x ; recall from named variable"},189};190 191#define BUFFER_SIZE 16384 /* max. length of input values, in chars */192 193/* Token types from the primitive lexical analyzer */194typedef enum { t_eof, t_symbol, t_number, t_error } token_t;195 196static token_t next_token(FILE *ifp, char *buf, int size);197static mp_result read_number(char *buf, mp_int *out);198static int find_command(cstate_t *ops);199static void print_value(mp_int v);200static mp_result run_file(FILE *ifp, cstate_t *op_state);201 202/* Error code used internally to signal input problems. */203static mp_result MP_INPUT;204 205static int g_output_radix = 10; /* output radix */206static FILE *g_output_file = NULL;207 208int main(int argc, char *argv[]) {209 extern char *optarg;210 extern int optind;211 212 int opt, errs = 0;213 FILE *ifp;214 215 cstate_t op_state;216 mp_result res;217 218 MP_INPUT = MP_MINERR - 1;219 220 g_output_file = stdout;221 while ((opt = getopt(argc, argv, "ho:")) != EOF) {222 switch (opt) {223 case 'h':224 fprintf(225 stderr,226 "Usage: imcalc [-h] [-o <output>] input*\n\n"227 "Options:\n"228 " -h : display this help message.\n"229 " -o <output> : send output to file.\n\n"230 231 "If no input files are given, the standard input is read. The\n"232 "special file name \"-\" is interpreted to mean the standard "233 "input.\n"234 "Output goes to standard output unless \"-o\" is used.\n\n");235 return 0;236 237 case 'o':238 if ((g_output_file = fopen(optarg, "wt")) == NULL) {239 fprintf(stderr, "Unable to open \"%s\" for writing: %s\n", optarg,240 strerror(errno));241 return 1;242 }243 break;244 245 default:246 fprintf(stderr,247 "Usage: imcalc [-h] [-o <output>] input*\n"248 " [use \"imcalc -h\" to get help]\n\n");249 return 1;250 }251 }252 253 if ((res = state_init(&op_state, 1)) != MP_OK) {254 fprintf(stderr, "Error: state_init: %s\n", mp_error_string(res));255 return 1;256 }257 258 if (optind < argc) {259 int ix;260 261 for (ix = optind; ix < argc; ++ix) {262 if (strcmp(argv[ix], "-") == 0)263 ifp = stdin;264 else if ((ifp = fopen(argv[optind], "rt")) == NULL) {265 fprintf(stderr, "Unable to open \"%s\" for reading: %s\n", argv[optind],266 strerror(errno));267 return 1;268 }269 270 if (run_file(ifp, &op_state) != MP_OK) ++errs;271 }272 273 state_clear(&op_state);274 return errs > 0;275 } else {276 int rv = 1 - (run_file(stdin, &op_state) == MP_OK);277 state_clear(&op_state);278 return rv;279 }280}281 282static token_t next_token(FILE *ifp, char *buf, int size) {283 int ch, pos = 0;284 token_t res;285 286 assert(buf != NULL && size > 0);287 288 while ((ch = fgetc(ifp)) != EOF && isspace(ch)) /* empty */289 ;290 291 if (ch == EOF) {292 buf[0] = '\0';293 return t_eof;294 }295 296 if (ch == '-') {297 int next = fgetc(ifp);298 if (next == EOF || !isdigit(next))299 res = t_symbol;300 else301 res = t_number;302 ungetc(next, ifp);303 } else if (isdigit(ch) || ch == '#')304 res = t_number;305 else306 res = t_symbol;307 308 buf[pos++] = ch;309 while ((ch = fgetc(ifp)) != EOF) {310 if ((res == t_number && ispunct(ch) && ch != '-') ||311 (res == t_symbol && isdigit(ch)) || isspace(ch)) {312 ungetc(ch, ifp);313 break;314 } else if (pos + 1 >= size) {315 res = t_error;316 break;317 }318 buf[pos++] = ch;319 }320 321 buf[pos] = '\0';322 return res;323}324 325static mp_result read_number(char *buf, mp_int *out) {326 int radix = 10, pos = 0;327 mp_result res;328 mp_int value;329 330 assert(buf != NULL && out != NULL);331 332 if (buf[pos] == '#') {333 switch (buf[1]) {334 case 'b':335 case 'B':336 radix = 2;337 break;338 case 'd':339 case 'D':340 radix = 10;341 break;342 case 'o':343 case 'O':344 radix = 8;345 break;346 case 'x':347 case 'X':348 radix = 16;349 break;350 default:351 return MP_BADARG;352 }353 354 pos += 2;355 }356 357 if ((value = mp_int_alloc()) == NULL) {358 *out = NULL;359 return MP_MEMORY;360 }361 362 if ((res = mp_int_read_string(value, radix, buf + pos)) != MP_OK) {363 mp_int_free(value);364 *out = NULL;365 return res;366 }367 368 *out = value;369 return res;370}371 372static int find_command(cstate_t *op) {373 int ix, jx;374 char *buf = op->ibuf;375 376 /* First, try to find the command by name */377 for (ix = 0; g_ops[ix].name != NULL; ++ix) {378 if (strcasecmp(buf, g_ops[ix].name) == 0) return ix;379 }380 381 /* If we don't find the command, try a variable lookup */382 for (jx = 0; (mp_size)jx < op->mused; ++jx) {383 if (strcmp(buf, op->names[jx]) == 0) return ix; /* sentinel */384 }385 386 /* If variable lookup fails, report command not found */387 return -1;388}389 390static void print_value(mp_int v) {391 if (g_output_radix == 0) {392 mp_result len = mp_int_binary_len(v);393 unsigned char *buf = malloc(len);394 int ix;395 396 if (buf != NULL) {397 mp_int_to_binary(v, buf, len);398 for (ix = 0; ix < len - 1; ++ix) {399 fprintf(g_output_file, "%02x.", buf[ix]);400 }401 fprintf(g_output_file, "%02x\n", buf[ix]);402 free(buf);403 } else {404 fprintf(g_output_file, "<insufficient memory to print>\n");405 }406 } else {407 mp_result len = mp_int_string_len(v, g_output_radix);408 char *buf = malloc(len);409 410 if (buf != NULL) {411 mp_int_to_string(v, g_output_radix, buf, len);412 fputs(buf, g_output_file);413 fputc('\n', g_output_file);414 free(buf);415 } else {416 fprintf(g_output_file, "<insufficient memory to print>\n");417 }418 }419}420 421static mp_result run_file(FILE *ifp, cstate_t *op_state) {422 mp_result res = MP_OK;423 token_t next;424 425 op_state->ifp = ifp;426 while ((next = next_token(ifp, op_state->ibuf, op_state->buflen)) != t_eof) {427 mp_int value = NULL;428 int cpos;429 430 switch (next) {431 case t_number:432 if ((res = read_number(op_state->ibuf, &value)) != MP_OK)433 fprintf(stderr, "error: invalid number syntax: %s\n", op_state->ibuf);434 else if ((res = stack_push(op_state, value)) != MP_OK)435 goto EXIT;436 break;437 case t_symbol:438 if ((cpos = find_command(op_state)) < 0) {439 fprintf(stderr, "error: command not understood: %s\n",440 op_state->ibuf);441 } else if (op_state->used < (mp_size)g_ops[cpos].stack_size) {442 fprintf(stderr, "error: not enough arguments (have %d, want %d)\n",443 op_state->used, g_ops[cpos].stack_size);444 } else if ((res = (g_ops[cpos].handler)(op_state)) != MP_OK) {445 if (res == MP_INPUT) {446 fprintf(stderr, "error: incorrect input format\n");447 } else {448 fprintf(stderr, "error: %s\n", mp_error_string(res));449 }450 }451 break;452 default:453 fprintf(stderr, "error: invalid input token: %s\n", op_state->ibuf);454 res = MP_BADARG;455 goto EXIT;456 }457 }458 459EXIT:460 return res;461}462 463static mp_result state_init(cstate_t *sp, mp_size n_elts) {464 int ix;465 466 assert(sp != NULL && n_elts > 0);467 468 if ((sp->elts = malloc(n_elts * sizeof(*(sp->elts)))) == NULL)469 return MP_MEMORY;470 if ((sp->mem = malloc(n_elts * sizeof(*(sp->mem)))) == NULL) {471 free(sp->elts);472 return MP_MEMORY;473 }474 if ((sp->names = malloc(n_elts * sizeof(*(sp->names)))) == NULL) {475 free(sp->mem);476 free(sp->elts);477 return MP_MEMORY;478 }479 if ((sp->ibuf = malloc(BUFFER_SIZE * sizeof(char))) == NULL) {480 free(sp->names);481 free(sp->mem);482 free(sp->elts);483 return MP_MEMORY;484 }485 486 for (ix = 0; (mp_size)ix < n_elts; ++ix) {487 sp->elts[ix] = NULL;488 sp->mem[ix] = NULL;489 sp->names[ix] = NULL;490 }491 492 sp->alloc = n_elts;493 sp->used = 0;494 sp->mslots = n_elts;495 sp->mused = 0;496 sp->buflen = BUFFER_SIZE;497 498 return MP_OK;499}500 501static void state_clear(cstate_t *sp) {502 assert(sp != NULL);503 504 if (sp->elts != NULL) {505 int ix;506 507 for (ix = 0; (mp_size)ix < sp->used; ++ix) {508 mp_int_clear(sp->elts[ix]);509 sp->elts[ix] = NULL;510 }511 512 free(sp->elts);513 sp->elts = NULL;514 sp->alloc = 0;515 sp->used = 0;516 }517 if (sp->mem != NULL) {518 int ix;519 520 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {521 mp_int_free(sp->mem[ix]);522 sp->mem[ix] = NULL;523 free(sp->names[ix]);524 sp->names[ix] = NULL;525 }526 527 free(sp->mem);528 sp->mem = NULL;529 free(sp->names);530 sp->names = NULL;531 532 sp->mslots = 0;533 sp->mused = 0;534 }535 if (sp->ibuf != NULL) {536 free(sp->ibuf);537 sp->buflen = 0;538 }539 if (sp->ifp != NULL) {540 fclose(sp->ifp);541 sp->ifp = NULL;542 }543}544 545static void stack_flush(cstate_t *sp) {546 int ix;547 548 assert(sp != NULL && sp->elts != NULL);549 550 for (ix = 0; (mp_size)ix < sp->used; ++ix) {551 mp_int_clear(sp->elts[ix]);552 sp->elts[ix] = NULL;553 }554 555 sp->used = 0;556}557 558static mp_result stack_push(cstate_t *sp, mp_int elt) {559 if (sp->used >= sp->alloc) {560 mp_size nsize = 2 * sp->alloc;561 mp_int *tmp;562 int ix;563 564 if ((tmp = malloc(nsize * sizeof(*(sp->elts)))) == NULL) return MP_MEMORY;565 566 for (ix = 0; (mp_size)ix < sp->used; ++ix) {567 tmp[ix] = sp->elts[ix];568 }569 570 free(sp->elts);571 sp->elts = tmp;572 sp->alloc = nsize;573 }574 575 sp->elts[sp->used++] = elt;576 return MP_OK;577}578 579static mp_result stack_pop(cstate_t *sp) {580 assert(sp != NULL && sp->elts != NULL);581 582 if (sp->used == 0) return MP_UNDEF;583 584 sp->used -= 1;585 mp_int_clear(sp->elts[sp->used]);586 sp->elts[sp->used] = NULL;587 588 return MP_OK;589}590 591static mp_result mem_insert(cstate_t *sp, const char *name, mp_int value) {592 int ix;593 594 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {595 if (strcmp(name, sp->names[ix]) == 0) break;596 }597 598 /* Two cases:599 ix < sp->mused ==> replacing existing entry.600 otherwise ==> adding new entry, may need to grow dictionary.601 */602 if ((mp_size)ix < sp->mused) {603 mp_int_free(sp->mem[ix]); /* fall through to the end */604 } else {605 if (sp->mused >= sp->mslots) {606 mp_size nsize = 2 * sp->mslots;607 mp_int *tz;608 char **tc;609 int jx;610 611 if ((tz = malloc(nsize * sizeof(*(sp->mem)))) == NULL) return MP_MEMORY;612 if ((tc = malloc(nsize * sizeof(*(sp->names)))) == NULL) {613 free(tz);614 return MP_MEMORY;615 }616 617 for (jx = 0; (mp_size)jx < sp->mused; ++jx) {618 tz[jx] = sp->mem[jx];619 tc[jx] = sp->names[jx];620 }621 622 free(sp->mem);623 sp->mem = tz;624 free(sp->names);625 sp->names = tc;626 627 sp->mslots = nsize;628 }629 630 sp->mused += 1;631 sp->names[ix] = malloc(1 + strlen(name));632 strcpy(sp->names[ix], name);633 }634 635 sp->mem[ix] = mp_int_alloc();636 return mp_int_copy(value, sp->mem[ix]);637}638 639static mp_result mem_recall(cstate_t *sp, const char *name, mp_int value) {640 int ix;641 642 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {643 if (strcmp(name, sp->names[ix]) == 0) {644 return mp_int_copy(sp->mem[ix], value);645 }646 }647 648 return MP_UNDEF; /* not found */649}650 651static mp_result mem_clear(cstate_t *sp) {652 int ix;653 654 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {655 mp_int_free(sp->mem[ix]);656 free(sp->names[ix]);657 }658 sp->mused = 0;659 660 return MP_OK;661}662 663static mp_result cf_abs(cstate_t *sp) {664 mp_int a = sp->elts[sp->used - 1];665 666 return mp_int_abs(a, a);667}668 669static mp_result cf_neg(cstate_t *sp) {670 mp_int a = sp->elts[sp->used - 1];671 672 return mp_int_neg(a, a);673}674 675static mp_result cf_add(cstate_t *sp) {676 mp_int b = sp->elts[sp->used - 1];677 mp_int a = sp->elts[sp->used - 2];678 mp_result res = mp_int_add(a, b, a);679 680 if (res == MP_OK) stack_pop(sp);681 682 return res;683}684 685static mp_result cf_sub(cstate_t *sp) {686 mp_int b = sp->elts[sp->used - 1];687 mp_int a = sp->elts[sp->used - 2];688 mp_result res = mp_int_sub(a, b, a);689 690 if (res == MP_OK) stack_pop(sp);691 692 return res;693}694 695static mp_result cf_mul(cstate_t *sp) {696 mp_int b = sp->elts[sp->used - 1];697 mp_int a = sp->elts[sp->used - 2];698 mp_result res = mp_int_mul(a, b, a);699 700 if (res == MP_OK) stack_pop(sp);701 702 return res;703}704 705static mp_result cf_divmod(cstate_t *sp) {706 mp_int b = sp->elts[sp->used - 1];707 mp_int a = sp->elts[sp->used - 2];708 709 return mp_int_div(a, b, a, b);710}711 712static mp_result cf_div(cstate_t *sp) {713 mp_int b = sp->elts[sp->used - 1];714 mp_int a = sp->elts[sp->used - 2];715 mp_result res = mp_int_div(a, b, a, NULL);716 717 if (res == MP_OK) stack_pop(sp);718 719 return res;720}721 722static mp_result cf_mod(cstate_t *sp) {723 mp_int b = sp->elts[sp->used - 1];724 mp_int a = sp->elts[sp->used - 2];725 mp_result res = mp_int_mod(a, b, a);726 727 if (res == MP_OK) stack_pop(sp);728 729 return res;730}731 732static mp_result cf_expt(cstate_t *sp) {733 mp_int b = sp->elts[sp->used - 1];734 mp_int a = sp->elts[sp->used - 2];735 mp_result res;736 mp_small bval;737 738 if ((res = mp_int_to_int(b, &bval)) != MP_OK) return res;739 740 stack_pop(sp);741 return mp_int_expt(a, bval, a);742}743 744static mp_result cf_exptmod(cstate_t *sp) {745 mp_int m = sp->elts[sp->used - 1];746 mp_int b = sp->elts[sp->used - 2];747 mp_int a = sp->elts[sp->used - 3];748 mp_result res = mp_int_exptmod(a, b, m, a);749 750 if (res == MP_OK) {751 stack_pop(sp);752 stack_pop(sp);753 }754 755 return res;756}757 758static mp_result cf_square(cstate_t *sp) {759 mp_int a = sp->elts[sp->used - 1];760 761 return mp_int_sqr(a, a);762}763 764static mp_result cf_invmod(cstate_t *sp) {765 mp_int m = sp->elts[sp->used - 1];766 mp_int a = sp->elts[sp->used - 2];767 mp_result res = mp_int_invmod(a, m, a);768 769 stack_pop(sp);770 771 return res;772}773 774static mp_result cf_gcd(cstate_t *sp) {775 mp_int b = sp->elts[sp->used - 1];776 mp_int a = sp->elts[sp->used - 2];777 mp_result res = mp_int_gcd(a, b, a);778 779 if (res == MP_OK) stack_pop(sp);780 781 return res;782}783 784static mp_result cf_xgcd(cstate_t *sp) {785 mp_int b = sp->elts[sp->used - 1];786 mp_int a = sp->elts[sp->used - 2];787 mp_int t;788 mp_result res;789 790 if ((t = mp_int_alloc()) == NULL) return MP_MEMORY;791 if ((res = mp_int_egcd(a, b, a, b, t)) != MP_OK) {792 mp_int_free(t);793 return res;794 }795 796 if ((res = stack_push(sp, t)) != MP_OK) mp_int_free(t);797 798 return res;799}800 801static mp_result cf_sqrt(cstate_t *sp) {802 mp_int a = sp->elts[sp->used - 1];803 804 return mp_int_sqrt(a, a);805}806 807static mp_result cf_root(cstate_t *sp) {808 mp_int a = sp->elts[sp->used - 2];809 mp_int bp = sp->elts[sp->used - 1];810 mp_small b;811 mp_result res;812 813 if ((res = mp_int_to_int(bp, &b)) != MP_OK) return res;814 815 stack_pop(sp);816 return mp_int_root(a, b, a);817}818 819static mp_result cf_cmplt(cstate_t *sp) {820 mp_int b = sp->elts[sp->used - 1];821 mp_int a = sp->elts[sp->used - 2];822 mp_result res;823 824 res = mp_int_set_value(a, (mp_int_compare(a, b) < 0));825 stack_pop(sp);826 return res;827}828 829static mp_result cf_cmpgt(cstate_t *sp) {830 mp_int b = sp->elts[sp->used - 1];831 mp_int a = sp->elts[sp->used - 2];832 mp_result res;833 834 res = mp_int_set_value(a, (mp_int_compare(a, b) > 0));835 stack_pop(sp);836 return res;837}838 839static mp_result cf_cmple(cstate_t *sp) {840 mp_int b = sp->elts[sp->used - 1];841 mp_int a = sp->elts[sp->used - 2];842 mp_result res;843 844 res = mp_int_set_value(a, (mp_int_compare(a, b) <= 0));845 stack_pop(sp);846 return res;847}848 849static mp_result cf_cmpge(cstate_t *sp) {850 mp_int b = sp->elts[sp->used - 1];851 mp_int a = sp->elts[sp->used - 2];852 mp_result res;853 854 res = mp_int_set_value(a, (mp_int_compare(a, b) >= 0));855 stack_pop(sp);856 return res;857}858 859static mp_result cf_cmpeq(cstate_t *sp) {860 mp_int b = sp->elts[sp->used - 1];861 mp_int a = sp->elts[sp->used - 2];862 mp_result res;863 864 res = mp_int_set_value(a, (mp_int_compare(a, b) == 0));865 stack_pop(sp);866 return res;867}868 869static mp_result cf_cmpne(cstate_t *sp) {870 mp_int b = sp->elts[sp->used - 1];871 mp_int a = sp->elts[sp->used - 2];872 mp_result res;873 874 res = mp_int_set_value(a, (mp_int_compare(a, b) != 0));875 stack_pop(sp);876 return res;877}878 879static mp_result cf_inc(cstate_t *sp) {880 mp_int a = sp->elts[sp->used - 1];881 882 return mp_int_add_value(a, 1, a);883}884 885static mp_result cf_dec(cstate_t *sp) {886 mp_int a = sp->elts[sp->used - 1];887 888 return mp_int_sub_value(a, 1, a);889}890 891static mp_result cf_fact(cstate_t *sp) {892 mpz_t tmp;893 mp_int x = sp->elts[sp->used - 1];894 mp_result res = MP_OK;895 896 if (mp_int_compare_zero(x) < 0) return MP_UNDEF;897 898 (void)mp_int_init_value(&tmp, 1);899 900 while (mp_int_compare_value(x, 1) > 0) {901 if ((res = mp_int_mul(&tmp, x, &tmp)) != MP_OK) goto CLEANUP;902 if ((res = mp_int_sub_value(x, 1, x)) != MP_OK) goto CLEANUP;903 }904 905 res = mp_int_copy(&tmp, x);906 907CLEANUP:908 mp_int_clear(&tmp);909 return res;910}911 912static mp_result cf_pprint(cstate_t *sp) {913 print_value(sp->elts[sp->used - 1]);914 stack_pop(sp);915 return MP_OK;916}917 918static mp_result cf_print(cstate_t *sp) {919 print_value(sp->elts[sp->used - 1]);920 return MP_OK;921}922 923static mp_result cf_pstack(cstate_t *sp) {924 int ix;925 926 if (sp->used == 0) {927 fprintf(g_output_file, "<stack empty>\n");928 } else {929 for (ix = 0; (mp_size)ix < sp->used; ++ix) {930 fprintf(g_output_file, "%2d: ", ix);931 print_value(sp->elts[sp->used - 1 - ix]);932 }933 }934 935 return MP_OK;936}937 938static mp_result cf_clstk(cstate_t *sp) {939 stack_flush(sp);940 941 return MP_OK;942}943 944static mp_result cf_pop(cstate_t *sp) { return stack_pop(sp); }945 946static mp_result cf_dup(cstate_t *sp) {947 mp_int cp = mp_int_alloc();948 mp_result res;949 950 if (cp == NULL) return MP_MEMORY;951 952 if ((res = mp_int_copy(sp->elts[sp->used - 1], cp)) != MP_OK) {953 mp_int_free(cp);954 return res;955 }956 957 if ((res = stack_push(sp, cp)) != MP_OK) mp_int_free(cp);958 959 return res;960}961 962static mp_result cf_copy(cstate_t *sp) {963 mp_int n = sp->elts[sp->used - 1];964 mp_result res;965 mp_small ncopy;966 int ix;967 968 if ((res = mp_int_to_int(n, &ncopy)) != MP_OK) return res;969 970 if (ncopy < 1 || ncopy >= sp->used) return MP_RANGE;971 972 stack_pop(sp);973 974 for (ix = 0; ix < ncopy; ++ix) {975 mp_int old = sp->elts[sp->used - ncopy];976 mp_int new = mp_int_alloc();977 978 if (new == NULL) return MP_MEMORY;979 980 if ((res = mp_int_copy(old, new)) != MP_OK) {981 mp_int_free(new);982 return res;983 }984 if ((res = stack_push(sp, new)) != MP_OK) return res;985 }986 987 return MP_OK;988}989 990static mp_result cf_swap(cstate_t *sp) {991 mp_int t = sp->elts[sp->used - 1];992 993 sp->elts[sp->used - 1] = sp->elts[sp->used - 2];994 sp->elts[sp->used - 2] = t;995 996 return MP_OK;997}998 999static mp_result cf_rot(cstate_t *sp) {1000 mp_int t = sp->elts[sp->used - 3];1001 1002 sp->elts[sp->used - 3] = sp->elts[sp->used - 2];1003 sp->elts[sp->used - 2] = sp->elts[sp->used - 1];1004 sp->elts[sp->used - 1] = t;1005 1006 return MP_OK;1007}1008 1009static mp_result cf_pick(cstate_t *sp) {1010 mp_int n = sp->elts[sp->used - 1];1011 mp_result res;1012 mp_small pos = 0;1013 1014 if ((res = mp_int_to_int(n, &pos)) != MP_OK) return res;1015 1016 if (pos < 0 || pos >= sp->used - 1) return MP_RANGE;1017 1018 return mp_int_copy(sp->elts[sp->used - 2 - pos], n);1019}1020 1021static mp_result cf_setr(cstate_t *sp) {1022 mp_int a = sp->elts[sp->used - 1];1023 mp_result res;1024 mp_small rdx = 0;1025 1026 if ((res = mp_int_to_int(a, &rdx)) != MP_OK) return res;1027 1028 if (rdx < MP_MIN_RADIX || rdx > MP_MAX_RADIX) return MP_RANGE;1029 1030 g_output_radix = rdx;1031 stack_pop(sp);1032 return MP_OK;1033}1034 1035static mp_result cf_setbin(cstate_t *sp) {1036 g_output_radix = 0;1037 return MP_OK;1038}1039 1040static mp_result cf_help(cstate_t *sp) {1041 int ix, maxlen = 10; /* minimum width */1042 1043 for (ix = 0; g_ops[ix].name != NULL; ++ix) {1044 int len = strlen(g_ops[ix].name);1045 1046 if (len > maxlen) maxlen = len;1047 }1048 1049 fprintf(stderr, "Operators understood:\n");1050 for (ix = 0; g_ops[ix].name != NULL; ++ix) {1051 int len = strlen(g_ops[ix].name);1052 1053 fputs(g_ops[ix].name, stderr);1054 while (len++ <= maxlen) fputc(' ', stderr);1055 1056 fprintf(stderr, "%s\n", g_ops[ix].descript);1057 }1058 fputc('\n', stderr);1059 1060 return MP_OK;1061}1062 1063static mp_result cf_store(cstate_t *sp) {1064 mp_result res;1065 1066 if (next_token(sp->ifp, sp->ibuf, sp->buflen) != t_symbol) return MP_INPUT;1067 1068 if ((res = mem_insert(sp, sp->ibuf, sp->elts[sp->used - 1])) != MP_OK)1069 return res;1070 1071 return stack_pop(sp);1072}1073 1074static mp_result cf_recall(cstate_t *sp) {1075 mp_result res;1076 mp_int val;1077 1078 if (next_token(sp->ifp, sp->ibuf, sp->buflen) != t_symbol) return MP_INPUT;1079 1080 if ((val = mp_int_alloc()) == NULL) return MP_MEMORY;1081 if ((res = mem_recall(sp, sp->ibuf, val)) != MP_OK) {1082 mp_int_free(val);1083 return res;1084 }1085 1086 return stack_push(sp, val);1087}1088 1089static mp_result cf_cmem(cstate_t *sp) { return mem_clear(sp); }1090 1091static mp_result cf_pmem(cstate_t *sp) {1092 int ix, max_len = 0;1093 1094 if (sp->mused == 0) {1095 fprintf(g_output_file, "<memory empty>\n");1096 return MP_OK;1097 }1098 1099 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {1100 int ln = strlen(sp->names[ix]);1101 1102 if (ln > max_len) max_len = ln;1103 }1104 1105 max_len += 1; /* allow for a padding space */1106 1107 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {1108 int ln = strlen(sp->names[ix]);1109 1110 fprintf(g_output_file, "%s:", sp->names[ix]);1111 1112 while (ln++ < max_len) fputc(' ', g_output_file);1113 1114 print_value(sp->mem[ix]);1115 }1116 1117 return MP_OK;1118}1119 1120static mp_result cf_qrecall(cstate_t *sp) {1121 mp_result res;1122 mp_int val;1123 1124 if ((val = mp_int_alloc()) == NULL) return MP_MEMORY;1125 1126 if ((res = mem_recall(sp, sp->ibuf, val)) != MP_OK) {1127 mp_int_free(val);1128 return res;1129 }1130 1131 return stack_push(sp, val);1132}1133 1134/* Here there be dragons */1135