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