extern char *malloc(), *realloc();
int (*f__lioproc
)(), (*l_getc
)(), (*l_ungetc
)();
int (*f__lioproc
)(ftnint
*, char*, ftnlen
, ftnint
), (*l_getc
)(void),
#define isblnk(x) (f__ltab[x+1]&B)
#define issep(x) (f__ltab[x+1]&SX)
#define isapos(x) (f__ltab[x+1]&AX)
#define isexp(x) (f__ltab[x+1]&EX)
#define issign(x) (f__ltab[x+1]&SG)
#define iswhit(x) (f__ltab[x+1]&WH)
char f__ltab
[128+1] = { /* offset one for EOF */
0,0,AX
,0,0,0,0,0,0,WH
|B
,SX
|WH
,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
SX
|B
|WH
,0,AX
,0,0,0,0,AX
,0,0,0,SG
,SX
,SG
,0,SX
,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,EX
,EX
,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
AX
,0,0,0,EX
,EX
,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
un_getc(x
,f__cf
) int x
; FILE *f__cf
;
un_getc(int x
, FILE *f__cf
)
{ return ungetc(x
,f__cf
); }
if(f__curunit
->uend
) return(EOF
);
if((ch
=getc(f__cf
))!=EOF
) return(ch
);
f__curunit
->uend
= l_eof
= 1;
if(f__curunit
->uend
) return(0);
while((ch
=t_getc())!='\n' && ch
!=EOF
);
int f__lcount
,f__ltype
,nml_read
;
#define ERR(x) if(n=(x)) return(n)
#define GETC(x) (x=(*l_getc)())
#define Ungetc(x,y) (*l_ungetc)(x,y)
l_R(poststar
) int poststar
;
char s
[FMAX
+EXPMAXDIGS
+4];
register char *sp
, *spe
, *sp1
;
int havenum
, havestar
, se
;
case '-': *sp
++ = ch
; sp1
++; spe
++;
if (sp
< spe
) *sp
++ = ch
;
if (ch
== '*' && !poststar
) {
if (sp
== sp1
|| exp
|| *s
== '-') {
errfl(f__elist
->cierr
,112,"bad repetition count");
if (havenum
&& isexp(ch
)) {
errfl(f__elist
->cierr
,112,"exponent field");
while(isdigit(GETC(ch
))) {
(void) Ungetc(ch
, f__cf
);
sprintf(sp
+1, "e%ld", exp
);
if (havestar
&& ( ch
== ' '
errfl(f__elist
->cierr
,112,"invalid number");
rd_count(ch
) register int ch
;
rd_count(register int ch
)
if (ch
< '0' || ch
> '9')
while(GETC(ch
) >= '0' && ch
<= '9')
f__lcount
= 10*f__lcount
+ ch
- '0';
if(f__lcount
>0) return(0);
if (nml_read
> 1 && (ch
< '0' || ch
> '9')) {
if(!f__cf
|| !feof(f__cf
))
errfl(f__elist
->cierr
,112,"complex format");
err(f__elist
->cierr
,(EOF
),"lread");
if(!f__cf
|| !feof(f__cf
))
errfl(f__elist
->cierr
,112,"no star");
err(f__elist
->cierr
,(EOF
),"lread");
errfl(f__elist
->cierr
,112,"no real part");
{ (void) Ungetc(ch
,f__cf
);
errfl(f__elist
->cierr
,112,"no comma");
errfl(f__elist
->cierr
,112,"no imaginary part");
if(ch
!=')') errfl(f__elist
->cierr
,112,"no )");
if(f__lcount
>0) return(0);
if(!f__cf
|| !feof(f__cf
))
errfl(f__elist
->cierr
,112,"no star");
err(f__elist
->cierr
,(EOF
),"lread");
if(isblnk(ch
) || issep(ch
) || ch
==EOF
)
{ (void) Ungetc(ch
,f__cf
);
errfl(f__elist
->cierr
,112,"logical");
while(!issep(GETC(ch
)) && ch
!=EOF
);
(void) Ungetc(ch
, f__cf
);
if(f__lcount
>0) return(0);
if(f__lchar
!=NULL
) free(f__lchar
);
p
=f__lchar
= (char *)malloc((unsigned int)size
);
errfl(f__elist
->cierr
,113,"no space");
/* allow Fortran 8x-style unquoted string... */
/* either find a repetition count or the string */
f__lcount
= 10*f__lcount
+ ch
- '0';
f__lchar
= (char *)realloc(f__lchar
,
(unsigned int)(size
+= BUFSIZE
));
else (void) Ungetc(ch
,f__cf
);
if(GETC(ch
)=='\'' || ch
=='"') quote
=ch
;
else if(isblnk(ch
) || (issep(ch
) && ch
!= '\n') || ch
==EOF
)
{ (void) Ungetc(ch
,f__cf
);
/* Fortran 8x-style unquoted string */
f__lchar
= (char *)realloc(f__lchar
,
(unsigned int)(size
+= BUFSIZE
));
{ while(GETC(ch
)!=quote
&& ch
!='\n'
&& ch
!=EOF
&& ++i
<size
) *p
++ = ch
;
f__lchar
= (char *)realloc(f__lchar
,
(unsigned int)(size
+= BUFSIZE
));
else if(ch
==EOF
) return(EOF
);
{ if(*(p
-1) != '\\') continue;
{ if(++i
<size
) *p
++ = ch
;
{ (void) Ungetc(ch
,f__cf
);
if(a
->ciunit
>=MXUNIT
|| a
->ciunit
<0)
err(a
->cierr
,101,"stler");
f__curunit
= &f__units
[a
->ciunit
];
if(f__curunit
->ufd
==NULL
&& fk_open(SEQ
,FMT
,a
->ciunit
))
if(!f__curunit
->ufmt
) err(a
->cierr
,103,"lio")
l_read(number
,ptr
,len
,type
) ftnint
*number
,type
; char *ptr
; ftnlen len
;
l_read(ftnint
*number
, char *ptr
, ftnlen len
, ftnint type
)
#define Ptr ((flex *)ptr)
err(f__elist
->ciend
, EOF
, "list in")
(void) Ungetc(ch
, f__cf
);
while (GETC(ch
) == ' ' || ch
== '\t');
if (ch
!= ',' || f__lcount
> 1)
err(f__elist
->ciend
,(EOF
),"list in")
errfl(f__elist
->cierr
,errno
,"list in");
if(f__ltype
==0) goto bump
;
Ptr
->flchar
= (char)f__lx
;
Ptr
->flshort
= (short)f__lx
;
b_char(f__lchar
,ptr
,len
);
if(f__lcount
>0) f__lcount
--;
integer
s_rsle(a
) cilist
*a
;
integer
s_rsle(cilist
*a
)
if(f__curunit
->uwrt
&& f__nowreading(f__curunit
))
err(a
->cierr
,errno
,"read start");