Commit | Line | Data |
---|---|---|
25b64855 JB |
1 | /* |
2 | * Copyright (c) 1980 Regents of the University of California. | |
3 | * All rights reserved. The Berkeley software License Agreement | |
4 | * specifies the terms and conditions for redistribution. | |
5 | * | |
a59237a4 | 6 | * @(#)rsnmle.c 5.4 %G% |
25b64855 JB |
7 | */ |
8 | ||
9 | /* | |
10 | * name-list read | |
11 | */ | |
12 | ||
13 | #include "fio.h" | |
14 | #include "lio.h" | |
15 | #include "nmlio.h" | |
16 | #include <ctype.h> | |
17 | ||
b0df27de | 18 | LOCAL char *nml_rd; |
25b64855 JB |
19 | |
20 | static int ch; | |
e8492a6c JB |
21 | LOCAL nameflag; |
22 | LOCAL char var_name[VL+1]; | |
25b64855 JB |
23 | |
24 | #define SP 1 | |
25 | #define B 2 | |
26 | #define AP 4 | |
27 | #define EX 8 | |
e8492a6c JB |
28 | #define INTG 16 |
29 | #define RL 32 | |
30 | #define LGC 64 | |
31 | #define IRL (INTG | RL | LGC ) | |
25b64855 JB |
32 | #define isblnk(x) (ltab[x+1]&B) /* space, tab, newline */ |
33 | #define issep(x) (ltab[x+1]&SP) /* space, tab, newline, comma */ | |
34 | #define isapos(x) (ltab[x+1]&AP) /* apost., quote mark */ | |
35 | #define isexp(x) (ltab[x+1]&EX) /* d, e, D, E */ | |
e8492a6c JB |
36 | #define isint(x) (ltab[x+1]&INTG) /* 0-9, plus, minus */ |
37 | #define isrl(x) (ltab[x+1]&RL) /* 0-9, plus, minus, period */ | |
38 | #define islgc(x) (ltab[x+1]&LGC) /* 0-9, period, t, f, T, F */ | |
25b64855 | 39 | |
b0df27de | 40 | #define GETC (ch=t_getc()) |
25b64855 JB |
41 | #define UNGETC() ungetc(ch,cf) |
42 | ||
43 | LOCAL char *lchar; | |
44 | LOCAL double lx,ly; | |
45 | LOCAL int ltype; | |
46 | int t_getc(), ungetc(); | |
47 | ||
48 | LOCAL char ltab[128+1] = | |
49 | { 0, /* offset one for EOF */ | |
e8492a6c JB |
50 | /* 0- 15 */ 0,0,0,0,0,0,0,0,0,SP|B,SP|B,0,0,0,0,0, /* TAB,NEWLINE */ |
51 | /* 16- 31 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
52 | /* 32- 47 */ SP|B,0,AP,0,0,0,0,AP,0,0,0,RL|INTG,SP,RL|INTG,RL|LGC,0, /* space,",',comma,., */ | |
53 | /* 48- 63 */ IRL,IRL,IRL,IRL,IRL,IRL,IRL,IRL,IRL,IRL,0,0,0,0,0,0, /* digits */ | |
54 | /* 64- 79 */ 0,0,0,0,EX,EX,LGC,0,0,0,0,0,0,0,0,0, /* D,E,F */ | |
55 | /* 80- 95 */ 0,0,0,0,LGC,0,0,0,0,0,0,0,0,0,0,0, /* T */ | |
56 | /* 96-111 */ 0,0,0,0,EX,EX,LGC,0,0,0,0,0,0,0,0,0, /* d,e,f */ | |
57 | /* 112-127 */ 0,0,0,0,LGC,0,0,0,0,0,0,0,0,0,0,0 /* t */ | |
25b64855 JB |
58 | }; |
59 | ||
60 | s_rsne(a) namelist_arglist *a; | |
61 | { | |
b0df27de | 62 | int n; |
25b64855 JB |
63 | struct namelistentry *entry; |
64 | int nelem, vlen, vtype; | |
65 | char *nmlist_nm, *addr; | |
25b64855 | 66 | |
b0df27de | 67 | nml_rd = "namelist read"; |
25b64855 JB |
68 | reading = YES; |
69 | formatted = NAMELIST; | |
70 | fmtbuf = "ext namelist io"; | |
71 | if(n=c_le(a,READ)) return(n); | |
25b64855 JB |
72 | getn = t_getc; |
73 | ungetn = ungetc; | |
74 | leof = curunit->uend; | |
25b64855 JB |
75 | if(curunit->uwrt && ! nowreading(curunit)) err(errflag, errno, nml_rd) |
76 | ||
77 | /* look for " &namelistname " */ | |
78 | nmlist_nm = a->namelist->namelistname; | |
b0df27de | 79 | while(isblnk(GETC)) ; |
25b64855 JB |
80 | /* check for "&end" (like IBM) or "$end" (like DEC) */ |
81 | if(ch != '&' && ch != '$') goto rderr; | |
82 | /* save it - write out using the same character as used on input */ | |
83 | namelistkey_ = ch; | |
84 | while( *nmlist_nm ) | |
b0df27de JB |
85 | if( GETC != *nmlist_nm++ ) |
86 | { | |
87 | nml_rd = "incorrect namelist name"; | |
88 | goto rderr; | |
89 | } | |
90 | if(!isblnk(GETC)) goto rderr; | |
91 | while(isblnk(GETC)) ; | |
25b64855 JB |
92 | if(leof) goto rderr; |
93 | UNGETC(); | |
94 | ||
b0df27de | 95 | while( GETC != namelistkey_ ) |
25b64855 | 96 | { |
e8492a6c | 97 | UNGETC(); |
25b64855 | 98 | /* get variable name */ |
e8492a6c JB |
99 | if(!nameflag && rd_name(var_name)) goto rderr; |
100 | ||
25b64855 JB |
101 | entry = a->namelist->names; |
102 | /* loop through namelist entries looking for this variable name */ | |
103 | while( entry->varname[0] != 0 ) | |
104 | { | |
105 | if( strcmp(entry->varname, var_name) == 0 ) goto got_name; | |
106 | entry++; | |
107 | } | |
b0df27de | 108 | nml_rd = "incorrect variable name"; |
25b64855 JB |
109 | goto rderr; |
110 | got_name: | |
e8492a6c | 111 | if( n = get_pars( entry, &addr, &nelem, &vlen, &vtype )) |
25b64855 | 112 | goto rderr_n; |
b0df27de | 113 | while(isblnk(GETC)) ; |
25b64855 | 114 | if(ch != '=') goto rderr; |
e8492a6c JB |
115 | |
116 | nameflag = NO; | |
b0df27de JB |
117 | if(n = l_read( nelem, addr, vlen, vtype )) goto rderr_n; |
118 | while(isblnk(GETC)); | |
119 | if(ch == ',') while(isblnk(GETC)); | |
25b64855 JB |
120 | UNGETC(); |
121 | if(leof) goto rderr; | |
122 | } | |
25b64855 | 123 | /* check for 'end' after '&' or '$'*/ |
b0df27de | 124 | if(GETC!='e' || GETC!='n' || GETC!='d' ) |
25b64855 JB |
125 | goto rderr; |
126 | /* flush to next input record */ | |
127 | flush: | |
b0df27de | 128 | while(GETC != '\n' && ch != EOF); |
25b64855 JB |
129 | return(ch == EOF ? EOF : OK); |
130 | ||
131 | rderr: | |
132 | if(leof) | |
b0df27de | 133 | n = EOF; |
25b64855 | 134 | else |
b0df27de JB |
135 | n = F_ERNMLIST; |
136 | rderr_n: | |
137 | if(n == EOF ) err(endflag,EOF,nml_rd); | |
138 | /* flush after error in case restart I/O */ | |
139 | if(ch != '\n') while(GETC != '\n' && ch != EOF) ; | |
140 | err(errflag,n,nml_rd) | |
25b64855 JB |
141 | } |
142 | ||
143 | #define MAXSUBS 7 | |
144 | ||
145 | LOCAL | |
146 | get_pars( entry, addr, nelem, vlen, vtype ) | |
147 | struct namelistentry *entry; | |
148 | char **addr; /* beginning address to read into */ | |
149 | int *nelem, /* number of elements to read */ | |
150 | *vlen, /* length of elements */ | |
151 | *vtype; /* type of elements */ | |
152 | { | |
153 | int offset, i, n, | |
154 | *dimptr, /* points to dimensioning info */ | |
155 | ndim, /* number of dimensions */ | |
156 | baseoffset, /* offset of corner element */ | |
157 | *span, /* subscript span for each dimension */ | |
158 | subs[MAXSUBS], /* actual subscripts */ | |
159 | subcnt = -1; /* number of actual subscripts */ | |
160 | ||
161 | ||
162 | /* get element size and base address */ | |
163 | *vlen = entry->typelen; | |
164 | *addr = entry->varaddr; | |
165 | ||
166 | /* get type */ | |
167 | switch ( *vtype = entry->type ) { | |
168 | case TYSHORT: | |
169 | case TYLONG: | |
170 | case TYREAL: | |
171 | case TYDREAL: | |
172 | case TYCOMPLEX: | |
173 | case TYDCOMPLEX: | |
174 | case TYLOGICAL: | |
175 | case TYCHAR: | |
176 | break; | |
177 | default: | |
e8492a6c | 178 | fatal(F_ERSYS,"unknown type in rsnmle"); |
25b64855 JB |
179 | } |
180 | ||
181 | /* get number of elements */ | |
182 | dimptr = entry->dimp; | |
183 | if( dimptr==NULL ) | |
184 | { /* scalar */ | |
185 | *nelem = 1; | |
186 | return(OK); | |
187 | } | |
188 | ||
b0df27de | 189 | if( GETC != '(' ) |
25b64855 JB |
190 | { /* entire array */ |
191 | *nelem = dimptr[1]; | |
192 | UNGETC(); | |
193 | return(OK); | |
194 | } | |
195 | ||
196 | /* get element length, number of dimensions, base, span vector */ | |
197 | ndim = dimptr[0]; | |
198 | if(ndim<=0 || ndim>MAXSUBS) fatal(F_ERSYS,"illegal dimensions"); | |
199 | baseoffset = dimptr[2]; | |
200 | span = dimptr+3; | |
201 | ||
202 | /* get subscripts from input data */ | |
203 | while(ch!=')') { | |
204 | if( ++subcnt > MAXSUBS-1 ) return F_ERNMLIST; | |
205 | if(n=get_int(&subs[subcnt])) return n; | |
b0df27de | 206 | GETC; |
25b64855 JB |
207 | if(leof) return EOF; |
208 | if(ch != ',' && ch != ')') return F_ERNMLIST; | |
209 | } | |
210 | if( ++subcnt != ndim ) return F_ERNMLIST; | |
211 | ||
212 | offset = subs[ndim-1]; | |
213 | for( i = ndim-2; i>=0; i-- ) | |
214 | offset = subs[i] + span[i]*offset; | |
215 | offset -= baseoffset; | |
216 | *nelem = dimptr[1] - offset; | |
25b64855 JB |
217 | if( offset < 0 || offset >= dimptr[1] ) |
218 | return F_ERNMLIST; | |
219 | *addr = *addr + (*vlen)*offset; | |
220 | return OK; | |
221 | } | |
222 | ||
223 | LOCAL | |
224 | get_int(subval) | |
225 | int *subval; | |
226 | { | |
227 | int sign=0, value=0, cnt=0; | |
228 | ||
229 | /* look for sign */ | |
b0df27de | 230 | if(GETC == '-') sign = -1; |
25b64855 JB |
231 | else if(ch == '+') ; |
232 | else UNGETC(); | |
233 | if(ch == EOF) return(EOF); | |
234 | ||
b0df27de | 235 | while(isdigit(GETC)) |
25b64855 JB |
236 | { |
237 | value = 10*value + ch-'0'; | |
238 | cnt++; | |
239 | } | |
240 | UNGETC(); | |
a59237a4 | 241 | if(ch == EOF) return EOF; |
25b64855 JB |
242 | if(cnt == 0 ) return F_ERNMLIST; |
243 | if(sign== -1) value = -value; | |
244 | *subval = value; | |
245 | return OK; | |
246 | } | |
247 | ||
248 | LOCAL | |
249 | rd_name(ptr) | |
250 | char *ptr; | |
251 | { | |
252 | /* read a variable name from the input stream */ | |
253 | char *init = ptr-1; | |
254 | ||
b0df27de | 255 | if(!isalpha(GETC)) { |
25b64855 JB |
256 | UNGETC(); |
257 | return(ERROR); | |
258 | } | |
259 | *ptr++ = ch; | |
b0df27de | 260 | while(isalnum(GETC)) |
25b64855 JB |
261 | { |
262 | if(ptr-init > VL ) return(ERROR); | |
263 | *ptr++ = ch; | |
264 | } | |
265 | *ptr = '\0'; | |
266 | UNGETC(); | |
267 | return(OK); | |
268 | } | |
269 | ||
270 | LOCAL | |
271 | t_getc() | |
272 | { int ch; | |
273 | static newline = YES; | |
274 | rd: | |
275 | if(curunit->uend) { | |
276 | leof = EOF; | |
277 | return(EOF); | |
278 | } | |
279 | if((ch=getc(cf))!=EOF) | |
280 | { | |
281 | if(ch == '\n') newline = YES; | |
282 | else if(newline==YES) | |
283 | { /* skip first character on each line for namelist */ | |
284 | newline = NO; | |
285 | goto rd; | |
286 | } | |
287 | return(ch); | |
288 | } | |
289 | if(feof(cf)) | |
290 | { curunit->uend = YES; | |
291 | leof = EOF; | |
292 | } | |
293 | else clearerr(cf); | |
294 | return(EOF); | |
295 | } | |
296 | ||
297 | LOCAL | |
298 | l_read(number,ptr,len,type) ftnint number,type; flex *ptr; ftnlen len; | |
299 | { int i,n; | |
300 | double *yy; | |
301 | float *xx; | |
e8492a6c JB |
302 | |
303 | lcount = 0; | |
25b64855 JB |
304 | for(i=0;i<number;i++) |
305 | { | |
306 | if(leof) return EOF; | |
e8492a6c | 307 | if(lcount==0) |
25b64855 | 308 | { |
e8492a6c JB |
309 | ltype = NULL; |
310 | if(i!=0) | |
311 | { /* skip to comma */ | |
b0df27de | 312 | while(isblnk(GETC)); |
e8492a6c JB |
313 | if(leof) return(EOF); |
314 | if(ch == namelistkey_) | |
315 | { UNGETC(); | |
316 | return(OK); | |
317 | } | |
318 | if(ch != ',' ) return(F_ERNMLIST); | |
319 | } | |
b0df27de | 320 | while(isblnk(GETC)); |
e8492a6c | 321 | if(leof) return(EOF); |
25b64855 | 322 | UNGETC(); |
e8492a6c | 323 | if(i!=0 && ch == namelistkey_) return(OK); |
25b64855 JB |
324 | |
325 | switch((int)type) | |
326 | { | |
327 | case TYSHORT: | |
328 | case TYLONG: | |
e8492a6c JB |
329 | if(!isint(ch)) return(OK); |
330 | ERRNM(l_R(1)); | |
331 | break; | |
25b64855 JB |
332 | case TYREAL: |
333 | case TYDREAL: | |
e8492a6c | 334 | if(!isrl(ch)) return(OK); |
25b64855 JB |
335 | ERRNM(l_R(1)); |
336 | break; | |
337 | case TYCOMPLEX: | |
338 | case TYDCOMPLEX: | |
e8492a6c | 339 | if(!isdigit(ch) && ch!='(') return(OK); |
25b64855 JB |
340 | ERRNM(l_C()); |
341 | break; | |
342 | case TYLOGICAL: | |
e8492a6c | 343 | if(!islgc(ch)) return(OK); |
25b64855 | 344 | ERRNM(l_L()); |
e8492a6c | 345 | if(nameflag) return(OK); |
25b64855 JB |
346 | break; |
347 | case TYCHAR: | |
e8492a6c | 348 | if(!isdigit(ch) && !isapos(ch)) return(OK); |
25b64855 JB |
349 | ERRNM(l_CHAR()); |
350 | break; | |
351 | } | |
25b64855 | 352 | |
e8492a6c JB |
353 | if(leof) return(EOF); |
354 | /* peek at next character - | |
355 | should be separator or namelistkey_ */ | |
b0df27de | 356 | GETC; UNGETC(); |
e8492a6c | 357 | if(!issep(ch) && (ch != namelistkey_)) |
25b64855 | 358 | return( leof?EOF:F_ERNMLIST ); |
e8492a6c | 359 | } |
25b64855 | 360 | |
e8492a6c JB |
361 | if(!ltype) return(F_ERNMLIST); |
362 | switch((int)type) | |
25b64855 JB |
363 | { |
364 | case TYSHORT: | |
365 | ptr->flshort=lx; | |
366 | break; | |
367 | case TYLOGICAL: | |
368 | if(len == sizeof(short)) | |
369 | ptr->flshort = lx; | |
370 | else | |
371 | ptr->flint = lx; | |
372 | break; | |
373 | case TYLONG: | |
374 | ptr->flint=lx; | |
375 | break; | |
376 | case TYREAL: | |
377 | ptr->flreal=lx; | |
378 | break; | |
379 | case TYDREAL: | |
380 | ptr->fldouble=lx; | |
381 | break; | |
382 | case TYCOMPLEX: | |
383 | xx=(float *)ptr; | |
384 | *xx++ = ly; | |
385 | *xx = lx; | |
386 | break; | |
387 | case TYDCOMPLEX: | |
388 | yy=(double *)ptr; | |
389 | *yy++ = ly; | |
390 | *yy = lx; | |
391 | break; | |
392 | case TYCHAR: | |
393 | b_char(lchar,(char *)ptr,len); | |
394 | break; | |
395 | } | |
396 | if(lcount>0) lcount--; | |
397 | ptr = (flex *)((char *)ptr + len); | |
398 | } | |
399 | if(lcount>0) return F_ERNMLIST; | |
400 | return(OK); | |
401 | } | |
402 | ||
25b64855 JB |
403 | LOCAL |
404 | get_repet() | |
b0df27de | 405 | { |
25b64855 | 406 | double lc; |
b0df27de | 407 | if(isdigit(GETC)) |
25b64855 JB |
408 | { UNGETC(); |
409 | rd_int(&lc); | |
410 | lcount = (int)lc; | |
b0df27de | 411 | if(GETC!='*') |
25b64855 JB |
412 | if(leof) return(EOF); |
413 | else return(F_ERREPT); | |
414 | } | |
415 | else | |
416 | { lcount = 1; | |
417 | UNGETC(); | |
418 | } | |
419 | return(OK); | |
420 | } | |
421 | ||
422 | LOCAL | |
423 | l_R(flg) int flg; | |
424 | { double a,b,c,d; | |
425 | int da,db,dc,dd; | |
b0df27de | 426 | int i,sign=0; |
25b64855 JB |
427 | a=b=c=d=0; |
428 | da=db=dc=dd=0; | |
429 | ||
430 | if( flg ) /* real */ | |
431 | { | |
432 | da=rd_int(&a); /* repeat count ? */ | |
b0df27de | 433 | if(GETC=='*') |
25b64855 JB |
434 | { |
435 | if (a <= 0.) return(F_ERNREP); | |
436 | lcount=(int)a; | |
437 | db=rd_int(&b); /* whole part of number */ | |
438 | } | |
439 | else | |
440 | { UNGETC(); | |
441 | db=da; | |
442 | b=a; | |
443 | lcount=1; | |
444 | } | |
445 | } | |
446 | else /* complex */ | |
447 | { | |
448 | db=rd_int(&b); | |
449 | } | |
450 | ||
b0df27de | 451 | if(GETC=='.' && isdigit(GETC)) |
25b64855 JB |
452 | { UNGETC(); |
453 | dc=rd_int(&c); /* fractional part of number */ | |
454 | } | |
455 | else | |
456 | { UNGETC(); | |
457 | dc=0; | |
458 | c=0.; | |
459 | } | |
b0df27de | 460 | if(isexp(GETC)) |
25b64855 JB |
461 | dd=rd_int(&d); /* exponent */ |
462 | else if (ch == '+' || ch == '-') | |
463 | { UNGETC(); | |
464 | dd=rd_int(&d); | |
465 | } | |
466 | else | |
467 | { UNGETC(); | |
468 | dd=0; | |
469 | } | |
470 | if(db<0 || b<0) | |
471 | { sign=1; | |
472 | b = -b; | |
473 | } | |
474 | for(i=0;i<dc;i++) c/=10.; | |
475 | b=b+c; | |
476 | if (dd > 0) | |
477 | { for(i=0;i<d;i++) b *= 10.; | |
478 | for(i=0;i< -d;i++) b /= 10.; | |
479 | } | |
480 | lx=sign?-b:b; | |
481 | ltype=TYLONG; | |
482 | return(OK); | |
483 | } | |
484 | ||
485 | LOCAL | |
486 | rd_int(x) double *x; | |
b0df27de | 487 | { int sign=0,i=0; |
25b64855 | 488 | double y=0.0; |
b0df27de | 489 | if(GETC=='-') sign = -1; |
25b64855 JB |
490 | else if(ch=='+') sign=0; |
491 | else UNGETC(); | |
b0df27de | 492 | while(isdigit(GETC)) |
25b64855 JB |
493 | { i++; |
494 | y=10*y + ch-'0'; | |
495 | } | |
496 | UNGETC(); | |
497 | if(sign) y = -y; | |
498 | *x = y; | |
499 | return(y==0.0?sign:i); /* 0:[+]&&y==0, -1:-&&y==0, >0:#digits&&y!=0 */ | |
500 | } | |
501 | ||
502 | LOCAL | |
503 | l_C() | |
b0df27de | 504 | { int n; |
25b64855 | 505 | if(n=get_repet()) return(n); /* get repeat count */ |
b0df27de JB |
506 | if(GETC!='(') err(errflag,F_ERNMLIST,"no (") |
507 | while(isblnk(GETC)); | |
25b64855 JB |
508 | UNGETC(); |
509 | l_R(0); /* get real part */ | |
510 | ly = lx; | |
b0df27de | 511 | while(isblnk(GETC)); /* get comma */ |
e8492a6c JB |
512 | if(leof) return(EOF); |
513 | if(ch!=',') return(F_ERNMLIST); | |
b0df27de | 514 | while(isblnk(GETC)); |
e8492a6c JB |
515 | UNGETC(); |
516 | if(leof) return(EOF); | |
25b64855 | 517 | l_R(0); /* get imag part */ |
b0df27de | 518 | while(isblnk(GETC)); |
25b64855 JB |
519 | if(ch!=')') err(errflag,F_ERNMLIST,"no )") |
520 | ltype = TYCOMPLEX; | |
521 | return(OK); | |
522 | } | |
523 | ||
524 | LOCAL | |
525 | l_L() | |
526 | { | |
b0df27de JB |
527 | int n, keychar=ch, scanned=NO; |
528 | if(ch=='f' || ch=='F' || ch=='t' || ch=='T') | |
e8492a6c | 529 | { |
b0df27de | 530 | scanned=YES; |
e8492a6c JB |
531 | if(rd_name(var_name)) |
532 | return(leof?EOF:F_ERNMLIST); | |
b0df27de JB |
533 | while(isblnk(GETC)); |
534 | UNGETC(); | |
e8492a6c JB |
535 | if(ch == '=' || ch == '(') |
536 | { /* found a name, not a value */ | |
e8492a6c JB |
537 | nameflag = YES; |
538 | return(OK); | |
539 | } | |
540 | } | |
541 | else | |
542 | { | |
543 | if(n=get_repet()) return(n); /* get repeat count */ | |
b0df27de JB |
544 | if(GETC=='.') GETC; |
545 | keychar = ch; | |
e8492a6c | 546 | } |
b0df27de | 547 | switch(keychar) |
25b64855 JB |
548 | { |
549 | case 't': | |
550 | case 'T': | |
551 | lx=1; | |
552 | break; | |
553 | case 'f': | |
554 | case 'F': | |
555 | lx=0; | |
556 | break; | |
557 | default: | |
e8492a6c | 558 | if(ch==EOF) return(EOF); |
25b64855 JB |
559 | else err(errflag,F_ERNMLIST,"logical not T or F"); |
560 | } | |
561 | ltype=TYLOGICAL; | |
b0df27de JB |
562 | if(scanned==NO) |
563 | { | |
564 | while(!issep(GETC) && ch!=EOF) ; | |
565 | UNGETC(); | |
566 | } | |
25b64855 JB |
567 | if(ch == EOF ) return(EOF); |
568 | return(OK); | |
569 | } | |
570 | ||
571 | #define BUFSIZE 128 | |
572 | LOCAL | |
573 | l_CHAR() | |
b0df27de | 574 | { int size,i,n; |
25b64855 JB |
575 | char quote,*p; |
576 | if(n=get_repet()) return(n); /* get repeat count */ | |
b0df27de | 577 | if(isapos(GETC)) quote=ch; |
25b64855 JB |
578 | else if(ch == EOF) return EOF; |
579 | else return F_ERNMLIST; | |
580 | ltype=TYCHAR; | |
581 | if(lchar!=NULL) free(lchar); | |
582 | size=BUFSIZE-1; | |
583 | p=lchar=(char *)malloc(BUFSIZE); | |
584 | if(lchar==NULL) return (F_ERSPACE); | |
585 | for(i=0;;) | |
b0df27de | 586 | { while( GETC!=quote && ch!='\n' && ch!=EOF && ++i<size ) |
25b64855 JB |
587 | *p++ = ch; |
588 | if(i==size) | |
589 | { | |
590 | newone: | |
591 | size += BUFSIZE; | |
592 | lchar=(char *)realloc(lchar, size+1); | |
593 | if(lchar==NULL) return( F_ERSPACE ); | |
594 | p=lchar+i-1; | |
595 | *p++ = ch; | |
596 | } | |
597 | else if(ch==EOF) return(EOF); | |
598 | else if(ch=='\n') | |
599 | { if(*(p-1) == '\\') *(p-1) = ch; | |
600 | } | |
b0df27de | 601 | else if(GETC==quote) |
25b64855 JB |
602 | { if(++i<size) *p++ = ch; |
603 | else goto newone; | |
604 | } | |
605 | else | |
606 | { UNGETC(); | |
607 | *p = '\0'; | |
608 | return(OK); | |
609 | } | |
610 | } | |
611 | } |