src/glpgmp.c
author Alpar Juttner <alpar@cs.elte.hu>
Sun, 05 Dec 2010 17:35:23 +0100
changeset 2 4c8956a7bdf4
permissions -rw-r--r--
Set up CMAKE build environment
alpar@1
     1
/* glpgmp.c */
alpar@1
     2
alpar@1
     3
/***********************************************************************
alpar@1
     4
*  This code is part of GLPK (GNU Linear Programming Kit).
alpar@1
     5
*
alpar@1
     6
*  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
alpar@1
     7
*  2009, 2010 Andrew Makhorin, Department for Applied Informatics,
alpar@1
     8
*  Moscow Aviation Institute, Moscow, Russia. All rights reserved.
alpar@1
     9
*  E-mail: <mao@gnu.org>.
alpar@1
    10
*
alpar@1
    11
*  GLPK is free software: you can redistribute it and/or modify it
alpar@1
    12
*  under the terms of the GNU General Public License as published by
alpar@1
    13
*  the Free Software Foundation, either version 3 of the License, or
alpar@1
    14
*  (at your option) any later version.
alpar@1
    15
*
alpar@1
    16
*  GLPK is distributed in the hope that it will be useful, but WITHOUT
alpar@1
    17
*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
alpar@1
    18
*  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
alpar@1
    19
*  License for more details.
alpar@1
    20
*
alpar@1
    21
*  You should have received a copy of the GNU General Public License
alpar@1
    22
*  along with GLPK. If not, see <http://www.gnu.org/licenses/>.
alpar@1
    23
***********************************************************************/
alpar@1
    24
alpar@1
    25
#define _GLPSTD_STDIO
alpar@1
    26
#include "glpdmp.h"
alpar@1
    27
#include "glpgmp.h"
alpar@1
    28
#define xfault xerror
alpar@1
    29
alpar@1
    30
#ifdef HAVE_GMP               /* use GNU MP bignum library */
alpar@1
    31
alpar@1
    32
int gmp_pool_count(void) { return 0; }
alpar@1
    33
alpar@1
    34
void gmp_free_mem(void) { return; }
alpar@1
    35
alpar@1
    36
#else                         /* use GLPK bignum module */
alpar@1
    37
alpar@1
    38
static DMP *gmp_pool = NULL;
alpar@1
    39
static int gmp_size = 0;
alpar@1
    40
static unsigned short *gmp_work = NULL;
alpar@1
    41
alpar@1
    42
void *gmp_get_atom(int size)
alpar@1
    43
{     if (gmp_pool == NULL)
alpar@1
    44
         gmp_pool = dmp_create_pool();
alpar@1
    45
      return dmp_get_atom(gmp_pool, size);
alpar@1
    46
}
alpar@1
    47
alpar@1
    48
void gmp_free_atom(void *ptr, int size)
alpar@1
    49
{     xassert(gmp_pool != NULL);
alpar@1
    50
      dmp_free_atom(gmp_pool, ptr, size);
alpar@1
    51
      return;
alpar@1
    52
}
alpar@1
    53
alpar@1
    54
int gmp_pool_count(void)
alpar@1
    55
{     if (gmp_pool == NULL)
alpar@1
    56
         return 0;
alpar@1
    57
      else
alpar@1
    58
         return dmp_in_use(gmp_pool).lo;
alpar@1
    59
}
alpar@1
    60
alpar@1
    61
unsigned short *gmp_get_work(int size)
alpar@1
    62
{     xassert(size > 0);
alpar@1
    63
      if (gmp_size < size)
alpar@1
    64
      {  if (gmp_size == 0)
alpar@1
    65
         {  xassert(gmp_work == NULL);
alpar@1
    66
            gmp_size = 100;
alpar@1
    67
         }
alpar@1
    68
         else
alpar@1
    69
         {  xassert(gmp_work != NULL);
alpar@1
    70
            xfree(gmp_work);
alpar@1
    71
         }
alpar@1
    72
         while (gmp_size < size) gmp_size += gmp_size;
alpar@1
    73
         gmp_work = xcalloc(gmp_size, sizeof(unsigned short));
alpar@1
    74
      }
alpar@1
    75
      return gmp_work;
alpar@1
    76
}
alpar@1
    77
alpar@1
    78
void gmp_free_mem(void)
alpar@1
    79
{     if (gmp_pool != NULL) dmp_delete_pool(gmp_pool);
alpar@1
    80
      if (gmp_work != NULL) xfree(gmp_work);
alpar@1
    81
      gmp_pool = NULL;
alpar@1
    82
      gmp_size = 0;
alpar@1
    83
      gmp_work = NULL;
alpar@1
    84
      return;
alpar@1
    85
}
alpar@1
    86
alpar@1
    87
/*====================================================================*/
alpar@1
    88
alpar@1
    89
mpz_t _mpz_init(void)
alpar@1
    90
{     /* initialize x, and set its value to 0 */
alpar@1
    91
      mpz_t x;
alpar@1
    92
      x = gmp_get_atom(sizeof(struct mpz));
alpar@1
    93
      x->val = 0;
alpar@1
    94
      x->ptr = NULL;
alpar@1
    95
      return x;
alpar@1
    96
}
alpar@1
    97
alpar@1
    98
void mpz_clear(mpz_t x)
alpar@1
    99
{     /* free the space occupied by x */
alpar@1
   100
      mpz_set_si(x, 0);
alpar@1
   101
      xassert(x->ptr == NULL);
alpar@1
   102
      /* free the number descriptor */
alpar@1
   103
      gmp_free_atom(x, sizeof(struct mpz));
alpar@1
   104
      return;
alpar@1
   105
}
alpar@1
   106
alpar@1
   107
void mpz_set(mpz_t z, mpz_t x)
alpar@1
   108
{     /* set the value of z from x */
alpar@1
   109
      struct mpz_seg *e, *ee, *es;
alpar@1
   110
      if (z != x)
alpar@1
   111
      {  mpz_set_si(z, 0);
alpar@1
   112
         z->val = x->val;
alpar@1
   113
         xassert(z->ptr == NULL);
alpar@1
   114
         for (e = x->ptr, es = NULL; e != NULL; e = e->next)
alpar@1
   115
         {  ee = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   116
            memcpy(ee->d, e->d, 12);
alpar@1
   117
            ee->next = NULL;
alpar@1
   118
            if (z->ptr == NULL)
alpar@1
   119
               z->ptr = ee;
alpar@1
   120
            else
alpar@1
   121
               es->next = ee;
alpar@1
   122
            es = ee;
alpar@1
   123
         }
alpar@1
   124
      }
alpar@1
   125
      return;
alpar@1
   126
}
alpar@1
   127
alpar@1
   128
void mpz_set_si(mpz_t x, int val)
alpar@1
   129
{     /* set the value of x to val */
alpar@1
   130
      struct mpz_seg *e;
alpar@1
   131
      /* free existing segments, if any */
alpar@1
   132
      while (x->ptr != NULL)
alpar@1
   133
      {  e = x->ptr;
alpar@1
   134
         x->ptr = e->next;
alpar@1
   135
         gmp_free_atom(e, sizeof(struct mpz_seg));
alpar@1
   136
      }
alpar@1
   137
      /* assign new value */
alpar@1
   138
      if (val == 0x80000000)
alpar@1
   139
      {  /* long format is needed */
alpar@1
   140
         x->val = -1;
alpar@1
   141
         x->ptr = e = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   142
         memset(e->d, 0, 12);
alpar@1
   143
         e->d[1] = 0x8000;
alpar@1
   144
         e->next = NULL;
alpar@1
   145
      }
alpar@1
   146
      else
alpar@1
   147
      {  /* short format is enough */
alpar@1
   148
         x->val = val;
alpar@1
   149
      }
alpar@1
   150
      return;
alpar@1
   151
}
alpar@1
   152
alpar@1
   153
double mpz_get_d(mpz_t x)
alpar@1
   154
{     /* convert x to a double, truncating if necessary */
alpar@1
   155
      struct mpz_seg *e;
alpar@1
   156
      int j;
alpar@1
   157
      double val, deg;
alpar@1
   158
      if (x->ptr == NULL)
alpar@1
   159
         val = (double)x->val;
alpar@1
   160
      else
alpar@1
   161
      {  xassert(x->val != 0);
alpar@1
   162
         val = 0.0;
alpar@1
   163
         deg = 1.0;
alpar@1
   164
         for (e = x->ptr; e != NULL; e = e->next)
alpar@1
   165
         {  for (j = 0; j <= 5; j++)
alpar@1
   166
            {  val += deg * (double)((int)e->d[j]);
alpar@1
   167
               deg *= 65536.0;
alpar@1
   168
            }
alpar@1
   169
         }
alpar@1
   170
         if (x->val < 0) val = - val;
alpar@1
   171
      }
alpar@1
   172
      return val;
alpar@1
   173
}
alpar@1
   174
alpar@1
   175
double mpz_get_d_2exp(int *exp, mpz_t x)
alpar@1
   176
{     /* convert x to a double, truncating if necessary (i.e. rounding
alpar@1
   177
         towards zero), and returning the exponent separately;
alpar@1
   178
         the return value is in the range 0.5 <= |d| < 1 and the
alpar@1
   179
         exponent is stored to *exp; d*2^exp is the (truncated) x value;
alpar@1
   180
         if x is zero, the return is 0.0 and 0 is stored to *exp;
alpar@1
   181
         this is similar to the standard C frexp function */
alpar@1
   182
      struct mpz_seg *e;
alpar@1
   183
      int j, n, n1;
alpar@1
   184
      double val;
alpar@1
   185
      if (x->ptr == NULL)
alpar@1
   186
         val = (double)x->val, n = 0;
alpar@1
   187
      else
alpar@1
   188
      {  xassert(x->val != 0);
alpar@1
   189
         val = 0.0, n = 0;
alpar@1
   190
         for (e = x->ptr; e != NULL; e = e->next)
alpar@1
   191
         {  for (j = 0; j <= 5; j++)
alpar@1
   192
            {  val += (double)((int)e->d[j]);
alpar@1
   193
               val /= 65536.0, n += 16;
alpar@1
   194
            }
alpar@1
   195
         }
alpar@1
   196
         if (x->val < 0) val = - val;
alpar@1
   197
      }
alpar@1
   198
      val = frexp(val, &n1);
alpar@1
   199
      *exp = n + n1;
alpar@1
   200
      return val;
alpar@1
   201
}
alpar@1
   202
alpar@1
   203
void mpz_swap(mpz_t x, mpz_t y)
alpar@1
   204
{     /* swap the values x and y efficiently */
alpar@1
   205
      int val;
alpar@1
   206
      void *ptr;
alpar@1
   207
      val = x->val, ptr = x->ptr;
alpar@1
   208
      x->val = y->val, x->ptr = y->ptr;
alpar@1
   209
      y->val = val, y->ptr = ptr;
alpar@1
   210
      return;
alpar@1
   211
}
alpar@1
   212
alpar@1
   213
static void normalize(mpz_t x)
alpar@1
   214
{     /* normalize integer x that includes removing non-significant
alpar@1
   215
         (leading) zeros and converting to short format, if possible */
alpar@1
   216
      struct mpz_seg *es, *e;
alpar@1
   217
      /* if the integer is in short format, it remains unchanged */
alpar@1
   218
      if (x->ptr == NULL)
alpar@1
   219
      {  xassert(x->val != 0x80000000);
alpar@1
   220
         goto done;
alpar@1
   221
      }
alpar@1
   222
      xassert(x->val == +1 || x->val == -1);
alpar@1
   223
      /* find the last (most significant) non-zero segment */
alpar@1
   224
      es = NULL;
alpar@1
   225
      for (e = x->ptr; e != NULL; e = e->next)
alpar@1
   226
      {  if (e->d[0] || e->d[1] || e->d[2] ||
alpar@1
   227
             e->d[3] || e->d[4] || e->d[5]) es = e;
alpar@1
   228
      }
alpar@1
   229
      /* if all segments contain zeros, the integer is zero */
alpar@1
   230
      if (es == NULL)
alpar@1
   231
      {  mpz_set_si(x, 0);
alpar@1
   232
         goto done;
alpar@1
   233
      }
alpar@1
   234
      /* remove non-significant (leading) zero segments */
alpar@1
   235
      while (es->next != NULL)
alpar@1
   236
      {  e = es->next;
alpar@1
   237
         es->next = e->next;
alpar@1
   238
         gmp_free_atom(e, sizeof(struct mpz_seg));
alpar@1
   239
      }
alpar@1
   240
      /* convert the integer to short format, if possible */
alpar@1
   241
      e = x->ptr;
alpar@1
   242
      if (e->next == NULL && e->d[1] <= 0x7FFF &&
alpar@1
   243
         !e->d[2] && !e->d[3] && !e->d[4] && !e->d[5])
alpar@1
   244
      {  int val;
alpar@1
   245
         val = (int)e->d[0] + ((int)e->d[1] << 16);
alpar@1
   246
         if (x->val < 0) val = - val;
alpar@1
   247
         mpz_set_si(x, val);
alpar@1
   248
      }
alpar@1
   249
done: return;
alpar@1
   250
}
alpar@1
   251
alpar@1
   252
void mpz_add(mpz_t z, mpz_t x, mpz_t y)
alpar@1
   253
{     /* set z to x + y */
alpar@1
   254
      static struct mpz_seg zero = { { 0, 0, 0, 0, 0, 0 }, NULL };
alpar@1
   255
      struct mpz_seg dumx, dumy, *ex, *ey, *ez, *es, *ee;
alpar@1
   256
      int k, sx, sy, sz;
alpar@1
   257
      unsigned int t;
alpar@1
   258
      /* if [x] = 0 then [z] = [y] */
alpar@1
   259
      if (x->val == 0)
alpar@1
   260
      {  xassert(x->ptr == NULL);
alpar@1
   261
         mpz_set(z, y);
alpar@1
   262
         goto done;
alpar@1
   263
      }
alpar@1
   264
      /* if [y] = 0 then [z] = [x] */
alpar@1
   265
      if (y->val == 0)
alpar@1
   266
      {  xassert(y->ptr == NULL);
alpar@1
   267
         mpz_set(z, x);
alpar@1
   268
         goto done;
alpar@1
   269
      }
alpar@1
   270
      /* special case when both [x] and [y] are in short format */
alpar@1
   271
      if (x->ptr == NULL && y->ptr == NULL)
alpar@1
   272
      {  int xval = x->val, yval = y->val, zval = x->val + y->val;
alpar@1
   273
         xassert(xval != 0x80000000 && yval != 0x80000000);
alpar@1
   274
         if (!(xval > 0 && yval > 0 && zval <= 0 ||
alpar@1
   275
               xval < 0 && yval < 0 && zval >= 0))
alpar@1
   276
         {  mpz_set_si(z, zval);
alpar@1
   277
            goto done;
alpar@1
   278
         }
alpar@1
   279
      }
alpar@1
   280
      /* convert [x] to long format, if necessary */
alpar@1
   281
      if (x->ptr == NULL)
alpar@1
   282
      {  xassert(x->val != 0x80000000);
alpar@1
   283
         if (x->val >= 0)
alpar@1
   284
         {  sx = +1;
alpar@1
   285
            t = (unsigned int)(+ x->val);
alpar@1
   286
         }
alpar@1
   287
         else
alpar@1
   288
         {  sx = -1;
alpar@1
   289
            t = (unsigned int)(- x->val);
alpar@1
   290
         }
alpar@1
   291
         ex = &dumx;
alpar@1
   292
         ex->d[0] = (unsigned short)t;
alpar@1
   293
         ex->d[1] = (unsigned short)(t >> 16);
alpar@1
   294
         ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0;
alpar@1
   295
         ex->next = NULL;
alpar@1
   296
      }
alpar@1
   297
      else
alpar@1
   298
      {  sx = x->val;
alpar@1
   299
         xassert(sx == +1 || sx == -1);
alpar@1
   300
         ex = x->ptr;
alpar@1
   301
      }
alpar@1
   302
      /* convert [y] to long format, if necessary */
alpar@1
   303
      if (y->ptr == NULL)
alpar@1
   304
      {  xassert(y->val != 0x80000000);
alpar@1
   305
         if (y->val >= 0)
alpar@1
   306
         {  sy = +1;
alpar@1
   307
            t = (unsigned int)(+ y->val);
alpar@1
   308
         }
alpar@1
   309
         else
alpar@1
   310
         {  sy = -1;
alpar@1
   311
            t = (unsigned int)(- y->val);
alpar@1
   312
         }
alpar@1
   313
         ey = &dumy;
alpar@1
   314
         ey->d[0] = (unsigned short)t;
alpar@1
   315
         ey->d[1] = (unsigned short)(t >> 16);
alpar@1
   316
         ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0;
alpar@1
   317
         ey->next = NULL;
alpar@1
   318
      }
alpar@1
   319
      else
alpar@1
   320
      {  sy = y->val;
alpar@1
   321
         xassert(sy == +1 || sy == -1);
alpar@1
   322
         ey = y->ptr;
alpar@1
   323
      }
alpar@1
   324
      /* main fragment */
alpar@1
   325
      sz = sx;
alpar@1
   326
      ez = es = NULL;
alpar@1
   327
      if (sx > 0 && sy > 0 || sx < 0 && sy < 0)
alpar@1
   328
      {  /* [x] and [y] have identical signs -- addition */
alpar@1
   329
         t = 0;
alpar@1
   330
         for (; ex || ey; ex = ex->next, ey = ey->next)
alpar@1
   331
         {  if (ex == NULL) ex = &zero;
alpar@1
   332
            if (ey == NULL) ey = &zero;
alpar@1
   333
            ee = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   334
            for (k = 0; k <= 5; k++)
alpar@1
   335
            {  t += (unsigned int)ex->d[k];
alpar@1
   336
               t += (unsigned int)ey->d[k];
alpar@1
   337
               ee->d[k] = (unsigned short)t;
alpar@1
   338
               t >>= 16;
alpar@1
   339
            }
alpar@1
   340
            ee->next = NULL;
alpar@1
   341
            if (ez == NULL)
alpar@1
   342
               ez = ee;
alpar@1
   343
            else
alpar@1
   344
               es->next = ee;
alpar@1
   345
            es = ee;
alpar@1
   346
         }
alpar@1
   347
         if (t)
alpar@1
   348
         {  /* overflow -- one extra digit is needed */
alpar@1
   349
            ee = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   350
            ee->d[0] = 1;
alpar@1
   351
            ee->d[1] = ee->d[2] = ee->d[3] = ee->d[4] = ee->d[5] = 0;
alpar@1
   352
            ee->next = NULL;
alpar@1
   353
            xassert(es != NULL);
alpar@1
   354
            es->next = ee;
alpar@1
   355
         }
alpar@1
   356
      }
alpar@1
   357
      else
alpar@1
   358
      {  /* [x] and [y] have different signs -- subtraction */
alpar@1
   359
         t = 1;
alpar@1
   360
         for (; ex || ey; ex = ex->next, ey = ey->next)
alpar@1
   361
         {  if (ex == NULL) ex = &zero;
alpar@1
   362
            if (ey == NULL) ey = &zero;
alpar@1
   363
            ee = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   364
            for (k = 0; k <= 5; k++)
alpar@1
   365
            {  t += (unsigned int)ex->d[k];
alpar@1
   366
               t += (0xFFFF - (unsigned int)ey->d[k]);
alpar@1
   367
               ee->d[k] = (unsigned short)t;
alpar@1
   368
               t >>= 16;
alpar@1
   369
            }
alpar@1
   370
            ee->next = NULL;
alpar@1
   371
            if (ez == NULL)
alpar@1
   372
               ez = ee;
alpar@1
   373
            else
alpar@1
   374
               es->next = ee;
alpar@1
   375
            es = ee;
alpar@1
   376
         }
alpar@1
   377
         if (!t)
alpar@1
   378
         {  /* |[x]| < |[y]| -- result in complement coding */
alpar@1
   379
            sz = - sz;
alpar@1
   380
            t = 1;
alpar@1
   381
            for (ee = ez; ee != NULL; ee = ee->next)
alpar@1
   382
            for (k = 0; k <= 5; k++)
alpar@1
   383
            {  t += (0xFFFF - (unsigned int)ee->d[k]);
alpar@1
   384
               ee->d[k] = (unsigned short)t;
alpar@1
   385
               t >>= 16;
alpar@1
   386
            }
alpar@1
   387
         }
alpar@1
   388
      }
alpar@1
   389
      /* contruct and normalize result */
alpar@1
   390
      mpz_set_si(z, 0);
alpar@1
   391
      z->val = sz;
alpar@1
   392
      z->ptr = ez;
alpar@1
   393
      normalize(z);
alpar@1
   394
done: return;
alpar@1
   395
}
alpar@1
   396
alpar@1
   397
void mpz_sub(mpz_t z, mpz_t x, mpz_t y)
alpar@1
   398
{     /* set z to x - y */
alpar@1
   399
      if (x == y)
alpar@1
   400
         mpz_set_si(z, 0);
alpar@1
   401
      else
alpar@1
   402
      {  y->val = - y->val;
alpar@1
   403
         mpz_add(z, x, y);
alpar@1
   404
         if (y != z) y->val = - y->val;
alpar@1
   405
      }
alpar@1
   406
      return;
alpar@1
   407
}
alpar@1
   408
alpar@1
   409
void mpz_mul(mpz_t z, mpz_t x, mpz_t y)
alpar@1
   410
{     /* set z to x * y */
alpar@1
   411
      struct mpz_seg dumx, dumy, *ex, *ey, *es, *e;
alpar@1
   412
      int sx, sy, k, nx, ny, n;
alpar@1
   413
      unsigned int t;
alpar@1
   414
      unsigned short *work, *wx, *wy;
alpar@1
   415
      /* if [x] = 0 then [z] = 0 */
alpar@1
   416
      if (x->val == 0)
alpar@1
   417
      {  xassert(x->ptr == NULL);
alpar@1
   418
         mpz_set_si(z, 0);
alpar@1
   419
         goto done;
alpar@1
   420
      }
alpar@1
   421
      /* if [y] = 0 then [z] = 0 */
alpar@1
   422
      if (y->val == 0)
alpar@1
   423
      {  xassert(y->ptr == NULL);
alpar@1
   424
         mpz_set_si(z, 0);
alpar@1
   425
         goto done;
alpar@1
   426
      }
alpar@1
   427
      /* special case when both [x] and [y] are in short format */
alpar@1
   428
      if (x->ptr == NULL && y->ptr == NULL)
alpar@1
   429
      {  int xval = x->val, yval = y->val, sz = +1;
alpar@1
   430
         xassert(xval != 0x80000000 && yval != 0x80000000);
alpar@1
   431
         if (xval < 0) xval = - xval, sz = - sz;
alpar@1
   432
         if (yval < 0) yval = - yval, sz = - sz;
alpar@1
   433
         if (xval <= 0x7FFFFFFF / yval)
alpar@1
   434
         {  mpz_set_si(z, sz * (xval * yval));
alpar@1
   435
            goto done;
alpar@1
   436
         }
alpar@1
   437
      }
alpar@1
   438
      /* convert [x] to long format, if necessary */
alpar@1
   439
      if (x->ptr == NULL)
alpar@1
   440
      {  xassert(x->val != 0x80000000);
alpar@1
   441
         if (x->val >= 0)
alpar@1
   442
         {  sx = +1;
alpar@1
   443
            t = (unsigned int)(+ x->val);
alpar@1
   444
         }
alpar@1
   445
         else
alpar@1
   446
         {  sx = -1;
alpar@1
   447
            t = (unsigned int)(- x->val);
alpar@1
   448
         }
alpar@1
   449
         ex = &dumx;
alpar@1
   450
         ex->d[0] = (unsigned short)t;
alpar@1
   451
         ex->d[1] = (unsigned short)(t >> 16);
alpar@1
   452
         ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0;
alpar@1
   453
         ex->next = NULL;
alpar@1
   454
      }
alpar@1
   455
      else
alpar@1
   456
      {  sx = x->val;
alpar@1
   457
         xassert(sx == +1 || sx == -1);
alpar@1
   458
         ex = x->ptr;
alpar@1
   459
      }
alpar@1
   460
      /* convert [y] to long format, if necessary */
alpar@1
   461
      if (y->ptr == NULL)
alpar@1
   462
      {  xassert(y->val != 0x80000000);
alpar@1
   463
         if (y->val >= 0)
alpar@1
   464
         {  sy = +1;
alpar@1
   465
            t = (unsigned int)(+ y->val);
alpar@1
   466
         }
alpar@1
   467
         else
alpar@1
   468
         {  sy = -1;
alpar@1
   469
            t = (unsigned int)(- y->val);
alpar@1
   470
         }
alpar@1
   471
         ey = &dumy;
alpar@1
   472
         ey->d[0] = (unsigned short)t;
alpar@1
   473
         ey->d[1] = (unsigned short)(t >> 16);
alpar@1
   474
         ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0;
alpar@1
   475
         ey->next = NULL;
alpar@1
   476
      }
alpar@1
   477
      else
alpar@1
   478
      {  sy = y->val;
alpar@1
   479
         xassert(sy == +1 || sy == -1);
alpar@1
   480
         ey = y->ptr;
alpar@1
   481
      }
alpar@1
   482
      /* determine the number of digits of [x] */
alpar@1
   483
      nx = n = 0;
alpar@1
   484
      for (e = ex; e != NULL; e = e->next)
alpar@1
   485
      for (k = 0; k <= 5; k++)
alpar@1
   486
      {  n++;
alpar@1
   487
         if (e->d[k]) nx = n;
alpar@1
   488
      }
alpar@1
   489
      xassert(nx > 0);
alpar@1
   490
      /* determine the number of digits of [y] */
alpar@1
   491
      ny = n = 0;
alpar@1
   492
      for (e = ey; e != NULL; e = e->next)
alpar@1
   493
      for (k = 0; k <= 5; k++)
alpar@1
   494
      {  n++;
alpar@1
   495
         if (e->d[k]) ny = n;
alpar@1
   496
      }
alpar@1
   497
      xassert(ny > 0);
alpar@1
   498
      /* we need working array containing at least nx+ny+ny places */
alpar@1
   499
      work = gmp_get_work(nx+ny+ny);
alpar@1
   500
      /* load digits of [x] */
alpar@1
   501
      wx = &work[0];
alpar@1
   502
      for (n = 0; n < nx; n++) wx[ny+n] = 0;
alpar@1
   503
      for (n = 0, e = ex; e != NULL; e = e->next)
alpar@1
   504
         for (k = 0; k <= 5; k++, n++)
alpar@1
   505
            if (e->d[k]) wx[ny+n] = e->d[k];
alpar@1
   506
      /* load digits of [y] */
alpar@1
   507
      wy = &work[nx+ny];
alpar@1
   508
      for (n = 0; n < ny; n++) wy[n] = 0;
alpar@1
   509
      for (n = 0, e = ey; e != NULL; e = e->next)
alpar@1
   510
         for (k = 0; k <= 5; k++, n++)
alpar@1
   511
            if (e->d[k]) wy[n] = e->d[k];
alpar@1
   512
      /* compute [x] * [y] */
alpar@1
   513
      bigmul(nx, ny, wx, wy);
alpar@1
   514
      /* construct and normalize result */
alpar@1
   515
      mpz_set_si(z, 0);
alpar@1
   516
      z->val = sx * sy;
alpar@1
   517
      es = NULL;
alpar@1
   518
      k = 6;
alpar@1
   519
      for (n = 0; n < nx+ny; n++)
alpar@1
   520
      {  if (k > 5)
alpar@1
   521
         {  e = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   522
            e->d[0] = e->d[1] = e->d[2] = 0;
alpar@1
   523
            e->d[3] = e->d[4] = e->d[5] = 0;
alpar@1
   524
            e->next = NULL;
alpar@1
   525
            if (z->ptr == NULL)
alpar@1
   526
               z->ptr = e;
alpar@1
   527
            else
alpar@1
   528
               es->next = e;
alpar@1
   529
            es = e;
alpar@1
   530
            k = 0;
alpar@1
   531
         }
alpar@1
   532
         es->d[k++] = wx[n];
alpar@1
   533
      }
alpar@1
   534
      normalize(z);
alpar@1
   535
done: return;
alpar@1
   536
}
alpar@1
   537
alpar@1
   538
void mpz_neg(mpz_t z, mpz_t x)
alpar@1
   539
{     /* set z to 0 - x */
alpar@1
   540
      mpz_set(z, x);
alpar@1
   541
      z->val = - z->val;
alpar@1
   542
      return;
alpar@1
   543
}
alpar@1
   544
alpar@1
   545
void mpz_abs(mpz_t z, mpz_t x)
alpar@1
   546
{     /* set z to the absolute value of x */
alpar@1
   547
      mpz_set(z, x);
alpar@1
   548
      if (z->val < 0) z->val = - z->val;
alpar@1
   549
      return;
alpar@1
   550
}
alpar@1
   551
alpar@1
   552
void mpz_div(mpz_t q, mpz_t r, mpz_t x, mpz_t y)
alpar@1
   553
{     /* divide x by y, forming quotient q and/or remainder r
alpar@1
   554
         if q = NULL then quotient is not stored; if r = NULL then
alpar@1
   555
         remainder is not stored
alpar@1
   556
         the sign of quotient is determined as in algebra while the
alpar@1
   557
         sign of remainder is the same as the sign of dividend:
alpar@1
   558
         +26 : +7 = +3, remainder is +5
alpar@1
   559
         -26 : +7 = -3, remainder is -5
alpar@1
   560
         +26 : -7 = -3, remainder is +5
alpar@1
   561
         -26 : -7 = +3, remainder is -5 */
alpar@1
   562
      struct mpz_seg dumx, dumy, *ex, *ey, *es, *e;
alpar@1
   563
      int sx, sy, k, nx, ny, n;
alpar@1
   564
      unsigned int t;
alpar@1
   565
      unsigned short *work, *wx, *wy;
alpar@1
   566
      /* divide by zero is not allowed */
alpar@1
   567
      if (y->val == 0)
alpar@1
   568
      {  xassert(y->ptr == NULL);
alpar@1
   569
         xfault("mpz_div: divide by zero not allowed\n");
alpar@1
   570
      }
alpar@1
   571
      /* if [x] = 0 then [q] = [r] = 0 */
alpar@1
   572
      if (x->val == 0)
alpar@1
   573
      {  xassert(x->ptr == NULL);
alpar@1
   574
         if (q != NULL) mpz_set_si(q, 0);
alpar@1
   575
         if (r != NULL) mpz_set_si(r, 0);
alpar@1
   576
         goto done;
alpar@1
   577
      }
alpar@1
   578
      /* special case when both [x] and [y] are in short format */
alpar@1
   579
      if (x->ptr == NULL && y->ptr == NULL)
alpar@1
   580
      {  int xval = x->val, yval = y->val;
alpar@1
   581
         xassert(xval != 0x80000000 && yval != 0x80000000);
alpar@1
   582
         if (q != NULL) mpz_set_si(q, xval / yval);
alpar@1
   583
         if (r != NULL) mpz_set_si(r, xval % yval);
alpar@1
   584
         goto done;
alpar@1
   585
      }
alpar@1
   586
      /* convert [x] to long format, if necessary */
alpar@1
   587
      if (x->ptr == NULL)
alpar@1
   588
      {  xassert(x->val != 0x80000000);
alpar@1
   589
         if (x->val >= 0)
alpar@1
   590
         {  sx = +1;
alpar@1
   591
            t = (unsigned int)(+ x->val);
alpar@1
   592
         }
alpar@1
   593
         else
alpar@1
   594
         {  sx = -1;
alpar@1
   595
            t = (unsigned int)(- x->val);
alpar@1
   596
         }
alpar@1
   597
         ex = &dumx;
alpar@1
   598
         ex->d[0] = (unsigned short)t;
alpar@1
   599
         ex->d[1] = (unsigned short)(t >> 16);
alpar@1
   600
         ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0;
alpar@1
   601
         ex->next = NULL;
alpar@1
   602
      }
alpar@1
   603
      else
alpar@1
   604
      {  sx = x->val;
alpar@1
   605
         xassert(sx == +1 || sx == -1);
alpar@1
   606
         ex = x->ptr;
alpar@1
   607
      }
alpar@1
   608
      /* convert [y] to long format, if necessary */
alpar@1
   609
      if (y->ptr == NULL)
alpar@1
   610
      {  xassert(y->val != 0x80000000);
alpar@1
   611
         if (y->val >= 0)
alpar@1
   612
         {  sy = +1;
alpar@1
   613
            t = (unsigned int)(+ y->val);
alpar@1
   614
         }
alpar@1
   615
         else
alpar@1
   616
         {  sy = -1;
alpar@1
   617
            t = (unsigned int)(- y->val);
alpar@1
   618
         }
alpar@1
   619
         ey = &dumy;
alpar@1
   620
         ey->d[0] = (unsigned short)t;
alpar@1
   621
         ey->d[1] = (unsigned short)(t >> 16);
alpar@1
   622
         ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0;
alpar@1
   623
         ey->next = NULL;
alpar@1
   624
      }
alpar@1
   625
      else
alpar@1
   626
      {  sy = y->val;
alpar@1
   627
         xassert(sy == +1 || sy == -1);
alpar@1
   628
         ey = y->ptr;
alpar@1
   629
      }
alpar@1
   630
      /* determine the number of digits of [x] */
alpar@1
   631
      nx = n = 0;
alpar@1
   632
      for (e = ex; e != NULL; e = e->next)
alpar@1
   633
      for (k = 0; k <= 5; k++)
alpar@1
   634
      {  n++;
alpar@1
   635
         if (e->d[k]) nx = n;
alpar@1
   636
      }
alpar@1
   637
      xassert(nx > 0);
alpar@1
   638
      /* determine the number of digits of [y] */
alpar@1
   639
      ny = n = 0;
alpar@1
   640
      for (e = ey; e != NULL; e = e->next)
alpar@1
   641
      for (k = 0; k <= 5; k++)
alpar@1
   642
      {  n++;
alpar@1
   643
         if (e->d[k]) ny = n;
alpar@1
   644
      }
alpar@1
   645
      xassert(ny > 0);
alpar@1
   646
      /* if nx < ny then [q] = 0 and [r] = [x] */
alpar@1
   647
      if (nx < ny)
alpar@1
   648
      {  if (r != NULL) mpz_set(r, x);
alpar@1
   649
         if (q != NULL) mpz_set_si(q, 0);
alpar@1
   650
         goto done;
alpar@1
   651
      }
alpar@1
   652
      /* we need working array containing at least nx+ny+1 places */
alpar@1
   653
      work = gmp_get_work(nx+ny+1);
alpar@1
   654
      /* load digits of [x] */
alpar@1
   655
      wx = &work[0];
alpar@1
   656
      for (n = 0; n < nx; n++) wx[n] = 0;
alpar@1
   657
      for (n = 0, e = ex; e != NULL; e = e->next)
alpar@1
   658
         for (k = 0; k <= 5; k++, n++)
alpar@1
   659
            if (e->d[k]) wx[n] = e->d[k];
alpar@1
   660
      /* load digits of [y] */
alpar@1
   661
      wy = &work[nx+1];
alpar@1
   662
      for (n = 0; n < ny; n++) wy[n] = 0;
alpar@1
   663
      for (n = 0, e = ey; e != NULL; e = e->next)
alpar@1
   664
         for (k = 0; k <= 5; k++, n++)
alpar@1
   665
            if (e->d[k]) wy[n] = e->d[k];
alpar@1
   666
      /* compute quotient and remainder */
alpar@1
   667
      xassert(wy[ny-1] != 0);
alpar@1
   668
      bigdiv(nx-ny, ny, wx, wy);
alpar@1
   669
      /* construct and normalize quotient */
alpar@1
   670
      if (q != NULL)
alpar@1
   671
      {  mpz_set_si(q, 0);
alpar@1
   672
         q->val = sx * sy;
alpar@1
   673
         es = NULL;
alpar@1
   674
         k = 6;
alpar@1
   675
         for (n = ny; n <= nx; n++)
alpar@1
   676
         {  if (k > 5)
alpar@1
   677
            {  e = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   678
               e->d[0] = e->d[1] = e->d[2] = 0;
alpar@1
   679
               e->d[3] = e->d[4] = e->d[5] = 0;
alpar@1
   680
               e->next = NULL;
alpar@1
   681
               if (q->ptr == NULL)
alpar@1
   682
                  q->ptr = e;
alpar@1
   683
               else
alpar@1
   684
                  es->next = e;
alpar@1
   685
               es = e;
alpar@1
   686
               k = 0;
alpar@1
   687
            }
alpar@1
   688
            es->d[k++] = wx[n];
alpar@1
   689
         }
alpar@1
   690
         normalize(q);
alpar@1
   691
      }
alpar@1
   692
      /* construct and normalize remainder */
alpar@1
   693
      if (r != NULL)
alpar@1
   694
      {  mpz_set_si(r, 0);
alpar@1
   695
         r->val = sx;
alpar@1
   696
         es = NULL;
alpar@1
   697
         k = 6;
alpar@1
   698
         for (n = 0; n < ny; n++)
alpar@1
   699
         {  if (k > 5)
alpar@1
   700
            {  e = gmp_get_atom(sizeof(struct mpz_seg));
alpar@1
   701
               e->d[0] = e->d[1] = e->d[2] = 0;
alpar@1
   702
               e->d[3] = e->d[4] = e->d[5] = 0;
alpar@1
   703
               e->next = NULL;
alpar@1
   704
               if (r->ptr == NULL)
alpar@1
   705
                  r->ptr = e;
alpar@1
   706
               else
alpar@1
   707
                  es->next = e;
alpar@1
   708
               es = e;
alpar@1
   709
               k = 0;
alpar@1
   710
            }
alpar@1
   711
            es->d[k++] = wx[n];
alpar@1
   712
         }
alpar@1
   713
         normalize(r);
alpar@1
   714
      }
alpar@1
   715
done: return;
alpar@1
   716
}
alpar@1
   717
alpar@1
   718
void mpz_gcd(mpz_t z, mpz_t x, mpz_t y)
alpar@1
   719
{     /* set z to the greatest common divisor of x and y */
alpar@1
   720
      /* in case of arbitrary integers GCD(x, y) = GCD(|x|, |y|), and,
alpar@1
   721
         in particular, GCD(0, 0) = 0 */
alpar@1
   722
      mpz_t u, v, r;
alpar@1
   723
      mpz_init(u);
alpar@1
   724
      mpz_init(v);
alpar@1
   725
      mpz_init(r);
alpar@1
   726
      mpz_abs(u, x);
alpar@1
   727
      mpz_abs(v, y);
alpar@1
   728
      while (mpz_sgn(v))
alpar@1
   729
      {  mpz_div(NULL, r, u, v);
alpar@1
   730
         mpz_set(u, v);
alpar@1
   731
         mpz_set(v, r);
alpar@1
   732
      }
alpar@1
   733
      mpz_set(z, u);
alpar@1
   734
      mpz_clear(u);
alpar@1
   735
      mpz_clear(v);
alpar@1
   736
      mpz_clear(r);
alpar@1
   737
      return;
alpar@1
   738
}
alpar@1
   739
alpar@1
   740
int mpz_cmp(mpz_t x, mpz_t y)
alpar@1
   741
{     /* compare x and y; return a positive value if x > y, zero if
alpar@1
   742
         x = y, or a nefative value if x < y */
alpar@1
   743
      static struct mpz_seg zero = { { 0, 0, 0, 0, 0, 0 }, NULL };
alpar@1
   744
      struct mpz_seg dumx, dumy, *ex, *ey;
alpar@1
   745
      int cc, sx, sy, k;
alpar@1
   746
      unsigned int t;
alpar@1
   747
      if (x == y)
alpar@1
   748
      {  cc = 0;
alpar@1
   749
         goto done;
alpar@1
   750
      }
alpar@1
   751
      /* special case when both [x] and [y] are in short format */
alpar@1
   752
      if (x->ptr == NULL && y->ptr == NULL)
alpar@1
   753
      {  int xval = x->val, yval = y->val;
alpar@1
   754
         xassert(xval != 0x80000000 && yval != 0x80000000);
alpar@1
   755
         cc = (xval > yval ? +1 : xval < yval ? -1 : 0);
alpar@1
   756
         goto done;
alpar@1
   757
      }
alpar@1
   758
      /* special case when [x] and [y] have different signs */
alpar@1
   759
      if (x->val > 0 && y->val <= 0 || x->val == 0 && y->val < 0)
alpar@1
   760
      {  cc = +1;
alpar@1
   761
         goto done;
alpar@1
   762
      }
alpar@1
   763
      if (x->val < 0 && y->val >= 0 || x->val == 0 && y->val > 0)
alpar@1
   764
      {  cc = -1;
alpar@1
   765
         goto done;
alpar@1
   766
      }
alpar@1
   767
      /* convert [x] to long format, if necessary */
alpar@1
   768
      if (x->ptr == NULL)
alpar@1
   769
      {  xassert(x->val != 0x80000000);
alpar@1
   770
         if (x->val >= 0)
alpar@1
   771
         {  sx = +1;
alpar@1
   772
            t = (unsigned int)(+ x->val);
alpar@1
   773
         }
alpar@1
   774
         else
alpar@1
   775
         {  sx = -1;
alpar@1
   776
            t = (unsigned int)(- x->val);
alpar@1
   777
         }
alpar@1
   778
         ex = &dumx;
alpar@1
   779
         ex->d[0] = (unsigned short)t;
alpar@1
   780
         ex->d[1] = (unsigned short)(t >> 16);
alpar@1
   781
         ex->d[2] = ex->d[3] = ex->d[4] = ex->d[5] = 0;
alpar@1
   782
         ex->next = NULL;
alpar@1
   783
      }
alpar@1
   784
      else
alpar@1
   785
      {  sx = x->val;
alpar@1
   786
         xassert(sx == +1 || sx == -1);
alpar@1
   787
         ex = x->ptr;
alpar@1
   788
      }
alpar@1
   789
      /* convert [y] to long format, if necessary */
alpar@1
   790
      if (y->ptr == NULL)
alpar@1
   791
      {  xassert(y->val != 0x80000000);
alpar@1
   792
         if (y->val >= 0)
alpar@1
   793
         {  sy = +1;
alpar@1
   794
            t = (unsigned int)(+ y->val);
alpar@1
   795
         }
alpar@1
   796
         else
alpar@1
   797
         {  sy = -1;
alpar@1
   798
            t = (unsigned int)(- y->val);
alpar@1
   799
         }
alpar@1
   800
         ey = &dumy;
alpar@1
   801
         ey->d[0] = (unsigned short)t;
alpar@1
   802
         ey->d[1] = (unsigned short)(t >> 16);
alpar@1
   803
         ey->d[2] = ey->d[3] = ey->d[4] = ey->d[5] = 0;
alpar@1
   804
         ey->next = NULL;
alpar@1
   805
      }
alpar@1
   806
      else
alpar@1
   807
      {  sy = y->val;
alpar@1
   808
         xassert(sy == +1 || sy == -1);
alpar@1
   809
         ey = y->ptr;
alpar@1
   810
      }
alpar@1
   811
      /* main fragment */
alpar@1
   812
      xassert(sx > 0 && sy > 0 || sx < 0 && sy < 0);
alpar@1
   813
      cc = 0;
alpar@1
   814
      for (; ex || ey; ex = ex->next, ey = ey->next)
alpar@1
   815
      {  if (ex == NULL) ex = &zero;
alpar@1
   816
         if (ey == NULL) ey = &zero;
alpar@1
   817
         for (k = 0; k <= 5; k++)
alpar@1
   818
         {  if (ex->d[k] > ey->d[k]) cc = +1;
alpar@1
   819
            if (ex->d[k] < ey->d[k]) cc = -1;
alpar@1
   820
         }
alpar@1
   821
      }
alpar@1
   822
      if (sx < 0) cc = - cc;
alpar@1
   823
done: return cc;
alpar@1
   824
}
alpar@1
   825
alpar@1
   826
int mpz_sgn(mpz_t x)
alpar@1
   827
{     /* return +1 if x > 0, 0 if x = 0, and -1 if x < 0 */
alpar@1
   828
      int s;
alpar@1
   829
      s = (x->val > 0 ? +1 : x->val < 0 ? -1 : 0);
alpar@1
   830
      return s;
alpar@1
   831
}
alpar@1
   832
alpar@1
   833
int mpz_out_str(void *_fp, int base, mpz_t x)
alpar@1
   834
{     /* output x on stream fp, as a string in given base; the base
alpar@1
   835
         may vary from 2 to 36;
alpar@1
   836
         return the number of bytes written, or if an error occurred,
alpar@1
   837
         return 0 */
alpar@1
   838
      FILE *fp = _fp;
alpar@1
   839
      mpz_t b, y, r;
alpar@1
   840
      int n, j, nwr = 0;
alpar@1
   841
      unsigned char *d;
alpar@1
   842
      static char *set = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
alpar@1
   843
      if (!(2 <= base && base <= 36))
alpar@1
   844
         xfault("mpz_out_str: base = %d; invalid base\n", base);
alpar@1
   845
      mpz_init(b);
alpar@1
   846
      mpz_set_si(b, base);
alpar@1
   847
      mpz_init(y);
alpar@1
   848
      mpz_init(r);
alpar@1
   849
      /* determine the number of digits */
alpar@1
   850
      mpz_abs(y, x);
alpar@1
   851
      for (n = 0; mpz_sgn(y) != 0; n++)
alpar@1
   852
         mpz_div(y, NULL, y, b);
alpar@1
   853
      if (n == 0) n = 1;
alpar@1
   854
      /* compute the digits */
alpar@1
   855
      d = xmalloc(n);
alpar@1
   856
      mpz_abs(y, x);
alpar@1
   857
      for (j = 0; j < n; j++)
alpar@1
   858
      {  mpz_div(y, r, y, b);
alpar@1
   859
         xassert(0 <= r->val && r->val < base && r->ptr == NULL);
alpar@1
   860
         d[j] = (unsigned char)r->val;
alpar@1
   861
      }
alpar@1
   862
      /* output the integer to the stream */
alpar@1
   863
      if (fp == NULL) fp = stdout;
alpar@1
   864
      if (mpz_sgn(x) < 0)
alpar@1
   865
         fputc('-', fp), nwr++;
alpar@1
   866
      for (j = n-1; j >= 0; j--)
alpar@1
   867
         fputc(set[d[j]], fp), nwr++;
alpar@1
   868
      if (ferror(fp)) nwr = 0;
alpar@1
   869
      mpz_clear(b);
alpar@1
   870
      mpz_clear(y);
alpar@1
   871
      mpz_clear(r);
alpar@1
   872
      xfree(d);
alpar@1
   873
      return nwr;
alpar@1
   874
}
alpar@1
   875
alpar@1
   876
/*====================================================================*/
alpar@1
   877
alpar@1
   878
mpq_t _mpq_init(void)
alpar@1
   879
{     /* initialize x, and set its value to 0/1 */
alpar@1
   880
      mpq_t x;
alpar@1
   881
      x = gmp_get_atom(sizeof(struct mpq));
alpar@1
   882
      x->p.val = 0;
alpar@1
   883
      x->p.ptr = NULL;
alpar@1
   884
      x->q.val = 1;
alpar@1
   885
      x->q.ptr = NULL;
alpar@1
   886
      return x;
alpar@1
   887
}
alpar@1
   888
alpar@1
   889
void mpq_clear(mpq_t x)
alpar@1
   890
{     /* free the space occupied by x */
alpar@1
   891
      mpz_set_si(&x->p, 0);
alpar@1
   892
      xassert(x->p.ptr == NULL);
alpar@1
   893
      mpz_set_si(&x->q, 0);
alpar@1
   894
      xassert(x->q.ptr == NULL);
alpar@1
   895
      /* free the number descriptor */
alpar@1
   896
      gmp_free_atom(x, sizeof(struct mpq));
alpar@1
   897
      return;
alpar@1
   898
}
alpar@1
   899
alpar@1
   900
void mpq_canonicalize(mpq_t x)
alpar@1
   901
{     /* remove any factors that are common to the numerator and
alpar@1
   902
         denominator of x, and make the denominator positive */
alpar@1
   903
      mpz_t f;
alpar@1
   904
      xassert(x->q.val != 0);
alpar@1
   905
      if (x->q.val < 0)
alpar@1
   906
      {  mpz_neg(&x->p, &x->p);
alpar@1
   907
         mpz_neg(&x->q, &x->q);
alpar@1
   908
      }
alpar@1
   909
      mpz_init(f);
alpar@1
   910
      mpz_gcd(f, &x->p, &x->q);
alpar@1
   911
      if (!(f->val == 1 && f->ptr == NULL))
alpar@1
   912
      {  mpz_div(&x->p, NULL, &x->p, f);
alpar@1
   913
         mpz_div(&x->q, NULL, &x->q, f);
alpar@1
   914
      }
alpar@1
   915
      mpz_clear(f);
alpar@1
   916
      return;
alpar@1
   917
}
alpar@1
   918
alpar@1
   919
void mpq_set(mpq_t z, mpq_t x)
alpar@1
   920
{     /* set the value of z from x */
alpar@1
   921
      if (z != x)
alpar@1
   922
      {  mpz_set(&z->p, &x->p);
alpar@1
   923
         mpz_set(&z->q, &x->q);
alpar@1
   924
      }
alpar@1
   925
      return;
alpar@1
   926
}
alpar@1
   927
alpar@1
   928
void mpq_set_si(mpq_t x, int p, unsigned int q)
alpar@1
   929
{     /* set the value of x to p/q */
alpar@1
   930
      if (q == 0)
alpar@1
   931
         xfault("mpq_set_si: zero denominator not allowed\n");
alpar@1
   932
      mpz_set_si(&x->p, p);
alpar@1
   933
      xassert(q <= 0x7FFFFFFF);
alpar@1
   934
      mpz_set_si(&x->q, q);
alpar@1
   935
      return;
alpar@1
   936
}
alpar@1
   937
alpar@1
   938
double mpq_get_d(mpq_t x)
alpar@1
   939
{     /* convert x to a double, truncating if necessary */
alpar@1
   940
      int np, nq;
alpar@1
   941
      double p, q;
alpar@1
   942
      p = mpz_get_d_2exp(&np, &x->p);
alpar@1
   943
      q = mpz_get_d_2exp(&nq, &x->q);
alpar@1
   944
      return ldexp(p / q, np - nq);
alpar@1
   945
}
alpar@1
   946
alpar@1
   947
void mpq_set_d(mpq_t x, double val)
alpar@1
   948
{     /* set x to val; there is no rounding, the conversion is exact */
alpar@1
   949
      int s, n, d, j;
alpar@1
   950
      double f;
alpar@1
   951
      mpz_t temp;
alpar@1
   952
      xassert(-DBL_MAX <= val && val <= +DBL_MAX);
alpar@1
   953
      mpq_set_si(x, 0, 1);
alpar@1
   954
      if (val > 0.0)
alpar@1
   955
         s = +1;
alpar@1
   956
      else if (val < 0.0)
alpar@1
   957
         s = -1;
alpar@1
   958
      else
alpar@1
   959
         goto done;
alpar@1
   960
      f = frexp(fabs(val), &n);
alpar@1
   961
      /* |val| = f * 2^n, where 0.5 <= f < 1.0 */
alpar@1
   962
      mpz_init(temp);
alpar@1
   963
      while (f != 0.0)
alpar@1
   964
      {  f *= 16.0, n -= 4;
alpar@1
   965
         d = (int)f;
alpar@1
   966
         xassert(0 <= d && d <= 15);
alpar@1
   967
         f -= (double)d;
alpar@1
   968
         /* x := 16 * x + d */
alpar@1
   969
         mpz_set_si(temp, 16);
alpar@1
   970
         mpz_mul(&x->p, &x->p, temp);
alpar@1
   971
         mpz_set_si(temp, d);
alpar@1
   972
         mpz_add(&x->p, &x->p, temp);
alpar@1
   973
      }
alpar@1
   974
      mpz_clear(temp);
alpar@1
   975
      /* x := x * 2^n */
alpar@1
   976
      if (n > 0)
alpar@1
   977
      {  for (j = 1; j <= n; j++)
alpar@1
   978
            mpz_add(&x->p, &x->p, &x->p);
alpar@1
   979
      }
alpar@1
   980
      else if (n < 0)
alpar@1
   981
      {  for (j = 1; j <= -n; j++)
alpar@1
   982
            mpz_add(&x->q, &x->q, &x->q);
alpar@1
   983
         mpq_canonicalize(x);
alpar@1
   984
      }
alpar@1
   985
      if (s < 0) mpq_neg(x, x);
alpar@1
   986
done: return;
alpar@1
   987
}
alpar@1
   988
alpar@1
   989
void mpq_add(mpq_t z, mpq_t x, mpq_t y)
alpar@1
   990
{     /* set z to x + y */
alpar@1
   991
      mpz_t p, q;
alpar@1
   992
      mpz_init(p);
alpar@1
   993
      mpz_init(q);
alpar@1
   994
      mpz_mul(p, &x->p, &y->q);
alpar@1
   995
      mpz_mul(q, &x->q, &y->p);
alpar@1
   996
      mpz_add(p, p, q);
alpar@1
   997
      mpz_mul(q, &x->q, &y->q);
alpar@1
   998
      mpz_set(&z->p, p);
alpar@1
   999
      mpz_set(&z->q, q);
alpar@1
  1000
      mpz_clear(p);
alpar@1
  1001
      mpz_clear(q);
alpar@1
  1002
      mpq_canonicalize(z);
alpar@1
  1003
      return;
alpar@1
  1004
}
alpar@1
  1005
alpar@1
  1006
void mpq_sub(mpq_t z, mpq_t x, mpq_t y)
alpar@1
  1007
{     /* set z to x - y */
alpar@1
  1008
      mpz_t p, q;
alpar@1
  1009
      mpz_init(p);
alpar@1
  1010
      mpz_init(q);
alpar@1
  1011
      mpz_mul(p, &x->p, &y->q);
alpar@1
  1012
      mpz_mul(q, &x->q, &y->p);
alpar@1
  1013
      mpz_sub(p, p, q);
alpar@1
  1014
      mpz_mul(q, &x->q, &y->q);
alpar@1
  1015
      mpz_set(&z->p, p);
alpar@1
  1016
      mpz_set(&z->q, q);
alpar@1
  1017
      mpz_clear(p);
alpar@1
  1018
      mpz_clear(q);
alpar@1
  1019
      mpq_canonicalize(z);
alpar@1
  1020
      return;
alpar@1
  1021
}
alpar@1
  1022
alpar@1
  1023
void mpq_mul(mpq_t z, mpq_t x, mpq_t y)
alpar@1
  1024
{     /* set z to x * y */
alpar@1
  1025
      mpz_mul(&z->p, &x->p, &y->p);
alpar@1
  1026
      mpz_mul(&z->q, &x->q, &y->q);
alpar@1
  1027
      mpq_canonicalize(z);
alpar@1
  1028
      return;
alpar@1
  1029
}
alpar@1
  1030
alpar@1
  1031
void mpq_div(mpq_t z, mpq_t x, mpq_t y)
alpar@1
  1032
{     /* set z to x / y */
alpar@1
  1033
      mpz_t p, q;
alpar@1
  1034
      if (mpq_sgn(y) == 0)
alpar@1
  1035
         xfault("mpq_div: zero divisor not allowed\n");
alpar@1
  1036
      mpz_init(p);
alpar@1
  1037
      mpz_init(q);
alpar@1
  1038
      mpz_mul(p, &x->p, &y->q);
alpar@1
  1039
      mpz_mul(q, &x->q, &y->p);
alpar@1
  1040
      mpz_set(&z->p, p);
alpar@1
  1041
      mpz_set(&z->q, q);
alpar@1
  1042
      mpz_clear(p);
alpar@1
  1043
      mpz_clear(q);
alpar@1
  1044
      mpq_canonicalize(z);
alpar@1
  1045
      return;
alpar@1
  1046
}
alpar@1
  1047
alpar@1
  1048
void mpq_neg(mpq_t z, mpq_t x)
alpar@1
  1049
{     /* set z to 0 - x */
alpar@1
  1050
      mpq_set(z, x);
alpar@1
  1051
      mpz_neg(&z->p, &z->p);
alpar@1
  1052
      return;
alpar@1
  1053
}
alpar@1
  1054
alpar@1
  1055
void mpq_abs(mpq_t z, mpq_t x)
alpar@1
  1056
{     /* set z to the absolute value of x */
alpar@1
  1057
      mpq_set(z, x);
alpar@1
  1058
      mpz_abs(&z->p, &z->p);
alpar@1
  1059
      xassert(mpz_sgn(&x->q) > 0);
alpar@1
  1060
      return;
alpar@1
  1061
}
alpar@1
  1062
alpar@1
  1063
int mpq_cmp(mpq_t x, mpq_t y)
alpar@1
  1064
{     /* compare x and y; return a positive value if x > y, zero if
alpar@1
  1065
         x = y, or a nefative value if x < y */
alpar@1
  1066
      mpq_t temp;
alpar@1
  1067
      int s;
alpar@1
  1068
      mpq_init(temp);
alpar@1
  1069
      mpq_sub(temp, x, y);
alpar@1
  1070
      s = mpq_sgn(temp);
alpar@1
  1071
      mpq_clear(temp);
alpar@1
  1072
      return s;
alpar@1
  1073
}
alpar@1
  1074
alpar@1
  1075
int mpq_sgn(mpq_t x)
alpar@1
  1076
{     /* return +1 if x > 0, 0 if x = 0, and -1 if x < 0 */
alpar@1
  1077
      int s;
alpar@1
  1078
      s = mpz_sgn(&x->p);
alpar@1
  1079
      xassert(mpz_sgn(&x->q) > 0);
alpar@1
  1080
      return s;
alpar@1
  1081
}
alpar@1
  1082
alpar@1
  1083
int mpq_out_str(void *_fp, int base, mpq_t x)
alpar@1
  1084
{     /* output x on stream fp, as a string in given base; the base
alpar@1
  1085
         may vary from 2 to 36; output is in the form 'num/den' or if
alpar@1
  1086
         the denominator is 1 then just 'num';
alpar@1
  1087
         if the parameter fp is a null pointer, stdout is assumed;
alpar@1
  1088
         return the number of bytes written, or if an error occurred,
alpar@1
  1089
         return 0 */
alpar@1
  1090
      FILE *fp = _fp;
alpar@1
  1091
      int nwr;
alpar@1
  1092
      if (!(2 <= base && base <= 36))
alpar@1
  1093
         xfault("mpq_out_str: base = %d; invalid base\n", base);
alpar@1
  1094
      if (fp == NULL) fp = stdout;
alpar@1
  1095
      nwr = mpz_out_str(fp, base, &x->p);
alpar@1
  1096
      if (x->q.val == 1 && x->q.ptr == NULL)
alpar@1
  1097
         ;
alpar@1
  1098
      else
alpar@1
  1099
      {  fputc('/', fp), nwr++;
alpar@1
  1100
         nwr += mpz_out_str(fp, base, &x->q);
alpar@1
  1101
      }
alpar@1
  1102
      if (ferror(fp)) nwr = 0;
alpar@1
  1103
      return nwr;
alpar@1
  1104
}
alpar@1
  1105
alpar@1
  1106
#endif
alpar@1
  1107
alpar@1
  1108
/* eof */