1 /*
2   Name:     imcalc.c
3   Purpose:  Simple RPN calculator based on IMath library.
4   Author:   M. J. Fromberger
5 
6   This is a very simplistic RPN calculator that will let you test the features
7   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 copy
12   of this software and associated documentation files (the "Software"), to deal
13   in the Software without restriction, including without limitation the rights
14   to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
15   copies of the Software, and to permit persons to whom the Software is
16   furnished to do so, subject to the following conditions:
17 
18   The above copyright notice and this permission notice shall be included in
19   all copies or substantial portions of the Software.
20 
21   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
22   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
23   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
24   AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
25   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 THE
27   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 on
47    the stack, and commands cause them to be consumed in various ways.
48  */
49 typedef 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 
67 static mp_result state_init(cstate_t *sp, mp_size n_elts);
68 static void state_clear(cstate_t *sp);
69 static void stack_flush(cstate_t *sp);
70 static mp_result stack_push(cstate_t *sp, mp_int elt);
71 static mp_result stack_pop(cstate_t *sp);
72 static mp_result mem_insert(cstate_t *sp, const char *name, mp_int value);
73 static mp_result mem_recall(cstate_t *sp, const char *name, mp_int value);
74 static mp_result mem_clear(cstate_t *sp);
75 
76 typedef mp_result (*op_func)(cstate_t *);
77 
78 static mp_result cf_abs(cstate_t *sp);
79 static mp_result cf_neg(cstate_t *sp);
80 static mp_result cf_add(cstate_t *sp);
81 static mp_result cf_sub(cstate_t *sp);
82 static mp_result cf_mul(cstate_t *sp);
83 static mp_result cf_divmod(cstate_t *sp);
84 static mp_result cf_div(cstate_t *sp);
85 static mp_result cf_mod(cstate_t *sp);
86 static mp_result cf_expt(cstate_t *sp);
87 static mp_result cf_exptmod(cstate_t *sp);
88 static mp_result cf_square(cstate_t *sp);
89 static mp_result cf_invmod(cstate_t *sp);
90 static mp_result cf_gcd(cstate_t *sp);
91 static mp_result cf_xgcd(cstate_t *sp);
92 static mp_result cf_sqrt(cstate_t *sp);
93 static mp_result cf_root(cstate_t *sp);
94 static mp_result cf_cmplt(cstate_t *sp);
95 static mp_result cf_cmpgt(cstate_t *sp);
96 static mp_result cf_cmple(cstate_t *sp);
97 static mp_result cf_cmpge(cstate_t *sp);
98 static mp_result cf_cmpeq(cstate_t *sp);
99 static mp_result cf_cmpne(cstate_t *sp);
100 static mp_result cf_inc(cstate_t *sp);
101 static mp_result cf_dec(cstate_t *sp);
102 static mp_result cf_fact(cstate_t *sp);
103 static mp_result cf_pprint(cstate_t *sp);
104 static mp_result cf_print(cstate_t *sp);
105 static mp_result cf_pstack(cstate_t *sp);
106 static mp_result cf_clstk(cstate_t *sp);
107 static mp_result cf_pop(cstate_t *sp);
108 static mp_result cf_dup(cstate_t *sp);
109 static mp_result cf_copy(cstate_t *sp);
110 static mp_result cf_swap(cstate_t *sp);
111 static mp_result cf_rot(cstate_t *sp);
112 static mp_result cf_pick(cstate_t *sp);
113 static mp_result cf_setr(cstate_t *sp);
114 static mp_result cf_setbin(cstate_t *sp);
115 static mp_result cf_help(cstate_t *sp);
116 static mp_result cf_store(cstate_t *sp);
117 static mp_result cf_recall(cstate_t *sp);
118 static mp_result cf_cmem(cstate_t *sp);
119 static mp_result cf_pmem(cstate_t *sp);
120 static mp_result cf_qrecall(cstate_t *sp);
121 
122 typedef 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 
129 static 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 implicit
186        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 */
194 typedef enum { t_eof, t_symbol, t_number, t_error } token_t;
195 
196 static token_t next_token(FILE *ifp, char *buf, int size);
197 static mp_result read_number(char *buf, mp_int *out);
198 static int find_command(cstate_t *ops);
199 static void print_value(mp_int v);
200 static mp_result run_file(FILE *ifp, cstate_t *op_state);
201 
202 /* Error code used internally to signal input problems. */
203 static mp_result MP_INPUT;
204 
205 static int g_output_radix = 10; /* output radix */
206 static FILE *g_output_file = NULL;
207 
main(int argc,char * argv[])208 int 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 
next_token(FILE * ifp,char * buf,int size)282 static 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     else
301       res = t_number;
302     ungetc(next, ifp);
303   } else if (isdigit(ch) || ch == '#')
304     res = t_number;
305   else
306     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 
read_number(char * buf,mp_int * out)325 static 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 
find_command(cstate_t * op)372 static 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 
print_value(mp_int v)390 static 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 
run_file(FILE * ifp,cstate_t * op_state)421 static 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 
459 EXIT:
460   return res;
461 }
462 
state_init(cstate_t * sp,mp_size n_elts)463 static 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 
state_clear(cstate_t * sp)501 static 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 
stack_flush(cstate_t * sp)545 static 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 
stack_push(cstate_t * sp,mp_int elt)558 static 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 
stack_pop(cstate_t * sp)579 static 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 
mem_insert(cstate_t * sp,const char * name,mp_int value)591 static 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 
mem_recall(cstate_t * sp,const char * name,mp_int value)639 static 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 
mem_clear(cstate_t * sp)651 static 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 
cf_abs(cstate_t * sp)663 static 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 
cf_neg(cstate_t * sp)669 static 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 
cf_add(cstate_t * sp)675 static 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 
cf_sub(cstate_t * sp)685 static 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 
cf_mul(cstate_t * sp)695 static 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 
cf_divmod(cstate_t * sp)705 static 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 
cf_div(cstate_t * sp)712 static 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 
cf_mod(cstate_t * sp)722 static 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 
cf_expt(cstate_t * sp)732 static 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 
cf_exptmod(cstate_t * sp)744 static 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 
cf_square(cstate_t * sp)758 static 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 
cf_invmod(cstate_t * sp)764 static 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 
cf_gcd(cstate_t * sp)774 static 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 
cf_xgcd(cstate_t * sp)784 static 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 
cf_sqrt(cstate_t * sp)801 static 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 
cf_root(cstate_t * sp)807 static 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 
cf_cmplt(cstate_t * sp)819 static 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 
cf_cmpgt(cstate_t * sp)829 static 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 
cf_cmple(cstate_t * sp)839 static 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 
cf_cmpge(cstate_t * sp)849 static 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 
cf_cmpeq(cstate_t * sp)859 static 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 
cf_cmpne(cstate_t * sp)869 static 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 
cf_inc(cstate_t * sp)879 static 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 
cf_dec(cstate_t * sp)885 static 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 
cf_fact(cstate_t * sp)891 static 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 
907 CLEANUP:
908   mp_int_clear(&tmp);
909   return res;
910 }
911 
cf_pprint(cstate_t * sp)912 static 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 
cf_print(cstate_t * sp)918 static mp_result cf_print(cstate_t *sp) {
919   print_value(sp->elts[sp->used - 1]);
920   return MP_OK;
921 }
922 
cf_pstack(cstate_t * sp)923 static 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 
cf_clstk(cstate_t * sp)938 static mp_result cf_clstk(cstate_t *sp) {
939   stack_flush(sp);
940 
941   return MP_OK;
942 }
943 
cf_pop(cstate_t * sp)944 static mp_result cf_pop(cstate_t *sp) { return stack_pop(sp); }
945 
cf_dup(cstate_t * sp)946 static 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 
cf_copy(cstate_t * sp)962 static 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 
cf_swap(cstate_t * sp)990 static 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 
cf_rot(cstate_t * sp)999 static 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 
cf_pick(cstate_t * sp)1009 static 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 
cf_setr(cstate_t * sp)1021 static 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 
cf_setbin(cstate_t * sp)1035 static mp_result cf_setbin(cstate_t *sp) {
1036   g_output_radix = 0;
1037   return MP_OK;
1038 }
1039 
cf_help(cstate_t * sp)1040 static 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 
cf_store(cstate_t * sp)1063 static 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 
cf_recall(cstate_t * sp)1074 static 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 
cf_cmem(cstate_t * sp)1089 static mp_result cf_cmem(cstate_t *sp) { return mem_clear(sp); }
1090 
cf_pmem(cstate_t * sp)1091 static 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 
cf_qrecall(cstate_t * sp)1120 static 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