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 */
53static void out_char (int);
54
55/* there is no POSIX standard for dc, so we'll take the GNU definitions */
56int 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 */
64int
65dc_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 */
79int
80dc_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 */
94int
95dc_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 */
109int
110dc_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 */
128int
129dc_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 */
149int
150dc_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
164int
165dc_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 */
185int
186dc_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 */
200int
201dc_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 */
223int
224dc_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
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 */
234int
235dc_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 */
251dc_data
252dc_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 */
272dc_data
273dc_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
355/* return the "length" of the number */
356int
357dc_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 */
369int
370dc_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
383/* initialize the math subsystem */
384void
385dc_math_init DC_DECLVOID()
386{
387	bc_init_numbers();
388}
389
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 */
394void
395dc_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 */
413void
414dc_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
458/* deallocate an instance of a dc_num */
459void
460dc_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 */
472dc_data
473dc_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
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
503int 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
509static void
510out_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
533void
534out_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__
543void
544rt_error (char *mesg, ...)
545#else
546void
547rt_error (mesg)
548     char *mesg;
549#endif
550#else
551void
552rt_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__
576void
577rt_warn (char *mesg, ...)
578#else
579void
580rt_warn (mesg)
581     char *mesg;
582#endif
583#else
584void
585rt_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}
601