Commit | Line | Data |
---|---|---|
5547e99f F |
1 | #include "defs" |
2 | ||
3 | ||
4 | setopt(p,q) | |
5 | char *p; | |
6 | char *q; | |
7 | { | |
8 | int qval; | |
9 | qval = (q!=NULL) && ( equals(q, "yes") || equals(q, "on") ); | |
10 | ||
11 | if(equals(p,"debug")) dbgopt = 1; | |
12 | else if(equals(p,"ndebug")) dbgopt = 0; | |
13 | else if(equals(p,"pfort")) langopt = 0; | |
14 | else if(equals(p,"ratfor")) langopt = 1; | |
15 | else if(equals(p,"efl")) langopt = 2; | |
16 | else if(equals(p,"dots")) | |
17 | dotsopt = qval; | |
18 | else if(equals(p,"ioerror")) | |
19 | { | |
20 | if(equals(q,"none")) | |
21 | tailor.errmode = IOERRNONE; | |
22 | else if(equals(q,"ibm")) | |
23 | tailor.errmode = IOERRIBM; | |
24 | else if(equals(q,"fortran77")) | |
25 | tailor.errmode = IOERRFORT77; | |
26 | else execerr("unknown ioerror option %s", q); | |
27 | } | |
28 | else if(equals(p, "system")) | |
29 | { | |
30 | register struct system *sysp; | |
31 | for(sysp = systab ; sysp->sysname ; ++sysp) | |
32 | if( equals(q, sysp->sysname) ) | |
33 | break; | |
34 | ||
35 | if(sysp->sysname) | |
36 | tailinit(sysp); | |
37 | else | |
38 | execerr("unknown system %s", q); | |
39 | } | |
40 | else if(equals(p, "continue")) | |
41 | tailor.ftncontnu = equals(q, "column1"); | |
42 | else if(equals(p, "procheader")) | |
43 | tailor.procheader = (q ? copys(q) : 0); | |
44 | else if(equals(p, "hollincall")) | |
45 | tailor.hollincall = qval; | |
46 | else if(equals(p, "longcomplextype")) | |
47 | { | |
48 | tailor.lngcxtype = (q ? copys(q) : CNULL); | |
49 | if(qval) | |
50 | eflftn[TYLCOMPLEX] = FTNDCOMPLEX; | |
51 | } | |
52 | else if(equals(p, "longcomplexprefix")) | |
53 | tailor.lngcxprefix = (q ? copys(q) : CNULL); | |
54 | else if(equals(p, "fortran77")) | |
55 | { | |
56 | if(tailor.ftn77 = (q==NULL || qval) ) | |
57 | tailor.errmode = IOERRFORT77; | |
58 | else if(tailor.errmode == IOERRFORT77) | |
59 | tailor.errmode = IOERRNONE; | |
60 | } | |
61 | ||
62 | else if( !tailop(p,q) ) | |
63 | execerr("unknown option %s", p); | |
64 | ||
65 | if(langopt==2) | |
66 | setdot(dotsopt); | |
67 | else if(langopt==1) | |
68 | setdot(1); | |
69 | } | |
70 | ||
71 | ||
72 | ||
73 | ||
74 | tailinit(sysp) | |
75 | register struct system *sysp; | |
76 | { | |
77 | register int sysf = sysp->sysno; | |
78 | tailor.ftncontnu = (sysf==UNIX); | |
79 | tailor.ftnsys = sysf; | |
80 | tailor.ftnin = 5; | |
81 | tailor.ftnout = 6; | |
82 | tailor.errmode = (sysf==UNIX ? IOERRFORT77 : IOERRIBM); | |
83 | tailor.charcomp = 2; | |
84 | tailor.hollincall = YES; | |
85 | tailor.deltastno = 1; | |
86 | tailor.dclintrinsics = YES; | |
87 | ||
88 | tailsize(sysp->chperwd); | |
89 | tailfmt(sysp->idig, sysp->rdig, sysp->ddig); | |
90 | } | |
91 | ||
92 | ||
93 | ||
94 | ||
95 | ||
96 | tailsize(wordsize) | |
97 | int wordsize; | |
98 | { | |
99 | int i; | |
100 | ||
101 | tailor.ftnchwd = wordsize; | |
102 | tailor.ftnsize[FTNINT] = wordsize; | |
103 | tailor.ftnsize[FTNREAL] = wordsize; | |
104 | tailor.ftnsize[FTNLOG] = wordsize; | |
105 | tailor.ftnsize[FTNCOMPLEX] = 2*wordsize; | |
106 | tailor.ftnsize[FTNDOUBLE] = 2*wordsize; | |
107 | tailor.ftnsize[FTNDCOMPLEX] = 2*wordsize; | |
108 | ||
109 | for(i = 0 ; i<NFTNTYPES ; ++i) | |
110 | tailor.ftnalign[i] = tailor.ftnsize[i]; | |
111 | } | |
112 | ||
113 | ||
114 | ||
115 | ||
116 | tailfmt(idig, rdig, ddig) | |
117 | int idig, rdig, ddig; | |
118 | { | |
119 | sprintf(msg, "i%d", idig); | |
120 | tailor.dfltfmt[TYINT] = copys(msg); | |
121 | ||
122 | sprintf(msg, "e%d.%d", rdig+8, rdig); | |
123 | tailor.dfltfmt[TYREAL] = copys(msg); | |
124 | ||
125 | sprintf(msg, "d%d.%d", ddig+8, ddig); | |
126 | tailor.dfltfmt[TYLREAL] = copys(msg); | |
127 | ||
128 | sprintf(msg, "1h(,1p%s,2h, ,%s,1h)", | |
129 | tailor.dfltfmt[TYREAL], tailor.dfltfmt[TYREAL]); | |
130 | tailor.dfltfmt[TYCOMPLEX] = copys(msg); | |
131 | ||
132 | sprintf(msg, "1h(,1p%s,2h, ,%s,1h)", | |
133 | tailor.dfltfmt[TYLREAL], tailor.dfltfmt[TYLREAL]); | |
134 | tailor.dfltfmt[TYLCOMPLEX] = copys(msg); | |
135 | ||
136 | tailor.dfltfmt[TYLOG] = "l2"; | |
137 | } | |
138 | ||
139 | ||
140 | ||
141 | ||
142 | tailop(n,v) | |
143 | char *n, *v; | |
144 | { | |
145 | int val; | |
146 | struct itable { char *optn; int *ioptloc; } *ip; | |
147 | struct ctable { char *optn; char **coptloc; } *cp; | |
148 | static struct ctable formats[ ] = { | |
149 | "iformat", &tailor.dfltfmt[TYINT], | |
150 | "rformat", &tailor.dfltfmt[TYREAL], | |
151 | "dformat", &tailor.dfltfmt[TYLREAL], | |
152 | "zformat", &tailor.dfltfmt[TYCOMPLEX], | |
153 | "zdformat", &tailor.dfltfmt[TYLCOMPLEX], | |
154 | "lformat", &tailor.dfltfmt[TYLOG], | |
155 | 0, 0 }; | |
156 | ||
157 | static struct itable ints[ ] = { | |
158 | "ftnin", &tailor.ftnin, | |
159 | "ftnout", &tailor.ftnout, | |
160 | "charperint", &tailor.ftnchwd, | |
161 | "charcomp", &tailor.charcomp, | |
162 | "deltastno", &tailor.deltastno, | |
163 | "dclintrinsics", &tailor.dclintrinsics, | |
164 | "isize", &tailor.ftnsize[FTNINT], | |
165 | "rsize", &tailor.ftnsize[FTNREAL], | |
166 | "dsize", &tailor.ftnsize[FTNDOUBLE], | |
167 | "lsize", &tailor.ftnsize[FTNLOG], | |
168 | "zsize", &tailor.ftnsize[FTNCOMPLEX], | |
169 | "ialign", &tailor.ftnalign[FTNINT], | |
170 | "ralign", &tailor.ftnalign[FTNREAL], | |
171 | "dalign", &tailor.ftnalign[FTNDOUBLE], | |
172 | "lalign", &tailor.ftnalign[FTNLOG], | |
173 | "zalign", &tailor.ftnalign[FTNCOMPLEX], | |
174 | 0, 0 }; | |
175 | ||
176 | for(cp = formats; cp->optn ; ++cp) | |
177 | if(equals(n, cp->optn)) | |
178 | { | |
179 | *(cp->coptloc) = copys(v); | |
180 | return(1); | |
181 | } | |
182 | ||
183 | for(ip = ints ; ip->optn ; ++ip) | |
184 | if(equals(n, ip->optn)) | |
185 | { | |
186 | if( equals(v, "yes") || equals(v, "on") ) | |
187 | val = 1; | |
188 | else if( equals(v, "no") || equals(v, "off") ) | |
189 | val = 0; | |
190 | else val = convci(v); | |
191 | *(ip->ioptloc) = val; | |
192 | return(1); | |
193 | } | |
194 | ||
195 | return(0); | |
196 | } |