1 /****************************************************************
2 Copyright (C) 1997-2001 Lucent Technologies
3 All Rights Reserved
4
5 Permission to use, copy, modify, and distribute this software and
6 its documentation for any purpose and without fee is hereby
7 granted, provided that the above copyright notice appear in all
8 copies and that both that the copyright notice and this
9 permission notice and warranty disclaimer appear in supporting
10 documentation, and that the name of Lucent or any of its entities
11 not be used in advertising or publicity pertaining to
12 distribution of the software without specific, written prior
13 permission.
14
15 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
16 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
17 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
18 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
20 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
21 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
22 THIS SOFTWARE.
23 ****************************************************************/
24
25 #include "asl.h"
26
27 #ifdef __cplusplus
28 extern "C" {
29 #endif
30
31 extern void fpinit_ASL(VOID);
32
33 #ifdef KR_headers
34 extern int Sscanf();
35 #else
36 extern int Sscanf(char*, const char*, ...);
37 #endif
38
39 #undef Want_bswap
40 #ifdef IEEE_MC68k
41 #define Want_bswap
42 #endif
43 #ifdef IEEE_8087
44 #define Want_bswap
45 #endif
46 #ifdef Want_bswap
47
48 void
49 #ifdef KR_headers
bswap_ASL(x,L)50 bswap_ASL(x, L) void *x; unsigned long L;
51 #else
52 bswap_ASL(void *x, unsigned long L)
53 #endif
54 {
55 char *s = (char*)x;
56 int t;
57 switch(L) {
58 case 2:
59 t = s[0]; s[0] = s[1]; s[1] = t;
60 break;
61 case 4:
62 t = s[0]; s[0] = s[3]; s[3] = t;
63 t = s[1]; s[1] = s[2]; s[2] = t;
64 break;
65 case 8:
66 t = s[0]; s[0] = s[7]; s[7] = t;
67 t = s[1]; s[1] = s[6]; s[6] = t;
68 t = s[2]; s[2] = s[5]; s[5] = t;
69 t = s[3]; s[3] = s[4]; s[4] = t;
70 }
71 }
72
73 #endif /* Want_bswap */
74
75 static void
76 #ifdef KR_headers
badfmt(R)77 badfmt(R) EdRead *R;
78 #else
79 badfmt(EdRead *R)
80 #endif
81 {
82 badread(R);
83 fprintf(Stderr, "Unrecognized binary format.\n");
84 exit(1);
85 }
86
87 static void
88 #ifdef KR_headers
badints(R,got,wanted)89 badints(R, got, wanted) EdRead *R; int got, wanted;
90 #else
91 badints(EdRead *R, int got, int wanted)
92 #endif
93 {
94 badread(R);
95 fprintf(Stderr, "got only %d integers; wanted %d\n", got, wanted);
96 exit(1);
97 }
98
99 static void
100 #ifdef KR_headers
read2(R,x,y)101 read2(R, x, y) EdRead *R; int *x, *y;
102 #else
103 read2(EdRead *R, int *x, int *y)
104 #endif
105 {
106 char *s;
107 int k;
108
109 s = read_line(R);
110 k = Sscanf(s, " %d %d", x, y);
111 if (k != 2)
112 badints(R, k, 2);
113 }
114
115 FILE *
116 #ifdef KR_headers
jac0dim_ASL(asl,stub,stub_len)117 jac0dim_ASL(asl, stub, stub_len) ASL *asl; char *stub; ftnlen stub_len;
118 #else
119 jac0dim_ASL(ASL *asl, char *stub, ftnlen stub_len)
120 #endif
121 {
122 FILE *nl;
123 int i, k, nlv;
124 char *s, *se;
125 EdRead ER, *R;
126
127 if (!asl)
128 badasl_ASL(asl,0,"jac0dim");
129 fpinit_ASL(); /* get IEEE arithmetic, if possible */
130
131 if (stub_len <= 0)
132 for(i = 0; stub[i]; i++);
133 else
134 for(i = stub_len; stub[i-1] == ' ' && i > 0; --i);
135 filename = (char *)M1alloc(i + 5);
136 s = stub_end = filename + i;
137 strncpy(filename, stub, i);
138 strcpy(s, ".nl");
139 nl = fopen(filename, "rb");
140 if (!nl && i > 3 && !strncmp(s-3, ".nl", 3)) {
141 *s = 0;
142 stub_end = s - 3;
143 nl = fopen(filename, "rb");
144 }
145 if (!nl) {
146 if (return_nofile)
147 return 0;
148 fflush(stdout);
149 what_prog();
150 fprintf(Stderr, "can't open %s\n", filename);
151 exit(1);
152 }
153 R = EdReadInit_ASL(&ER, asl, nl, 0);
154 R->Line = 0;
155 s = read_line(R);
156 binary_nl = 0;
157 switch(*s) {
158 #ifdef DEPRECATED
159 case 'E': /* deprecated "-oe" format */
160 {int ncsi = 0;
161 k = Sscanf(s, "E%d %d %d %d %d %d", &n_var, &n_con,
162 &n_obj, &maxrownamelen, &maxcolnamelen, &ncsi);
163 if (k < 5)
164 badints(R, k, 5);
165 if (ncsi) {
166 if (ncsi != 6) {
167 badread(R);
168 fprintf(Stderr,
169 "expected 6th integer to be 0 or 6, not %d\n",
170 ncsi);
171 exit(1);
172 }
173 s = read_line(R);
174 k = Sscanf(s, " %d %d %d %d %d %d",
175 &comb, &comc, &como, &comc1, &como1, &nfunc);
176 if (k != 6)
177 badints(R, k, 6);
178 }
179 }
180 break;
181 #endif
182 case 'b':
183 binary_nl = 1;
184 case 'g':
185 if (k = ampl_options[0] = strtol(++s, &se, 10)) {
186 if (k > 9) {
187 fprintf(Stderr,
188 "ampl_options = %d is too large\n", k);
189 exit(1);
190 }
191 for(i = 1; i <= k && se > s; i++)
192 ampl_options[i] = strtol(s = se,&se,10);
193 if (ampl_options[2] == 3)
194 ampl_vbtol = strtod(s = se, &se);
195 }
196 s = read_line(R);
197 n_eqn = -1;
198 k = Sscanf(s, " %d %d %d %d %d %d", &n_var, &n_con,
199 &n_obj, &nranges, &n_eqn, &n_lcon);
200 if (k < 3)
201 badints(R,k,3);
202 nclcon = n_con + n_lcon;
203
204 /* formerly read2(R, &nlc, &nlo); */
205 s = read_line(R);
206 n_cc = nlcc = 0;
207 k = Sscanf(s, " %d %d %d %d", &nlc, &nlo, &n_cc, &nlcc);
208 if (k < 2)
209 badints(R,k,2);
210 n_cc += nlcc;
211
212 read2(R, &nlnc, &lnc);
213 nlvb = -1;
214 s = read_line(R);
215 k = Sscanf(s, " %d %d %d", &nlvc, &nlvo, &nlvb);
216 if (k < 2)
217 badints(R,k,2);
218
219 /* read2(R, &nwv, &nfunc); */
220 s = read_line(R);
221 asl->i.flags = 0;
222 k = Sscanf(s, " %d %d %d %d", &nwv, &nfunc, &i,
223 &asl->i.flags);
224 if (k < 2)
225 badints(R,k,2);
226 else if (k >= 3 && i != Arith_Kind_ASL && i) {
227 #ifdef Want_bswap
228 if (i > 0 && i + Arith_Kind_ASL == 3) {
229 asl->i.iadjfcn = asl->i.dadjfcn = bswap_ASL;
230 binary_nl = i << 1;
231 }
232 else
233 #endif
234 badfmt(R);
235 }
236
237 if (nlvb < 0) /* ampl versions < 19930630 */
238 read2(R, &nbv, &niv);
239 else {
240 s = read_line(R);
241 k = Sscanf(s, " %d %d %d %d %d", &nbv, &niv,
242 &nlvbi, &nlvci, &nlvoi);
243 if (k != 5)
244 badints(R,k,5);
245 }
246 read2(R, &nzc, &nzo);
247 read2(R, &maxrownamelen, &maxcolnamelen);
248 s = read_line(R);
249 k = Sscanf(s, " %d %d %d %d %d", &comb, &comc, &como,
250 &comc1, &como1);
251 if (k != 5)
252 badints(R,k,5);
253 }
254 student_check_ASL(asl);
255 if (n_con < 0 || n_var <= 0 || n_obj < 0) {
256 what_prog();
257 fprintf(Stderr,
258 "jacdim: got M = %d, N = %d, NO = %d\n", n_con, n_var, n_obj);
259 exit(1);
260 }
261 asl->i.n_var0 = n_var;
262 asl->i.n_con0 = n_con;
263 if ((nlv = nlvc) < nlvo)
264 nlv = nlvo;
265 if (nlv <= 0)
266 nlv = 1;
267 x0len = nlv * sizeof(real);
268 x0kind = ASL_first_x;
269 n_conjac[0] = 0;
270 n_conjac[1] = n_con;
271 c_vars = o_vars = n_var; /* confusion arises otherwise */
272 return nl;
273 }
274
275 FILE *
276 #ifdef KR_headers
jac_dim_ASL(asl,stub,M,N,NO,NZ,MXROW,MXCOL,stub_len)277 jac_dim_ASL(asl, stub, M, N, NO, NZ, MXROW, MXCOL, stub_len)
278 ASL *asl; char *stub;
279 fint *M, *N, *NO, *NZ, *MXROW, *MXCOL;
280 fint stub_len;
281 #else
282 jac_dim_ASL(ASL *asl, char *stub, fint *M, fint *N, fint *NO, fint *NZ,
283 fint *MXROW, fint *MXCOL, fint stub_len)
284 #endif
285 {
286 FILE *nl;
287
288 if (nl = jac0dim_ASL(asl, stub, stub_len)) {
289 *M = n_con;
290 *N = n_var;
291 *NO = n_obj;
292 *NZ = nzc;
293 *MXROW = maxrownamelen;
294 *MXCOL = maxcolnamelen;
295 }
296 return nl;
297 }
298
299 #ifdef __cplusplus
300 }
301 #endif
302