![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dofio.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.lib / libI77|
Return to dofio.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.lib / libI77 |
1.1 root 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.2 12/21/87
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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.