source: trunk/MagicSoft/slalib/dfltin.c

Last change on this file was 731, checked in by tbretz, 24 years ago
*** empty log message ***
  • Property svn:executable set to *
File size: 16.5 KB
Line 
1#include "slalib.h"
2#include "slamac.h"
3#include <string.h>
4
5static int idchf ( int, char*, int*, int*, double* );
6
7void slaDfltin ( char *string, int *nstrt, double *dreslt, int *jflag )
8/*
9** - - - - - - - - - -
10** s l a D f l t i n
11** - - - - - - - - - -
12**
13** Convert free-format input into double precision floating point.
14**
15** Given:
16** *string char string containing field to be decoded
17** *nstrt int where to start decode (1st = 1)
18**
19** Returned:
20** *nstrt int advanced to next field
21** *dreslt double result
22** *jflag int -1 = -OK, 0 = +OK, 1 = null field, 2 = error
23**
24** Called: idchf
25**
26** Notes:
27**
28** 1 A tab character is interpreted as a space, and lower
29** case d,e are interpreted as upper case.
30**
31** 2 The basic format is #^.^@#^ where # means + or -,
32** ^ means a decimal subfield and @ means D or E.
33**
34** 3 Spaces:
35** Leading spaces are ignored.
36** Embedded spaces are allowed only after # and D or E,
37** and after . where the first ^ is absent.
38** Trailing spaces are ignored; the first signifies
39** end of decoding and subsequent ones are skipped.
40**
41** 4 Field separators:
42** Any character other than +,-,0-9,.,D,E or space may be
43** used to end a field. Comma is recognized by slaDfltin
44** as a special case; it is skipped, leaving the
45** pointer on the next character. See 12, below.
46**
47** 5 Both signs are optional. The default is +.
48**
49** 6 The mantissa defaults to 1.
50**
51** 7 The exponent defaults to e0.
52**
53** 8 The decimal subfields may be of any length.
54**
55** 9 The decimal point is optional for whole numbers.
56**
57** 10 A null field is one that does not begin with
58** +,-,0-9,.,D or E, or consists entirely of spaces.
59** If the field is null, jflag is set to 1 and dreslt
60** is left untouched.
61**
62** 11 nstrt = 1 for the first character in the string.
63**
64** 12 On return from slaDfltin, nstrt is set ready for the next
65** decode - following trailing blanks and (if used) the
66** comma separator. If a separator other than comma is
67** being used, nstrt must be incremented before the next
68** call to slaDfltin.
69**
70** 13 Errors (jflag=2) occur when:
71** a) A +, -, D or E is left unsatisfied.
72** b) The decimal point is present without at least
73** one decimal subfield.
74** c) An exponent more than 100 has been presented.
75**
76** 14 When an error has been detected, nstrt is left
77** pointing to the character following the last
78** one used before the error came to light. This
79** may be after the point at which a more sophisticated
80** program could have detected the error. For example,
81** slaDfltin does not detect that '1e999' is unacceptable
82** until the whole field has been read.
83**
84** 15 Certain highly unlikely combinations of mantissa &
85** exponent can cause arithmetic faults during the
86** decode, in some cases despite the fact that they
87** together could be construed as a valid number.
88**
89** 16 Decoding is left to right, one pass.
90**
91** 17 End of field may occur in either of two ways:
92** a) As dictated by the string length.
93** b) Detected during the decode.
94** (b overrides a.)
95**
96** 18 See also slaFlotin and slaIntin.
97**
98** Last revision: 6 November 1999
99**
100** Copyright P.T.Wallace. All rights reserved.
101*/
102
103/* Definitions shared between slaDfltin and idchf */
104#define NUMBER 0
105#define SPACE 1
106#define EXPSYM 2
107#define PERIOD 3
108#define PLUS 4
109#define MINUS 5
110#define COMMA 6
111#define OTHER 7
112#define END 8
113
114{
115 int l_string, nptr, ndigit;
116 double digit;
117
118/* Current state of the decode and the values it can take */
119
120 int state;
121
122#define seek_sign 100
123#define neg_mant 200
124#define seek_1st_leading_digit 300
125#define accept_leading_digit 400
126#define seek_digit_when_none_before_pt 500
127#define seek_trailing_digit 600
128#define accept_trailing_digit 700
129#define accept_uns_exp_no_mant 800
130#define seek_sign_exp 900
131#define neg_exp 1000
132#define seek_1st_exp_digit 1100
133#define accept_exp_digit 1200
134#define end_of_field 1300
135#define build_result 1310
136#define seeking_end_of_field 1620
137#define next_field_OK 1720
138#define next_field_default 9100
139#define null_field 9110
140#define next_field_error 9200
141#define error 9210
142#define done 9900
143
144
145 int msign, nexp, ndp, isignx, j;
146 double dmant;
147
148
149/* Find string length */
150 l_string = strlen ( string );
151
152/* Current character index */
153 nptr = *nstrt - 1;
154
155/* Set defaults: mantissa & sign, exponent & sign, decimal place count */
156 dmant = 0.0;
157 msign = 1;
158 nexp = 0;
159 isignx = 1;
160 ndp = 0;
161
162/* Initialize state to "looking for sign" */
163 state = seek_sign;
164
165/* Loop until decode is complete */
166 while ( state != done ) {
167 switch ( state ) {
168
169 case seek_sign :
170
171 /* Look for sign */
172 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
173 case NUMBER :
174 state = accept_leading_digit;
175 break;
176 case SPACE :
177 state = seek_sign;
178 break;
179 case EXPSYM :
180 state = accept_uns_exp_no_mant;
181 break;
182 case PERIOD :
183 state = seek_digit_when_none_before_pt;
184 break;
185 case PLUS :
186 state = seek_1st_leading_digit;
187 break;
188 case MINUS :
189 state = neg_mant;
190 break;
191 case OTHER :
192 state = next_field_default;
193 break;
194 case COMMA :
195 case END :
196 state = null_field;
197 break;
198 default :
199 state = error;
200 }
201 break;
202
203 case neg_mant :
204
205 /* Negative mantissa */
206 msign = -1;
207
208 case seek_1st_leading_digit :
209
210 /* Look for first leading decimal */
211 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
212 case NUMBER :
213 state = accept_leading_digit;
214 break;
215 case SPACE :
216 state = seek_1st_leading_digit;
217 break;
218 case EXPSYM :
219 state = accept_uns_exp_no_mant;
220 break;
221 case PERIOD :
222 state = seek_digit_when_none_before_pt;
223 break;
224 case PLUS :
225 case MINUS :
226 case COMMA :
227 case OTHER :
228 state = next_field_error;
229 break;
230 case END :
231 default :
232 state = error;
233 }
234 break;
235
236 case accept_leading_digit :
237
238 /* Accept leading decimals */
239 dmant = dmant * 1e1 + digit;
240 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
241 case NUMBER :
242 state = accept_leading_digit;
243 break;
244 case SPACE :
245 state = build_result;
246 break;
247 case EXPSYM :
248 state = seek_sign_exp;
249 break;
250 case PERIOD :
251 state = seek_trailing_digit;
252 break;
253 case PLUS :
254 case MINUS :
255 case COMMA :
256 case OTHER :
257 state = end_of_field;
258 break;
259 case END :
260 state = build_result;
261 break;
262 default :
263 state = error;
264 }
265 break;
266
267 case seek_digit_when_none_before_pt :
268
269 /* Look for decimal when none preceded the point */
270 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
271 case NUMBER :
272 state = accept_trailing_digit;
273 break;
274 case SPACE :
275 state = seek_digit_when_none_before_pt;
276 break;
277 case EXPSYM :
278 case PERIOD :
279 case PLUS :
280 case MINUS :
281 case COMMA :
282 case OTHER :
283 state = next_field_error;
284 break;
285 case END :
286 default :
287 state = error;
288 }
289 break;
290
291 case seek_trailing_digit :
292
293 /* Look for trailing decimals */
294 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
295 case NUMBER :
296 state = accept_trailing_digit;
297 break;
298 case EXPSYM :
299 state = seek_sign_exp;
300 break;
301 case PERIOD :
302 case PLUS :
303 case MINUS :
304 case COMMA :
305 case OTHER :
306 state = end_of_field;
307 break;
308 case SPACE :
309 case END :
310 state = build_result;
311 break;
312 default :
313 state = error;
314 }
315 break;
316
317 case accept_trailing_digit :
318
319 /* Accept trailing decimals */
320 ndp++;
321 dmant = dmant * 1e1 + digit;
322 state = seek_trailing_digit;
323 break;
324
325 case accept_uns_exp_no_mant :
326
327 /* Exponent symbol first in field: default mantissa to 1 */
328 dmant = 1.0;
329
330 case seek_sign_exp :
331
332 /* Look for sign of exponent */
333 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
334 case NUMBER :
335 state = accept_exp_digit;
336 break;
337 case SPACE :
338 state = seek_sign_exp;
339 break;
340 case PLUS :
341 state = seek_1st_exp_digit;
342 break;
343 case MINUS :
344 state = neg_exp;
345 break;
346 case EXPSYM :
347 case PERIOD :
348 case COMMA :
349 case OTHER :
350 state = next_field_error;
351 break;
352 case END :
353 default :
354 state = error;
355 }
356 break;
357
358 case neg_exp :
359
360 /* Exponent negative */
361 isignx = -1;
362
363 case seek_1st_exp_digit :
364
365 /* Look for first digit of exponent */
366 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
367 case NUMBER :
368 state = accept_exp_digit;
369 break;
370 case SPACE :
371 state = seek_1st_exp_digit;
372 break;
373 case EXPSYM :
374 case PERIOD :
375 case PLUS :
376 case MINUS :
377 case COMMA :
378 case OTHER :
379 state = next_field_error;
380 break;
381 case END :
382 default :
383 state = error;
384 }
385 break;
386
387 case accept_exp_digit :
388
389 /* Use exponent digit */
390 nexp = nexp * 10 + ndigit;
391 if ( nexp > 100 ) {
392 state = next_field_error;
393 } else {
394
395 /* Look for subsequent digits of exponent */
396 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
397 case NUMBER :
398 state = accept_exp_digit;
399 break;
400 case SPACE :
401 state = build_result;
402 break;
403 case EXPSYM :
404 case PERIOD :
405 case PLUS :
406 case MINUS :
407 case COMMA :
408 case OTHER :
409 state = end_of_field;
410 break;
411 case END :
412 state = build_result;
413 break;
414 default :
415 state = error;
416 }
417 }
418 break;
419
420 case end_of_field :
421
422 /* Off the end of the field: move pointer back */
423 nptr--;
424
425 case build_result :
426
427 /* Combine exponent and decimal place count */
428 nexp = nexp * isignx - ndp;
429
430 /* Sign of exponent? */
431 if ( nexp >= 0 ) {
432
433 /* Positive exponent: scale up */
434 while ( nexp >= 10 ) {
435 dmant *= 1e10;
436 nexp -= 10;
437 }
438 while ( nexp >= 1 ) {
439 dmant *= 1e1;
440 nexp--;
441 }
442 } else {
443
444 /* Negative exponent: scale down */
445 while ( nexp <= -10 ) {
446 dmant /= 1e10;
447 nexp += 10;
448 }
449 while ( nexp <= -1 ) {
450 dmant /= 1e1;
451 nexp++;
452 }
453 }
454
455 /* Get result & status */
456 if ( msign == 1 ) {
457 *dreslt = dmant;
458 j = 0;
459 } else {
460 *dreslt = -dmant;
461 j = -1;
462 }
463
464 case seeking_end_of_field :
465
466 /* Skip to end of field */
467 switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) {
468 case SPACE :
469 state = seeking_end_of_field;
470 break;
471 case NUMBER :
472 case EXPSYM :
473 case PERIOD :
474 case PLUS :
475 case MINUS :
476 case OTHER :
477 state = next_field_OK;
478 break;
479 case COMMA :
480 case END :
481 state = done;
482 break;
483 default :
484 state = error;
485 }
486 break;
487
488 case next_field_OK :
489
490 /* Next field terminates successful decode */
491 nptr--;
492 state = done;
493 break;
494
495 case next_field_default :
496
497 /* Next field terminates null decode */
498 nptr--;
499
500 case null_field :
501
502 /* Null decode */
503 j = 1;
504 state = done;
505 break;
506
507 case next_field_error :
508
509 /* Next field detected prematurely */
510 nptr--;
511
512 case error :
513
514 /* Decode has failed: set bad status */
515 j = 2;
516 state = done;
517 break;
518
519 default :
520 state = error;
521 }
522 }
523
524/* Finished: return updated pointer and the status */
525 *nstrt = nptr + 1;
526 *jflag = j;
527}
528
529static int idchf ( int l_string, char *string,
530 int *nptr, int *ndigit, double *digit )
531/*
532** - - - - -
533** i d c h f
534** - - - - -
535**
536** Internal routine used by slaDfltin:
537**
538** identify next character in string.
539**
540** Given:
541** l_string int length of string
542** string char* string
543** nptr int* character to be identified (1st = 0)
544**
545** Returned:
546** nptr int* incremented unless end of field
547** ndigit int* 0-9 if character was a numeral
548** digit double* (double) ndigit
549**
550** Returned (function value):
551** idchf int vector for identified character:
552**
553** value meaning
554**
555** NUMBER 0-9
556** SPACE space or tab
557** EXPSYM D, d, E or e
558** PERIOD .
559** PLUS +
560** MINUS -
561** COMMA ,
562** OTHER else
563** END outside field
564**
565** Last revision: 24 June 1996
566**
567** Copyright P.T.Wallace. All rights reserved.
568*/
569{
570 int ivec, ictab;
571 char c;
572
573/* Character/vector tables */
574
575#define NCREC (20)
576 static char kctab[NCREC] = { '0','1','2','3','4','5',
577 '6','7','8','9',
578 ' ','\t',
579 'D','d','E','e',
580 '.',
581 '+',
582 '-',
583 ',' };
584
585 static int kvtab[NCREC] = { NUMBER, NUMBER, NUMBER, NUMBER, NUMBER,
586 NUMBER, NUMBER, NUMBER, NUMBER, NUMBER,
587 SPACE, SPACE,
588 EXPSYM, EXPSYM, EXPSYM, EXPSYM,
589 PERIOD,
590 PLUS,
591 MINUS,
592 COMMA };
593
594
595/* Initialize returned value */
596 ivec = OTHER;
597
598/* Pointer outside field? */
599 if ( *nptr < 0 || *nptr >= l_string ) {
600
601 /* Yes: prepare returned value */
602 ivec = END;
603
604 } else {
605
606 /* Not end of field: identify character */
607 c = string [ *nptr ];
608 for ( ictab = 0; ictab < NCREC; ictab++ ) {
609 if ( kctab [ ictab ] == c ) {
610
611 /* Recognized */
612 ivec = kvtab [ ictab ];
613
614 /* Allow for numerals */
615 *ndigit = ictab;
616 *digit = (double) *ndigit;
617
618 /* Quit the loop */
619 break;
620 }
621 }
622
623 /* Increment pointer */
624 ( *nptr )++;
625 }
626
627/* Return the value identifying the character */
628 return ivec;
629}
Note: See TracBrowser for help on using the repository browser.