2.11BSD#431 - /usr/src/usr.lib/libI77/dofio.c

   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:  *
   6:  *	@(#)dofio.c	5.1.1	1/1/94
   7:  */
   8: 
   9: /*
  10:  * fortran format executer
  11:  */
  12: 
  13: #include "fio.h"
  14: #include "format.h"
  15: 
  16: #define DO(x)   if(n=x) err(n>0?errflag:endflag,n,dfio)
  17: #define DO_F(x) if(n=x) err_f(n>0?errflag:endflag,n,dfio)
  18: #define err_f(f,n,s)    {if(f) return(dof_err(n)); else fatal(n,s);}
  19: #define STKSZ 10
  20: LOCAL int cnt[STKSZ],ret[STKSZ],cp,rp;
  21: LOCAL char *dfio = "dofio";
  22: int used_data;
  23: 
  24: en_fio()
  25: {   ftnint one=1;
  26:     return(do_fio(&one,NULL,0L));
  27: }
  28: 
  29: /* OP_TYPE_TAB is defined in format.h,
  30: 		  it is NED for X,SLASH,APOS,H,TL,TR,T
  31: 		  ED  for I,IM,F,E,EE,D,DE,G,GE,L,A,AW
  32: 		  and returns op for other values
  33:  */
  34: 
  35: LOCAL int optypes[] = OP_TYPE_TAB;
  36: LOCAL int rep_count, in_mid;
  37: 
  38: do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
  39: {   struct syl *p;
  40:     int n,i,more,optype;
  41:     more = *number;
  42:     for(;;) {
  43:       if( (optype = ((p= &syl_ptr[pc])->op)) > LAST_TERM )
  44:         err_f(errflag,F_ERFMT,"impossible code");
  45: #ifdef DEBUG
  46:       fprintf(stderr," pc=%d, cnt[%d]=%d, ret[%d]=%d, op=%d\n",
  47:         pc,cp,cnt[cp],rp,ret[rp],optype); /*for debug*/
  48: #endif
  49:       switch(optypes[optype])
  50:       {
  51:       case NED:
  52:         DO_F((*doned)(p,ptr))
  53:         pc++;
  54:         break;
  55:       case ED:
  56:         if(in_mid == NO) rep_count = p->rpcnt;
  57:         in_mid = YES;
  58:         while (rep_count > 0 ) {
  59:             if(ptr==NULL)
  60:             {   DO((*doend)('\n'))
  61:             return(OK);
  62:             }
  63:             if(!more) return(OK);
  64:             used_data = YES;
  65:             DO_F((*doed)(p,ptr,len))
  66:             ptr += len;
  67:             more--;
  68:             rep_count--;
  69:         }
  70:         pc++;
  71:         in_mid = NO;
  72:         break;
  73:       case STACK:       /* repeat count */
  74:         if(++cp==STKSZ) err_f(errflag,F_ERFMT,"too many nested ()")
  75:         cnt[cp]=p->p1;
  76:         pc++;
  77:         break;
  78:       case RET:     /* open paren */
  79:         if(++rp==STKSZ) err_f(errflag,F_ERFMT,"too many nested ()")
  80:         ret[rp]=p->p1;
  81:         pc++;
  82:         break;
  83:       case GOTO:        /* close paren */
  84:         if(--cnt[cp]<=0)
  85:         {   cp--;
  86:             rp--;
  87:             pc++;
  88:         }
  89:         else pc = ret[rp--] + 1;
  90:         break;
  91:       case REVERT:      /* end of format */
  92:         if(ptr==NULL)
  93:         {   DO((*doend)('\n'))
  94:             return(OK);
  95:         }
  96:         if(!more) return(OK);
  97:         if( used_data == NO ) err_f(errflag,F_ERFMT,"\nNo more editing terms in format");
  98:         used_data = NO;
  99:         rp=cp=0;
 100:         pc = p->p1;
 101:         DO((*dorevert)())
 102:         break;
 103:       case COLON:
 104: #ifndef KOSHER
 105:       case DOLAR:               /*** NOT STANDARD FORTRAN ***/
 106: #endif
 107:         if (ptr == NULL)
 108:         {   DO((*doend)((char)p->p1))
 109:             return(OK);
 110:         }
 111:         if (!more) return(OK);
 112:         pc++;
 113:         break;
 114: #ifndef KOSHER
 115:       case SU:              /*** NOT STANDARD FORTRAN ***/
 116: #endif
 117:       case SS:
 118:       case SP:
 119:       case S: cplus = p->p1;
 120:         signit = p->p2;
 121:         pc++;
 122:         break;
 123:       case P:
 124:         scale = p->p1;
 125:         pc++;
 126:         break;
 127: #ifndef KOSHER
 128:       case R:                   /*** NOT STANDARD FORTRAN ***/
 129:         radix = p->p1;
 130:         pc++;
 131:         break;
 132:       case B:                   /*** NOT STANDARD FORTRAN ***/
 133:         if (external) cblank = curunit->ublnk;
 134:         else cblank = 0;        /* blank = 'NULL' */
 135:         pc++;
 136:         break;
 137: #endif
 138:       case BNZ:
 139:         cblank = p->p1;
 140:         pc++;
 141:         break;
 142:       default:
 143:         err_f(errflag,F_ERFMT,"impossible code")
 144:       }
 145:     }
 146: }
 147: 
 148: fmt_bg()
 149: {
 150:     in_mid = NO;
 151:     cp=rp=pc=cursor=0;
 152:     cnt[0]=ret[0]=0;
 153:     used_data = NO;
 154: }
 155: 
 156: LOCAL
 157: dof_err(n)
 158: {
 159:     if( reading==YES && external==YES && sequential==YES) donewrec();
 160:     return(errno=n);
 161: }

Defined functions

Defined variables

Defined macros