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 */
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 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 */
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: argc, argv: argv, shortopts: "ho:")) != EOF) {
222 switch (opt) {
223 case 'h':
224 fprintf(
225 stderr,
226 format: "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(filename: optarg, modes: "wt")) == NULL) {
239 fprintf(stderr, format: "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 format: "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(sp: &op_state, n_elts: 1)) != MP_OK) {
254 fprintf(stderr, format: "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(s1: argv[ix], s2: "-") == 0)
263 ifp = stdin;
264 else if ((ifp = fopen(filename: argv[optind], modes: "rt")) == NULL) {
265 fprintf(stderr, format: "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: &op_state) != MP_OK) ++errs;
271 }
272
273 state_clear(sp: &op_state);
274 return errs > 0;
275 } else {
276 int rv = 1 - (run_file(stdin, op_state: &op_state) == MP_OK);
277 state_clear(sp: &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(stream: 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(stream: ifp);
298 if (next == EOF || !isdigit(next))
299 res = t_symbol;
300 else
301 res = t_number;
302 ungetc(c: next, stream: 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(stream: ifp)) != EOF) {
310 if ((res == t_number && ispunct(ch) && ch != '-') ||
311 (res == t_symbol && isdigit(ch)) || isspace(ch)) {
312 ungetc(c: ch, stream: 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(z: value, radix, str: buf + pos)) != MP_OK) {
363 mp_int_free(z: 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(s1: buf, s2: 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(s1: buf, s2: 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(z: v);
393 unsigned char *buf = malloc(size: len);
394 int ix;
395
396 if (buf != NULL) {
397 mp_int_to_binary(z: v, buf, limit: len);
398 for (ix = 0; ix < len - 1; ++ix) {
399 fprintf(stream: g_output_file, format: "%02x.", buf[ix]);
400 }
401 fprintf(stream: g_output_file, format: "%02x\n", buf[ix]);
402 free(ptr: buf);
403 } else {
404 fprintf(stream: g_output_file, format: "<insufficient memory to print>\n");
405 }
406 } else {
407 mp_result len = mp_int_string_len(z: v, radix: g_output_radix);
408 char *buf = malloc(size: len);
409
410 if (buf != NULL) {
411 mp_int_to_string(z: v, radix: g_output_radix, str: buf, limit: len);
412 fputs(s: buf, stream: g_output_file);
413 fputc(c: '\n', stream: g_output_file);
414 free(ptr: buf);
415 } else {
416 fprintf(stream: g_output_file, format: "<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, buf: op_state->ibuf, size: 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(buf: op_state->ibuf, out: &value)) != MP_OK)
433 fprintf(stderr, format: "error: invalid number syntax: %s\n", op_state->ibuf);
434 else if ((res = stack_push(sp: op_state, elt: value)) != MP_OK)
435 goto EXIT;
436 break;
437 case t_symbol:
438 if ((cpos = find_command(op: op_state)) < 0) {
439 fprintf(stderr, format: "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, format: "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, format: "error: incorrect input format\n");
447 } else {
448 fprintf(stderr, format: "error: %s\n", mp_error_string(res));
449 }
450 }
451 break;
452 default:
453 fprintf(stderr, format: "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(size: n_elts * sizeof(*(sp->elts)))) == NULL)
469 return MP_MEMORY;
470 if ((sp->mem = malloc(size: n_elts * sizeof(*(sp->mem)))) == NULL) {
471 free(ptr: sp->elts);
472 return MP_MEMORY;
473 }
474 if ((sp->names = malloc(size: n_elts * sizeof(*(sp->names)))) == NULL) {
475 free(ptr: sp->mem);
476 free(ptr: sp->elts);
477 return MP_MEMORY;
478 }
479 if ((sp->ibuf = malloc(BUFFER_SIZE * sizeof(char))) == NULL) {
480 free(ptr: sp->names);
481 free(ptr: sp->mem);
482 free(ptr: 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(z: sp->elts[ix]);
509 sp->elts[ix] = NULL;
510 }
511
512 free(ptr: 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(z: sp->mem[ix]);
522 sp->mem[ix] = NULL;
523 free(ptr: sp->names[ix]);
524 sp->names[ix] = NULL;
525 }
526
527 free(ptr: sp->mem);
528 sp->mem = NULL;
529 free(ptr: sp->names);
530 sp->names = NULL;
531
532 sp->mslots = 0;
533 sp->mused = 0;
534 }
535 if (sp->ibuf != NULL) {
536 free(ptr: sp->ibuf);
537 sp->buflen = 0;
538 }
539 if (sp->ifp != NULL) {
540 fclose(stream: 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(z: 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(size: 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(ptr: 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(z: 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(s1: name, s2: 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(z: 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(size: nsize * sizeof(*(sp->mem)))) == NULL) return MP_MEMORY;
612 if ((tc = malloc(size: nsize * sizeof(*(sp->names)))) == NULL) {
613 free(ptr: 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(ptr: sp->mem);
623 sp->mem = tz;
624 free(ptr: sp->names);
625 sp->names = tc;
626
627 sp->mslots = nsize;
628 }
629
630 sp->mused += 1;
631 sp->names[ix] = malloc(size: 1 + strlen(s: name));
632 strcpy(dest: sp->names[ix], src: name);
633 }
634
635 sp->mem[ix] = mp_int_alloc();
636 return mp_int_copy(a: value, c: 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(s1: name, s2: sp->names[ix]) == 0) {
644 return mp_int_copy(a: sp->mem[ix], c: 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(z: sp->mem[ix]);
656 free(ptr: 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, c: 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, c: 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, c: 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, c: 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, c: 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, q: a, r: 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, q: 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, m: b, c: 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(z: b, out: &bval)) != MP_OK) return res;
739
740 stack_pop(sp);
741 return mp_int_expt(a, b: bval, c: 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, c: 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, c: 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, c: 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, c: 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, c: a, x: b, y: t)) != MP_OK) {
792 mp_int_free(z: t);
793 return res;
794 }
795
796 if ((res = stack_push(sp, elt: t)) != MP_OK) mp_int_free(z: 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, c: 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(z: bp, out: &b)) != MP_OK) return res;
814
815 stack_pop(sp);
816 return mp_int_root(a, b, c: 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(z: a, value: (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(z: a, value: (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(z: a, value: (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(z: a, value: (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(z: a, value: (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(z: a, value: (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, value: 1, c: 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, value: 1, c: 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(z: x) < 0) return MP_UNDEF;
897
898 (void)mp_int_init_value(z: &tmp, value: 1);
899
900 while (mp_int_compare_value(z: x, v: 1) > 0) {
901 if ((res = mp_int_mul(a: &tmp, b: x, c: &tmp)) != MP_OK) goto CLEANUP;
902 if ((res = mp_int_sub_value(a: x, value: 1, c: x)) != MP_OK) goto CLEANUP;
903 }
904
905 res = mp_int_copy(a: &tmp, c: x);
906
907CLEANUP:
908 mp_int_clear(z: &tmp);
909 return res;
910}
911
912static mp_result cf_pprint(cstate_t *sp) {
913 print_value(v: 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(v: 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(stream: g_output_file, format: "<stack empty>\n");
928 } else {
929 for (ix = 0; (mp_size)ix < sp->used; ++ix) {
930 fprintf(stream: g_output_file, format: "%2d: ", ix);
931 print_value(v: 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(a: sp->elts[sp->used - 1], c: cp)) != MP_OK) {
953 mp_int_free(z: cp);
954 return res;
955 }
956
957 if ((res = stack_push(sp, elt: cp)) != MP_OK) mp_int_free(z: 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(z: n, out: &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(a: old, c: new)) != MP_OK) {
981 mp_int_free(z: new);
982 return res;
983 }
984 if ((res = stack_push(sp, elt: 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(z: n, out: &pos)) != MP_OK) return res;
1015
1016 if (pos < 0 || pos >= sp->used - 1) return MP_RANGE;
1017
1018 return mp_int_copy(a: sp->elts[sp->used - 2 - pos], c: 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(z: a, out: &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(s: g_ops[ix].name);
1045
1046 if (len > maxlen) maxlen = len;
1047 }
1048
1049 fprintf(stderr, format: "Operators understood:\n");
1050 for (ix = 0; g_ops[ix].name != NULL; ++ix) {
1051 int len = strlen(s: g_ops[ix].name);
1052
1053 fputs(s: g_ops[ix].name, stderr);
1054 while (len++ <= maxlen) fputc(c: ' ', stderr);
1055
1056 fprintf(stderr, format: "%s\n", g_ops[ix].descript);
1057 }
1058 fputc(c: '\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(ifp: sp->ifp, buf: sp->ibuf, size: sp->buflen) != t_symbol) return MP_INPUT;
1067
1068 if ((res = mem_insert(sp, name: sp->ibuf, value: 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(ifp: sp->ifp, buf: sp->ibuf, size: sp->buflen) != t_symbol) return MP_INPUT;
1079
1080 if ((val = mp_int_alloc()) == NULL) return MP_MEMORY;
1081 if ((res = mem_recall(sp, name: sp->ibuf, value: val)) != MP_OK) {
1082 mp_int_free(z: val);
1083 return res;
1084 }
1085
1086 return stack_push(sp, elt: 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(stream: g_output_file, format: "<memory empty>\n");
1096 return MP_OK;
1097 }
1098
1099 for (ix = 0; (mp_size)ix < sp->mused; ++ix) {
1100 int ln = strlen(s: 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(s: sp->names[ix]);
1109
1110 fprintf(stream: g_output_file, format: "%s:", sp->names[ix]);
1111
1112 while (ln++ < max_len) fputc(c: ' ', stream: g_output_file);
1113
1114 print_value(v: 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, name: sp->ibuf, value: val)) != MP_OK) {
1127 mp_int_free(z: val);
1128 return res;
1129 }
1130
1131 return stack_push(sp, elt: val);
1132}
1133
1134/* Here there be dragons */
1135

source code of polly/lib/External/isl/imath/examples/imcalc.c