GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
/* Program for computing integer expressions using the GNU Multiple Precision1Arithmetic Library.23Copyright 1997, 1999, 2000, 2001, 2002, 2005 Free Software Foundation, Inc.45This program is free software; you can redistribute it and/or modify it under6the terms of the GNU General Public License as published by the Free Software7Foundation; either version 2 of the License, or (at your option) any later8version.910This program is distributed in the hope that it will be useful, but WITHOUT ANY11WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A12PARTICULAR PURPOSE. See the GNU General Public License for more details.1314You should have received a copy of the GNU General Public License along with15this program; if not, write to the Free Software Foundation, Inc., 51 Franklin16Street, Fifth Floor, Boston, MA 02110-1301, USA. */171819/* This expressions evaluator works by building an expression tree (using a20recursive descent parser) which is then evaluated. The expression tree is21useful since we want to optimize certain expressions (like a^b % c).2223Usage: pexpr [options] expr ...24(Assuming you called the executable `pexpr' of course.)2526Command line options:2728-b print output in binary29-o print output in octal30-d print output in decimal (the default)31-x print output in hexadecimal32-b<NUM> print output in base NUM33-t print timing information34-html output html35-wml output wml36-split split long lines each 80th digit37*/3839/* Define LIMIT_RESOURCE_USAGE if you want to make sure the program doesn't40use up extensive resources (cpu, memory). Useful for the GMP demo on the41GMP web site, since we cannot load the server too much. */4243#include "pexpr-config.h"4445#include <string.h>46#include <stdio.h>47#include <stdlib.h>48#include <setjmp.h>49#include <signal.h>50#include <ctype.h>5152#include <time.h>53#include <sys/types.h>54#include <sys/time.h>55#if HAVE_SYS_RESOURCE_H56#include <sys/resource.h>57#endif5859#include "gmp.h"6061/* SunOS 4 and HPUX 9 don't define a canonical SIGSTKSZ, use a default. */62#ifndef SIGSTKSZ63#define SIGSTKSZ 409664#endif656667#define TIME(t,func) \68do { int __t0, __t, __tmp; \69__t0 = cputime (); \70{func;} \71__tmp = cputime () - __t0; \72(t) = __tmp; \73} while (0)7475/* GMP version 1.x compatibility. */76#if ! (__GNU_MP_VERSION >= 2)77typedef MP_INT __mpz_struct;78typedef __mpz_struct mpz_t[1];79typedef __mpz_struct *mpz_ptr;80#define mpz_fdiv_q mpz_div81#define mpz_fdiv_r mpz_mod82#define mpz_tdiv_q_2exp mpz_div_2exp83#define mpz_sgn(Z) ((Z)->size < 0 ? -1 : (Z)->size > 0)84#endif8586/* GMP version 2.0 compatibility. */87#if ! (__GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1)88#define mpz_swap(a,b) \89do { __mpz_struct __t; __t = *a; *a = *b; *b = __t;} while (0)90#endif9192jmp_buf errjmpbuf;9394enum op_t {NOP, LIT, NEG, NOT, PLUS, MINUS, MULT, DIV, MOD, REM, INVMOD, POW,95AND, IOR, XOR, SLL, SRA, POPCNT, HAMDIST, GCD, LCM, SQRT, ROOT, FAC,96LOG, LOG2, FERMAT, MERSENNE, FIBONACCI, RANDOM, NEXTPRIME, BINOM};9798/* Type for the expression tree. */99struct expr100{101enum op_t op;102union103{104struct {struct expr *lhs, *rhs;} ops;105mpz_t val;106} operands;107};108109typedef struct expr *expr_t;110111void cleanup_and_exit __GMP_PROTO ((int));112113char *skipspace __GMP_PROTO ((char *));114void makeexp __GMP_PROTO ((expr_t *, enum op_t, expr_t, expr_t));115void free_expr __GMP_PROTO ((expr_t));116char *expr __GMP_PROTO ((char *, expr_t *));117char *term __GMP_PROTO ((char *, expr_t *));118char *power __GMP_PROTO ((char *, expr_t *));119char *factor __GMP_PROTO ((char *, expr_t *));120int match __GMP_PROTO ((char *, char *));121int matchp __GMP_PROTO ((char *, char *));122int cputime __GMP_PROTO ((void));123124void mpz_eval_expr __GMP_PROTO ((mpz_ptr, expr_t));125void mpz_eval_mod_expr __GMP_PROTO ((mpz_ptr, expr_t, mpz_ptr));126127char *error;128int flag_print = 1;129int print_timing = 0;130int flag_html = 0;131int flag_wml = 0;132int flag_splitup_output = 0;133char *newline = "";134gmp_randstate_t rstate;135136137138/* cputime() returns user CPU time measured in milliseconds. */139#if ! HAVE_CPUTIME140#if HAVE_GETRUSAGE141int142cputime (void)143{144struct rusage rus;145146getrusage (0, &rus);147return rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;148}149#else150#if HAVE_CLOCK151int152cputime (void)153{154if (CLOCKS_PER_SEC < 100000)155return clock () * 1000 / CLOCKS_PER_SEC;156return clock () / (CLOCKS_PER_SEC / 1000);157}158#else159int160cputime (void)161{162return 0;163}164#endif165#endif166#endif167168169int170stack_downwards_helper (char *xp)171{172char y;173return &y < xp;174}175int176stack_downwards_p (void)177{178char x;179return stack_downwards_helper (&x);180}181182183void184setup_error_handler (void)185{186#if HAVE_SIGACTION187struct sigaction act;188act.sa_handler = cleanup_and_exit;189sigemptyset (&(act.sa_mask));190#define SIGNAL(sig) sigaction (sig, &act, NULL)191#else192struct { int sa_flags; } act;193#define SIGNAL(sig) signal (sig, cleanup_and_exit)194#endif195act.sa_flags = 0;196197/* Set up a stack for signal handling. A typical cause of error is stack198overflow, and in such situation a signal can not be delivered on the199overflown stack. */200#if HAVE_SIGALTSTACK201{202/* AIX uses stack_t, MacOS uses struct sigaltstack, various other203systems have both. */204#if HAVE_STACK_T205stack_t s;206#else207struct sigaltstack s;208#endif209s.ss_sp = malloc (SIGSTKSZ);210s.ss_size = SIGSTKSZ;211s.ss_flags = 0;212if (sigaltstack (&s, NULL) != 0)213perror("sigaltstack");214act.sa_flags = SA_ONSTACK;215}216#else217#if HAVE_SIGSTACK218{219struct sigstack s;220s.ss_sp = malloc (SIGSTKSZ);221if (stack_downwards_p ())222s.ss_sp += SIGSTKSZ;223s.ss_onstack = 0;224if (sigstack (&s, NULL) != 0)225perror("sigstack");226act.sa_flags = SA_ONSTACK;227}228#else229#endif230#endif231232#ifdef LIMIT_RESOURCE_USAGE233{234struct rlimit limit;235236limit.rlim_cur = limit.rlim_max = 0;237setrlimit (RLIMIT_CORE, &limit);238239limit.rlim_cur = 3;240limit.rlim_max = 4;241setrlimit (RLIMIT_CPU, &limit);242243limit.rlim_cur = limit.rlim_max = 16 * 1024 * 1024;244setrlimit (RLIMIT_DATA, &limit);245246getrlimit (RLIMIT_STACK, &limit);247limit.rlim_cur = 4 * 1024 * 1024;248setrlimit (RLIMIT_STACK, &limit);249250SIGNAL (SIGXCPU);251}252#endif /* LIMIT_RESOURCE_USAGE */253254SIGNAL (SIGILL);255SIGNAL (SIGSEGV);256#ifdef SIGBUS /* not in mingw */257SIGNAL (SIGBUS);258#endif259SIGNAL (SIGFPE);260SIGNAL (SIGABRT);261}262263int264main (int argc, char **argv)265{266struct expr *e;267int i;268mpz_t r;269int errcode = 0;270char *str;271int base = 10;272273setup_error_handler ();274275gmp_randinit (rstate, GMP_RAND_ALG_LC, 128);276277{278#if HAVE_GETTIMEOFDAY279struct timeval tv;280gettimeofday (&tv, NULL);281gmp_randseed_ui (rstate, tv.tv_sec + tv.tv_usec);282#else283time_t t;284time (&t);285gmp_randseed_ui (rstate, t);286#endif287}288289mpz_init (r);290291while (argc > 1 && argv[1][0] == '-')292{293char *arg = argv[1];294295if (arg[1] >= '0' && arg[1] <= '9')296break;297298if (arg[1] == 't')299print_timing = 1;300else if (arg[1] == 'b' && arg[2] >= '0' && arg[2] <= '9')301{302base = atoi (arg + 2);303if (base < 2 || base > 36)304{305fprintf (stderr, "error: invalid output base\n");306exit (-1);307}308}309else if (arg[1] == 'b' && arg[2] == 0)310base = 2;311else if (arg[1] == 'x' && arg[2] == 0)312base = 16;313else if (arg[1] == 'X' && arg[2] == 0)314base = -16;315else if (arg[1] == 'o' && arg[2] == 0)316base = 8;317else if (arg[1] == 'd' && arg[2] == 0)318base = 10;319else if (strcmp (arg, "-html") == 0)320{321flag_html = 1;322newline = "<br>";323}324else if (strcmp (arg, "-wml") == 0)325{326flag_wml = 1;327newline = "<br/>";328}329else if (strcmp (arg, "-split") == 0)330{331flag_splitup_output = 1;332}333else if (strcmp (arg, "-noprint") == 0)334{335flag_print = 0;336}337else338{339fprintf (stderr, "error: unknown option `%s'\n", arg);340exit (-1);341}342argv++;343argc--;344}345346for (i = 1; i < argc; i++)347{348int s;349int jmpval;350351/* Set up error handler for parsing expression. */352jmpval = setjmp (errjmpbuf);353if (jmpval != 0)354{355fprintf (stderr, "error: %s%s\n", error, newline);356fprintf (stderr, " %s%s\n", argv[i], newline);357if (! flag_html)358{359/* ??? Dunno how to align expression position with arrow in360HTML ??? */361fprintf (stderr, " ");362for (s = jmpval - (long) argv[i]; --s >= 0; )363putc (' ', stderr);364fprintf (stderr, "^\n");365}366367errcode |= 1;368continue;369}370371str = expr (argv[i], &e);372373if (str[0] != 0)374{375fprintf (stderr,376"error: garbage where end of expression expected%s\n",377newline);378fprintf (stderr, " %s%s\n", argv[i], newline);379if (! flag_html)380{381/* ??? Dunno how to align expression position with arrow in382HTML ??? */383fprintf (stderr, " ");384for (s = str - argv[i]; --s; )385putc (' ', stderr);386fprintf (stderr, "^\n");387}388389errcode |= 1;390free_expr (e);391continue;392}393394/* Set up error handler for evaluating expression. */395if (setjmp (errjmpbuf))396{397fprintf (stderr, "error: %s%s\n", error, newline);398fprintf (stderr, " %s%s\n", argv[i], newline);399if (! flag_html)400{401/* ??? Dunno how to align expression position with arrow in402HTML ??? */403fprintf (stderr, " ");404for (s = str - argv[i]; --s >= 0; )405putc (' ', stderr);406fprintf (stderr, "^\n");407}408409errcode |= 2;410continue;411}412413if (print_timing)414{415int t;416TIME (t, mpz_eval_expr (r, e));417printf ("computation took %d ms%s\n", t, newline);418}419else420mpz_eval_expr (r, e);421422if (flag_print)423{424size_t out_len;425char *tmp, *s;426427out_len = mpz_sizeinbase (r, base >= 0 ? base : -base) + 2;428#ifdef LIMIT_RESOURCE_USAGE429if (out_len > 100000)430{431printf ("result is about %ld digits, not printing it%s\n",432(long) out_len - 3, newline);433exit (-2);434}435#endif436tmp = malloc (out_len);437438if (print_timing)439{440int t;441printf ("output conversion ");442TIME (t, mpz_get_str (tmp, base, r));443printf ("took %d ms%s\n", t, newline);444}445else446mpz_get_str (tmp, base, r);447448out_len = strlen (tmp);449if (flag_splitup_output)450{451for (s = tmp; out_len > 80; s += 80)452{453fwrite (s, 1, 80, stdout);454printf ("%s\n", newline);455out_len -= 80;456}457458fwrite (s, 1, out_len, stdout);459}460else461{462fwrite (tmp, 1, out_len, stdout);463}464465free (tmp);466printf ("%s\n", newline);467}468else469{470printf ("result is approximately %ld digits%s\n",471(long) mpz_sizeinbase (r, base >= 0 ? base : -base),472newline);473}474475free_expr (e);476}477478exit (errcode);479}480481char *482expr (char *str, expr_t *e)483{484expr_t e2;485486str = skipspace (str);487if (str[0] == '+')488{489str = term (str + 1, e);490}491else if (str[0] == '-')492{493str = term (str + 1, e);494makeexp (e, NEG, *e, NULL);495}496else if (str[0] == '~')497{498str = term (str + 1, e);499makeexp (e, NOT, *e, NULL);500}501else502{503str = term (str, e);504}505506for (;;)507{508str = skipspace (str);509switch (str[0])510{511case 'p':512if (match ("plus", str))513{514str = term (str + 4, &e2);515makeexp (e, PLUS, *e, e2);516}517else518return str;519break;520case 'm':521if (match ("minus", str))522{523str = term (str + 5, &e2);524makeexp (e, MINUS, *e, e2);525}526else527return str;528break;529case '+':530str = term (str + 1, &e2);531makeexp (e, PLUS, *e, e2);532break;533case '-':534str = term (str + 1, &e2);535makeexp (e, MINUS, *e, e2);536break;537default:538return str;539}540}541}542543char *544term (char *str, expr_t *e)545{546expr_t e2;547548str = power (str, e);549for (;;)550{551str = skipspace (str);552switch (str[0])553{554case 'm':555if (match ("mul", str))556{557str = power (str + 3, &e2);558makeexp (e, MULT, *e, e2);559break;560}561if (match ("mod", str))562{563str = power (str + 3, &e2);564makeexp (e, MOD, *e, e2);565break;566}567return str;568case 'd':569if (match ("div", str))570{571str = power (str + 3, &e2);572makeexp (e, DIV, *e, e2);573break;574}575return str;576case 'r':577if (match ("rem", str))578{579str = power (str + 3, &e2);580makeexp (e, REM, *e, e2);581break;582}583return str;584case 'i':585if (match ("invmod", str))586{587str = power (str + 6, &e2);588makeexp (e, REM, *e, e2);589break;590}591return str;592case 't':593if (match ("times", str))594{595str = power (str + 5, &e2);596makeexp (e, MULT, *e, e2);597break;598}599if (match ("thru", str))600{601str = power (str + 4, &e2);602makeexp (e, DIV, *e, e2);603break;604}605if (match ("through", str))606{607str = power (str + 7, &e2);608makeexp (e, DIV, *e, e2);609break;610}611return str;612case '*':613str = power (str + 1, &e2);614makeexp (e, MULT, *e, e2);615break;616case '/':617str = power (str + 1, &e2);618makeexp (e, DIV, *e, e2);619break;620case '%':621str = power (str + 1, &e2);622makeexp (e, MOD, *e, e2);623break;624default:625return str;626}627}628}629630char *631power (char *str, expr_t *e)632{633expr_t e2;634635str = factor (str, e);636while (str[0] == '!')637{638str++;639makeexp (e, FAC, *e, NULL);640}641str = skipspace (str);642if (str[0] == '^')643{644str = power (str + 1, &e2);645makeexp (e, POW, *e, e2);646}647return str;648}649650int651match (char *s, char *str)652{653char *ostr = str;654int i;655656for (i = 0; s[i] != 0; i++)657{658if (str[i] != s[i])659return 0;660}661str = skipspace (str + i);662return str - ostr;663}664665int666matchp (char *s, char *str)667{668char *ostr = str;669int i;670671for (i = 0; s[i] != 0; i++)672{673if (str[i] != s[i])674return 0;675}676str = skipspace (str + i);677if (str[0] == '(')678return str - ostr + 1;679return 0;680}681682struct functions683{684char *spelling;685enum op_t op;686int arity; /* 1 or 2 means real arity; 0 means arbitrary. */687};688689struct functions fns[] =690{691{"sqrt", SQRT, 1},692#if __GNU_MP_VERSION >= 2693{"root", ROOT, 2},694{"popc", POPCNT, 1},695{"hamdist", HAMDIST, 2},696#endif697{"gcd", GCD, 0},698#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1699{"lcm", LCM, 0},700#endif701{"and", AND, 0},702{"ior", IOR, 0},703#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 1704{"xor", XOR, 0},705#endif706{"plus", PLUS, 0},707{"pow", POW, 2},708{"minus", MINUS, 2},709{"mul", MULT, 0},710{"div", DIV, 2},711{"mod", MOD, 2},712{"rem", REM, 2},713#if __GNU_MP_VERSION >= 2714{"invmod", INVMOD, 2},715#endif716{"log", LOG, 2},717{"log2", LOG2, 1},718{"F", FERMAT, 1},719{"M", MERSENNE, 1},720{"fib", FIBONACCI, 1},721{"Fib", FIBONACCI, 1},722{"random", RANDOM, 1},723{"nextprime", NEXTPRIME, 1},724{"binom", BINOM, 2},725{"binomial", BINOM, 2},726{"fac", FAC, 1},727{"fact", FAC, 1},728{"factorial", FAC, 1},729{"", NOP, 0}730};731732char *733factor (char *str, expr_t *e)734{735expr_t e1, e2;736737str = skipspace (str);738739if (isalpha (str[0]))740{741int i;742int cnt;743744for (i = 0; fns[i].op != NOP; i++)745{746if (fns[i].arity == 1)747{748cnt = matchp (fns[i].spelling, str);749if (cnt != 0)750{751str = expr (str + cnt, &e1);752str = skipspace (str);753if (str[0] != ')')754{755error = "expected `)'";756longjmp (errjmpbuf, (int) (long) str);757}758makeexp (e, fns[i].op, e1, NULL);759return str + 1;760}761}762}763764for (i = 0; fns[i].op != NOP; i++)765{766if (fns[i].arity != 1)767{768cnt = matchp (fns[i].spelling, str);769if (cnt != 0)770{771str = expr (str + cnt, &e1);772str = skipspace (str);773774if (str[0] != ',')775{776error = "expected `,' and another operand";777longjmp (errjmpbuf, (int) (long) str);778}779780str = skipspace (str + 1);781str = expr (str, &e2);782str = skipspace (str);783784if (fns[i].arity == 0)785{786while (str[0] == ',')787{788makeexp (&e1, fns[i].op, e1, e2);789str = skipspace (str + 1);790str = expr (str, &e2);791str = skipspace (str);792}793}794795if (str[0] != ')')796{797error = "expected `)'";798longjmp (errjmpbuf, (int) (long) str);799}800801makeexp (e, fns[i].op, e1, e2);802return str + 1;803}804}805}806}807808if (str[0] == '(')809{810str = expr (str + 1, e);811str = skipspace (str);812if (str[0] != ')')813{814error = "expected `)'";815longjmp (errjmpbuf, (int) (long) str);816}817str++;818}819else if (str[0] >= '0' && str[0] <= '9')820{821expr_t res;822char *s, *sc;823824res = malloc (sizeof (struct expr));825res -> op = LIT;826mpz_init (res->operands.val);827828s = str;829while (isalnum (str[0]))830str++;831sc = malloc (str - s + 1);832memcpy (sc, s, str - s);833sc[str - s] = 0;834835mpz_set_str (res->operands.val, sc, 0);836*e = res;837free (sc);838}839else840{841error = "operand expected";842longjmp (errjmpbuf, (int) (long) str);843}844return str;845}846847char *848skipspace (char *str)849{850while (str[0] == ' ')851str++;852return str;853}854855/* Make a new expression with operation OP and right hand side856RHS and left hand side lhs. Put the result in R. */857void858makeexp (expr_t *r, enum op_t op, expr_t lhs, expr_t rhs)859{860expr_t res;861res = malloc (sizeof (struct expr));862res -> op = op;863res -> operands.ops.lhs = lhs;864res -> operands.ops.rhs = rhs;865*r = res;866return;867}868869/* Free the memory used by expression E. */870void871free_expr (expr_t e)872{873if (e->op != LIT)874{875free_expr (e->operands.ops.lhs);876if (e->operands.ops.rhs != NULL)877free_expr (e->operands.ops.rhs);878}879else880{881mpz_clear (e->operands.val);882}883}884885/* Evaluate the expression E and put the result in R. */886void887mpz_eval_expr (mpz_ptr r, expr_t e)888{889mpz_t lhs, rhs;890891switch (e->op)892{893case LIT:894mpz_set (r, e->operands.val);895return;896case PLUS:897mpz_init (lhs); mpz_init (rhs);898mpz_eval_expr (lhs, e->operands.ops.lhs);899mpz_eval_expr (rhs, e->operands.ops.rhs);900mpz_add (r, lhs, rhs);901mpz_clear (lhs); mpz_clear (rhs);902return;903case MINUS:904mpz_init (lhs); mpz_init (rhs);905mpz_eval_expr (lhs, e->operands.ops.lhs);906mpz_eval_expr (rhs, e->operands.ops.rhs);907mpz_sub (r, lhs, rhs);908mpz_clear (lhs); mpz_clear (rhs);909return;910case MULT:911mpz_init (lhs); mpz_init (rhs);912mpz_eval_expr (lhs, e->operands.ops.lhs);913mpz_eval_expr (rhs, e->operands.ops.rhs);914mpz_mul (r, lhs, rhs);915mpz_clear (lhs); mpz_clear (rhs);916return;917case DIV:918mpz_init (lhs); mpz_init (rhs);919mpz_eval_expr (lhs, e->operands.ops.lhs);920mpz_eval_expr (rhs, e->operands.ops.rhs);921mpz_fdiv_q (r, lhs, rhs);922mpz_clear (lhs); mpz_clear (rhs);923return;924case MOD:925mpz_init (rhs);926mpz_eval_expr (rhs, e->operands.ops.rhs);927mpz_abs (rhs, rhs);928mpz_eval_mod_expr (r, e->operands.ops.lhs, rhs);929mpz_clear (rhs);930return;931case REM:932/* Check if lhs operand is POW expression and optimize for that case. */933if (e->operands.ops.lhs->op == POW)934{935mpz_t powlhs, powrhs;936mpz_init (powlhs);937mpz_init (powrhs);938mpz_init (rhs);939mpz_eval_expr (powlhs, e->operands.ops.lhs->operands.ops.lhs);940mpz_eval_expr (powrhs, e->operands.ops.lhs->operands.ops.rhs);941mpz_eval_expr (rhs, e->operands.ops.rhs);942mpz_powm (r, powlhs, powrhs, rhs);943if (mpz_cmp_si (rhs, 0L) < 0)944mpz_neg (r, r);945mpz_clear (powlhs);946mpz_clear (powrhs);947mpz_clear (rhs);948return;949}950951mpz_init (lhs); mpz_init (rhs);952mpz_eval_expr (lhs, e->operands.ops.lhs);953mpz_eval_expr (rhs, e->operands.ops.rhs);954mpz_fdiv_r (r, lhs, rhs);955mpz_clear (lhs); mpz_clear (rhs);956return;957#if __GNU_MP_VERSION >= 2958case INVMOD:959mpz_init (lhs); mpz_init (rhs);960mpz_eval_expr (lhs, e->operands.ops.lhs);961mpz_eval_expr (rhs, e->operands.ops.rhs);962mpz_invert (r, lhs, rhs);963mpz_clear (lhs); mpz_clear (rhs);964return;965#endif966case POW:967mpz_init (lhs); mpz_init (rhs);968mpz_eval_expr (lhs, e->operands.ops.lhs);969if (mpz_cmpabs_ui (lhs, 1) <= 0)970{971/* For 0^rhs and 1^rhs, we just need to verify that972rhs is well-defined. For (-1)^rhs we need to973determine (rhs mod 2). For simplicity, compute974(rhs mod 2) for all three cases. */975expr_t two, et;976two = malloc (sizeof (struct expr));977two -> op = LIT;978mpz_init_set_ui (two->operands.val, 2L);979makeexp (&et, MOD, e->operands.ops.rhs, two);980e->operands.ops.rhs = et;981}982983mpz_eval_expr (rhs, e->operands.ops.rhs);984if (mpz_cmp_si (rhs, 0L) == 0)985/* x^0 is 1 */986mpz_set_ui (r, 1L);987else if (mpz_cmp_si (lhs, 0L) == 0)988/* 0^y (where y != 0) is 0 */989mpz_set_ui (r, 0L);990else if (mpz_cmp_ui (lhs, 1L) == 0)991/* 1^y is 1 */992mpz_set_ui (r, 1L);993else if (mpz_cmp_si (lhs, -1L) == 0)994/* (-1)^y just depends on whether y is even or odd */995mpz_set_si (r, (mpz_get_ui (rhs) & 1) ? -1L : 1L);996else if (mpz_cmp_si (rhs, 0L) < 0)997/* x^(-n) is 0 */998mpz_set_ui (r, 0L);999else1000{1001unsigned long int cnt;1002unsigned long int y;1003/* error if exponent does not fit into an unsigned long int. */1004if (mpz_cmp_ui (rhs, ~(unsigned long int) 0) > 0)1005goto pow_err;10061007y = mpz_get_ui (rhs);1008/* x^y == (x/(2^c))^y * 2^(c*y) */1009#if __GNU_MP_VERSION >= 21010cnt = mpz_scan1 (lhs, 0);1011#else1012cnt = 0;1013#endif1014if (cnt != 0)1015{1016if (y * cnt / cnt != y)1017goto pow_err;1018mpz_tdiv_q_2exp (lhs, lhs, cnt);1019mpz_pow_ui (r, lhs, y);1020mpz_mul_2exp (r, r, y * cnt);1021}1022else1023mpz_pow_ui (r, lhs, y);1024}1025mpz_clear (lhs); mpz_clear (rhs);1026return;1027pow_err:1028error = "result of `pow' operator too large";1029mpz_clear (lhs); mpz_clear (rhs);1030longjmp (errjmpbuf, 1);1031case GCD:1032mpz_init (lhs); mpz_init (rhs);1033mpz_eval_expr (lhs, e->operands.ops.lhs);1034mpz_eval_expr (rhs, e->operands.ops.rhs);1035mpz_gcd (r, lhs, rhs);1036mpz_clear (lhs); mpz_clear (rhs);1037return;1038#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 11039case LCM:1040mpz_init (lhs); mpz_init (rhs);1041mpz_eval_expr (lhs, e->operands.ops.lhs);1042mpz_eval_expr (rhs, e->operands.ops.rhs);1043mpz_lcm (r, lhs, rhs);1044mpz_clear (lhs); mpz_clear (rhs);1045return;1046#endif1047case AND:1048mpz_init (lhs); mpz_init (rhs);1049mpz_eval_expr (lhs, e->operands.ops.lhs);1050mpz_eval_expr (rhs, e->operands.ops.rhs);1051mpz_and (r, lhs, rhs);1052mpz_clear (lhs); mpz_clear (rhs);1053return;1054case IOR:1055mpz_init (lhs); mpz_init (rhs);1056mpz_eval_expr (lhs, e->operands.ops.lhs);1057mpz_eval_expr (rhs, e->operands.ops.rhs);1058mpz_ior (r, lhs, rhs);1059mpz_clear (lhs); mpz_clear (rhs);1060return;1061#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 11062case XOR:1063mpz_init (lhs); mpz_init (rhs);1064mpz_eval_expr (lhs, e->operands.ops.lhs);1065mpz_eval_expr (rhs, e->operands.ops.rhs);1066mpz_xor (r, lhs, rhs);1067mpz_clear (lhs); mpz_clear (rhs);1068return;1069#endif1070case NEG:1071mpz_eval_expr (r, e->operands.ops.lhs);1072mpz_neg (r, r);1073return;1074case NOT:1075mpz_eval_expr (r, e->operands.ops.lhs);1076mpz_com (r, r);1077return;1078case SQRT:1079mpz_init (lhs);1080mpz_eval_expr (lhs, e->operands.ops.lhs);1081if (mpz_sgn (lhs) < 0)1082{1083error = "cannot take square root of negative numbers";1084mpz_clear (lhs);1085longjmp (errjmpbuf, 1);1086}1087mpz_sqrt (r, lhs);1088return;1089#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 11090case ROOT:1091mpz_init (lhs); mpz_init (rhs);1092mpz_eval_expr (lhs, e->operands.ops.lhs);1093mpz_eval_expr (rhs, e->operands.ops.rhs);1094if (mpz_sgn (rhs) <= 0)1095{1096error = "cannot take non-positive root orders";1097mpz_clear (lhs); mpz_clear (rhs);1098longjmp (errjmpbuf, 1);1099}1100if (mpz_sgn (lhs) < 0 && (mpz_get_ui (rhs) & 1) == 0)1101{1102error = "cannot take even root orders of negative numbers";1103mpz_clear (lhs); mpz_clear (rhs);1104longjmp (errjmpbuf, 1);1105}11061107{1108unsigned long int nth = mpz_get_ui (rhs);1109if (mpz_cmp_ui (rhs, ~(unsigned long int) 0) > 0)1110{1111/* If we are asked to take an awfully large root order, cheat and1112ask for the largest order we can pass to mpz_root. This saves1113some error prone special cases. */1114nth = ~(unsigned long int) 0;1115}1116mpz_root (r, lhs, nth);1117}1118mpz_clear (lhs); mpz_clear (rhs);1119return;1120#endif1121case FAC:1122mpz_eval_expr (r, e->operands.ops.lhs);1123if (mpz_size (r) > 1)1124{1125error = "result of `!' operator too large";1126longjmp (errjmpbuf, 1);1127}1128mpz_fac_ui (r, mpz_get_ui (r));1129return;1130#if __GNU_MP_VERSION >= 21131case POPCNT:1132mpz_eval_expr (r, e->operands.ops.lhs);1133{ long int cnt;1134cnt = mpz_popcount (r);1135mpz_set_si (r, cnt);1136}1137return;1138case HAMDIST:1139{ long int cnt;1140mpz_init (lhs); mpz_init (rhs);1141mpz_eval_expr (lhs, e->operands.ops.lhs);1142mpz_eval_expr (rhs, e->operands.ops.rhs);1143cnt = mpz_hamdist (lhs, rhs);1144mpz_clear (lhs); mpz_clear (rhs);1145mpz_set_si (r, cnt);1146}1147return;1148#endif1149case LOG2:1150mpz_eval_expr (r, e->operands.ops.lhs);1151{ unsigned long int cnt;1152if (mpz_sgn (r) <= 0)1153{1154error = "logarithm of non-positive number";1155longjmp (errjmpbuf, 1);1156}1157cnt = mpz_sizeinbase (r, 2);1158mpz_set_ui (r, cnt - 1);1159}1160return;1161case LOG:1162{ unsigned long int cnt;1163mpz_init (lhs); mpz_init (rhs);1164mpz_eval_expr (lhs, e->operands.ops.lhs);1165mpz_eval_expr (rhs, e->operands.ops.rhs);1166if (mpz_sgn (lhs) <= 0)1167{1168error = "logarithm of non-positive number";1169mpz_clear (lhs); mpz_clear (rhs);1170longjmp (errjmpbuf, 1);1171}1172if (mpz_cmp_ui (rhs, 256) >= 0)1173{1174error = "logarithm base too large";1175mpz_clear (lhs); mpz_clear (rhs);1176longjmp (errjmpbuf, 1);1177}1178cnt = mpz_sizeinbase (lhs, mpz_get_ui (rhs));1179mpz_set_ui (r, cnt - 1);1180mpz_clear (lhs); mpz_clear (rhs);1181}1182return;1183case FERMAT:1184{1185unsigned long int t;1186mpz_init (lhs);1187mpz_eval_expr (lhs, e->operands.ops.lhs);1188t = (unsigned long int) 1 << mpz_get_ui (lhs);1189if (mpz_cmp_ui (lhs, ~(unsigned long int) 0) > 0 || t == 0)1190{1191error = "too large Mersenne number index";1192mpz_clear (lhs);1193longjmp (errjmpbuf, 1);1194}1195mpz_set_ui (r, 1);1196mpz_mul_2exp (r, r, t);1197mpz_add_ui (r, r, 1);1198mpz_clear (lhs);1199}1200return;1201case MERSENNE:1202mpz_init (lhs);1203mpz_eval_expr (lhs, e->operands.ops.lhs);1204if (mpz_cmp_ui (lhs, ~(unsigned long int) 0) > 0)1205{1206error = "too large Mersenne number index";1207mpz_clear (lhs);1208longjmp (errjmpbuf, 1);1209}1210mpz_set_ui (r, 1);1211mpz_mul_2exp (r, r, mpz_get_ui (lhs));1212mpz_sub_ui (r, r, 1);1213mpz_clear (lhs);1214return;1215case FIBONACCI:1216{ mpz_t t;1217unsigned long int n, i;1218mpz_init (lhs);1219mpz_eval_expr (lhs, e->operands.ops.lhs);1220if (mpz_sgn (lhs) <= 0 || mpz_cmp_si (lhs, 1000000000) > 0)1221{1222error = "Fibonacci index out of range";1223mpz_clear (lhs);1224longjmp (errjmpbuf, 1);1225}1226n = mpz_get_ui (lhs);1227mpz_clear (lhs);12281229#if __GNU_MP_VERSION > 2 || __GNU_MP_VERSION_MINOR >= 11230mpz_fib_ui (r, n);1231#else1232mpz_init_set_ui (t, 1);1233mpz_set_ui (r, 1);12341235if (n <= 2)1236mpz_set_ui (r, 1);1237else1238{1239for (i = 3; i <= n; i++)1240{1241mpz_add (t, t, r);1242mpz_swap (t, r);1243}1244}1245mpz_clear (t);1246#endif1247}1248return;1249case RANDOM:1250{1251unsigned long int n;1252mpz_init (lhs);1253mpz_eval_expr (lhs, e->operands.ops.lhs);1254if (mpz_sgn (lhs) <= 0 || mpz_cmp_si (lhs, 1000000000) > 0)1255{1256error = "random number size out of range";1257mpz_clear (lhs);1258longjmp (errjmpbuf, 1);1259}1260n = mpz_get_ui (lhs);1261mpz_clear (lhs);1262mpz_urandomb (r, rstate, n);1263}1264return;1265case NEXTPRIME:1266{1267mpz_eval_expr (r, e->operands.ops.lhs);1268mpz_nextprime (r, r);1269}1270return;1271case BINOM:1272mpz_init (lhs); mpz_init (rhs);1273mpz_eval_expr (lhs, e->operands.ops.lhs);1274mpz_eval_expr (rhs, e->operands.ops.rhs);1275{1276unsigned long int k;1277if (mpz_cmp_ui (rhs, ~(unsigned long int) 0) > 0)1278{1279error = "k too large in (n over k) expression";1280mpz_clear (lhs); mpz_clear (rhs);1281longjmp (errjmpbuf, 1);1282}1283k = mpz_get_ui (rhs);1284mpz_bin_ui (r, lhs, k);1285}1286mpz_clear (lhs); mpz_clear (rhs);1287return;1288default:1289abort ();1290}1291}12921293/* Evaluate the expression E modulo MOD and put the result in R. */1294void1295mpz_eval_mod_expr (mpz_ptr r, expr_t e, mpz_ptr mod)1296{1297mpz_t lhs, rhs;12981299switch (e->op)1300{1301case POW:1302mpz_init (lhs); mpz_init (rhs);1303mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);1304mpz_eval_expr (rhs, e->operands.ops.rhs);1305mpz_powm (r, lhs, rhs, mod);1306mpz_clear (lhs); mpz_clear (rhs);1307return;1308case PLUS:1309mpz_init (lhs); mpz_init (rhs);1310mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);1311mpz_eval_mod_expr (rhs, e->operands.ops.rhs, mod);1312mpz_add (r, lhs, rhs);1313if (mpz_cmp_si (r, 0L) < 0)1314mpz_add (r, r, mod);1315else if (mpz_cmp (r, mod) >= 0)1316mpz_sub (r, r, mod);1317mpz_clear (lhs); mpz_clear (rhs);1318return;1319case MINUS:1320mpz_init (lhs); mpz_init (rhs);1321mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);1322mpz_eval_mod_expr (rhs, e->operands.ops.rhs, mod);1323mpz_sub (r, lhs, rhs);1324if (mpz_cmp_si (r, 0L) < 0)1325mpz_add (r, r, mod);1326else if (mpz_cmp (r, mod) >= 0)1327mpz_sub (r, r, mod);1328mpz_clear (lhs); mpz_clear (rhs);1329return;1330case MULT:1331mpz_init (lhs); mpz_init (rhs);1332mpz_eval_mod_expr (lhs, e->operands.ops.lhs, mod);1333mpz_eval_mod_expr (rhs, e->operands.ops.rhs, mod);1334mpz_mul (r, lhs, rhs);1335mpz_mod (r, r, mod);1336mpz_clear (lhs); mpz_clear (rhs);1337return;1338default:1339mpz_init (lhs);1340mpz_eval_expr (lhs, e);1341mpz_mod (r, lhs, mod);1342mpz_clear (lhs);1343return;1344}1345}13461347void1348cleanup_and_exit (int sig)1349{1350switch (sig) {1351#ifdef LIMIT_RESOURCE_USAGE1352case SIGXCPU:1353printf ("expression took too long to evaluate%s\n", newline);1354break;1355#endif1356case SIGFPE:1357printf ("divide by zero%s\n", newline);1358break;1359default:1360printf ("expression required too much memory to evaluate%s\n", newline);1361break;1362}1363exit (-2);1364}136513661367