Blame dc/numeric.c

Packit 70b277
/* 
Packit 70b277
 * interface dc to the bc numeric routines
Packit 70b277
 *
Packit 70b277
 * Copyright (C) 1994, 1997, 1998, 2000, 2005, 2008, 2013, 2017
Packit 70b277
 * Free Software Foundation, Inc.
Packit 70b277
 *
Packit 70b277
 * This program is free software; you can redistribute it and/or modify
Packit 70b277
 * it under the terms of the GNU General Public License as published by
Packit 70b277
 * the Free Software Foundation; either version 3, or (at your option)
Packit 70b277
 * any later version.
Packit 70b277
 *
Packit 70b277
 * This program is distributed in the hope that it will be useful,
Packit 70b277
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Packit 70b277
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Packit 70b277
 * GNU General Public License for more details.
Packit 70b277
 *
Packit 70b277
 * You should have received a copy of the GNU General Public License
Packit 70b277
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
Packit 70b277
 *
Packit 70b277
 */
Packit 70b277
Packit 70b277
/* This should be the only module that knows the internals of type dc_num */
Packit 70b277
/* In this particular implementation we just slather out some glue and
Packit 70b277
 * make use of bc's numeric routines.
Packit 70b277
 */
Packit 70b277
Packit 70b277
/* make all the header files see that these are really the same thing;
Packit 70b277
 * this is acceptable because everywhere else dc_number is just referenced
Packit 70b277
 * as a pointer-to-incomplete-structure type
Packit 70b277
 */
Packit 70b277
#define dc_number bc_struct
Packit 70b277
Packit 70b277
#include "config.h"
Packit 70b277
Packit 70b277
#include <stdio.h>
Packit 70b277
#include <ctype.h>
Packit 70b277
#ifdef HAVE_LIMITS_H
Packit 70b277
# include <limits.h>
Packit 70b277
#endif
Packit 70b277
#ifndef UCHAR_MAX
Packit 70b277
# define UCHAR_MAX ((unsigned char)~0)
Packit 70b277
#endif
Packit 70b277
#ifdef HAVE_STDLIB_H
Packit 70b277
# include <stdlib.h>
Packit 70b277
#endif
Packit 70b277
#ifdef HAVE_ERRNO_H
Packit 70b277
# include <errno.h>
Packit 70b277
#else
Packit 70b277
  extern int errno;
Packit 70b277
#endif
Packit 70b277
Packit 70b277
#include "number.h"
Packit 70b277
#include "dc.h"
Packit 70b277
#include "dc-proto.h"
Packit 70b277
Packit 70b277
#ifdef __GNUC__
Packit 70b277
# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__-0 >= 7) 
Packit 70b277
#  define ATTRIB(x) __attribute__(x)
Packit 70b277
# endif
Packit 70b277
#endif
Packit 70b277
#ifndef ATTRIB
Packit 70b277
# define ATTRIB(x)
Packit 70b277
#endif
Packit 70b277
Packit 70b277
/* Forward prototype */
Packit 70b277
static void out_char (int);
Packit 70b277
Packit 70b277
/* there is no POSIX standard for dc, so we'll take the GNU definitions */
Packit 70b277
int std_only = FALSE;
Packit 70b277
Packit 70b277
/* convert an opaque dc_num into a real bc_num */
Packit 70b277
/* by a freak accident, these are now no-op mappings,
Packit 70b277
 * but leave the notation here in case that changes later
Packit 70b277
 * */
Packit 70b277
#define CastNum(x)		(x)
Packit 70b277
#define CastNumPtr(x)	(x)
Packit 70b277
Packit 70b277
/* add two dc_nums, place into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_add DC_DECLARG((a, b, kscale, result))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale ATTRIB((unused)) DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	bc_add(CastNum(a), CastNum(b), CastNumPtr(result), 0);
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* subtract two dc_nums, place into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_sub DC_DECLARG((a, b, kscale, result))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale ATTRIB((unused)) DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	bc_sub(CastNum(a), CastNum(b), CastNumPtr(result), 0);
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* multiply two dc_nums, place into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_mul DC_DECLARG((a, b, kscale, result))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	bc_multiply(CastNum(a), CastNum(b), CastNumPtr(result), kscale);
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* divide two dc_nums, place into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_div DC_DECLARG((a, b, kscale, result))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	if (bc_divide(CastNum(a), CastNum(b), CastNumPtr(result), kscale)){
Packit 70b277
		fprintf(stderr, "%s: divide by zero\n", progname);
Packit 70b277
		return DC_DOMAIN_ERROR;
Packit 70b277
	}
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* divide two dc_nums, place quotient into *quotient and remainder
Packit 70b277
 * into *remainder;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_divrem DC_DECLARG((a, b, kscale, quotient, remainder))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *quotient DC_DECLSEP
Packit 70b277
	dc_num *remainder DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(quotient));
Packit 70b277
	bc_init_num(CastNumPtr(remainder));
Packit 70b277
	if (bc_divmod(CastNum(a), CastNum(b),
Packit 70b277
						CastNumPtr(quotient), CastNumPtr(remainder), kscale)){
Packit 70b277
		fprintf(stderr, "%s: divide by zero\n", progname);
Packit 70b277
		return DC_DOMAIN_ERROR;
Packit 70b277
	}
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* place the reminder of dividing a by b into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_rem DC_DECLARG((a, b, kscale, result))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	if (bc_modulo(CastNum(a), CastNum(b), CastNumPtr(result), kscale)){
Packit 70b277
		fprintf(stderr, "%s: remainder by zero\n", progname);
Packit 70b277
		return DC_DOMAIN_ERROR;
Packit 70b277
	}
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
int
Packit 70b277
dc_modexp DC_DECLARG((base, expo, mod, kscale, result))
Packit 70b277
	dc_num base DC_DECLSEP
Packit 70b277
	dc_num expo DC_DECLSEP
Packit 70b277
	dc_num mod DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	if (bc_raisemod(CastNum(base), CastNum(expo), CastNum(mod),
Packit 70b277
					CastNumPtr(result), kscale)){
Packit 70b277
		if (bc_is_zero(CastNum(mod)))
Packit 70b277
			fprintf(stderr, "%s: remainder by zero\n", progname);
Packit 70b277
		return DC_DOMAIN_ERROR;
Packit 70b277
	}
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* place the result of exponentiationg a by b into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_exp DC_DECLARG((a, b, kscale, result))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_init_num(CastNumPtr(result));
Packit 70b277
	bc_raise(CastNum(a), CastNum(b), CastNumPtr(result), kscale);
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* take the square root of the value, place into *result;
Packit 70b277
 * return DC_SUCCESS on success, DC_DOMAIN_ERROR on domain error
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_sqrt DC_DECLARG((value, kscale, result))
Packit 70b277
	dc_num value DC_DECLSEP
Packit 70b277
	int kscale DC_DECLSEP
Packit 70b277
	dc_num *result DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_num tmp;
Packit 70b277
Packit 70b277
	tmp = bc_copy_num(CastNum(value));
Packit 70b277
	if (!bc_sqrt(&tmp, kscale)){
Packit 70b277
		fprintf(stderr, "%s: square root of negative number\n", progname);
Packit 70b277
		bc_free_num(&tmp);
Packit 70b277
		return DC_DOMAIN_ERROR;
Packit 70b277
	}
Packit 70b277
	*(CastNumPtr(result)) = tmp;
Packit 70b277
	return DC_SUCCESS;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* compare dc_nums a and b;
Packit 70b277
 *  return a negative value if a < b;
Packit 70b277
 *  return a positive value if a > b;
Packit 70b277
 *  return zero value if a == b
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_compare DC_DECLARG((a, b))
Packit 70b277
	dc_num a DC_DECLSEP
Packit 70b277
	dc_num b DC_DECLEND
Packit 70b277
{
Packit 70b277
	return bc_compare(CastNum(a), CastNum(b));
Packit 70b277
}
Packit 70b277

Packit 70b277
/* attempt to convert a dc_num to its corresponding int value
Packit 70b277
 * If discard_p is DC_TOSS then deallocate the value after use.
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_num2int DC_DECLARG((value, discard_p))
Packit 70b277
	dc_num value DC_DECLSEP
Packit 70b277
	dc_discard discard_p DC_DECLEND
Packit 70b277
{
Packit 70b277
	long result;
Packit 70b277
Packit 70b277
	result = bc_num2long(CastNum(value));
Packit 70b277
	if (result == 0 && !bc_is_zero(CastNum(value))) {
Packit 70b277
		fprintf(stderr, "%s: value overflows simple integer; punting...\n",
Packit 70b277
				progname);
Packit 70b277
		result = -1; /* more appropriate for dc's purposes */
Packit 70b277
	}
Packit 70b277
	if (discard_p == DC_TOSS)
Packit 70b277
		dc_free_num(&value);
Packit 70b277
	return (int)result;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* convert a C integer value into a dc_num */
Packit 70b277
/* For convenience of the caller, package the dc_num
Packit 70b277
 * into a dc_data result.
Packit 70b277
 */
Packit 70b277
dc_data
Packit 70b277
dc_int2data DC_DECLARG((value))
Packit 70b277
	int value DC_DECLEND
Packit 70b277
{
Packit 70b277
	dc_data result;
Packit 70b277
Packit 70b277
	bc_init_num(CastNumPtr(&result.v.number));
Packit 70b277
	bc_int2num(CastNumPtr(&result.v.number), value);
Packit 70b277
	result.dc_type = DC_NUMBER;
Packit 70b277
	return result;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* get a dc_num from some input stream;
Packit 70b277
 *  input is a function which knows how to read the desired input stream
Packit 70b277
 *  ibase is the input base (2<=ibase<=DC_IBASE_MAX)
Packit 70b277
 *  *readahead will be set to the readahead character consumed while
Packit 70b277
 *   looking for the end-of-number
Packit 70b277
 */
Packit 70b277
/* For convenience of the caller, package the dc_num
Packit 70b277
 * into a dc_data result.
Packit 70b277
 */
Packit 70b277
dc_data
Packit 70b277
dc_getnum DC_DECLARG((input, ibase, readahead))
Packit 70b277
	int (*input) DC_PROTO((void)) DC_DECLSEP
Packit 70b277
	int ibase DC_DECLSEP
Packit 70b277
	int *readahead DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_num	base;
Packit 70b277
	bc_num	result;
Packit 70b277
	bc_num	build;
Packit 70b277
	bc_num	tmp;
Packit 70b277
	bc_num	divisor;
Packit 70b277
	dc_data	full_result;
Packit 70b277
	int		negative = 0;
Packit 70b277
	int		digit;
Packit 70b277
	int		decimal;
Packit 70b277
	int		c;
Packit 70b277
Packit 70b277
	bc_init_num(&tmp);
Packit 70b277
	bc_init_num(&build);
Packit 70b277
	bc_init_num(&base);
Packit 70b277
	result = bc_copy_num(_zero_);
Packit 70b277
	bc_int2num(&base, ibase);
Packit 70b277
	c = (*input)();
Packit 70b277
	while (isspace(c))
Packit 70b277
		c = (*input)();
Packit 70b277
	if (c == '_' || c == '-'){
Packit 70b277
		negative = c;
Packit 70b277
		c = (*input)();
Packit 70b277
	}else if (c == '+'){
Packit 70b277
		c = (*input)();
Packit 70b277
	}
Packit 70b277
	while (isspace(c))
Packit 70b277
		c = (*input)();
Packit 70b277
	for (;;){
Packit 70b277
		if (isdigit(c))
Packit 70b277
			digit = c - '0';
Packit 70b277
		else if ('A' <= c && c <= 'F')
Packit 70b277
			digit = 10 + c - 'A';
Packit 70b277
		else
Packit 70b277
			break;
Packit Service e6fd6c
		c = (*input)();
Packit 70b277
		bc_int2num(&tmp, digit);
Packit 70b277
		bc_multiply(result, base, &result, 0);
Packit 70b277
		bc_add(result, tmp, &result, 0);
Packit 70b277
	}
Packit 70b277
	if (c == '.'){
Packit 70b277
		bc_free_num(&build);
Packit 70b277
		bc_free_num(&tmp);
Packit 70b277
		divisor = bc_copy_num(_one_);
Packit 70b277
		build = bc_copy_num(_zero_);
Packit 70b277
		decimal = 0;
Packit 70b277
		for (;;){
Packit Service e6fd6c
			c = (*input)();
Packit 70b277
			if (isdigit(c))
Packit 70b277
				digit = c - '0';
Packit 70b277
			else if ('A' <= c && c <= 'F')
Packit 70b277
				digit = 10 + c - 'A';
Packit 70b277
			else
Packit 70b277
				break;
Packit 70b277
			bc_int2num(&tmp, digit);
Packit 70b277
			bc_multiply(build, base, &build, 0);
Packit 70b277
			bc_add(build, tmp, &build, 0);
Packit 70b277
			bc_multiply(divisor, base, &divisor, 0);
Packit 70b277
			++decimal;
Packit 70b277
		}
Packit 70b277
		bc_divide(build, divisor, &build, decimal);
Packit 70b277
		bc_add(result, build, &result, 0);
Packit 70b277
	}
Packit 70b277
	/* Final work. */
Packit 70b277
	if (negative)
Packit 70b277
		bc_sub(_zero_, result, &result, 0);
Packit 70b277
Packit 70b277
	bc_free_num(&tmp);
Packit 70b277
	bc_free_num(&build);
Packit 70b277
	bc_free_num(&base);
Packit 70b277
	if (readahead)
Packit 70b277
		*readahead = c;
Packit 70b277
	*CastNumPtr(&full_result.v.number) = result;
Packit 70b277
	full_result.dc_type = DC_NUMBER;
Packit 70b277
	return full_result;
Packit 70b277
}
Packit 70b277
Packit 70b277

Packit 70b277
/* Return the "length" of the number, ignoring *all* leading zeros,
Packit 70b277
 * (including those to the right of the radix point!)
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_numlen DC_DECLARG((value))
Packit 70b277
	dc_num value DC_DECLEND
Packit 70b277
{
Packit 70b277
	/* XXX warning: unholy coziness with the internals of a bc_num! */
Packit 70b277
	bc_num num = CastNum(value);
Packit 70b277
	char *p = num->n_value;
Packit 70b277
	int i = num->n_len + num->n_scale;
Packit 70b277
Packit 70b277
	while (1
Packit 70b277
		--i, ++p;
Packit 70b277
	return i;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* return the scale factor of the passed dc_num
Packit 70b277
 * If discard_p is DC_TOSS then deallocate the value after use.
Packit 70b277
 */
Packit 70b277
int
Packit 70b277
dc_tell_scale DC_DECLARG((value, discard_p))
Packit 70b277
	dc_num value DC_DECLSEP
Packit 70b277
	dc_discard discard_p DC_DECLEND
Packit 70b277
{
Packit 70b277
	int kscale;
Packit 70b277
Packit 70b277
	kscale = CastNum(value)->n_scale;
Packit 70b277
	if (discard_p == DC_TOSS)
Packit 70b277
		dc_free_num(&value);
Packit 70b277
	return kscale;
Packit 70b277
}
Packit 70b277
Packit 70b277

Packit 70b277
/* initialize the math subsystem */
Packit 70b277
void
Packit 70b277
dc_math_init DC_DECLVOID()
Packit 70b277
{
Packit 70b277
	bc_init_numbers();
Packit 70b277
}
Packit 70b277

Packit 70b277
/* print out a dc_num in output base obase to stdout;
Packit 70b277
 * if discard_p is DC_TOSS then deallocate the value after use
Packit 70b277
 */
Packit 70b277
void
Packit 70b277
dc_out_num DC_DECLARG((value, obase, discard_p))
Packit 70b277
	dc_num value DC_DECLSEP
Packit 70b277
	int obase DC_DECLSEP
Packit 70b277
	dc_discard discard_p DC_DECLEND
Packit 70b277
{
Packit 70b277
	out_char('\0'); /* clear the column counter */
Packit 70b277
	bc_out_num(CastNum(value), obase, out_char, 0);
Packit 70b277
	if (discard_p == DC_TOSS)
Packit 70b277
		dc_free_num(&value);
Packit 70b277
}
Packit 70b277
Packit 70b277
/* dump out the absolute value of the integer part of a
Packit 70b277
 * dc_num as a byte stream, without any line wrapping;
Packit 70b277
 * if discard_p is DC_TOSS then deallocate the value after use
Packit 70b277
 */
Packit 70b277
void
Packit 70b277
dc_dump_num DC_DECLARG((dcvalue, discard_p))
Packit 70b277
	dc_num dcvalue DC_DECLSEP
Packit 70b277
	dc_discard discard_p DC_DECLEND
Packit 70b277
{
Packit 70b277
	struct digit_stack { int digit; struct digit_stack *link;};
Packit 70b277
	struct digit_stack *top_of_stack = NULL;
Packit 70b277
	struct digit_stack *cur;
Packit 70b277
	struct digit_stack *next;
Packit 70b277
	bc_num value;
Packit 70b277
	bc_num obase;
Packit 70b277
	bc_num digit;
Packit 70b277
Packit 70b277
	bc_init_num(&value);
Packit 70b277
	bc_init_num(&obase);
Packit 70b277
	bc_init_num(&digit);
Packit 70b277
Packit 70b277
	/* we only handle the integer portion: */
Packit 70b277
	bc_divide(CastNum(dcvalue), _one_, &value, 0);
Packit 70b277
	/* we only handle the absolute value: */
Packit 70b277
	value->n_sign = PLUS;
Packit 70b277
	/* we're done with the dcvalue parameter: */
Packit 70b277
	if (discard_p == DC_TOSS)
Packit 70b277
		dc_free_num(&dcvalue);
Packit 70b277
Packit 70b277
	bc_int2num(&obase, 1+UCHAR_MAX);
Packit 70b277
	do {
Packit 70b277
		(void) bc_divmod(value, obase, &value, &digit, 0);
Packit 70b277
		cur = dc_malloc(sizeof *cur);
Packit 70b277
		cur->digit = (int)bc_num2long(digit);
Packit 70b277
		cur->link = top_of_stack;
Packit 70b277
		top_of_stack = cur;
Packit 70b277
	} while (!bc_is_zero(value));
Packit 70b277
Packit 70b277
	for (cur=top_of_stack; cur; cur=next) {
Packit 70b277
		putchar(cur->digit);
Packit 70b277
		next = cur->link;
Packit 70b277
		free(cur);
Packit 70b277
	}
Packit 70b277
Packit 70b277
	bc_free_num(&digit);
Packit 70b277
	bc_free_num(&obase);
Packit 70b277
	bc_free_num(&value);
Packit 70b277
}
Packit 70b277

Packit 70b277
/* deallocate an instance of a dc_num */
Packit 70b277
void
Packit 70b277
dc_free_num DC_DECLARG((value))
Packit 70b277
	dc_num *value DC_DECLEND
Packit 70b277
{
Packit 70b277
	bc_free_num(CastNumPtr(value));
Packit 70b277
}
Packit 70b277
Packit 70b277
/* return a duplicate of the number in the passed value */
Packit 70b277
/* The mismatched data types forces the caller to deal with
Packit 70b277
 * bad dc_type'd dc_data values, and makes it more convenient
Packit 70b277
 * for the caller to not have to do the grunge work of setting
Packit 70b277
 * up a dc_type result.
Packit 70b277
 */
Packit 70b277
dc_data
Packit 70b277
dc_dup_num DC_DECLARG((value))
Packit 70b277
	dc_num value DC_DECLEND
Packit 70b277
{
Packit 70b277
	dc_data result;
Packit 70b277
Packit 70b277
	++CastNum(value)->n_refs;
Packit 70b277
	result.v.number = value;
Packit 70b277
	result.dc_type = DC_NUMBER;
Packit 70b277
	return result;
Packit 70b277
}
Packit 70b277
Packit 70b277

Packit 70b277
Packit 70b277
/*---------------------------------------------------------------------------\
Packit 70b277
| The rest of this file consists of stubs for bc routines called by numeric.c|
Packit 70b277
| so as to minimize the amount of bc code needed to build dc.                |
Packit 70b277
| The bulk of the code was just lifted straight out of the bc source.        |
Packit 70b277
\---------------------------------------------------------------------------*/
Packit 70b277
Packit 70b277
#ifdef HAVE_STDARG_H
Packit 70b277
# include <stdarg.h>
Packit 70b277
#else
Packit 70b277
# include <varargs.h>
Packit 70b277
#endif
Packit 70b277
Packit 70b277
#ifndef HAVE_STRTOL
Packit 70b277
/* Maintain some of the error checking of a real strtol() on
Packit 70b277
 * ancient systems that lack one, but punting on the niceties
Packit 70b277
 * of supporting bases other than 10 and overflow checking.
Packit 70b277
 */
Packit 70b277
long
Packit 70b277
strtol(const char *s, char **end, int base)
Packit 70b277
{
Packit 70b277
	int sign = 1;
Packit 70b277
	long result = 0;
Packit 70b277
Packit 70b277
	for (;; ++s) {
Packit 70b277
		if (*s == '-')
Packit 70b277
			sign = -sign;
Packit 70b277
		else if (*s != '+' && !isspace(*(const unsigned char *)s))
Packit 70b277
			break;
Packit 70b277
	}
Packit 70b277
	while (isdigit(*(const unsigned char *)s))
Packit 70b277
		result = 10*result + (*s++ - '0');
Packit 70b277
	*end = s;
Packit 70b277
	return result * sign;
Packit 70b277
}
Packit 70b277
#endif /*!HAVE_STRTOL*/
Packit 70b277
Packit 70b277
Packit 70b277
static int out_col = 0;
Packit 70b277
static int line_max = -1;	/* negative means "need to check environment" */
Packit 70b277
#define DEFAULT_LINE_MAX 70
Packit 70b277
Packit 70b277
static void
Packit 70b277
set_line_max_from_environment(void)
Packit 70b277
{
Packit 70b277
	const char *env_line_len = getenv("DC_LINE_LENGTH");
Packit 70b277
	line_max = DEFAULT_LINE_MAX;
Packit 70b277
	errno = 0;
Packit 70b277
	if (env_line_len) {
Packit 70b277
		char *endptr;
Packit 70b277
		long proposed_line_len = strtol(env_line_len, &endptr, 0);
Packit 70b277
		line_max = (int)proposed_line_len;
Packit 70b277
Packit 70b277
		/* silently enforce sanity */
Packit 70b277
		while (isspace(*(const unsigned char *)endptr))
Packit 70b277
			++endptr;
Packit 70b277
		if (*endptr || errno || line_max != proposed_line_len
Packit 70b277
					|| line_max < 0 || line_max == 1)
Packit 70b277
			line_max = DEFAULT_LINE_MAX;
Packit 70b277
	}
Packit 70b277
}
Packit 70b277
Packit 70b277
/* Output routines: Write a character CH to the standard output.
Packit 70b277
   It keeps track of the number of characters output and may
Packit 70b277
   break the output with a "\<cr>". */
Packit 70b277
Packit 70b277
static void
Packit 70b277
out_char (ch)
Packit 70b277
	int ch;
Packit 70b277
{
Packit 70b277
	if (ch == '\0') {
Packit 70b277
		out_col = 0;
Packit 70b277
	} else {
Packit 70b277
		if (line_max < 0)
Packit 70b277
			set_line_max_from_environment();
Packit 70b277
		if (++out_col >= line_max && line_max != 0) {
Packit 70b277
			putchar ('\\');
Packit 70b277
			putchar ('\n');
Packit 70b277
			out_col = 1;
Packit 70b277
		}
Packit 70b277
		putchar(ch);
Packit 70b277
	}
Packit 70b277
}
Packit 70b277
Packit 70b277
/* Malloc could not get enough memory. */
Packit 70b277
Packit 70b277
void
Packit 70b277
out_of_memory()
Packit 70b277
{
Packit 70b277
	dc_memfail();
Packit 70b277
}
Packit 70b277
Packit 70b277
/* Runtime error --- will print a message and stop the machine. */
Packit 70b277
Packit 70b277
#ifdef HAVE_STDARG_H
Packit 70b277
#ifdef __STDC__
Packit 70b277
void
Packit 70b277
rt_error (char *mesg, ...)
Packit 70b277
#else
Packit 70b277
void
Packit 70b277
rt_error (mesg)
Packit 70b277
	char *mesg;
Packit 70b277
#endif
Packit 70b277
#else
Packit 70b277
void
Packit 70b277
rt_error (mesg, va_alist)
Packit 70b277
	char *mesg;
Packit 70b277
#endif
Packit 70b277
{
Packit 70b277
	va_list args;
Packit 70b277
Packit 70b277
	fprintf (stderr, "Runtime error: ");
Packit 70b277
#ifdef HAVE_STDARG_H
Packit 70b277
	va_start (args, mesg);
Packit 70b277
#else
Packit 70b277
	va_start (args);
Packit 70b277
#endif
Packit 70b277
	vfprintf (stderr, mesg, args);
Packit 70b277
	va_end (args);
Packit 70b277
	fprintf (stderr, "\n");
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* A runtime warning tells of some action taken by the processor that
Packit 70b277
   may change the program execution but was not enough of a problem
Packit 70b277
   to stop the execution. */
Packit 70b277
Packit 70b277
#ifdef HAVE_STDARG_H
Packit 70b277
#ifdef __STDC__
Packit 70b277
void
Packit 70b277
rt_warn (char *mesg, ...)
Packit 70b277
#else
Packit 70b277
void
Packit 70b277
rt_warn (mesg)
Packit 70b277
	char *mesg;
Packit 70b277
#endif
Packit 70b277
#else
Packit 70b277
void
Packit 70b277
rt_warn (mesg, va_alist)
Packit 70b277
	char *mesg;
Packit 70b277
#endif
Packit 70b277
{
Packit 70b277
	va_list args;
Packit 70b277
Packit 70b277
	fprintf (stderr, "Runtime warning: ");
Packit 70b277
#ifdef HAVE_STDARG_H
Packit 70b277
	va_start (args, mesg);
Packit 70b277
#else
Packit 70b277
	va_start (args);
Packit 70b277
#endif
Packit 70b277
	vfprintf (stderr, mesg, args);
Packit 70b277
	va_end (args);
Packit 70b277
	fprintf (stderr, "\n");
Packit 70b277
}
Packit 70b277
Packit 70b277

Packit 70b277
/*
Packit 70b277
 * Local Variables:
Packit 70b277
 * mode: C
Packit 70b277
 * tab-width: 4
Packit 70b277
 * End:
Packit 70b277
 * vi: set ts=4 :
Packit 70b277
 */