Пример #1
0
int
c_sue (cilist64 *a, unit **fu)
{
    unit *ftnunit;

    if ((ftnunit = map_luno (a->ciunit)) == NULL)
        errret(a->cierr, 101, "startio");
    while (fu != &f77curunit && test_and_set( &ftnunit->lock_unit, 1L ))
        ;
    *fu = ftnunit;
    if (ftnunit->uconn <= 0 && fk_open (SEQ, UNF, a->ciunit)) {
        ftnunit->uconn = 0;
        errret(a->cierr, 114, "sue");
    }
    ftnunit->f77errlist.cierr = a->cierr;
    ftnunit->f77errlist.ciend = a->ciend;
    ftnunit->f77errlist.cieor = a->cieor;
    ftnunit->f77errlist.cisize = a->cisize;
    ftnunit->f77errlist.iciunit = 0;
    if (ftnunit->ufmt > 0) {
        if ((ftnunit->ufd == stdin || ftnunit->ufd == stdout ||
                ftnunit->ufd == stderr) && ftnunit->useek)
            /* these guys can be redirected so it might not be an error,
            ** let's assume it is correct here.   If there is any error
            ** it can be caught later
            */
            ftnunit->ufmt = 1;
        else
            errret(a->cierr, 103, "sue");
    }
    if (!ftnunit->useek && ftnunit->uacc == SEQUENTIAL)
        errret(a->cierr, 103, "sue");
    return (0);
}
Пример #2
0
c_sfe(cilist *a) /* check */
#endif
{       unit *p;
        f__curunit = p = &f__units[a->ciunit];
        if(a->ciunit >= MXUNIT || a->ciunit<0)
                err(a->cierr,101,"startio");
        if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe")
        if(!p->ufmt) err(a->cierr,102,"sfe")
        return(0);
}
Пример #3
0
int
c_sfe(cilist *a, int flag) /* check */
{
	unit *p;

	if(a->ciunit >= MXUNIT || a->ciunit<0)
		err(a->cierr,101,"startio");
	p = &units[a->ciunit];
	if(p->ufd==NULL && fk_open(flag,SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe")
	if(!p->ufmt) err(a->cierr,102,"sfe")
	return(0);
}
Пример #4
0
Файл: sue.c Проект: Sciumo/f2c
int c_sue(cilist *a)
{
	f__external=f__sequential=1;
	f__formatted=0;
	f__curunit = &f__units[a->ciunit];
	if(a->ciunit >= MXUNIT || a->ciunit < 0)
		err(a->cierr,101,"startio");
	f__elist=a;
	if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit))
		err(a->cierr,114,"sue");
	f__cf=f__curunit->ufd;
	if(f__curunit->ufmt) err(a->cierr,103,"sue")
	if(!f__curunit->useek) err(a->cierr,103,"sue")
	return(0);
}
Пример #5
0
c_le(cilist *a)
#endif
{
	f__fmtbuf="list io";
	if(a->ciunit>=MXUNIT || a->ciunit<0)
		err(a->cierr,101,"stler");
	f__scale=f__recpos=0;
	f__elist=a;
	f__curunit = &f__units[a->ciunit];
	if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit))
		err(a->cierr,102,"lio");
	f__cf=f__curunit->ufd;
	if(!f__curunit->ufmt) err(a->cierr,103,"lio")
	return(0);
}
Пример #6
0
int
c_sue(cilist *a, int flag)
{
	if(a->ciunit >= MXUNIT || a->ciunit < 0)
		err(a->cierr,101,"startio");
	external=sequential=1;
	formatted=0;
	curunit = &units[a->ciunit];
	elist=a;
	if(curunit->ufd==NULL && fk_open(flag,SEQ,UNF,a->ciunit))
		err(a->cierr,114,"sue");
	cf=curunit->ufd;
	if(curunit->ufmt) err(a->cierr,103,"sue")
	if(!curunit->useek) err(a->cierr,103,"sue")
	return(0);
}
Пример #7
0
int
f_rew(alist *a)
{
	unit *b;
	if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"rewind");
	b = &units[a->aunit];
	if(b->ufd==NULL && fk_open(READ,SEQ,FMT,a->aunit)) err(a->aerr,114,"rewind")
	if(!b->useek) err(a->aerr,106,"rewind")
	if(b->uwrt)
	{	nowreading(b);
		t_runc(b);
	}
	rewind(b->ufd);
	b->uend=0;
	return(0);
}
Пример #8
0
c_due(cilist *a)
#endif
{
	if(!f__init) f_init();
	if(a->ciunit>=MXUNIT || a->ciunit<0)
		err(a->cierr,101,"startio");
	f__sequential=f__formatted=f__recpos=0;
	f__external=1;
	f__curunit = &f__units[a->ciunit];
	f__elist=a;
	if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
	f__cf=f__curunit->ufd;
	if(f__curunit->ufmt) err(a->cierr,102,"cdue")
	if(!f__curunit->useek) err(a->cierr,104,"cdue")
	if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue")
	(void) fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);
	f__curunit->uend = 0;
	return(0);
}
Пример #9
0
int
c_due(cilist *a, int flag)
{
	if(!init) f_init();
	if(a->ciunit>=MXUNIT || a->ciunit<0)
		err(a->cierr,101,"startio");
	recpos=sequential=formatted=0;
	external=1;
	curunit = &units[a->ciunit];
	elist=a;
	if(curunit->ufd==NULL && fk_open(flag,DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
	cf=curunit->ufd;
	if(curunit->ufmt) err(a->cierr,102,"cdue")
	if(!curunit->useek) err(a->cierr,104,"cdue")
	if(curunit->ufd==NULL) err(a->cierr,114,"cdue")
	fseek(cf,(long)(a->cirec-1)*curunit->url,0);
	curunit->uend = 0;
	return(0);
}
Пример #10
0
c_dfe(cilist *a)
#endif
{
	f__sequential=0;
	f__formatted=f__external=1;
	f__elist=a;
	f__cursor=f__scale=f__recpos=0;
	f__curunit = &f__units[a->ciunit];
	if(a->ciunit>MXUNIT || a->ciunit<0)
		err(a->cierr,101,"startchk");
	if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit))
		err(a->cierr,104,"dfe");
	f__cf=f__curunit->ufd;
	if(!f__curunit->ufmt) err(a->cierr,102,"dfe");
	if(!f__curunit->useek) err(a->cierr,104,"dfe");
	f__fmtbuf=a->cifmt;
	if(a->cirec <= 0)
		err(a->cierr,130,"dfe");
	fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET);
	f__curunit->uend = 0;
	return(0);
}
Пример #11
0
static int
c_dfe (cilist64 *a, unit **fu) 
{
   unit		*ftnunit;
extern FILE *debugfile;

   if ((ftnunit = *fu = find_luno (a->ciunit)) == NULL)
      if (fk_open (DIR, FMT, a->ciunit))
	 err(a->cierr, 104, "dfe");
   while (fu != &f77curunit && test_and_set( &ftnunit->lock_unit, 1L ))
       ;
   ftnunit->f77errlist.cierr = a->cierr;
   ftnunit->f77errlist.ciend = a->ciend;
   ftnunit->f77errlist.cieor = a->cieor;
   ftnunit->f77errlist.cisize = a->cisize;
   ftnunit->f77errlist.iciunit = 0;
   ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
   ftnunit->f77scale = 0;
   ftnunit->ufd = ftnunit->ufd;

   if (!ftnunit->ufmt)
      err(a->cierr, 102, "dfe")
	 if (!ftnunit->useek)
	 err(a->cierr, 104, "dfe")
	    if (a->cirec < 1)
	    err(a->cierr, 168, "dfe");
   ftnunit->f77fmtbuf = a->cifmt;

   /* fprintf( debugfile, "At position %d for thread %d, oldrec = %d, newrec = %d\n", ftell( ftnunit->ufd ), mp_my_threadnum_(), ftnunit->uirec, a->cirec ); */
   if (FSEEK (ftnunit->ufd,  (ftnll)ftnunit->url * (a->cirec - 1), 0))
      err( a->cierr, errno, "Direct formatted");
   if (ftnunit->uassocv)
      set_var ((ftnintu *)ftnunit->uassocv,
	       ftnunit->umask, ASSOCV, a->cirec);
   ftnunit->uend = 0;
   return (0);
}
Пример #12
0
integer f_back(alist *a)
#endif
{  unit *b;
  OFF_T v, w, x, y, z;
  uiolen n;
  FILE *f;

  f__curunit = b = &f__units[a->aunit];       /* curunit for error messages */
  if(a->aunit >= MXUNIT || a->aunit < 0)
         err(a->aerr,101,"backspace")
  if(b->useek==0) err(a->aerr,106,"backspace")
  if(b->ufd == NULL) {
         fk_open(1, 1, a->aunit);
         return(0);
         }
  if(b->uend==1)
  {       b->uend=0;
         return(0);
  }
  if(b->uwrt) {
         t_runc(a);
         if(f__nowreading(b))
                err(a->aerr,errno,"backspace")
         }