Home | History | Annotate | Download | only in common
      1 /*
      2  * CDDL HEADER START
      3  *
      4  * The contents of this file are subject to the terms of the
      5  * Common Development and Distribution License, Version 1.0 only
      6  * (the "License").  You may not use this file except in compliance
      7  * with the License.
      8  *
      9  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
     10  * or http://www.opensolaris.org/os/licensing.
     11  * See the License for the specific language governing permissions
     12  * and limitations under the License.
     13  *
     14  * When distributing Covered Code, include this CDDL HEADER in each
     15  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
     16  * If applicable, add the following below this CDDL HEADER, with the
     17  * fields enclosed by brackets "[]" replaced with your own identifying
     18  * information: Portions Copyright [yyyy] [name of copyright owner]
     19  *
     20  * CDDL HEADER END
     21  */
     22 /*
     23  * Copyright (c) 1990-1995, by Sun Microsystems, Inc.
     24  * All rights reserved.
     25  */
     26 
     27 #pragma	ident	"%Z%%M%	%I%	%E% SMI"
     28 
     29 /*
     30  * This file contains the common part of string_to_decimal, func_to_decimal,
     31  * and file_to_decimal. NEXT must be defined to cause CURRENT to contain the
     32  * next input character.   ATEOF must be defined to be == EOF if an input
     33  * file is at EOF, != EOF otherwise.
     34  */
     35 
     36 {
     37 	int             sigfound;
     38 	int             ids = 0;
     39 	int             i;
     40 	int             nzbp = 0, nzap = 0;	/* Length of zero substring
     41 						 * before point, after point. */
     42 	char            decpt;
     43 	int             nfast, nfastlimit;
     44 	char           *pfast;
     45 
     46 	*pform = invalid_form;	/* Invalid until we find something. */
     47 	*pechar = NULL;		/* No exponent field assumed. */
     48 	pd->fpclass = fp_normal;/* Defaults. */
     49 	pd->sign = 0;		/* Positive. */
     50 	pd->exponent = 0;
     51 	pd->more = 0;		/* Assume no overflow of digits on NaN
     52 				 * string. */
     53 	if (fortran_conventions != 0)
     54 		decpt = '.';
     55 	else
     56 #ifdef PRE41
     57 		decpt = '.';
     58 #else
     59 		decpt = *(localeconv()->decimal_point);
     60 #endif
     61 	while (isspace(CURRENT)) {
     62 		NEXT;
     63 	}			/* Skip white space. */
     64 	if (fortran_conventions >= 2) {
     65 		/*
     66 		 * All white space - valid zero for Fortran formatted input.
     67 		 */
     68 		*pform = whitespace_form;
     69 		if (isspace(*cp))
     70 			good = cp;
     71 		else
     72 			good = cp - 1;
     73 		if ((nread >= nmax) && (CURRENT == NULL)) {	/* Used up field width. */
     74 			pd->fpclass = fp_zero;
     75 			goto done;
     76 		}
     77 	}
     78 	if (CURRENT == '+') {
     79 		NEXT;
     80 	} else if (CURRENT == '-') {	/* Negative. */
     81 		pd->sign = 1;
     82 		NEXT;
     83 	}
     84 	sigfound = -1;		/* -1 = no digits found yet. */
     85 
     86 	if (('1' <= CURRENT) && (CURRENT <= '9')) {
     87 		good = cp;
     88 		*pform = fixed_int_form;
     89 		sigfound = 1;	/* 1 = significant digits found. */
     90 		pd->ds[ids++] = CURRENT;
     91 		NEXT;
     92 		goto number;
     93 	} else
     94 		switch (CURRENT) {
     95 		case ' ':
     96 			if (fortran_conventions < 2)
     97 				goto firstdefault;
     98 		case '0':
     99 			*pform = fixed_int_form;
    100 			while ((CURRENT == '0') || ((fortran_conventions >= 2) && (CURRENT == ' '))) {
    101 				NEXT;
    102 			}	/* Ignore leading zeros. */
    103 			if ((*cp == '0') || ((fortran_conventions >= 2) && (*cp == ' ')))
    104 				good = cp;
    105 			else
    106 				good = cp - 1;
    107 			sigfound = 0;	/* 0 = only zeros found yet. */
    108 			goto number;
    109 		case 'i':
    110 		case 'I':
    111 			{	/* Try infinity. */
    112 				static char    *infstring = "INFINITY";
    113 				int             is, iagree;
    114 
    115 #define UCASE(c) ( (('a' <= c) && (c <= 'z')) ? c - 32 : c )
    116 
    117 				NEXT;
    118 				is = 1;
    119 				while (is <= 7 &&
    120 					UCASE(CURRENT) == infstring[is]) {
    121 					NEXT;
    122 					is++;
    123 				}
    124 					iagree = is;
    125 				if (CURRENT != NULL) {
    126 					is++;	/* To account for infstring
    127 						 * indexing starting at 0.
    128 						 */
    129 				}
    130 				if (iagree >= 3) {	/* Found syntactically
    131 							 * valid infinity. */
    132 					if (iagree < 8) {	/* INFxxxx */
    133 						if (iagree > 3) {
    134 							nmax++;	/* 1083219 */
    135 							CURRENT = EOF;	/* 1083219 */
    136 						}
    137 						good = cp - (is - 3);
    138 						*pform = inf_form;
    139 					} else {	/* INFINITYxxx */
    140 						good = cp - (is - 8);
    141 						*pform = infinity_form;
    142 					}
    143 					pd->fpclass = fp_infinity;
    144 					sigfound = iagree;
    145 				}
    146 				else {
    147 					nmax++;			/* 1083219 */
    148 					CURRENT = EOF;		/* 1083219 */
    149 				}
    150 				goto done;
    151 			}
    152 		case 'n':
    153 		case 'N':
    154 			{	/* Try NaN. */
    155 				static char    *nanstring = "NAN(";
    156 				int             is;
    157 
    158 				NEXT;
    159 				is = 1;
    160 				while (is <= 3 &&
    161 					UCASE(CURRENT) == nanstring[is]) {
    162 					NEXT;
    163 					is++;
    164 				}
    165 				if ((is == 3)) {	/* Found syntactically
    166 							 * valid NaN. */
    167 					*pform = nan_form;
    168 					good = CURRENT == NULL ? cp : cp - 1;
    169 					pd->fpclass = fp_quiet;
    170 					sigfound = 1;
    171 				}
    172 				else if (is == 4) {	/* Found NaN followed by
    173 						 * parenthesis. */
    174 					good = CURRENT == NULL ? cp - 1 : cp - 2;
    175 					*pform = nan_form;
    176 					pd->fpclass = fp_quiet;
    177 					sigfound = 1;
    178 					while ((CURRENT != 0) && (CURRENT != ')') && (ids < (DECIMAL_STRING_LENGTH - 1))) {
    179 						pd->ds[ids++] = CURRENT;
    180 						NEXT;
    181 					}
    182 					while ((CURRENT != 0) && (CURRENT != ')') && (ATEOF != EOF)) {	/* Pick up rest of
    183 													 * string. */
    184 						pd->more = 1;
    185 						NEXT;
    186 					}
    187 					if (CURRENT == ')') {
    188 						good = cp;
    189 						NEXT;
    190 					*pform = nanstring_form;
    191 				}
    192 					else {
    193 						nmax++;		/* 1083219 */
    194 						CURRENT = EOF;	/* 1083219 */
    195 					}
    196 				}
    197 				else {
    198 					nmax++;		/* 1083219 */
    199 					CURRENT = EOF;	/* 1083219 */
    200 				}
    201 				goto done;
    202 			}
    203 		default:
    204 			if (CURRENT == decpt) {
    205 				NEXT;	/* Try number. */
    206 				goto afterpoint;
    207 			}
    208 	firstdefault:
    209 			goto done;
    210 		}
    211 
    212 number:
    213 
    214 nextnumber:
    215 	if (('1' <= CURRENT) && (CURRENT <= '9')) {
    216 		if ((ids + nzbp + 2) >= DECIMAL_STRING_LENGTH) {	/* Not enough room to
    217 									 * store it all:  fake
    218 									 * end of string. */
    219 			pd->exponent += nzbp + 1;
    220 			pd->more = 1;
    221 			pd->ds[ids] = 0;	/* Actual string termination. */
    222 			ids = DECIMAL_STRING_LENGTH - 1;	/* To allow end of
    223 								 * program to terminate
    224 								 * again. */
    225 		} else {
    226 			for (i = 0; (i < nzbp); i++)
    227 				pd->ds[ids++] = '0';
    228 			pd->ds[ids++] = CURRENT;
    229 		}
    230 		*pform = fixed_int_form;
    231 		sigfound = 1;
    232 		nzbp = 0;
    233 		NEXT;
    234 		nfastlimit = DECIMAL_STRING_LENGTH - 3 - ids;
    235 		if ((0 < nfastlimit) && ('1' <= CURRENT) && (CURRENT <= '9')) {	/* Special handling for
    236 										 * common case. */
    237 			nfast = 0;
    238 			pfast = &(pd->ds[ids]);
    239 			do {
    240 				pfast[nfast++] = CURRENT;
    241 				NEXT;
    242 			}
    243 			while (('1' <= CURRENT) && (CURRENT <= '9') && (nfast < nfastlimit));
    244 			ids += nfast;
    245 		}
    246 		if (CURRENT == '0')
    247 			goto nextnumberzero;	/* common case */
    248 		good = cp;
    249 		if (('1' > *good) || (*good > '9'))
    250 			good--;	/* look out if we fell off end */
    251 		goto nextnumber;
    252 	} else
    253 		switch (CURRENT) {
    254 		case ' ':
    255 			if (fortran_conventions < 2)
    256 				goto numberdefault;
    257 			if (fortran_conventions == 2) {
    258 				NEXT;
    259 				goto nextnumber;
    260 			}
    261 		case '0':
    262 			*pform = fixed_int_form;
    263 	nextnumberzero:
    264 			while ((CURRENT == '0') || (CURRENT == ' ')) {	/* Accumulate zero
    265 									 * substring. */
    266 				if (CURRENT == ' ') {
    267 					if (fortran_conventions < 2) {
    268 						good = cp - 1;
    269 						goto numberdefault;
    270 					}
    271 					if (fortran_conventions == 2) {
    272 						nzbp--;	/* Undo effect of
    273 							 * following nzbp++ */
    274 					}
    275 				}
    276 				good = cp;
    277 				nzbp++;
    278 				NEXT;
    279 			}
    280 			goto nextnumber;
    281 
    282 		case 'E':
    283 		case 'e':
    284 	efound:
    285 			*pechar = cp;
    286 			if (sigfound == -1)	/* exp following no digits?
    287 						 * bad format */
    288 				goto done;
    289 			if (sigfound > 0)
    290 				pd->exponent += nzbp;
    291 			goto exponent;
    292 		case '+':
    293 		case '-':
    294 		case 'D':
    295 		case 'd':
    296 		case 'Q':
    297 		case 'q':
    298 			if (fortran_conventions != 0)
    299 				goto efound;
    300 		default:
    301 			if (CURRENT == decpt) {
    302 				NEXT;
    303 				goto afterpoint;
    304 			}
    305 	numberdefault:
    306 			if (sigfound > 0)
    307 				pd->exponent += nzbp;
    308 			goto done;
    309 		}
    310 
    311 afterpoint:
    312 	if (sigfound >= 0) {	/* Better accept the point as good, but don't
    313 				 * accept the next character after.  */
    314 		good = cp - 1;	/* Assume cp points past. */
    315 		if (*good != decpt)	/* If not, bump good. */
    316 			good++;
    317 	}
    318 	switch (*pform) {	/* Revise *pform now that point has been
    319 				 * found. */
    320 	case invalid_form:
    321 	case whitespace_form:
    322 		*pform = fixed_dotfrac_form;
    323 		break;
    324 	case fixed_int_form:
    325 		*pform = fixed_intdot_form;
    326 		break;
    327 	}
    328 switchafterpoint:
    329 	if (('1' <= CURRENT) && (CURRENT <= '9')) {
    330 		if (*pform == fixed_intdot_form)
    331 			*pform = fixed_intdotfrac_form;
    332 		good = cp;
    333 		if (sigfound < 1) {	/* No significant digits found so
    334 					 * far. */
    335 			sigfound = 1;
    336 			pd->ds[ids++] = CURRENT;
    337 			pd->exponent = -(nzap + 1);
    338 		} else {	/* Significant digits have begun. */
    339 			if ((ids + nzbp + nzap + 2) >= DECIMAL_STRING_LENGTH) {	/* Not enough room to
    340 										 * store it all:  fake
    341 										 * end of string. */
    342 				pd->exponent += nzbp;
    343 				pd->more = 1;
    344 				pd->ds[ids] = 0;	/* Actual string
    345 							 * termination. */
    346 				ids = DECIMAL_STRING_LENGTH - 1;	/* To allow end of
    347 									 * program to terminate
    348 									 * again. */
    349 			} else {
    350 				for (i = 0; (i < (nzbp + nzap)); i++)
    351 					pd->ds[ids++] = '0';
    352 				pd->ds[ids++] = CURRENT;
    353 				pd->exponent -= nzap + 1;
    354 			}
    355 		}
    356 		nzbp = 0;
    357 		nzap = 0;
    358 		NEXT;
    359 		nfastlimit = DECIMAL_STRING_LENGTH - 3 - ids;
    360 		if ((0 < nfastlimit) && ('1' <= CURRENT) && (CURRENT <= '9')) {	/* Special handling for
    361 										 * common case. */
    362 			nfast = 0;
    363 			pfast = &(pd->ds[ids]);
    364 			do {
    365 				pfast[nfast++] = CURRENT;
    366 				NEXT;
    367 			}
    368 			while (('1' <= CURRENT) && (CURRENT <= '9') && (nfast < nfastlimit));
    369 			good = cp;
    370 			if (('1' > *good) || (*good > '9'))
    371 				good--;	/* look out if we fell off end */
    372 			ids += nfast;
    373 			pd->exponent -= nfast;
    374 		}
    375 		if (CURRENT == '0')
    376 			goto zeroafterpoint;
    377 		goto switchafterpoint;
    378 	} else
    379 		switch (CURRENT) {
    380 		case ' ':
    381 			if (fortran_conventions < 2)
    382 				goto afterpointdefault;
    383 			if (fortran_conventions == 2) {
    384 				/*
    385 				 * To pass FCVS, all blanks after point must
    386 				 * count as if zero seen.
    387 				 */
    388 				if (sigfound == -1)
    389 					sigfound = 0;
    390 				NEXT;
    391 				goto switchafterpoint;
    392 			}
    393 		case '0':
    394 			if (*pform == fixed_intdot_form)
    395 				*pform = fixed_intdotfrac_form;
    396 			if (sigfound == -1)
    397 				sigfound = 0;
    398 	zeroafterpoint:
    399 			good = cp;
    400 			nzap++;
    401 			NEXT;
    402 			while ((CURRENT == '0') || (CURRENT == ' ')) {
    403 				if (CURRENT == ' ') {	/* Handle blanks and
    404 							 * Fortran. */
    405 					if (fortran_conventions < 2) {
    406 						good = cp - 1;
    407 						goto afterpointdefault;
    408 					}
    409 					if (fortran_conventions == 2) {
    410 						nzap--;	/* Undo following nzap++ */
    411 					}
    412 				}
    413 				nzap++;
    414 				NEXT;
    415 			}
    416 			good = cp;
    417 			if (*good != '0')
    418 				good--;
    419 			goto switchafterpoint;
    420 
    421 		case 'E':
    422 		case 'e':
    423 	efound2:
    424 			*pechar = cp;
    425 			if (sigfound == -1)	/* exp following no digits?
    426 						 * bad! */
    427 				goto done;
    428 			if (sigfound > 0)
    429 				pd->exponent += nzbp;
    430 			goto exponent;
    431 		case '+':
    432 		case '-':
    433 		case 'D':
    434 		case 'd':
    435 		case 'Q':
    436 		case 'q':
    437 			if (fortran_conventions != 0)
    438 				goto efound2;
    439 
    440 		default:
    441 	afterpointdefault:
    442 			if (sigfound > 0)
    443 				pd->exponent += nzbp;
    444 			goto done;
    445 		}
    446 exponent:
    447 	{
    448 		unsigned        explicitsign = 0, explicitexponent = 0;
    449 
    450 		if ((CURRENT != '+') && (CURRENT != '-')) {	/* Skip EeDd and
    451 								 * following blanks. */
    452 			NEXT;	/* Pass the EeDd. */
    453 			if (fortran_conventions >= 2)
    454 				while (CURRENT == ' ') {
    455 					NEXT;
    456 				}
    457 		}
    458 		if (CURRENT == '+') {
    459 			NEXT;
    460 		} else if (CURRENT == '-') {	/* Negative explicit
    461 						 * exponent. */
    462 			NEXT;
    463 			explicitsign = 1;
    464 		}
    465 		while ((('0' <= CURRENT) && (CURRENT <= '9')) || (CURRENT == ' ')) {	/* Accumulate explicit
    466 											 * exponent. */
    467 			if (CURRENT == ' ') {	/* Handle blanks and Fortran. */
    468 				if (fortran_conventions < 2)
    469 					goto doneexp;
    470 				if (fortran_conventions == 2) {
    471 					NEXT;
    472 					goto exploop;
    473 				}
    474 				CURRENT = '0';
    475 			}
    476 			good = cp;
    477 			if (explicitexponent <= 400000000) {
    478 				explicitexponent = 10 * explicitexponent + CURRENT - '0';
    479 			}
    480 			NEXT;
    481 			switch (*pform) {
    482 			case whitespace_form:
    483 			case fixed_int_form:
    484 				*pform = floating_int_form;
    485 				break;
    486 			case fixed_intdot_form:
    487 				*pform = floating_intdot_form;
    488 				break;
    489 			case fixed_dotfrac_form:
    490 				*pform = floating_dotfrac_form;
    491 				break;
    492 			case fixed_intdotfrac_form:
    493 				*pform = floating_intdotfrac_form;
    494 				break;
    495 			}
    496 	exploop:	;
    497 		}
    498 doneexp:
    499 		if (explicitsign == 1)
    500 			pd->exponent -= explicitexponent;
    501 		else
    502 			pd->exponent += explicitexponent;
    503 	}
    504 
    505 done:
    506 	if (fortran_conventions >= 2) {	/* Fill up field width with extra
    507 					 * blanks found. */
    508 		if (good == (cp - 1))
    509 			good = NULL;	/* Flag that whole field was good up
    510 					 * to now. */
    511 		while (CURRENT == ' ') {
    512 			NEXT;
    513 		}
    514 		if (good == NULL) {
    515 			good = CURRENT == NULL ? cp : cp - 1;
    516 		}
    517 	}
    518 	if (sigfound < 1)
    519 		pd->fpclass = fp_zero;	/* True zero found. */
    520 
    521 	pd->ds[ids] = 0;	/* Terminate decimal string. */
    522 	pd->ndigits = ids;	/* Save string length in ndigits. */
    523 	if (good >= cp0) {	/* Valid token found. */
    524 		*ppc = good + 1;/* token found - point one past. */
    525 	} else {		/* No valid token found. */
    526 		*pform = invalid_form;
    527 		*ppc = cp0;	/* No token found - revert to original value. */
    528 		pd->sign = 0;
    529 		pd->fpclass = fp_signaling;	/* If anyone looks, x will be
    530 						 * nan. */
    531 	}
    532 }
    533