lcalc.c

128位长双精度型数字运算包

register char *pline;
struct varent *pvar;
struct strent *pstr;
char *cp, *plc, *pn;
long lnc;
int i;
long double tem;

/* reference for old Whitesmiths compiler: */
/*
 *extern FILE *stdout;
 */

pline = interl;		/* get current location in command string	*/


/*	If at beginning of string, must ask for more input	*/
if( pline == line )
	{

	if( maccnt > 0 )
		{
		--maccnt;
		cp = maclin;
		plc = pline;
		while( (*plc++ = *cp++) != 0 )
			;
		goto mstart;
		}
	if( takptr < 0 )
		{	/* no take file active: prompt keyboard input */
		printf("* ");
		}
/* 	Various ways of typing in a command line. */

/*
 * Old Whitesmiths call to print "*" immediately
 * use RT11 .GTLIN to get command string
 * from command file or terminal
 */

/*
 *	fflush(stdout);
 *	gtlin(line);
 */

 
	zgets( line, TRUE );	/* keyboard input for other systems: */


mstart:
	uposs = 1;	/* unary operators possible at start of line */
	}

ignore:
/* Skip over spaces */
while( *pline == ' ' )
	++pline;

/* unary minus after operator */
if( uposs && (*pline == '-') )
	{
	psym = &oprtbl[2];	/* UMINUS */
	++pline;
	goto pdon3;
	}
	/* COMP */
/*
if( uposs && (*pline == '~') )
	{
	psym = &oprtbl[3];
	++pline;
	goto pdon3;
	}
*/
if( uposs && (*pline == '+') )	/* ignore leading plus sign */
	{
	++pline;
	goto ignore;
	}

/* end of null terminated input */
if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
	{
	pline = line;
	goto endlin;
	}
if( *pline == ';' )
	{
	++pline;
endlin:
	psym = &oprtbl[1];	/* EOL */
	goto pdon2;
	}


/*						parser()	*/


/* Test for numeric input */
if( (ISDIGIT(*pline)) || (*pline == '.') )
	{
	lnc = 0;	/* initialize numeric input to zero */
	qnc = 0.0L;
	if( *pline == '0' )
		{ /* leading "0" may mean octal or hex radix */
		++pline;
		if( *pline == '.' )
			goto decimal; /* 0.ddd */
		/* leading "0x" means hexadecimal radix */
		if( (*pline == 'x') || (*pline == 'X') )
			{
			++pline;
			while( ISXDIGIT(*pline) )
				{
				i = *pline++ & 0xff;
				if( i >= 'a' )
					i -= 047;
				if( i >= 'A' )
					i -= 07;
				i -= 060;
				lnc = (lnc << 4) + i;
				qnc = lnc;
				}
			goto numdon;
			}
		else
			{
			while( ISOCTAL( *pline ) )
				{
				i = ((*pline++) & 0xff) - 060;
				lnc = (lnc << 3) + i;
				qnc = lnc;
				}
			goto numdon;
			}
		}
	else
		{
		/* no leading "0" means decimal radix */
/******/
decimal:
		pn = number;
		while( (ISDIGIT(*pline)) || (*pline == '.') )
			*pn++ = *pline++;
/* get possible exponent field */
		if( (*pline == 'e') || (*pline == 'E') )
			*pn++ = *pline++;
		else
			goto numcvt;
		if( (*pline == '-') || (*pline == '+') )
			*pn++ = *pline++;
		while( ISDIGIT(*pline) )
			*pn++ = *pline++;
numcvt:
		*pn++ = ' ';
		*pn++ = 0;
/*
		asctoe64( number, &qnc );
*/
		asctoe113( number, &qnc );

/*		sscanf( number, "%le", &nc ); */
		}
/* output the number	*/
numdon:
	/* search the symbol table of constants 	*/
	pvar = &contbl[0];
	for( i=0; i<NCONST; i++ )
		{
		if( (pvar->attrib & BUSY) == 0 )
			goto confnd;
		tem = *pvar->value;
		if( tem == qnc )
			{
			psym = (struct symbol *)pvar;
			goto pdon2;
			}
		++pvar;
		}
	printf( "no room for constant\n" );
	psym = (struct symbol *)&contbl[0];
	goto pdon2;

confnd:
	pvar->spel= contbl[0].spel;
	pvar->attrib = CONST | BUSY;
	*pvar->value = qnc;
	psym = (struct symbol *)pvar;
	goto pdon2;
	}

/* check for operators */
psym = &oprtbl[3];
for( i=0; i<NOPR; i++ )
	{
	if( *pline == *(psym->spel) )
		goto pdon1;
	++psym;
	}

/* if quoted, it is a string variable */
if( *pline == '"' )
	{
	/* find an empty slot for the string */
	pstr = strtbl;	/* string table	*/
	for( i=0; i<NSTRNG-1; i++ ) 
		{
		if( (pstr->attrib & BUSY) == 0 )
			goto fndstr;
		++pstr;
		}
	printf( "No room for string\n" );
	pstr->attrib |= ILLEG;
	psym = (struct symbol *)pstr;
	goto pdon0;

fndstr:
	pstr->attrib |= BUSY;
	plc = pstr->string;
	++pline;
	for( i=0; i<39; i++ )
		{
		*plc++ = *pline;
		if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
			{
illstr:
			pstr = &strtbl[NSTRNG-1];
			pstr->attrib |= ILLEG;
			printf( "Missing string terminator\n" );
			psym = (struct symbol *)pstr;
			goto pdon0;
			}
		if( *pline++ == '"' )
			goto finstr;
		}

	goto illstr;	/* no terminator found */

finstr:
	--plc;
	*plc = '\0';
	psym = (struct symbol *)pstr;
	goto pdon2;
	}
/* If none of the above, search function and symbol tables:	*/

/* copy character string to array lc[] */
plc = &lc[0];
while( ISALPHA(*pline) )
	{
	/* convert to lower case characters */
	if( ISUPPER( *pline ) )
		*pline += 040;
	*plc++ = *pline++;
	}
*plc = 0;	/* Null terminate the output string */

/*						parser()	*/

psym = (struct symbol *)menstk[menptr];	/* function table	*/
plc = &lc[0];
cp = psym->spel;
do
	{
	if( strcmp( plc, cp ) == 0 )
		goto pdon3;	/* following unary minus is possible */
	++psym;
	cp = psym->spel;
	}
while( *cp != '\0' );

psym = (struct symbol *)&indtbl[0];	/* indirect symbol table */
plc = &lc[0];
cp = psym->spel;
do
	{
	if( strcmp( plc, cp ) == 0 )
		goto pdon2;
	++psym;
	cp = psym->spel;
	}
while( *cp != '\0' );

pdon0:
pline = line;	/* scrub line if illegal symbol */
goto pdon2;

pdon1:
++pline;
if( (psym->attrib & 0xf) == RPAREN )
pdon2:	uposs = 0;
else
pdon3:	uposs = 1;

interl = pline;
return( psym );
}		/* end of parser */

/*	exit from current menu */

long double cmdex()
{

if( menptr == 0 )
	{
	printf( "Main menu is active.\n" );
	}
else
	--menptr;

cmdh();
return(0.0L);
}


/*			gets()		*/

void zgets( gline, echo )
char *gline;
int echo;
{
register char *pline;
register int i;


scrub:
pline = gline;
getsl:
	if( (pline - gline) >= LINLEN )
		{
		printf( "\nLine too long\n *" );
		goto scrub;
		}
	if( takptr < 0 )
		{	/* get character from keyboard */
/*
if DECPDP
		gtlin( gline );
		return(0);
else
*/
		*pline = getchar();
/*endif*/
		}
	else
		{	/* get a character from take file */
		i = fgetc( takstk[takptr] );
		if( i == -1 )
			{	/* end of take file */
			if( takptr >= 0 )
				{	/* close file and bump take stack */
				fclose( takstk[takptr] );
				takptr -= 1;
				}
			if( takptr < 0 )	/* no more take files:   */
				printf( "*" ); /* prompt keyboard input */
			goto scrub;	/* start a new input line */
			}
		*pline = i;
		}

	*pline &= 0x7f;
	/* xon or xoff characters need filtering out. */
	if ( *pline == XON || *pline == XOFF )
		goto getsl;

	/*	control U or control C	*/
	if( (*pline == 025) || (*pline == 03) )
		{
		printf( "\n" );
		goto scrub;
		}

	/*  Backspace or rubout */
	if( (*pline == 010) || (*pline == 0177) )
		{
		pline -= 1;
		if( pline >= gline )
			{
			if ( echo )
				printf( "\010\040\010" );
			goto getsl;
			}
		else
			goto scrub;
		}
	if ( echo )
		printf( "%c", *pline );
	if( (*pline != '\n') && (*pline != '\r') )
		{
		++pline;
		goto getsl;
		}
	*pline = 0;
	if ( echo )
		printf( "%c", '\n' );	/* \r already echoed */
}


/*		help function  */
long double cmdhlp()
{

printf( "%s", idterp );
printf( "\nFunctions:\n" );
prhlst( &funtbl[0] );
printf( "\nVariables:\n" );
prhlst( &indtbl[0] );
printf( "\nOperators:\n" );
prhlst( &oprtbl[2] );
printf("\n");
return(0.0L);
}


long double cmdh()
{

prhlst( menstk[menptr] );
printf( "\n" );
return(0.0L);
}

/* print keyword spellings */

long double prhlst(ps)
register struct symbol *ps;
{
register int j, k;
int m;

j = 0;
while( *(ps->spel) != '\0' )
	{
	k = strlen( ps->spel )  -  1;
/* size of a tab field is 2**3 chars */
	m = ((k >> 3) + 1) << 3;
	j += m;
	if( j > 72 )
		{
		printf( "\n" );
		j = m;
		}
	printf( "%s\t", ps->spel );
	++ps;
	}
return(0.0L);
}


#if SALONE
void init(){}
#endif


/*	macro commands */

/*	define macro */
long double cmddm()
{

zgets( maclin, TRUE );
return(0.0L);
}

/*	type (i.e., display) macro */
long double cmdtm()
{

printf( "%s\n", maclin );
return(0.0L);
}

/*	execute macro # times */
long double cmdem( arg )
long double arg;
{
long double f;
long n;
long double floorl();

f = floorl(arg);
n = f;
if( n <= 0 )
	n = 1;
maccnt = n;
return(0.0L);
}


/* open a take file */

long double take( fname )
char *fname;
{
FILE *f;

while( *fname == ' ' )
	fname += 1;
f = fopen( fname, "r" );

if( f == 0 )
	{
	printf( "Can't open take file %s\n", fname );
	takptr = -1;	/* terminate all take file input */
	return(0.0L);
	}
takptr += 1;
takstk[ takptr ]  =  f;
printf( "Running %s\n", fname );
return(0.0L);
}


/*	abort macro execution */
long double abmac()
{

maccnt = 0;
interl = line;
return(0.0L);
}


/* display integer part in hex, octal, and decimal
 */
long double hex(qx)
long double qx;
{
long double f;
long z;
long double floorl();

f = floorl(qx);
z = f;
printf( "0%lo  0x%lx  %ld.\n", z, z, z );
return(qx);
}

#define NASC 16

long double bits( x )
long double x;
{
int i, j;
unsigned short dd[4], ee[10];
/* unsigned short e64[6]; */
/* char strx[40]; */
/* char str64[40]; */
unsigned short *p;

p = (unsigned short *) &x;
for( i=0; i<NE; i++ )
	ee[i] = *p++;

j = 0;
for( i=0; i<NE; i++ )
	{
	printf( "0x%04x,", ee[i] & 0xffff );
	if( ++j > 7 )
		{
		j = 0;
		printf( "\n" );
		}
	}
printf( "\n" );

/* double conversions
 */
*((double *)dd) = x;
printf( "double: " );
for( i=0; i<4; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );

#if 0
*(long double *)ee = *(double *)dd;
for( i=0; i<6; i++ )
	printf( "0x%04x,", ee[i] & 0xffff );
printf( "\n" );
/* printf( "Native printf: %.16e\n", *(double *)dd ); */
asctoe53( strx, dd );
printf( "asctoe53: " );
for( i=0; i<4; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );
asctoe53( str64, dd );
printf( "asc64toe53: " );
for( i=0; i<4; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );

/* float conversions
 */
etoe24( x, dd );
printf( "etoe24: " );
for( i=0; i<2; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );
asctoe24( str64, &dd );
printf( "asctoe24: " );
for( i=0; i<2; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );
e24toe( dd, ee );
printf( "e24toe: " );
for( i=0; i<NE; i++ )
	printf( "0x%04x,", ee[i] & 0xffff );
printf( "\n" );

e24toasc( dd, strx, NASC );
printf( "e24toasc: %s\n", strx );
/* printf( "Native printf: %.16e\n", (double) *(float *)dd ); */

asctoe24( strx, dd );
printf( "asctoe24: " );
for( i=0; i<2; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );

printf( "etodec: " );
etodec( x, dd );
for( i=0; i<4; i++ )
	printf( "0x%04x,", dd[i] & 0xffff );
printf( "\n" );
printf( "dectoe: " );
dectoe( dd, ee );
for( i=0; i<NE; i++ )
	printf( "0x%04x,", ee[i] & 0xffff );
printf( "\n" );
#ifdef DEC
printf( "DEC printf: %.16e\n", *(double *)dd );
#endif
#endif /* 0 */
return(x);
}


/* Exit to monitor. */
long double mxit()
{

exit(0);
return(0.0L);
}


long double cmddig( x )
long double x;
{
long double f;
long lx;

f = floorl(x);
lx = f;
ndigits = lx;
if( ndigits <= 0 )
	ndigits = DEFDIS;
return(f);
}


long double csys(x)
char *x;
{

system( x+1 );
cmdh();
return(0.0L);
}


long double ifrac(x)
long double x;
{
unsigned long lx;
long double y, z;

z = floorl(x);
lx = z;
y = x - z;
printf( " int = %lx\n", lx );
return(y);
}

long double compare(x, y)
long double x, y;
{
long double ans;

ans = -2.0L;
if( x < y )
	{
	printf( " < " );
	ans = -1.0L;
	}
if( x == y )
	{
	printf( " == " );
	ans = 0.0L;
	}
if( x > y )
	{
	printf( " > " );
	ans = 1.0L;
	}
if( x <= y )
	{
	printf( " <= " );
	}
if( x >= y )
	{
	printf( " >= " );
	}
if( x != y )
	{
	printf( " != " );
	}
return (ans);
}