gnu/dist/bc/dc/numeric.c

   1 /*
   2  * interface dc to the bc numeric routines
   3  *
   4  * Copyright (C) 1994, 1997, 1998, 2000 Free Software Foundation, Inc.
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2, or (at your option)
   9  * any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; if not, you can either send email to this
  18  * program's author (see below) or write to:
  19  *   The Free Software Foundation, Inc.
  20  *   59 Temple Place, Suite 330
  21  *   Boston, MA 02111 USA
  22  */
  23
  24 /* This should be the only module that knows the internals of type dc_num */
  25 /* In this particular implementation we just slather out some glue and
  26  * make use of bc's numeric routines.
  27  */
  28
  29 #include "config.h"
  30
  31 #include <stdio.h>
  32 #include <ctype.h>
  33 #ifdef HAVE_LIMITS_H
  34 # include <limits.h>
  35 #else
  36 # define UCHAR_MAX ((unsigned char)~0)
  37 #endif
  38 #include <stdlib.h>
  39 #include "number.h"
  40 #include "dc.h"
  41 #include "dc-proto.h"
  42
  43 #ifdef __GNUC__
  44 # if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__-0 >= 7)
  45 #  define ATTRIB(x) __attribute__(x)
  46 # endif
  47 #endif
  48 #ifndef ATTRIB
  49 # define ATTRIB(x)
  50 #endif
  51
  52 /* Forward prototype */
  53 static void out_char (int);
  54
  55 /* there is no POSIX standard for dc, so we'll take the GNU definitions */
  56 int std_only = FALSE;
  57
  58 /* convert an opaque dc_num into a real bc_num */
  59 #define CastNum(x)      ((bc_num)(x))
  60
  61 /* add two dc_nums, place into *result;
  62  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
  63  */
  64 int
  65 dc_add DC_DECLARG((a, b, kscale, result))
  66         dc_num a DC_DECLSEP
  67         dc_num b DC_DECLSEP
  68         int kscale ATTRIB((unused)) DC_DECLSEP
  69         dc_num *result DC_DECLEND
  70 {
  71         bc_init_num((bc_num *)result);
  72         bc_add(CastNum(a), CastNum(b), (bc_num *)result, 0);
  73         return DC_SUCCESS;
  74 }
  75
  76 /* subtract two dc_nums, place into *result;
  77  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
  78  */
  79 int
  80 dc_sub DC_DECLARG((a, b, kscale, result))
  81         dc_num a DC_DECLSEP
  82         dc_num b DC_DECLSEP
  83         int kscale ATTRIB((unused)) DC_DECLSEP
  84         dc_num *result DC_DECLEND
  85 {
  86         bc_init_num((bc_num *)result);
  87         bc_sub(CastNum(a), CastNum(b), (bc_num *)result, 0);
  88         return DC_SUCCESS;
  89 }
  90
  91 /* multiply two dc_nums, place into *result;
  92  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
  93  */
  94 int
  95 dc_mul DC_DECLARG((a, b, kscale, result))
  96         dc_num a DC_DECLSEP
  97         dc_num b DC_DECLSEP
  98         int kscale DC_DECLSEP
  99         dc_num *result DC_DECLEND
 100 {
 101         bc_init_num((bc_num *)result);
 102         bc_multiply(CastNum(a), CastNum(b), (bc_num *)result, kscale);
 103         return DC_SUCCESS;
 104 }
 105
 106 /* divide two dc_nums, place into *result;
 107  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
 108  */
 109 int
 110 dc_div DC_DECLARG((a, b, kscale, result))
 111         dc_num a DC_DECLSEP
 112         dc_num b DC_DECLSEP
 113         int kscale DC_DECLSEP
 114         dc_num *result DC_DECLEND
 115 {
 116         bc_init_num((bc_num *)result);
 117         if (bc_divide(CastNum(a), CastNum(b), (bc_num *)result, kscale)){
 118                 fprintf(stderr, "%s: divide by zero\n", progname);
 119                 return DC_DOMAIN_ERROR;
 120         }
 121         return DC_SUCCESS;
 122 }
 123
 124 /* divide two dc_nums, place quotient into *quotient and remainder
 125  * into *remainder;
 126  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
 127  */
 128 int
 129 dc_divrem DC_DECLARG((a, b, kscale, quotient, remainder))
 130         dc_num a DC_DECLSEP
 131         dc_num b DC_DECLSEP
 132         int kscale DC_DECLSEP
 133         dc_num *quotient DC_DECLSEP
 134         dc_num *remainder DC_DECLEND
 135 {
 136         bc_init_num((bc_num *)quotient);
 137         bc_init_num((bc_num *)remainder);
 138         if (bc_divmod(CastNum(a), CastNum(b),
 139                                                 (bc_num *)quotient, (bc_num *)remainder, kscale)){
 140                 fprintf(stderr, "%s: divide by zero\n", progname);
 141                 return DC_DOMAIN_ERROR;
 142         }
 143         return DC_SUCCESS;
 144 }
 145
 146 /* place the reminder of dividing a by b into *result;
 147  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
 148  */
 149 int
 150 dc_rem DC_DECLARG((a, b, kscale, result))
 151         dc_num a DC_DECLSEP
 152         dc_num b DC_DECLSEP
 153         int kscale DC_DECLSEP
 154         dc_num *result DC_DECLEND
 155 {
 156         bc_init_num((bc_num *)result);
 157         if (bc_modulo(CastNum(a), CastNum(b), (bc_num *)result, kscale)){
 158                 fprintf(stderr, "%s: remainder by zero\n", progname);
 159                 return DC_DOMAIN_ERROR;
 160         }
 161         return DC_SUCCESS;
 162 }
 163
 164 int
 165 dc_modexp DC_DECLARG((base, expo, mod, kscale, result))
 166         dc_num base DC_DECLSEP
 167         dc_num expo DC_DECLSEP
 168         dc_num mod DC_DECLSEP
 169         int kscale DC_DECLSEP
 170         dc_num *result DC_DECLEND
 171 {
 172         bc_init_num((bc_num *)result);
 173         if (bc_raisemod(CastNum(base), CastNum(expo), CastNum(mod),
 174                                         (bc_num *)result, kscale)){
 175                 if (bc_is_zero(CastNum(mod)))
 176                         fprintf(stderr, "%s: remainder by zero\n", progname);
 177                 return DC_DOMAIN_ERROR;
 178         }
 179         return DC_SUCCESS;
 180 }
 181
 182 /* place the result of exponentiationg a by b into *result;
 183  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
 184  */
 185 int
 186 dc_exp DC_DECLARG((a, b, kscale, result))
 187         dc_num a DC_DECLSEP
 188         dc_num b DC_DECLSEP
 189         int kscale DC_DECLSEP
 190         dc_num *result DC_DECLEND
 191 {
 192         bc_init_num((bc_num *)result);
 193         bc_raise(CastNum(a), CastNum(b), (bc_num *)result, kscale);
 194         return DC_SUCCESS;
 195 }
 196
 197 /* take the square root of the value, place into *result;
 198  * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
 199  */
 200 int
 201 dc_sqrt DC_DECLARG((value, kscale, result))
 202         dc_num value DC_DECLSEP
 203         int kscale DC_DECLSEP
 204         dc_num *result DC_DECLEND
 205 {
 206         bc_num tmp;
 207
 208         tmp = bc_copy_num(CastNum(value));
 209         if (!bc_sqrt(&tmp, kscale)){
 210                 fprintf(stderr, "%s: square root of negative number\n", progname);
 211                 bc_free_num(&tmp);
 212                 return DC_DOMAIN_ERROR;
 213         }
 214         *((bc_num *)result) = tmp;
 215         return DC_SUCCESS;
 216 }
 217
 218 /* compare dc_nums a and b;
 219  *  return a negative value if a < b;
 220  *  return a positive value if a > b;
 221  *  return zero value if a == b
 222  */
 223 int
 224 dc_compare DC_DECLARG((a, b))
 225         dc_num a DC_DECLSEP
 226         dc_num b DC_DECLEND
 227 {
 228         return bc_compare(CastNum(a), CastNum(b));
 229 }
 230 \f
 231 /* attempt to convert a dc_num to its corresponding int value
 232  * If discard_p is DC_TOSS then deallocate the value after use.
 233  */
 234 int
 235 dc_num2int DC_DECLARG((value, discard_p))
 236         dc_num value DC_DECLSEP
 237         dc_discard discard_p DC_DECLEND
 238 {
 239         long result;
 240
 241         result = bc_num2long(CastNum(value));
 242         if (discard_p == DC_TOSS)
 243                 dc_free_num(&value);
 244         return (int)result;
 245 }
 246
 247 /* convert a C integer value into a dc_num */
 248 /* For convenience of the caller, package the dc_num
 249  * into a dc_data result.
 250  */
 251 dc_data
 252 dc_int2data DC_DECLARG((value))
 253         int value DC_DECLEND
 254 {
 255         dc_data result;
 256
 257         bc_init_num((bc_num *)&result.v.number);
 258         bc_int2num((bc_num *)&result.v.number, value);
 259         result.dc_type = DC_NUMBER;
 260         return result;
 261 }
 262
 263 /* get a dc_num from some input stream;
 264  *  input is a function which knows how to read the desired input stream
 265  *  ibase is the input base (2<=ibase<=DC_IBASE_MAX)
 266  *  *readahead will be set to the readahead character consumed while
 267  *   looking for the end-of-number
 268  */
 269 /* For convenience of the caller, package the dc_num
 270  * into a dc_data result.
 271  */
 272 dc_data
 273 dc_getnum DC_DECLARG((input, ibase, readahead))
 274         int (*input) DC_PROTO((void)) DC_DECLSEP
 275         int ibase DC_DECLSEP
 276         int *readahead DC_DECLEND
 277 {
 278         bc_num  base;
 279         bc_num  result;
 280         bc_num  build;
 281         bc_num  tmp;
 282         bc_num  divisor;
 283         dc_data full_result;
 284         int             negative = 0;
 285         int             digit;
 286         int             decimal;
 287         int             c;
 288
 289         bc_init_num(&tmp);
 290         bc_init_num(&build);
 291         bc_init_num(&base);
 292         result = bc_copy_num(_zero_);
 293         bc_int2num(&base, ibase);
 294         c = (*input)();
 295         while (isspace(c))
 296                 c = (*input)();
 297         if (c == '_' || c == '-'){
 298                 negative = c;
 299                 c = (*input)();
 300         }else if (c == '+'){
 301                 c = (*input)();
 302         }
 303         while (isspace(c))
 304                 c = (*input)();
 305         for (;;){
 306                 if (isdigit(c))
 307                         digit = c - '0';
 308                 else if ('A' <= c && c <= 'F')
 309                         digit = 10 + c - 'A';
 310                 else
 311                         break;
 312                 c = (*input)();
 313                 bc_int2num(&tmp, digit);
 314                 bc_multiply(result, base, &result, 0);
 315                 bc_add(result, tmp, &result, 0);
 316         }
 317         if (c == '.'){
 318                 bc_free_num(&build);
 319                 bc_free_num(&tmp);
 320                 divisor = bc_copy_num(_one_);
 321                 build = bc_copy_num(_zero_);
 322                 decimal = 0;
 323                 for (;;){
 324                         c = (*input)();
 325                         if (isdigit(c))
 326                                 digit = c - '0';
 327                         else if ('A' <= c && c <= 'F')
 328                                 digit = 10 + c - 'A';
 329                         else
 330                                 break;
 331                         bc_int2num(&tmp, digit);
 332                         bc_multiply(build, base, &build, 0);
 333                         bc_add(build, tmp, &build, 0);
 334                         bc_multiply(divisor, base, &divisor, 0);
 335                         ++decimal;
 336                 }
 337                 bc_divide(build, divisor, &build, decimal);
 338                 bc_add(result, build, &result, 0);
 339         }
 340         /* Final work. */
 341         if (negative)
 342                 bc_sub(_zero_, result, &result, 0);
 343
 344         bc_free_num(&tmp);
 345         bc_free_num(&build);
 346         bc_free_num(&base);
 347         if (readahead)
 348                 *readahead = c;
 349         full_result.v.number = (dc_num)result;
 350         full_result.dc_type = DC_NUMBER;
 351         return full_result;
 352 }
 353
 354 \f
 355 /* return the "length" of the number */
 356 int
 357 dc_numlen DC_DECLARG((value))
 358         dc_num value DC_DECLEND
 359 {
 360         bc_num num = CastNum(value);
 361
 362         /* is this right??? */
 363         return num->n_len + num->n_scale - (*num->n_value == '\0');
 364 }
 365
 366 /* return the scale factor of the passed dc_num
 367  * If discard_p is DC_TOSS then deallocate the value after use.
 368  */
 369 int
 370 dc_tell_scale DC_DECLARG((value, discard_p))
 371         dc_num value DC_DECLSEP
 372         dc_discard discard_p DC_DECLEND
 373 {
 374         int kscale;
 375
 376         kscale = CastNum(value)->n_scale;
 377         if (discard_p == DC_TOSS)
 378                 dc_free_num(&value);
 379         return kscale;
 380 }
 381
 382 \f
 383 /* initialize the math subsystem */
 384 void
 385 dc_math_init DC_DECLVOID()
 386 {
 387         bc_init_numbers();
 388 }
 389 \f
 390 /* print out a dc_num in output base obase to stdout;
 391  * if newline_p is DC_WITHNL, terminate output with a '\n';
 392  * if discard_p is DC_TOSS then deallocate the value after use
 393  */
 394 void
 395 dc_out_num DC_DECLARG((value, obase, newline_p, discard_p))
 396         dc_num value DC_DECLSEP
 397         int obase DC_DECLSEP
 398         dc_newline newline_p DC_DECLSEP
 399         dc_discard discard_p DC_DECLEND
 400 {
 401         out_char('\0'); /* clear the column counter */
 402         bc_out_num(CastNum(value), obase, out_char, 0);
 403         if (newline_p == DC_WITHNL)
 404                 putchar ('\n');
 405         if (discard_p == DC_TOSS)
 406                 dc_free_num(&value);
 407 }
 408
 409 /* dump out the absolute value of the integer part of a
 410  * dc_num as a byte stream, without any line wrapping;
 411  * if discard_p is DC_TOSS then deallocate the value after use
 412  */
 413 void
 414 dc_dump_num DC_DECLARG((dcvalue, discard_p))
 415         dc_num dcvalue DC_DECLSEP
 416         dc_discard discard_p DC_DECLEND
 417 {
 418         struct digit_stack { int digit; struct digit_stack *link;};
 419         struct digit_stack *top_of_stack = NULL;
 420         struct digit_stack *cur;
 421         struct digit_stack *next;
 422         bc_num value;
 423         bc_num obase;
 424         bc_num digit;
 425
 426         bc_init_num(&value);
 427         bc_init_num(&obase);
 428         bc_init_num(&digit);
 429
 430         /* we only handle the integer portion: */
 431         bc_divide(CastNum(dcvalue), _one_, &value, 0);
 432         /* we only handle the absolute value: */
 433         value->n_sign = PLUS;
 434         /* we're done with the dcvalue parameter: */
 435         if (discard_p == DC_TOSS)
 436                 dc_free_num(&dcvalue);
 437
 438         bc_int2num(&obase, 1+UCHAR_MAX);
 439         do {
 440                 (void) bc_divmod(value, obase, &value, &digit, 0);
 441                 cur = dc_malloc(sizeof *cur);
 442                 cur->digit = (int)bc_num2long(digit);
 443                 cur->link = top_of_stack;
 444                 top_of_stack = cur;
 445         } while (!bc_is_zero(value));
 446
 447         for (cur=top_of_stack; cur; cur=next) {
 448                 putchar(cur->digit);
 449                 next = cur->link;
 450                 free(cur);
 451         }
 452
 453         bc_free_num(&digit);
 454         bc_free_num(&obase);
 455         bc_free_num(&value);
 456 }
 457 \f
 458 /* deallocate an instance of a dc_num */
 459 void
 460 dc_free_num DC_DECLARG((value))
 461         dc_num *value DC_DECLEND
 462 {
 463         bc_free_num((bc_num *)value);
 464 }
 465
 466 /* return a duplicate of the number in the passed value */
 467 /* The mismatched data types forces the caller to deal with
 468  * bad dc_type'd dc_data values, and makes it more convenient
 469  * for the caller to not have to do the grunge work of setting
 470  * up a dc_type result.
 471  */
 472 dc_data
 473 dc_dup_num DC_DECLARG((value))
 474         dc_num value DC_DECLEND
 475 {
 476         dc_data result;
 477
 478         ++CastNum(value)->n_refs;
 479         result.v.number = value;
 480         result.dc_type = DC_NUMBER;
 481         return result;
 482 }
 483
 484 \f
 485
 486 /*---------------------------------------------------------------------------\
 487 | The rest of this file consists of stubs for bc routines called by numeric.c|
 488 | so as to minimize the amount of bc code needed to build dc.                |
 489 | The bulk of the code was just lifted straight out of the bc source.        |
 490 \---------------------------------------------------------------------------*/
 491
 492 #ifdef HAVE_STDLIB_H
 493 # include <stdlib.h>
 494 #endif
 495
 496 #ifdef HAVE_STDARG_H
 497 # include <stdarg.h>
 498 #else
 499 # include <varargs.h>
 500 #endif
 501
 502
 503 int out_col = 0;
 504
 505 /* Output routines: Write a character CH to the standard output.
 506    It keeps track of the number of characters output and may
 507    break the output with a "\<cr>". */
 508
 509 static void
 510 out_char (ch)
 511      int ch;
 512 {
 513
 514   if (ch == '\0')
 515     {
 516       out_col = 0;
 517     }
 518   else
 519     {
 520       out_col++;
 521       if (out_col == 70)
 522         {
 523           putchar ('\\');
 524           putchar ('\n');
 525           out_col = 1;
 526         }
 527       putchar (ch);
 528     }
 529 }
 530
 531 /* Malloc could not get enough memory. */
 532
 533 void
 534 out_of_memory()
 535 {
 536   dc_memfail();
 537 }
 538
 539 /* Runtime error will  print a message and stop the machine. */
 540
 541 #ifdef HAVE_STDARG_H
 542 #ifdef __STDC__
 543 void
 544 rt_error (char *mesg, ...)
 545 #else
 546 void
 547 rt_error (mesg)
 548      char *mesg;
 549 #endif
 550 #else
 551 void
 552 rt_error (mesg, va_alist)
 553      char *mesg;
 554 #endif
 555 {
 556   va_list args;
 557
 558   fprintf (stderr, "Runtime error: ");
 559 #ifdef HAVE_STDARG_H
 560   va_start (args, mesg);
 561 #else
 562   va_start (args);
 563 #endif
 564   vfprintf (stderr, mesg, args);
 565   va_end (args);
 566   fprintf (stderr, "\n");
 567 }
 568
 569
 570 /* A runtime warning tells of some action taken by the processor that
 571    may change the program execution but was not enough of a problem
 572    to stop the execution. */
 573
 574 #ifdef HAVE_STDARG_H
 575 #ifdef __STDC__
 576 void
 577 rt_warn (char *mesg, ...)
 578 #else
 579 void
 580 rt_warn (mesg)
 581      char *mesg;
 582 #endif
 583 #else
 584 void
 585 rt_warn (mesg, va_alist)
 586      char *mesg;
 587 #endif
 588 {
 589   va_list args;
 590
 591   fprintf (stderr, "Runtime warning: ");
 592 #ifdef HAVE_STDARG_H
 593   va_start (args, mesg);
 594 #else
 595   va_start (args);
 596 #endif
 597   vfprintf (stderr, mesg, args);
 598   va_end (args);
 599   fprintf (stderr, "\n");
 600 }