1 /*
2 *+
3 * Name:
4 * palDfltin
5
6 * Purpose:
7 * Convert free-format input into double precision floating point
8
9 * Language:
10 * Starlink ANSI C
11
12 * Type of Module:
13 * Library routine
14
15 * Invocation:
16 * void palDfltin( const char * string, int *nstrt,
17 * double *dreslt, int *jflag );
18
19 * Arguments:
20 * string = const char * (Given)
21 * String containing number to be decoded.
22 * nstrt = int * (Given and Returned)
23 * Character number indicating where decoding should start.
24 * On output its value is updated to be the location of the
25 * possible next value. For compatibility with SLA the first
26 * character is index 1.
27 * dreslt = double * (Returned)
28 * Result. Not updated when jflag=1.
29 * jflag = int * (Returned)
30 * status: -1 = -OK, 0 = +OK, 1 = null, 2 = error
31
32 * Description:
33 * Extracts a number from an input string starting at the specified
34 * index.
35
36 * Authors:
37 * TIMJ: Tim Jenness (JAC, Hawaii)
38 * {enter_new_authors_here}
39
40 * Notes:
41 * - Uses the strtod() system call to do the parsing. This may lead to
42 * subtle differences when compared to the SLA/F parsing.
43 * - All "D" characters are converted to "E" to handle fortran exponents.
44 * - Commas are recognized as a special case and are skipped if one happens
45 * to be the next character when updating nstrt. Additionally the output
46 * nstrt position will skip past any trailing space.
47 * - If no number can be found flag will be set to 1.
48 * - If the number overflows or underflows jflag will be set to 2. For overflow
49 * the returned result will have the value HUGE_VAL, for underflow it
50 * will have the value 0.0.
51 * - For compatiblity with SLA/F -0 will be returned as "0" with jflag == -1.
52 * - Unlike slaDfltin a standalone "E" will return status 1 (could not find
53 * a number) rather than 2 (bad number).
54
55 * Implementation Status:
56 * - The code is more robust if the C99 copysign() function is available.
57 * This can recognize the -0.0 values returned by strtod. If copysign() is
58 * missing we try to scan the string looking for minus signs.
59
60 * History:
61 * 2012-03-08 (TIMJ):
62 * Initial version based on strtod
63 * Adapted with permission from the Fortran SLALIB library
64 * although this is a completely distinct implementation of the SLA API.
65 * 2012-06-21 (TIMJ):
66 * Provide a backup for missing copysign.
67 * 2012-06-22 (TIMJ):
68 * Check __STDC_VERSION__
69 * {enter_further_changes_here}
70
71 * Copyright:
72 * Copyright (C) 2012 Science and Technology Facilities Council.
73 * All Rights Reserved.
74
75 * Licence:
76 * This program is free software; you can redistribute it and/or
77 * modify it under the terms of the GNU General Public License as
78 * published by the Free Software Foundation; either version 3 of
79 * the License, or (at your option) any later version.
80 *
81 * This program is distributed in the hope that it will be
82 * useful, but WITHOUT ANY WARRANTY; without even the implied
83 * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
84 * PURPOSE. See the GNU General Public License for more details.
85 *
86 * You should have received a copy of the GNU General Public License
87 * along with this program; if not, write to the Free Software
88 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
89 * MA 02110-1301, USA.
90
91 * Bugs:
92 * {note_any_bugs_here}
93 *-
94 */
95
96 /* Use the config file if we have one, else look at
97 compiler defines to see if we have C99 */
98 #if HAVE_CONFIG_H
99 #include <config.h>
100 #else
101 #ifdef __STDC_VERSION__
102 # if (__STDC_VERSION__ >= 199901L)
103 # define HAVE_COPYSIGN 1
104 # endif
105 #endif
106 #endif
107
108 /* isblank() is a C99 feature so we just reimplement it if it is missing */
109 #if HAVE_ISBLANK
110 #define _POSIX_C_SOURCE 200112L
111 #define _ISOC99_SOURCE
112 #include <ctype.h>
113 # define ISBLANK isblank
114 #else
115
ISBLANK(int c)116 static int ISBLANK( int c ) {
117 return ( c == ' ' || c == '\t' );
118 }
119
120 #endif
121
122 #ifdef HAVE_BSD_STRING_H
123 #include <bsd/string.h>
124 #endif
125
126 /* System include files */
127 #include <stdlib.h>
128 #include <string.h>
129 #include <errno.h>
130 #include <ctype.h>
131
132 #include "pal.h"
133
134 #if HAVE_COPYSIGN
135 # define SCAN_FOR_MINUS 0
136 #else
137 # define SCAN_FOR_MINUS 1
138 #endif
139
140 /* We prefer to use the starutil package */
141 #if HAVE_STAR_UTIL_H
142 # include "star/util.h"
143 #else
144 #endif
145
palDfltin(const char * string,int * nstrt,double * dreslt,int * jflag)146 void palDfltin( const char * string, int *nstrt,
147 double *dreslt, int *jflag ) {
148
149 char * ctemp = NULL; /* Pointer into string */
150 char * endptr = NULL;/* Pointer to string after number */
151 double retval; /* Return value from strtod */
152
153 /* We have to copy the string in order to modify the exponents
154 from Fortran style. Rather than using malloc we have a static
155 buffer. Technically we only have to do the copy if we have a
156 D or d in the string. */
157 char tempbuf[256];
158
159 #if SCAN_FOR_MINUS
160 int dreslt_sign = 1;
161 int ipos = *nstrt;
162 const char * cctemp = NULL;
163
164 /* Scan the string looking for a minus sign. Then update the
165 start position for the subsequent copy iff we find a '-'.
166 Note that commas are a special delimiter so we stop looking for a
167 minus if we find one or if we find a digit. */
168 cctemp = &(string[ipos-1]);
169 while (!isdigit(*cctemp) && (*cctemp != ',') && (*cctemp != '\0')) {
170 if (*cctemp == '-') {
171 *nstrt = ipos;
172 dreslt_sign = -1;
173 break;
174 }
175 ipos++;
176 cctemp++;
177 }
178 #endif
179
180 /* Correct for SLA use of fortran convention */
181 #if HAVE_STAR_UTIL_H
182 star_strlcpy( tempbuf, &(string[*nstrt-1]), sizeof(tempbuf) );
183 #else
184 # if HAVE_STRLCPY
185 strlcpy( tempbuf, &(string[*nstrt-1]), sizeof(tempbuf) );
186 # else
187 /* Use standard C interface */
188 strncpy( tempbuf, &(string[*nstrt-1]), sizeof(tempbuf));
189 tempbuf[sizeof(tempbuf)-1] = '\0';
190 # endif
191 #endif
192
193 /* Convert d or D to E */
194 ctemp = tempbuf;
195 while (*ctemp != '\0') {
196 if (*ctemp == 'd' || *ctemp == 'D') *ctemp = 'E';
197 ctemp++;
198 }
199
200 /* strtod man page indicates that we should reset errno before
201 calling strtod */
202 errno = 0;
203
204 /* We know we are starting at the beginning of the string now */
205 retval = strtod( tempbuf, &endptr );
206 if (retval == 0.0 && endptr == tempbuf) {
207 /* conversion did not find anything */
208 *jflag = 1;
209
210 /* but SLA compatibility requires that we step
211 through to remove leading spaces. We also step
212 through alphabetic characters since they can never
213 be numbers standalone (no number starts with an 'E') */
214 while (ISBLANK(*endptr) || isalpha(*endptr) ) {
215 endptr++;
216 }
217
218 } else if ( errno == ERANGE ) {
219 *jflag = 2;
220 } else {
221 #if SCAN_FOR_MINUS
222 *jflag = (dreslt_sign < 0 ? -1 : 0);
223 #else
224 if ( retval < 0.0 ) {
225 *jflag = -1;
226 } else if ( retval == 0.0 ) {
227 /* Need to distinguish -0 from +0 */
228 double test = copysign( 1.0, retval );
229 if ( test < 0.0 ) {
230 *jflag = -1;
231 } else {
232 *jflag = 0;
233 }
234 } else {
235 *jflag = 0;
236 }
237 #endif
238 }
239
240 /* Sort out the position for the next index */
241 *nstrt += endptr - tempbuf;
242
243 /* Skip a comma */
244 if (*endptr == ',') {
245 (*nstrt)++;
246 } else {
247 /* jump past any leading spaces for the next part of the string */
248 ctemp = endptr;
249 while ( ISBLANK(*ctemp) ) {
250 (*nstrt)++;
251 ctemp++;
252 }
253 }
254
255 /* And the result unless we found nothing */
256 if (*jflag != 1) *dreslt = retval;
257
258 }
259