mirror of
https://git.FreeBSD.org/src.git
synced 2024-12-23 11:18:54 +00:00
c3ad4b4583
the function naming problem for complex double function i've recently aksed for in -committers. (The recently committed rev 1.5 of proc.c was actually also part of this update.) Should the mailing lists come to an agreement that f2c better belongs into the ports, this could be done nevertheless. For the time being, we've at least got a current version now. Thanks, Steve! Submitted by: Steve Kargl <sgk@troutmask.apl.washington.edu>
149 lines
2.5 KiB
C
149 lines
2.5 KiB
C
#include "f2c.h"
|
|
#include "fio.h"
|
|
#include "fmt.h"
|
|
extern char *f__icptr;
|
|
char *f__icend;
|
|
extern icilist *f__svic;
|
|
int f__icnum;
|
|
extern int f__hiwater;
|
|
z_getc(Void)
|
|
{
|
|
if(f__recpos++ < f__svic->icirlen) {
|
|
if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile");
|
|
return(*(unsigned char *)f__icptr++);
|
|
}
|
|
return '\n';
|
|
}
|
|
|
|
void
|
|
#ifdef KR_headers
|
|
z_putc(c)
|
|
#else
|
|
z_putc(int c)
|
|
#endif
|
|
{
|
|
if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen)
|
|
*f__icptr++ = c;
|
|
}
|
|
z_rnew(Void)
|
|
{
|
|
f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen;
|
|
f__recpos = 0;
|
|
f__cursor = 0;
|
|
f__hiwater = 0;
|
|
return 1;
|
|
}
|
|
|
|
static int
|
|
z_endp(Void)
|
|
{
|
|
(*f__donewrec)();
|
|
return 0;
|
|
}
|
|
|
|
#ifdef KR_headers
|
|
c_si(a) icilist *a;
|
|
#else
|
|
c_si(icilist *a)
|
|
#endif
|
|
{
|
|
f__elist = (cilist *)a;
|
|
f__fmtbuf=a->icifmt;
|
|
f__curunit = 0;
|
|
f__sequential=f__formatted=1;
|
|
f__external=0;
|
|
if(pars_f(f__fmtbuf)<0)
|
|
err(a->icierr,100,"startint");
|
|
fmt_bg();
|
|
f__cblank=f__cplus=f__scale=0;
|
|
f__svic=a;
|
|
f__icnum=f__recpos=0;
|
|
f__cursor = 0;
|
|
f__hiwater = 0;
|
|
f__icptr = a->iciunit;
|
|
f__icend = f__icptr + a->icirlen*a->icirnum;
|
|
f__cf = 0;
|
|
return(0);
|
|
}
|
|
|
|
int
|
|
iw_rev(Void)
|
|
{
|
|
if(f__workdone)
|
|
z_endp();
|
|
f__hiwater = f__recpos = f__cursor = 0;
|
|
return(f__workdone=0);
|
|
}
|
|
|
|
#ifdef KR_headers
|
|
integer s_rsfi(a) icilist *a;
|
|
#else
|
|
integer s_rsfi(icilist *a)
|
|
#endif
|
|
{ int n;
|
|
if(n=c_si(a)) return(n);
|
|
f__reading=1;
|
|
f__doed=rd_ed;
|
|
f__doned=rd_ned;
|
|
f__getn=z_getc;
|
|
f__dorevert = z_endp;
|
|
f__donewrec = z_rnew;
|
|
f__doend = z_endp;
|
|
return(0);
|
|
}
|
|
|
|
z_wnew(Void)
|
|
{
|
|
if (f__recpos < f__hiwater) {
|
|
f__icptr += f__hiwater - f__recpos;
|
|
f__recpos = f__hiwater;
|
|
}
|
|
while(f__recpos++ < f__svic->icirlen)
|
|
*f__icptr++ = ' ';
|
|
f__recpos = 0;
|
|
f__cursor = 0;
|
|
f__hiwater = 0;
|
|
f__icnum++;
|
|
return 1;
|
|
}
|
|
#ifdef KR_headers
|
|
integer s_wsfi(a) icilist *a;
|
|
#else
|
|
integer s_wsfi(icilist *a)
|
|
#endif
|
|
{ int n;
|
|
if(n=c_si(a)) return(n);
|
|
f__reading=0;
|
|
f__doed=w_ed;
|
|
f__doned=w_ned;
|
|
f__putn=z_putc;
|
|
f__dorevert = iw_rev;
|
|
f__donewrec = z_wnew;
|
|
f__doend = z_endp;
|
|
return(0);
|
|
}
|
|
integer e_rsfi(Void)
|
|
{ int n = en_fio();
|
|
f__fmtbuf = NULL;
|
|
return(n);
|
|
}
|
|
integer e_wsfi(Void)
|
|
{
|
|
int n;
|
|
n = en_fio();
|
|
f__fmtbuf = NULL;
|
|
if(f__svic->icirnum != 1
|
|
&& (f__icnum > f__svic->icirnum
|
|
|| (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
|
|
err(f__svic->icierr,110,"inwrite");
|
|
if (f__recpos < f__hiwater)
|
|
f__recpos = f__hiwater;
|
|
if (f__recpos >= f__svic->icirlen)
|
|
err(f__svic->icierr,110,"recend");
|
|
if (!f__recpos && f__icnum)
|
|
return n;
|
|
while(f__recpos++ < f__svic->icirlen)
|
|
*f__icptr++ = ' ';
|
|
return n;
|
|
}
|