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