4.3BSD - /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	6/7/85
   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: LOCAL int optypes[] = { OP_TYPE_TAB };
  35: LOCAL int rep_count, in_mid;
  36: 
  37: do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
  38: {   struct syl *p;
  39:     int n,i,more,optype;
  40:     more = *number;
  41:     for(;;) {
  42:       if( (optype = ((p= &syl_ptr[pc])->op)) > LAST_TERM )
  43:         err_f(errflag,F_ERFMT,"impossible code");
  44: #ifdef DEBUG
  45:       fprintf(stderr," pc=%d, cnt[%d]=%d, ret[%d]=%d, op=%d\n",
  46:         pc,cp,cnt[cp],rp,ret[rp],optype); /*for debug*/
  47: #endif
  48:       switch(optypes[optype])
  49:       {
  50:       case NED:
  51:         DO_F((*doned)(p,ptr))
  52:         pc++;
  53:         break;
  54:       case ED:
  55:         if(in_mid == NO) rep_count = p->rpcnt;
  56:         in_mid = YES;
  57:         while (rep_count > 0 ) {
  58:             if(ptr==NULL)
  59:             {   DO((*doend)('\n'))
  60:             return(OK);
  61:             }
  62:             if(!more) return(OK);
  63:             used_data = YES;
  64:             DO_F((*doed)(p,ptr,len))
  65:             ptr += len;
  66:             more--;
  67:             rep_count--;
  68:         }
  69:         pc++;
  70:         in_mid = NO;
  71:         break;
  72:       case STACK:       /* repeat count */
  73:         if(++cp==STKSZ) err_f(errflag,F_ERFMT,"too many nested ()")
  74:         cnt[cp]=p->p1;
  75:         pc++;
  76:         break;
  77:       case RET:     /* open paren */
  78:         if(++rp==STKSZ) err_f(errflag,F_ERFMT,"too many nested ()")
  79:         ret[rp]=p->p1;
  80:         pc++;
  81:         break;
  82:       case GOTO:        /* close paren */
  83:         if(--cnt[cp]<=0)
  84:         {   cp--;
  85:             rp--;
  86:             pc++;
  87:         }
  88:         else pc = ret[rp--] + 1;
  89:         break;
  90:       case REVERT:      /* end of format */
  91:         if(ptr==NULL)
  92:         {   DO((*doend)('\n'))
  93:             return(OK);
  94:         }
  95:         if(!more) return(OK);
  96:         if( used_data == NO ) err_f(errflag,F_ERFMT,"\nNo more editing terms in format");
  97:         used_data = NO;
  98:         rp=cp=0;
  99:         pc = p->p1;
 100:         DO((*dorevert)())
 101:         break;
 102:       case COLON:
 103: #ifndef KOSHER
 104:       case DOLAR:               /*** NOT STANDARD FORTRAN ***/
 105: #endif
 106:         if (ptr == NULL)
 107:         {   DO((*doend)((char)p->p1))
 108:             return(OK);
 109:         }
 110:         if (!more) return(OK);
 111:         pc++;
 112:         break;
 113: #ifndef KOSHER
 114:       case SU:              /*** NOT STANDARD FORTRAN ***/
 115: #endif
 116:       case SS:
 117:       case SP:
 118:       case S: cplus = p->p1;
 119:         signit = p->p2;
 120:         pc++;
 121:         break;
 122:       case P:
 123:         scale = p->p1;
 124:         pc++;
 125:         break;
 126: #ifndef KOSHER
 127:       case R:                   /*** NOT STANDARD FORTRAN ***/
 128:         radix = p->p1;
 129:         pc++;
 130:         break;
 131:       case B:                   /*** NOT STANDARD FORTRAN ***/
 132:         if (external) cblank = curunit->ublnk;
 133:         else cblank = 0;        /* blank = 'NULL' */
 134:         pc++;
 135:         break;
 136: #endif
 137:       case BNZ:
 138:         cblank = p->p1;
 139:         pc++;
 140:         break;
 141:       default:
 142:         err_f(errflag,F_ERFMT,"impossible code")
 143:       }
 144:     }
 145: }
 146: 
 147: fmt_bg()
 148: {
 149:     in_mid = NO;
 150:     cp=rp=pc=cursor=0;
 151:     cnt[0]=ret[0]=0;
 152:     used_data = NO;
 153: }
 154: 
 155: LOCAL
 156: dof_err(n)
 157: {
 158:     if( reading==YES && external==YES && sequential==YES) donewrec();
 159:     return(errno=n);
 160: }

Defined functions

Defined variables

Defined macros