⟦4d04708c0⟧

TextFile



/*
	Floating point package support routines

	Note the "fp" library function, available in DEFF2.CRL,
	is used extensively by all the floating point number
	crunching functions.

	-------------------------------------------------------------
	Usage: After compiling your program, link with this library
	by typing:

	A>clink <your program files> -f float <cr>
	-------------------------------------------------------------

	NEW FEATURE: a special "printf" function has been included
		     in this source file for use with floating point
		     operands, in addition to the normal types. The
		     printf presented here will take precedence over
		     the DEFF.CRL version when "float" is specified
		     on the CLINK command line at linkage time.
		     Note that the "fp" function, needed by most of
		     the functions in this file, resides in DEFF2.CRL
		     and will be automatically collected by CLINK.

	All functions here written by Bob Mathias, except printf and
	_spr (written by Leor Zolman.)
*/

#include <bdscio.h>

#define NORM_CODE	0
#define ADD_CODE	1
#define SUB_CODE	2
#define MULT_CODE	3
#define DIV_CODE	4
#define FTOA_CODE	5

fpcomp(op1,op2)
	char *op1,*op2;
æ
	char workÆ5Å;
	fpsub(work,op1,op2);
	if (workÆ3Å > 127) return (-1);
	if (workÆ0Å+workÆ1Å+workÆ2Å+workÆ3Å) return (1);
	return (0);
å

fpnorm(op1) char *op1;
æ	fp(NORM_CODE,op1,op1);return(op1);å

fpadd(result,op1,op2)
	char *result,*op1,*op2;
æ	fp(ADD_CODE,result,op1,op2);return(result);å

fpsub(result,op2,op1)
	char *result,*op1,*op2;
	æfp(SUB_CODE,result,op1,op2);return(result);å

fpmult(result,op1,op2)
	char *result,*op1,*op2;
æ	fp(MULT_CODE,result,op1,op2);return(result);å

fpdiv(result,op1,op2)
	char *result,*op1,*op2;
æ	fp(DIV_CODE,result,op1,op2);return(result);å

atof(fpno,s)
	char fpnoÆ5Å,*s;
æ
	char *fpnorm(),workÆ5Å,ZEROÆ5Å,FP_10Æ5Å;
	int sign_boolean,power;

	initb(FP_10,"0,0,0,80,4");
	setmem(fpno,5,0);
	sign_boolean=power=0;

	while (*s==' ' øø *s=='Øt') ++s;
	if (*s=='-')æsign_boolean=1;++s;å
	for (;isdigit(*s);++s)æ
		fpmult(fpno,fpno,FP_10);
		workÆ0Å=*s-'0';
		workÆ1Å=workÆ2Å=workÆ3Å=0;workÆ4Å=31;
		fpadd(fpno,fpno,fpnorm(work));
	å
	if (*s=='.')æ
		++s;
		for (;isdigit(*s);--power,++s)æ
			fpmult(fpno,fpno,FP_10);
			workÆ0Å=*s-'0';
			workÆ1Å=workÆ2Å=workÆ3Å=0;workÆ4Å=31;
			fpadd(fpno,fpno,fpnorm(work));
		å
	å
	if (toupper(*s) == 'E') æ++s; power += atoi(s); å
	if (power>0)
		for (;power!=0;--power) fpmult(fpno,fpno,FP_10);
	else
	if (power<0)
		for (;power!=0;++power) fpdiv(fpno,fpno,FP_10);
	if (sign_boolean)æ
		setmem(ZERO,5,0);
		fpsub(fpno,ZERO,fpno);
	å
	return(fpno);
å
ftoa(result,op1)
	char *result,*op1;
æ	fp(FTOA_CODE,result,op1);return(result);å

itof(op1,n)
char *op1;
int n;
æ
	char tempÆ20Å;
	return atof(op1, itoa(temp,n));
å

itoa(str,n)
char *str;
æ
	char *sptr;
	sptr = str;
	if (n<0) æ *sptr++ = '-'; n = -n; å
	_uspr(&sptr, n, 10);
	*sptr = 'Ø0';
	return str;
å

/*
	This is the special formatting function, which supports the
	"e" and "f" conversions as well as the normal "d", "s", etc.
	When using "e" or "f" format, the corresponding argument in
	the argument list should be a pointer to one of the five-byte
	strings used as floating point numbers by the floating point
	functions. Note that you don't need to ever use the "ftoa"
	function when using this special printf/sprintf combination;
	to achieve the same result as ftoa, a simple "%e" format
	conversion will do the trick. "%f" is used to eliminate the
	scientific notation and set the precision. The only ÆknownÅ
	difference between the "e" and "f" conversions as used here
	and the ones described in the Kernighan & Ritchie book is that
	ROUNDING does not take place in this version...e.g., printing
	a floating point number which happens to equal exactly 3.999
	using a "%5.2f" format conversion will produce " 3.99" instead
	of " 4.00".
*/

printf(format)
char *format;
æ
	int putchar();
	_spr(&format, &putchar);	/* use "_spr" to form the output */
å


_spr(fmt,putcf,arg1)
int (*putcf)();
char **fmt;
æ
	char _uspr(), c, base, *sptr, *format;
	char wbufÆMAXLINEÅ, *wptr, pf, ljflag, zfflag;
	int width, precision, exp, *args;

	format = *fmt++;	/* fmt first points to the format string */
	args = fmt;		/* now fmt points to the first arg value */
	while (c = *format++)
	  if (c == '%') æ
	    wptr = wbuf;
	    precision = 6;
	    ljflag = pf = zfflag = 0;

	    if (*format == '-') æ
		    format++;
		    ljflag++;
	     å

	    if (*format == '0') zfflag++;	/* test for zero fill */

	    width = isdigit(*format) ? _gv2(&format) : 0;

	    if ((c = *format++) == '.') æ
		    precision = _gv2(&format);
		    pf++;
		    c = *format++;
	     å

	    switch(toupper(c)) æ
		case 'E':  if (precision>7) precision = 7;
			   ftoa(wbuf,*args++);
			   strcpy(wbuf+precision+3, wbuf+10);
			   width -= strlen(wbuf);
			   goto pad2;

		case 'F':  ftoa(&wbufÆ60Å,*args++);
			   sptr = &wbufÆ60Å;
			   while ( *sptr++ != 'E')
				;
			   exp = atoi(sptr);
			   sptr = &wbufÆ60Å;
			   if (*sptr == ' ') sptr++;
			   if (*sptr == '-') æ
				*wptr++ = '-';
				sptr++;
				width--;
			    å
			   sptr += 2;

			   if (exp < 1) æ
				*wptr++ = '0';
				width--;
			    å

			   pf = 7;
			   while (exp > 0 && pf) æ
				*wptr++ = *sptr++;
				pf--;
				exp--;
				width--;
			    å

			   while (exp > 0) æ
				*wptr++ = '0';
				exp--;
				width--;
			    å

			   *wptr++ = '.';
			   width--;

			   while (exp < 0 && precision) æ
				*wptr++ = '0';
				exp++;
				precision--;
				width--;
			    å

			   while (precision && pf) æ
				*wptr++ = *sptr++;
				pf--;
				precision--;
				width--;
			    å

			   while (precision>0) æ
				*wptr++ = '0';
				precision--;
				width--;
			    å

			   goto pad;


		case 'D':  if (*args < 0) æ
				*wptr++ = '-';
				*args = -*args;
				width--;
			    å
		case 'U':  base = 10; goto val;

		case 'X':  base = 16; goto val;

		case 'O':  base = 8;

		     val:  width -= _uspr(&wptr,*args++,base);
			   goto pad;

		case 'C':  *wptr++ = *args++;
			   width--;
			   goto pad;

		case 'S':  if (!pf) precision = 200;
			   sptr = *args++;
			   while (*sptr && precision) æ
				*wptr++ = *sptr++;
				precision--;
				width--;
			    å

		     pad:  *wptr = 'Ø0';
		     pad2: wptr = wbuf;
			   if (!ljflag)
			    while (width-- > 0)
				if ((*putcf)(zfflag ? '0' : ' ',arg1) == ERROR)
					return ERROR;

			    while (*wptr)
				if ((*putcf)(*wptr++, arg1) == ERROR)
					return ERROR;

			    if (ljflag)
			     while (width-- > 0)
				if ((*putcf)(' ', arg1) == ERROR)
					return ERROR;
			   break;

		 default:  if ((*putcf)(c, arg1) == ERROR)
				return ERROR;
	     å
	  å
	  else if ((*putcf)(c, arg1) == ERROR)
		return ERROR;
å

«eof»
DataMuseum.dk

RegneCentralen RC700 "Piccolo"

⟦4d04708c0⟧ TextFile

Derivation

TextFile
