1 |
/* |
2 |
* CodeGen2.c |
3 |
* by Kirk Abbott and Ben Allan |
4 |
* Created: 1/94 |
5 |
* Version: $Revision: 1.22 $ |
6 |
* Version control file: $RCSfile: CodeGen2.c,v $ |
7 |
* Date last modified: $Date: 2003/08/23 18:43:05 $ |
8 |
* Last modified by: $Author: ballan $ |
9 |
* |
10 |
* This file is part of the ASCEND Tcl/Tk interface |
11 |
* |
12 |
* Copyright 1997, Carnegie Mellon University |
13 |
* |
14 |
* The ASCEND Tcl/Tk interface is free software; you can redistribute |
15 |
* it and/or modify it under the terms of the GNU General Public License as |
16 |
* published by the Free Software Foundation; either version 2 of the |
17 |
* License, or (at your option) any later version. |
18 |
* |
19 |
* The ASCEND Tcl/Tk interface is distributed in hope that it will be |
20 |
* useful, but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
22 |
* General Public License for more details. |
23 |
* |
24 |
* You should have received a copy of the GNU General Public License |
25 |
* along with the program; if not, write to the Free Software Foundation, |
26 |
* Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named |
27 |
* COPYING. COPYING is found in ../compiler. |
28 |
*/ |
29 |
|
30 |
#ifndef lint |
31 |
static CONST char CodeGen2ID[] = "$Id: CodeGen2.c,v 1.22 2003/08/23 18:43:05 ballan Exp $"; |
32 |
#endif |
33 |
|
34 |
|
35 |
/* |
36 |
* CodeGeneration 2 Routines |
37 |
* by Kirk Andre Abbott. |
38 |
* May 28, 1995. |
39 |
* Version: $Revision: 1.22 $ |
40 |
* Date last modified: $Date: 2003/08/23 18:43:05 $ |
41 |
* Copyright (C) 1995 Kirk Andre Abbott, CMU. |
42 |
*/ |
43 |
#include <math.h> |
44 |
#include <tcl.h> |
45 |
#include <tk.h> |
46 |
#include <utilities/ascConfig.h> |
47 |
#include <utilities/ascMalloc.h> |
48 |
#include <general/table.h> |
49 |
#include <general/dstring.h> |
50 |
#include <compiler/module.h> |
51 |
#include <compiler/library.h> |
52 |
#include <compiler/exprsym.h> |
53 |
#include <compiler/instance_io.h> |
54 |
#include <compiler/instance_enum.h> |
55 |
#include <compiler/relation_io.h> |
56 |
#include <solver/system.h> |
57 |
#include <solver/var.h> |
58 |
#include "Qlfdid.h" |
59 |
#include "UnitsProc.h" |
60 |
#include "CodeGen.h" |
61 |
|
62 |
|
63 |
#undef CG_OFFSET |
64 |
#define CG_OFFSET 0 |
65 |
|
66 |
struct CGFormat ASCEND_Format = { |
67 |
CG_ascend,CG_squarebracket,CG_hat_power,CG_ascend,CG_ascend |
68 |
}; |
69 |
struct CGFormat GAMS_Format = { |
70 |
CG_gams,CG_round,CG_dstar_power,CG_gams,CG_gams, |
71 |
}; |
72 |
struct CGFormat Math_Format = { |
73 |
CG_math,CG_round,CG_func_power,CG_math,CG_math |
74 |
}; |
75 |
|
76 |
/* |
77 |
* Remember to export these symbols from CodeGen.c |
78 |
*/ |
79 |
extern struct gl_list_t *PreProcessVars(struct Instance *); |
80 |
|
81 |
|
82 |
static int CmpTypes(CONST struct Instance *i1, CONST struct Instance *i2) |
83 |
{ |
84 |
return strcmp(InstanceType(i1),InstanceType(i2)); |
85 |
} |
86 |
|
87 |
static int CG_Classify(struct Instance *inst) |
88 |
{ |
89 |
return 1; |
90 |
} |
91 |
|
92 |
static struct gl_list_t *CodeGen2_SortVariables(struct var_variable **vp, |
93 |
int num) |
94 |
{ |
95 |
struct Instance *var_inst; |
96 |
struct gl_list_t *variables; |
97 |
int c; |
98 |
|
99 |
variables = gl_create((unsigned long)num); |
100 |
for (c=0;c<num;c++) { |
101 |
var_inst = var_instance(vp[c]); |
102 |
gl_append_ptr(variables,(char *)var_inst); |
103 |
} |
104 |
/* |
105 |
* Sort the list by type. |
106 |
*/ |
107 |
gl_sort(variables,(CmpFunc)CmpTypes); |
108 |
return variables; |
109 |
} |
110 |
|
111 |
/* |
112 |
********************************************************************** |
113 |
* This code assumes that the base type that the solver |
114 |
* operates upon is a solver_var. This must be changed if/when |
115 |
* we switch over to solver_reals or some other solver entry |
116 |
* point. |
117 |
* REMEMBER TO CHECK THAT WE NEVER GET CALLED WITH A EMPTY |
118 |
* LIST AND TO CHECK SINGLE ELEMENT LISTS. !! |
119 |
* |
120 |
* REMEMBER TO CHECK CHECK CHECK. |
121 |
********************************************************************** |
122 |
*/ |
123 |
|
124 |
|
125 |
static void CodeGen2_WriteImport(FILE *fp, char *file_prefix) |
126 |
{ |
127 |
FPRINTF(fp,"IMPORT %s_Init FROM lib%s;\n\n",file_prefix,file_prefix); |
128 |
} |
129 |
|
130 |
/* |
131 |
********************************************************************** |
132 |
* CodeGen_ParseTypes |
133 |
* |
134 |
* This function takes a string list -- a Tcl list -- of instance |
135 |
* names, and returns a gl_list_t of the correspoding instances. |
136 |
* If there are any errors, a NULL is returned. We will also return |
137 |
* the count of elements that tcl found. |
138 |
********************************************************************** |
139 |
*/ |
140 |
|
141 |
#define TYPE_HASH_SIZE 31 |
142 |
|
143 |
struct Table *CodeGen2_ParseTypes(Tcl_Interp *interp, char *strlist, |
144 |
int *found_count) |
145 |
{ |
146 |
struct Table *table; |
147 |
struct TypeDescription *desc; |
148 |
struct Instance *i; |
149 |
char **argv; /* the split list of strings */ |
150 |
int len,c; |
151 |
int error = 0; |
152 |
|
153 |
if (Tcl_SplitList(interp,strlist,found_count,&argv) != TCL_OK) { |
154 |
return NULL; |
155 |
} |
156 |
if (*found_count==0) { /* parsed ok, but was a zero length list */ |
157 |
if (argv !=NULL) { |
158 |
Tcl_Free((char *)argv); |
159 |
} |
160 |
return NULL; |
161 |
} |
162 |
len = *found_count; |
163 |
table = CreateTable((unsigned long)TYPE_HASH_SIZE); |
164 |
/* |
165 |
* Search for each type in turn. If found in the main |
166 |
* table, then add to our local table. |
167 |
*/ |
168 |
for (c=0;c<len;c++) { |
169 |
desc = FindType(argv[c]); |
170 |
if (desc) { |
171 |
AddTableData(table,(void *)desc,argv[c]); |
172 |
} else { |
173 |
FPRINTF(stderr,"Error in finding type %s\n",argv[c]); |
174 |
error++; |
175 |
break; |
176 |
} |
177 |
} |
178 |
|
179 |
if (error) { |
180 |
DestroyTable(table,0); |
181 |
if (argv !=NULL) { |
182 |
Tcl_Free((char *)argv); |
183 |
} |
184 |
return NULL; |
185 |
} else { |
186 |
if (argv !=NULL) { |
187 |
Tcl_Free((char *)argv); |
188 |
} |
189 |
return table; |
190 |
} |
191 |
} |
192 |
|
193 |
static void CodeGen2_WriteAscendNames(FILE *fp, char *file_prefix, |
194 |
struct Instance *reference, |
195 |
struct CGVar *cgvarlist, |
196 |
int nvars, |
197 |
struct Table *table) |
198 |
{ |
199 |
struct Instance *inst; |
200 |
struct TypeDescription *desc; |
201 |
CONST char *name; |
202 |
int i; |
203 |
|
204 |
FPRINTF(fp,"MODEL %s_names;\n\n",file_prefix); |
205 |
FPRINTF(fp,"(*\n"); |
206 |
for (i=0;i<nvars;i++) { |
207 |
inst = Asc_CGVarInstance(&cgvarlist[i]); |
208 |
if (table) { |
209 |
name = InstanceType(inst); |
210 |
desc = (struct TypeDescription *)LookupTableData(table,name); |
211 |
if (desc) { |
212 |
FPRINTF(fp,"x[%d]\t= ",i); |
213 |
WriteInstanceName(fp,inst,reference); |
214 |
FPRINTF(fp,";\n"); |
215 |
} |
216 |
} else { |
217 |
FPRINTF(fp,"x[%d]\t= ",i); |
218 |
WriteInstanceName(fp,inst,reference); |
219 |
FPRINTF(fp,";\n"); |
220 |
} |
221 |
} |
222 |
FPRINTF(fp,"*)\n\n"); |
223 |
FPRINTF(fp,"END %s_names;\n",file_prefix); |
224 |
} |
225 |
|
226 |
|
227 |
static void CodeGen2_WriteVarDecls(FILE *fp, char *file_prefix, |
228 |
struct Instance *reference, |
229 |
struct CGVar *cgvarlist, |
230 |
int nvars) |
231 |
{ |
232 |
CONST struct Instance *inst; |
233 |
struct CGVar *cgvar; |
234 |
char *type; |
235 |
int start = 0; |
236 |
int c, written=0; |
237 |
unsigned int filter,MASK; |
238 |
|
239 |
FPRINTF(fp,"MODEL %s__base REFINES %s;\n\n",file_prefix,file_prefix); |
240 |
FPRINTF(fp," all_vars, others, slv_var IS_A set OF integer;\n"); |
241 |
FPRINTF(fp," all_vars := [%d..%d];\n", start, nvars-1); |
242 |
FPRINTF(fp," others := [\n\t"); |
243 |
|
244 |
/* |
245 |
* Here we write out the set of variables that qualify as |
246 |
* 'others'. We deal with the first var as a special case, |
247 |
* so that we can do the commas correctly. |
248 |
*/ |
249 |
filter = cgvarlist[0].flags; |
250 |
if (filter & CG_SLV_REAL) { |
251 |
written = 0; |
252 |
} else { |
253 |
FPRINTF(fp,"%d",cgvarlist[0].cmplr_index); |
254 |
} |
255 |
|
256 |
for (c=1;c<nvars;c++) { |
257 |
filter = cgvarlist[c].flags; |
258 |
if (filter & CG_SLV_REAL) { |
259 |
continue; |
260 |
} |
261 |
FPRINTF(fp,",%d",cgvarlist[c].cmplr_index); |
262 |
} |
263 |
FPRINTF(fp,"];\n"); |
264 |
|
265 |
FPRINTF(fp," slv_var := all_vars - others;\n"); |
266 |
FPRINTF(fp," x_[all_vars] IS_A real;\n\n"); |
267 |
|
268 |
/* |
269 |
* Now we write out *all variables present in the model and |
270 |
* ARE_THE_SAME with the x[i]'s. E.g.: |
271 |
* |
272 |
* tray[2].liquid['in'], x[452] ARE_THE_SAME; |
273 |
*/ |
274 |
for (c=0;c<nvars;c++) { |
275 |
inst = cgvarlist[c].instance; |
276 |
FPRINTF(fp," x_[%d],\t",cgvarlist[c].cmplr_index); |
277 |
WriteInstanceName(fp,inst,reference); |
278 |
FPRINTF(fp,"\t ARE_THE_SAME;\n"); |
279 |
} |
280 |
PUTC('\n',fp); |
281 |
FPRINTF(fp,"END %s__base;\n\n",file_prefix); |
282 |
} |
283 |
|
284 |
|
285 |
static void CodeGen2_WriteRelDecls(FILE *fp, char *file_prefix, |
286 |
struct rel_relation **rp, int nrels) |
287 |
{ |
288 |
struct Instance *relinst, *inst; |
289 |
enum Expr_enum type; |
290 |
CONST struct relation *reln; |
291 |
struct CGVar *cgvar; |
292 |
int n_varsinrel, penultimate, i; |
293 |
unsigned long j; |
294 |
int relndx; |
295 |
|
296 |
|
297 |
FPRINTF(fp,"MODEL %s_plus_relations REFINES %s__base;\n\n", |
298 |
file_prefix, file_prefix); |
299 |
|
300 |
for (i=0;i<nrels;i++) { |
301 |
relndx = rel_index(rp[i]); |
302 |
FPRINTF(fp," relation_%d: %s(x_[", relndx, file_prefix); |
303 |
relinst = rel_instance(rp[i]); |
304 |
reln = GetInstanceRelation(relinst,&type); |
305 |
|
306 |
n_varsinrel = (int)NumberVariables(reln); |
307 |
penultimate = n_varsinrel - 1; |
308 |
if (n_varsinrel) { |
309 |
for (j=0;j<n_varsinrel;j++) { |
310 |
inst = RelationVariable(reln,j+1); |
311 |
cgvar = (struct CGVar *)GetInterfacePtr(inst); |
312 |
FPRINTF(fp,"%d",cgvar->cmplr_index); |
313 |
if (j!=penultimate) { |
314 |
PUTC(',',fp); |
315 |
} |
316 |
} |
317 |
} |
318 |
FPRINTF(fp,"] ; %d);\n", relndx); |
319 |
} |
320 |
|
321 |
PUTC('\n',fp); |
322 |
FPRINTF(fp,"END %s_plus_relations;\n\n", file_prefix); |
323 |
} |
324 |
|
325 |
|
326 |
/* |
327 |
********************************************************************** |
328 |
* Patches |
329 |
* |
330 |
* This is the beginning of some code to do writing out the ascend |
331 |
* models associated with glassboxes, properly. |
332 |
* By this we mean that sufficient information will be written out so |
333 |
* that the relations may be inserted properly at the scope that they |
334 |
* came from. We call this a PATCH file. |
335 |
* |
336 |
********************************************************************** |
337 |
*/ |
338 |
|
339 |
static struct Instance *FindNonArrayParent(struct Instance *i) |
340 |
{ |
341 |
struct Instance *tmp = i; |
342 |
while ((tmp) && (InstanceKind(tmp)!=MODEL_INST)) { |
343 |
if (NumberParents(tmp)==0) { |
344 |
break; |
345 |
} |
346 |
tmp = InstanceParent(tmp,1L); |
347 |
} |
348 |
if (InstanceKind(tmp)==MODEL_INST) { |
349 |
return tmp; |
350 |
} else { |
351 |
return NULL; |
352 |
} |
353 |
} |
354 |
|
355 |
/* |
356 |
* We write out a patch definition of the form: |
357 |
* |
358 |
* PATCH new_patch FOR old_type; |
359 |
* |
360 |
* reln['a'] : new__(x['b'], y[1], ... ,a.z; 12) IN a.b.c; |
361 |
* other[1] : new__(x['b'], a.b.z; 12); |
362 |
* |
363 |
* END new_patch; |
364 |
* |
365 |
* The first relation includes a statement of the scope. The second |
366 |
* does not, indicating that the relation was defined at the level of |
367 |
* the definition model. We could be pendantic and write out SELF, but |
368 |
* this should do. |
369 |
*/ |
370 |
static |
371 |
void CodeGen2_WritePatch(FILE *fp, char *file_prefix, |
372 |
struct Instance *reference, |
373 |
struct rel_relation **rp, |
374 |
int nrels) |
375 |
{ |
376 |
struct Instance *relinst, *inst; |
377 |
struct Instance *model; |
378 |
enum Expr_enum type; |
379 |
CONST struct relation *reln; |
380 |
int n_varsinrel,i; |
381 |
unsigned long j; |
382 |
int relndx, count = 0; /* used for breaking lines */ |
383 |
|
384 |
if (nrels==0) { |
385 |
return; |
386 |
} |
387 |
|
388 |
FPRINTF(fp,"PATCH %s_patch FOR %s;\n\n", |
389 |
file_prefix, InstanceType(reference)); |
390 |
|
391 |
|
392 |
for (i=0;i<nrels;i++) { |
393 |
relndx = rel_index(rp[i]); |
394 |
relinst = rel_instance(rp[i]); |
395 |
model = FindNonArrayParent(relinst); |
396 |
if (!model) { |
397 |
FPRINTF(stderr,"Error in finding rel parent -- skipping reln %d", |
398 |
relndx); |
399 |
continue; |
400 |
} |
401 |
WriteInstanceName(fp,relinst,model); /* the relation name */ |
402 |
fputs(" :\n",fp); |
403 |
count += FPRINTF(fp,"\t%s(",file_prefix); |
404 |
reln = GetInstanceRelation(relinst,&type); |
405 |
|
406 |
/* |
407 |
* Write out the glassbox relation, with its relation name |
408 |
* and variables in the current scope. We deal with the first |
409 |
* variable specially to get the commas correct. |
410 |
*/ |
411 |
n_varsinrel = (int)NumberVariables(reln); |
412 |
if (n_varsinrel) { |
413 |
inst = RelationVariable(reln,1); |
414 |
count += WriteInstanceName(fp,inst,model); |
415 |
} |
416 |
for (j=1;j<n_varsinrel;j++) { |
417 |
inst = RelationVariable(reln,j+1); |
418 |
count += fputs(" ,",fp); |
419 |
count += WriteInstanceName(fp,inst,model); |
420 |
if (count >= 60) { |
421 |
fputs("\t\n",fp); |
422 |
count = 0; |
423 |
} |
424 |
} |
425 |
/* |
426 |
* Write out the destination instance name. |
427 |
*/ |
428 |
if (model!=reference) { |
429 |
FPRINTF(fp," ; %d)\n\t IN ", relndx); |
430 |
WriteInstanceName(fp,model,reference); |
431 |
} else { |
432 |
FPRINTF(fp," ; %d)", relndx); |
433 |
} |
434 |
fputs(";\n\n",fp); |
435 |
count = 0; |
436 |
} |
437 |
|
438 |
PUTC('\n',fp); |
439 |
FPRINTF(fp,"END %s_patch;\n\n", file_prefix); |
440 |
} |
441 |
|
442 |
|
443 |
|
444 |
static void CodeGen2_WriteInits(FILE *fp, char *file_prefix, |
445 |
struct CGVar *cgvarlist, |
446 |
int nvars) |
447 |
{ |
448 |
struct Instance *inst; |
449 |
char *units = "?"; |
450 |
double value; |
451 |
int start = 0, i; |
452 |
|
453 |
/* |
454 |
* Write Header. |
455 |
*/ |
456 |
FPRINTF(fp,"MODEL %s_plus_init REFINES %s_plus_relations;\n\n", |
457 |
file_prefix, file_prefix); |
458 |
FPRINTF(fp," METHODS\n\n"); |
459 |
|
460 |
/* |
461 |
* Art's beloved clear procedure. |
462 |
*/ |
463 |
FPRINTF(fp," METHOD clear;\n"); |
464 |
FPRINTF(fp," x_[slv_var].fixed := FALSE;\n"); |
465 |
FPRINTF(fp," END clear;\n"); |
466 |
|
467 |
/* |
468 |
* Specify -- write out the vars that were fixed at the time |
469 |
* of codegeneration. |
470 |
*/ |
471 |
FPRINTF(fp," METHOD specify;\n"); |
472 |
for (i=0;i<nvars;i++) { |
473 |
if (Asc_CGVarFixed(&cgvarlist[i])) { |
474 |
assert(cgvarlist[i].flags & CG_SLV_REAL); |
475 |
FPRINTF(fp," x_[%d].fixed := TRUE;\n", cgvarlist[i].cmplr_index); |
476 |
} |
477 |
} |
478 |
FPRINTF(fp," END specify;\n"); |
479 |
|
480 |
/* |
481 |
* Values -- write out the values for all variables, along |
482 |
* with the appropriate units. FIX units later. For the moment |
483 |
* just write out wild values. |
484 |
*/ |
485 |
FPRINTF(fp," METHOD values;\n"); |
486 |
for (i=0;i<nvars;i++) { |
487 |
inst = Asc_CGVarInstance(&cgvarlist[i]); |
488 |
value = RealAtomValue(inst); |
489 |
FPRINTF(fp," x_[%d] := %12.8g {%s};\n", |
490 |
cgvarlist[i].cmplr_index, value, units); |
491 |
} |
492 |
FPRINTF(fp," END values;\n"); |
493 |
|
494 |
|
495 |
/* |
496 |
* Write Footer. |
497 |
*/ |
498 |
PUTC('\n',fp); |
499 |
FPRINTF(fp,"END %s_plus_init;\n\n", |
500 |
file_prefix); |
501 |
} |
502 |
|
503 |
|
504 |
|
505 |
/* |
506 |
* NOTE: Once we call set up, we have taken control of the |
507 |
* interface_ptrs associated with the variables. * We *must* *not* |
508 |
* use any of the struct var_variable *routines, but should use our CGVar |
509 |
* routines instead. This is critical. Shutdown will yield the |
510 |
* interface_ptr back to the previous owner. |
511 |
*/ |
512 |
|
513 |
|
514 |
void Asc_CodeGenWriteAscendFile(slv_system_t sys, |
515 |
FILE *fp, char *file_prefix, |
516 |
int gradients, |
517 |
char *typelist) |
518 |
{ |
519 |
struct Instance *root, *inst; |
520 |
struct rel_relation **rp; |
521 |
struct CGVar *cgvarlist, *cgvar; |
522 |
struct gl_list_t *list = NULL; |
523 |
struct Table *table = NULL; |
524 |
int nvars, nsolvervars, nrels; |
525 |
int result, found; |
526 |
|
527 |
nsolvervars = slv_get_num_master_vars(sys); /* to get an idea of how big */ |
528 |
if (nsolvervars==0) { |
529 |
return; |
530 |
} |
531 |
nrels = slv_get_num_master_rels(sys); |
532 |
rp = slv_get_master_rel_list(sys); |
533 |
|
534 |
root = g_solvinst_cur; /* see interface1.h */ |
535 |
list = PreProcessVars(root); |
536 |
nvars = (int)gl_length(list); |
537 |
assert(nvars>=nsolvervars); |
538 |
|
539 |
cgvarlist = Asc_CodeGenSetUpVariables3(list); |
540 |
result = CodeGen_SetupCodeGen(sys, cgvarlist,nvars, NULL,0, NULL,0, NULL,0, |
541 |
NULL,NULL); |
542 |
if (result) { |
543 |
goto error; |
544 |
} |
545 |
|
546 |
CodeGen2_WriteImport(fp, file_prefix); |
547 |
table = CodeGen2_ParseTypes(interp, typelist, &found); |
548 |
|
549 |
CodeGen2_WriteAscendNames(fp, file_prefix, root, cgvarlist, nvars, |
550 |
table); |
551 |
CodeGen2_WritePatch(fp, file_prefix, root, rp, nrels); |
552 |
/* |
553 |
* FIX FIX -- peel these out into another function. |
554 |
* CodeGen2_WriteVarDecls(fp, file_prefix, root, cgvarlist, nvars); |
555 |
* CodeGen2_WriteRelDecls(fp, file_prefix, rp, nrels); |
556 |
* CodeGen2_WriteInits(fp, file_prefix, cgvarlist, nvars); |
557 |
*/ |
558 |
error: |
559 |
if (list) { |
560 |
gl_destroy(list); |
561 |
} |
562 |
if (table) { |
563 |
DestroyTable(table,0); |
564 |
} |
565 |
Asc_CodeGenShutDown(); |
566 |
} |
567 |
|
568 |
|
569 |
|
570 |
/* |
571 |
******************************************************************* |
572 |
* These are the routines for doing code generation for the |
573 |
* MathematicaTM file format. It serves more for debugging purposes |
574 |
* than anything else. This way we can submit the generated functions |
575 |
* for evaluation by mathematica, and check them against what we |
576 |
* compute. More important though, is that we can get mathematica to |
577 |
* compute the gradients symbolically and numerically and back check |
578 |
* our gradients against them. |
579 |
* Although some of the functions are *very* similar to the c_format, |
580 |
* I have opted to duplicate the code, so as not to burden the |
581 |
* c_format which is expected to be used most. |
582 |
******************************************************************* |
583 |
*/ |
584 |
int CodeGen__WriteMathFuncs(FILE *fp, struct rel_relation *rel) |
585 |
{ |
586 |
struct Instance *rel_inst, *var_inst; |
587 |
RelationINF *r; |
588 |
enum Expr_enum type; |
589 |
Term *lhs,*rhs; |
590 |
int nchars; |
591 |
|
592 |
rel_inst = rel_instance(rel); |
593 |
r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */ |
594 |
if (type!=e_token) { |
595 |
FPRINTF(stderr,"rel type not supported in CodeGen_WriteMathFuncs\n"); |
596 |
return; |
597 |
} |
598 |
|
599 |
FPRINTF(fp,"f%d = ",rel_index(rel)); /* write label */ |
600 |
if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */ |
601 |
nchars = CodeGen_WriteSide(fp,lhs,r,&Math_Format,0); /* write lhs */ |
602 |
} |
603 |
if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */ |
604 |
FPRINTF(fp," - ("); |
605 |
nchars = CodeGen_WriteSide(fp,rhs,r,&Math_Format,nchars); /* write rhs */ |
606 |
PUTC(')',fp); |
607 |
} |
608 |
FPRINTF(fp,"\n"); |
609 |
return 0; |
610 |
} |
611 |
|
612 |
|
613 |
int CodeGen__WriteMathGrads(FILE *fp, struct rel_relation *rel, |
614 |
int *ndx_offset) |
615 |
{ |
616 |
/* |
617 |
* !!! Remember to remove all assumptions about vars being synonmous |
618 |
* with struct var_variable *'s !!! |
619 |
*/ |
620 |
struct Instance *rel_inst, *var_inst; |
621 |
struct CGVar *cgvar; |
622 |
RelationINF *r, *derivative; |
623 |
enum Expr_enum type; |
624 |
Term *lhs,*rhs; |
625 |
int a_index; |
626 |
int nchars; |
627 |
unsigned long n_varsinrel,j; |
628 |
|
629 |
a_index = *ndx_offset; |
630 |
|
631 |
rel_inst = rel_instance(rel); |
632 |
r = (RelationINF *)GetInstanceRelation(rel_inst,&type); |
633 |
if (type!=e_token) { |
634 |
FPRINTF(stderr,"rel type not supported in CodeGen_WriteMathFuncs\n"); |
635 |
return; |
636 |
} |
637 |
|
638 |
n_varsinrel = NumberVariables(r); |
639 |
for (j=1;j<=n_varsinrel;j++) { |
640 |
var_inst = RelationVariable(r,j); |
641 |
if (solver_var(var_inst)) { |
642 |
cgvar = Asc_CGInstanceVar(var_inst); |
643 |
FPRINTF(fp,"g%d = D[f%d,x%d];\n", /* MathTM instr. */ |
644 |
++a_index, rel_index(rel),cgvar->index); |
645 |
derivative = RelDeriveSloppy(r,j,CG_Classify); |
646 |
FPRINTF(fp,"myg%d = ",a_index); |
647 |
if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */ |
648 |
nchars = CodeGen_WriteSide(fp,lhs,derivative,&Math_Format,0); |
649 |
} |
650 |
if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */ |
651 |
FPRINTF(fp," - ("); |
652 |
nchars = CodeGen_WriteSide(fp,rhs,derivative,&Math_Format,nchars); |
653 |
PUTC(')',fp); |
654 |
} |
655 |
FPRINTF(fp,"\n"); |
656 |
RelDestroySloppy(derivative); |
657 |
} |
658 |
} |
659 |
*ndx_offset = a_index; /* set up for return */ |
660 |
return 0; |
661 |
} |
662 |
|
663 |
int CodeGen__WriteGamsFuncs(FILE *fp, struct rel_relation *rel) |
664 |
{ |
665 |
struct Instance *rel_inst, *var_inst; |
666 |
RelationINF *r; |
667 |
enum Expr_enum type; |
668 |
Term *lhs,*rhs; |
669 |
int nchars; |
670 |
double rel_nom; |
671 |
|
672 |
rel_inst = rel_instance(rel); |
673 |
r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */ |
674 |
/* this assumes RelationINF and struct relation are the same */ |
675 |
rel_nom = rel_nominal(rel); |
676 |
if (rel_nom < 0.00001) { |
677 |
rel_nom = 1.0; |
678 |
} |
679 |
if (type!=e_token) { |
680 |
FPRINTF(stderr,"rel type not supported in CodeGen_WriteGamsFuncs\n"); |
681 |
return; |
682 |
} |
683 |
if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */ |
684 |
FPRINTF(fp,"("); |
685 |
nchars = CodeGen_WriteSide(fp,lhs,r,&GAMS_Format,0); /* write lhs */ |
686 |
FPRINTF(fp,")/%.8g", rel_nom); |
687 |
if ((rhs = RelationINF_Rhs(r))==NULL) { |
688 |
return 0; /* if relation is objective function, job is done here */ |
689 |
} |
690 |
} |
691 |
switch(RelationRelop(r)) { |
692 |
case e_less: |
693 |
case e_lesseq: |
694 |
FPRINTF(fp," =l= "); |
695 |
break; |
696 |
case e_equal: |
697 |
FPRINTF(fp," =e= "); |
698 |
break; |
699 |
case e_greater: |
700 |
case e_greatereq: |
701 |
FPRINTF(fp," =g= "); |
702 |
break; |
703 |
default: |
704 |
FPRINTF(fp,"ERROR"); |
705 |
} |
706 |
if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */ |
707 |
FPRINTF(fp,"("); |
708 |
nchars = CodeGen_WriteSide(fp,rhs,r,&GAMS_Format,nchars); /* write rhs */ |
709 |
FPRINTF(fp,")/%.8g", rel_nom); |
710 |
} |
711 |
FPRINTF(fp,";\n"); |
712 |
return 0; |
713 |
} |
714 |
|
715 |
|
716 |
void CodeGen_WriteGamsFile(slv_system_t sys, |
717 |
FILE *fp, char *file_prefix, int gradients) |
718 |
{ |
719 |
struct rel_relation **rp, **op; |
720 |
expr_t obj; |
721 |
struct CGVar *vp, var; |
722 |
struct Instance *instance; |
723 |
int num_rels, num_vars, num_objs; |
724 |
int i,offset; |
725 |
double value; |
726 |
int index; |
727 |
int binaries_present = 0; |
728 |
int result, count; |
729 |
real64 val_tmp; |
730 |
char *objs=NULL; |
731 |
char *lhs=NULL, *rhs=NULL; |
732 |
int nchars; |
733 |
RelationINF *r; |
734 |
struct TypeDescription *type; |
735 |
enum type_kind binary = boolean_type; |
736 |
FILE *fp2; |
737 |
char *filename2 = NULL; |
738 |
|
739 |
filename2 = (char *)ascmalloc((strlen(file_prefix)+6)*sizeof(char)); |
740 |
sprintf(filename2,"%s.names",file_prefix); |
741 |
fp2 = fopen(filename2,"w"); |
742 |
|
743 |
(void)CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0, |
744 |
NULL,NULL); |
745 |
offset = CG_OFFSET-1; |
746 |
num_rels = g_cgdata.rels.num_rels; |
747 |
rp = g_cgdata.rels.rel_list; |
748 |
|
749 |
num_objs = g_cgdata.objs.num_objs; |
750 |
op = g_cgdata.objs.obj_list; |
751 |
|
752 |
num_vars = g_cgdata.vars.num_vars; |
753 |
vp = g_cgdata.vars.var_list; |
754 |
|
755 |
FPRINTF(fp,"$Title Ascend Generated GAMS Model"); |
756 |
FPRINTF(fp,"$offsymlist\n"); |
757 |
FPRINTF(fp,"$offsymxref\n"); |
758 |
FPRINTF(fp,"option limrow = 0;\n"); |
759 |
FPRINTF(fp,"option limcol = 0;\n"); |
760 |
FPRINTF(fp,"$inlinecom /* */\n\n"); |
761 |
|
762 |
FPRINTF(fp,"variables\n"); |
763 |
|
764 |
for (i=0;i<num_vars;i++) { |
765 |
index = vp[i].index; |
766 |
instance = vp[i].instance; |
767 |
FPRINTF(fp," x%d\t/* ", index); |
768 |
WriteInstanceName(fp,instance,NULL); |
769 |
FPRINTF(fp," */\n"); |
770 |
} |
771 |
for (i=0;i<num_objs;i++) { |
772 |
index = rel_index(op[i]); |
773 |
FPRINTF(fp," alpha%d\t/* objective variable */\n", index); |
774 |
} |
775 |
FPRINTF(fp," ;\n\n"); |
776 |
for (i=0;i<num_vars;i++) { |
777 |
index = vp[i].index; |
778 |
instance = vp[i].instance; |
779 |
type = InstanceTypeDesc(instance); |
780 |
if (strcmp(type->name,"solver_binary") == 0) { |
781 |
FPRINTF(fp,"binary variable x%d;\n", index); |
782 |
binaries_present = 1; |
783 |
} |
784 |
val_tmp = ((var_lower_bound(instance) < -1e08) |
785 |
? -1e08 |
786 |
: var_lower_bound(instance)); |
787 |
FPRINTF(fp," x%d.lo = %16.8g;\n", index, val_tmp); |
788 |
|
789 |
val_tmp = ((var_upper_bound(instance) > 1e08) |
790 |
? 1e08 |
791 |
: var_upper_bound(instance)); |
792 |
FPRINTF(fp," x%d.up = %16.8g;\n", index, val_tmp); |
793 |
|
794 |
val_tmp = (var_value(instance) > 1e09) ? 1e09 : var_value(instance); |
795 |
if (val_tmp < 0.00000001 && val_tmp > -0.00000001) {val_tmp = 0.0;} |
796 |
FPRINTF(fp," x%d.l = %16.8g;\n", index, val_tmp); |
797 |
|
798 |
if (var_fixed(instance)) { |
799 |
FPRINTF(fp," x%d.fx = %16.8g;\n", index,val_tmp); |
800 |
} |
801 |
if (fabs(val_tmp) > 0.01) { |
802 |
FPRINTF(fp," x%d.scale = %16.8g;\n", index, fabs(val_tmp)); |
803 |
} |
804 |
} |
805 |
|
806 |
FPRINTF(fp,"equations \n"); |
807 |
for (i=0;i<num_rels;i++) { |
808 |
index = rel_index(rp[i]); |
809 |
FPRINTF(fp," rel_%d\n",index); |
810 |
} |
811 |
for (i=0;i<num_objs;i++) { |
812 |
index = rel_index(op[i]); |
813 |
FPRINTF(fp," obj_%d\n",index); |
814 |
} |
815 |
FPRINTF(fp,";\n"); |
816 |
for (i=0;i<num_rels;i++) { |
817 |
index = rel_index(rp[i]); /* write label */ |
818 |
FPRINTF(fp,"rel_%d.. ",index); |
819 |
CodeGen__WriteGamsFuncs(fp,rp[i]); |
820 |
} |
821 |
|
822 |
FPRINTF(fp,"\n"); |
823 |
for (i=0;i<num_objs;i++) { |
824 |
index = rel_index(op[i]); /* write label */ |
825 |
if (rel_obj_negate_flag(op[i])) { /* objective is a maximization */ |
826 |
FPRINTF(fp,"obj_%d.. alpha%d =g= -(",index,index); |
827 |
} else { /* objective is a minimization */ |
828 |
FPRINTF(fp,"obj_%d.. alpha%d =g= (",index,index); |
829 |
} |
830 |
CodeGen__WriteGamsFuncs(fp,op[i]); |
831 |
FPRINTF(fp,");\n"); |
832 |
} |
833 |
|
834 |
FPRINTF(fp,"model test1 using /\n"); |
835 |
for (i=0;i<num_rels;i++) { |
836 |
if (rel_included(rp[i]) && rel_active(rp[i])) { |
837 |
index = rel_index(rp[i]); /* write label */ |
838 |
FPRINTF(fp,"rel_%d\n",index); |
839 |
} |
840 |
} |
841 |
FPRINTF(fp,"obj_0\n"); |
842 |
FPRINTF(fp," /;\n"); |
843 |
if (!binaries_present) { |
844 |
FPRINTF(fp,"option nlp = conopt;\n"); |
845 |
FPRINTF(fp,"test1.OPTFILE = 1;\n"); |
846 |
FPRINTF(fp,"test1.SCALEOPT = 2;\n"); |
847 |
FPRINTF(fp,"solve test1 using nlp minimizing alpha0;\n"); |
848 |
} else { |
849 |
FPRINTF(fp,"solve test1 using minlp minimizing alpha0;\n"); |
850 |
} |
851 |
FPRINTF(fp,"file out /%s.gms_val/;\n",file_prefix); |
852 |
FPRINTF(fp,"put out;\n"); |
853 |
FPRINTF(fp,"put\n"); |
854 |
for (i=0;i<num_vars;i++) { |
855 |
index = vp[i].index; |
856 |
instance = vp[i].instance; |
857 |
FPRINTF(fp2,"qassgn3 {"); |
858 |
WriteInstanceName(fp2,instance,NULL); |
859 |
FPRINTF(fp2,"} \n"); |
860 |
FPRINTF(fp,"x%d.l:26:18/\n", index); |
861 |
} |
862 |
FPRINTF(fp,"put //;\n"); |
863 |
fclose(fp); |
864 |
fclose(fp2); |
865 |
Asc_CodeGenShutDown(); |
866 |
} |
867 |
|
868 |
|
869 |
void CodeGen_WriteMathFile(slv_system_t sys, |
870 |
FILE *fp, char *file_prefix, int gradients) |
871 |
{ |
872 |
struct rel_relation **rp; |
873 |
struct CGVar *vp, var; |
874 |
struct Instance *instance; |
875 |
int num_rels, num_vars; |
876 |
int i,offset; |
877 |
double value; |
878 |
int index; |
879 |
int result; |
880 |
|
881 |
(void)CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0, |
882 |
NULL,NULL); |
883 |
offset = CG_OFFSET-1; |
884 |
num_rels = g_cgdata.rels.num_rels; |
885 |
rp = g_cgdata.rels.rel_list; |
886 |
|
887 |
/* |
888 |
* Write out some header stuff. |
889 |
*/ |
890 |
FPRINTF(fp,"Clear[\"x*\",\"f*\",\"g*\",\"myg*\"]\n"); |
891 |
FPRINTF(fp,"dummy >> result.out\n\n"); |
892 |
|
893 |
/* |
894 |
* Write the functions, our gradients and some gradient |
895 |
* instructions. |
896 |
*/ |
897 |
if (gradients) { |
898 |
PrepareDerivatives(1,1,1000); |
899 |
} |
900 |
|
901 |
for (i=0;i<num_rels;i++) { |
902 |
CodeGen__WriteMathFuncs(fp,rp[i]); |
903 |
if (gradients) { |
904 |
CodeGen__WriteMathGrads(fp,rp[i],&offset); |
905 |
} |
906 |
} |
907 |
|
908 |
if (gradients) { |
909 |
ShutDownDerivatives(); |
910 |
} |
911 |
|
912 |
/* |
913 |
* Write out the values of the variables. |
914 |
*/ |
915 |
num_vars = g_cgdata.vars.num_vars; |
916 |
vp = g_cgdata.vars.var_list; |
917 |
for (i=0;i<num_vars;i++) { |
918 |
index = vp[i].index; |
919 |
instance = vp[i].instance; |
920 |
value = var_value(instance); |
921 |
FPRINTF(fp,"x%d := %12.8f;\n",index, value); |
922 |
} |
923 |
|
924 |
/* |
925 |
* Finally write out the instructions for the calculated |
926 |
* values. The maximum number of incidences should now |
927 |
* be sitting in offset. (- 1) |
928 |
*/ |
929 |
for (i=0;i<offset;i++) { |
930 |
FPRINTF(fp,"g%d >>> result.out;\n",i); |
931 |
FPRINTF(fp,"myg%d >>> result.out;\n",i); |
932 |
} |
933 |
Asc_CodeGenShutDown(); |
934 |
} |
935 |
|
936 |
static FILE *SetUpMainFilePtr(char *filename, |
937 |
struct CGFormat *format) |
938 |
{ |
939 |
FILE *fp; |
940 |
switch(format->main_format) { |
941 |
case CG_gams: |
942 |
sprintf(filename,"%s.gms",filename); |
943 |
break; |
944 |
case CG_ascend: |
945 |
sprintf(filename,"%s.patch",filename); |
946 |
break; |
947 |
case CG_math: |
948 |
sprintf(filename,"%s.m",filename); |
949 |
break; |
950 |
case CG_linear: |
951 |
sprintf(filename,"%s.xsys",filename); |
952 |
break; |
953 |
} |
954 |
|
955 |
fp = fopen(filename,"w"); |
956 |
return fp; |
957 |
} |
958 |
/* The following code provides another entry point |
959 |
* for generating gams code. This allows gams users |
960 |
* to generate code only specifying the output filename. |
961 |
*/ |
962 |
|
963 |
int Asc_CodeGenGamsCmd(ClientData cdata, Tcl_Interp *interp, |
964 |
int argc, CONST84 char *argv[]) |
965 |
{ |
966 |
FILE *fp; |
967 |
int result = 0; |
968 |
char *filename = NULL; |
969 |
struct CGFormat format; |
970 |
slv_system_t sys = g_solvsys_cur; |
971 |
if ( argc != 2 ) { |
972 |
Tcl_AppendResult(interp,"wrong # args : ", |
973 |
"Usage __codegen_gams filename", (char *)NULL); |
974 |
return TCL_ERROR; |
975 |
} |
976 |
|
977 |
filename = (char *)ascmalloc((strlen(argv[1])+8)*sizeof(char)); |
978 |
strcpy(filename,argv[1]); |
979 |
result = CodeGen_CheckSystem(interp,sys); |
980 |
if (result) { |
981 |
return TCL_ERROR; |
982 |
} |
983 |
|
984 |
format = GAMS_Format; |
985 |
|
986 |
/* |
987 |
* Set up the file pointer based on the format. |
988 |
*/ |
989 |
fp = SetUpMainFilePtr(filename,&format); |
990 |
if (!fp) { |
991 |
Tcl_SetResult(interp, |
992 |
"__codegen_general file open failed. system not written.", |
993 |
TCL_STATIC); |
994 |
result = TCL_ERROR; |
995 |
goto error; |
996 |
} |
997 |
|
998 |
/* |
999 |
* Generate the code. Each of these formats sets up whatever |
1000 |
* support structures that are necessary. They will likewise |
1001 |
* destroy these structures themselves. |
1002 |
*/ |
1003 |
|
1004 |
CodeGen_WriteGamsFile(sys,fp,argv[1],0); |
1005 |
|
1006 |
error: |
1007 |
if (filename) { |
1008 |
ascfree(filename); |
1009 |
} |
1010 |
if (fp) { |
1011 |
fclose(fp); |
1012 |
} |
1013 |
return (result!=0) ? TCL_ERROR : TCL_OK; |
1014 |
} |
1015 |
|
1016 |
|
1017 |
/* |
1018 |
* This does some generic code generation schemes. |
1019 |
* ?grad?nograd? refers to whether gradient code should be |
1020 |
* generated. |
1021 |
* ?format? at the moment is one of linear,ascend,math,gams. |
1022 |
* type is a list of types which may be used to do some filtering |
1023 |
* of the information that is written out. |
1024 |
*/ |
1025 |
int Asc_CodeGenGeneralCmd(ClientData cdata, Tcl_Interp *interp, |
1026 |
int argc, CONST84 char *argv[]) |
1027 |
{ |
1028 |
FILE *fp; |
1029 |
int do_gradients=0; |
1030 |
int result = 0; |
1031 |
char *filename = NULL; |
1032 |
struct CGFormat format; |
1033 |
slv_system_t sys = g_solvsys_cur; |
1034 |
|
1035 |
if ( argc != 5 ) { |
1036 |
Tcl_AppendResult(interp,"wrong # args : ", |
1037 |
"Usage __codegen_general filename ?grad?nograd? ?format?", |
1038 |
"types", (char *)NULL); |
1039 |
return TCL_ERROR; |
1040 |
} |
1041 |
|
1042 |
filename = (char *)ascmalloc((strlen(argv[1])+16)*sizeof(char)); |
1043 |
strcpy(filename,argv[1]); |
1044 |
result = CodeGen_CheckSystem(interp,sys); |
1045 |
if (result) { |
1046 |
return TCL_ERROR; |
1047 |
} |
1048 |
|
1049 |
/* |
1050 |
* Check gradient args. |
1051 |
*/ |
1052 |
if (strncmp(argv[2],"gradients",4)==0) { |
1053 |
do_gradients = 1; |
1054 |
} |
1055 |
|
1056 |
/* |
1057 |
* Check format args; Default is Math_Format |
1058 |
*/ |
1059 |
if (strncmp(argv[3],"math",4)==0) { |
1060 |
format = Math_Format; |
1061 |
} else if (strncmp(argv[3],"gams",4)==0) { |
1062 |
format = GAMS_Format; |
1063 |
} else if (strncmp(argv[3],"ascend",4)==0) { |
1064 |
format = ASCEND_Format; |
1065 |
} else { |
1066 |
format = Math_Format; |
1067 |
} |
1068 |
|
1069 |
/* |
1070 |
* Set up the file pointer based on the format. |
1071 |
*/ |
1072 |
fp = SetUpMainFilePtr(filename,&format); |
1073 |
if (!fp) { |
1074 |
Tcl_SetResult(interp, |
1075 |
"__codegen_general file open failed. system not written.", |
1076 |
TCL_STATIC); |
1077 |
result = TCL_ERROR; |
1078 |
goto error; |
1079 |
} |
1080 |
|
1081 |
/* |
1082 |
* Generate the code. Each of these formats sets up whatever |
1083 |
* support structures that are necessary. They will likewise |
1084 |
* destroy these structures themselves. |
1085 |
*/ |
1086 |
switch(format.main_format) { |
1087 |
case CG_c: |
1088 |
Tcl_SetResult(interp, |
1089 |
"wrong format: Use \"__codegen_c\" instead", TCL_STATIC); |
1090 |
break; |
1091 |
case CG_math: |
1092 |
CodeGen_WriteMathFile(sys,fp,argv[1],do_gradients); |
1093 |
break; |
1094 |
case CG_ascend: |
1095 |
Asc_CodeGenWriteAscendFile(sys,fp,argv[1],do_gradients,argv[4]); |
1096 |
break; |
1097 |
case CG_gams: |
1098 |
CodeGen_WriteGamsFile(sys,fp,argv[1],do_gradients); |
1099 |
break; |
1100 |
case CG_linear: |
1101 |
FPRINTF(stderr,"Code generation file formats not yet supported\n"); |
1102 |
break; |
1103 |
default: |
1104 |
FPRINTF(stderr,"Unknown code generation file format\n"); |
1105 |
break; |
1106 |
} |
1107 |
|
1108 |
error: |
1109 |
if (filename) { |
1110 |
ascfree(filename); |
1111 |
} |
1112 |
if (fp) { |
1113 |
fclose(fp); |
1114 |
} |
1115 |
return (result!=0) ? TCL_ERROR : TCL_OK; |
1116 |
} |
1117 |
|
1118 |
|
1119 |
/* |
1120 |
* Some temporary stuff. |
1121 |
*/ |
1122 |
|
1123 |
struct TypeData { |
1124 |
CONST char *type; |
1125 |
int written; |
1126 |
}; |
1127 |
|
1128 |
static void Collect__Models(struct Instance *inst, |
1129 |
void *data) |
1130 |
{ |
1131 |
struct gl_list_t *list = (struct gl_list_t *)data; |
1132 |
|
1133 |
if (inst) { |
1134 |
switch (InstanceKind(inst)) { |
1135 |
case MODEL_INST: |
1136 |
case ARRAY_ENUM_INST: |
1137 |
case ARRAY_INT_INST: |
1138 |
gl_append_ptr(list,(char *)inst); |
1139 |
break; |
1140 |
default: |
1141 |
break; |
1142 |
} |
1143 |
} |
1144 |
} |
1145 |
|
1146 |
static struct gl_list_t *CollectModels(struct Instance *inst) |
1147 |
{ |
1148 |
struct gl_list_t *list; |
1149 |
list = gl_create(40L); |
1150 |
VisitInstanceTreeTwo(inst,Collect__Models,1,0,(void *)list); |
1151 |
return list; |
1152 |
} |
1153 |
|
1154 |
struct Table *MakeTypeTable(struct Instance *inst, |
1155 |
struct gl_list_t *list) |
1156 |
{ |
1157 |
CONST struct Instance *model; |
1158 |
struct TypeDescription *type; |
1159 |
struct Table *table; |
1160 |
struct TypeData *tdata; |
1161 |
CONST char *typename; |
1162 |
unsigned long len, c; |
1163 |
|
1164 |
/* |
1165 |
* Create a list and a table. Visit the tree *bottom up* |
1166 |
* and collect all models and array instances. |
1167 |
*/ |
1168 |
table = CreateTable(31L); |
1169 |
|
1170 |
len = gl_length(list); |
1171 |
for (c=1;c<=len;c++) { |
1172 |
model = (CONST struct Instance *)gl_fetch(list,c); |
1173 |
type = InstanceTypeDesc(model); |
1174 |
typename = InstanceType(model); |
1175 |
if (!typename) { |
1176 |
continue; |
1177 |
} |
1178 |
tdata = (struct TypeData *)LookupTableData(table,typename); |
1179 |
if (tdata) { |
1180 |
continue; |
1181 |
} else { |
1182 |
tdata = (struct TypeData *)ascmalloc(sizeof(struct TypeData)); |
1183 |
tdata->written = 0; |
1184 |
tdata->type = typename; |
1185 |
AddTableData(table,(void *)tdata,typename); |
1186 |
FPRINTF(stderr,"Added a new type --> %s\n",typename); |
1187 |
} |
1188 |
} |
1189 |
return table; |
1190 |
} |
1191 |
|
1192 |
static void PrintTypes(void *dataptr, void *fileptr) |
1193 |
{ |
1194 |
FILE *fp = (FILE *)fileptr; |
1195 |
struct TypeData *data = (struct TypeData *)dataptr; |
1196 |
CONST char *name; |
1197 |
int written; |
1198 |
|
1199 |
if (data && data->written==0) { |
1200 |
FPRINTF(fp,"Type --> %s\n",data->type); |
1201 |
data->written++; |
1202 |
} |
1203 |
} |
1204 |
|
1205 |
int Asc_CodeGenTypesCmd(ClientData cdata, Tcl_Interp *interp, |
1206 |
int argc, CONST84 char *argv[]) |
1207 |
{ |
1208 |
FILE *fp; |
1209 |
struct CGFormat format; |
1210 |
struct Table *table; |
1211 |
struct gl_list_t *list; |
1212 |
char *filename; |
1213 |
int result = TCL_OK; |
1214 |
|
1215 |
if ( argc != 2 ) { |
1216 |
Tcl_AppendResult(interp,"wrong # args : ", |
1217 |
"Usage __codegen_types filename", |
1218 |
(char *)NULL); |
1219 |
return TCL_ERROR; |
1220 |
} |
1221 |
|
1222 |
format = ASCEND_Format; |
1223 |
filename = (char *)ascmalloc((strlen(argv[1])+8)*sizeof(char)); |
1224 |
filename = strcpy(filename,argv[1]); |
1225 |
fp = SetUpMainFilePtr(filename,&format); |
1226 |
|
1227 |
list = CollectModels(g_curinst); |
1228 |
if (list) { |
1229 |
table = MakeTypeTable(g_curinst,list); |
1230 |
TableApplyAllTwo(table,PrintTypes,fp); |
1231 |
} else { |
1232 |
list = NULL; |
1233 |
table = NULL; |
1234 |
} |
1235 |
|
1236 |
error: |
1237 |
if (fp) { |
1238 |
fclose(fp); |
1239 |
} |
1240 |
if (list) { |
1241 |
gl_destroy(list); |
1242 |
} |
1243 |
if (table) { |
1244 |
DestroyTable(table,1); |
1245 |
} |
1246 |
return result; |
1247 |
} |
1248 |
|
1249 |
/* |
1250 |
* The above is some temporary stuff which must |
1251 |
* be deleted. |
1252 |
*/ |
1253 |
|
1254 |
|
1255 |
/* |
1256 |
* The following read and write functions are a rather |
1257 |
* speedy option to the read and write values functions |
1258 |
* in the browser. These functions read and write values |
1259 |
* based on the variable index numbers in the solver. |
1260 |
* This can be dangerous as NO checking is performed |
1261 |
* (other than checking the number of vars and the |
1262 |
* number of values to read are the same). |
1263 |
* YOU are responsible for making sure you are reading |
1264 |
* values into the correct instance! |
1265 |
*/ |
1266 |
void CodeGen_Write_Values_Fast(slv_system_t sys, |
1267 |
FILE *fp, char *file_prefix, |
1268 |
char *output_type) |
1269 |
{ |
1270 |
struct CGVar *vp; |
1271 |
struct Instance *instance; |
1272 |
int i, num_vars, index; |
1273 |
real64 (*proc)(struct var_variable *); |
1274 |
boolean (*boolean_proc)(struct var_variable *); |
1275 |
if (strncmp(output_type,"value",3)==0) { |
1276 |
proc = var_value; |
1277 |
} else if (strncmp(output_type,"nominal",3)==0) { |
1278 |
proc = var_nominal; |
1279 |
} else if (strncmp(output_type,"lower_bound",3)==0) { |
1280 |
proc = var_lower_bound; |
1281 |
} else if (strncmp(output_type,"upper_bound",3)==0) { |
1282 |
proc = var_upper_bound; |
1283 |
} else if (strncmp(output_type,"fixed",3)==0) { |
1284 |
boolean_proc = var_fixed; |
1285 |
} else { |
1286 |
FPRINTF(stderr,"must specify output type to be value, " |
1287 |
" nominal, lower_bound, upper_bound, or fixed\n"); |
1288 |
return; |
1289 |
} |
1290 |
CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0, NULL,NULL); |
1291 |
num_vars = g_cgdata.vars.num_vars; |
1292 |
vp = g_cgdata.vars.var_list; |
1293 |
FPRINTF(fp,"%i\n",num_vars); |
1294 |
if (strncmp(output_type,"fixed",3)==0) { |
1295 |
for (i=0;i<num_vars;i++) { |
1296 |
index = vp[i].index; |
1297 |
instance = vp[i].instance; |
1298 |
FPRINTF(fp,"%i\n",boolean_proc(instance)); |
1299 |
} |
1300 |
} else { |
1301 |
for (i=0;i<num_vars;i++) { |
1302 |
index = vp[i].index; |
1303 |
instance = vp[i].instance; |
1304 |
FPRINTF(fp,"%16.8g\n",proc(instance)); |
1305 |
} |
1306 |
} |
1307 |
Asc_CodeGenShutDown(); |
1308 |
} |
1309 |
|
1310 |
void CodeGen_Read_Values_Fast(slv_system_t sys, |
1311 |
FILE *fp, char *file_prefix, |
1312 |
char *input_type) |
1313 |
{ |
1314 |
struct CGVar *vp; |
1315 |
struct Instance *instance; |
1316 |
int i, num_vars, index, check; |
1317 |
real64 val_tmp; |
1318 |
int val_tmp_int; |
1319 |
boolean val_tmp_boolean; |
1320 |
char *buffer; |
1321 |
|
1322 |
void (*proc)(struct var_variable *,real64); |
1323 |
void (*boolean_proc)(struct var_variable *,boolean); |
1324 |
if (strncmp(input_type,"value",3)==0) { |
1325 |
proc = var_set_value; |
1326 |
} else if (strncmp(input_type,"nominal",3)==0) { |
1327 |
proc = var_set_nominal; |
1328 |
} else if (strncmp(input_type,"lower_bound",3)==0) { |
1329 |
proc = var_set_lower_bound; |
1330 |
} else if (strncmp(input_type,"upper_bound",3)==0) { |
1331 |
proc = var_set_upper_bound; |
1332 |
} else if (strncmp(input_type,"fixed",3)==0) { |
1333 |
boolean_proc = var_set_fixed; |
1334 |
} else { |
1335 |
FPRINTF(stderr,"must specify input type to be value," |
1336 |
" nominal, lower_bound, upper_bound, or fixed\n"); |
1337 |
return; |
1338 |
} |
1339 |
|
1340 |
CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0, |
1341 |
NULL,NULL); |
1342 |
|
1343 |
num_vars = g_cgdata.vars.num_vars; |
1344 |
vp = g_cgdata.vars.var_list; |
1345 |
|
1346 |
buffer = (char *)ascmalloc(16*sizeof(char)); |
1347 |
fgets(buffer,16,fp); |
1348 |
check = atoi(buffer); |
1349 |
if ( check == num_vars) { |
1350 |
if (strncmp(input_type,"fixed",3)==0) { |
1351 |
for (i=0;i<num_vars;i++) { |
1352 |
index = vp[i].index; |
1353 |
instance = vp[i].instance; |
1354 |
fgets(buffer,10,fp); |
1355 |
val_tmp_int = atoi(buffer); |
1356 |
if (val_tmp_int) { |
1357 |
val_tmp_boolean = 1; |
1358 |
} else { |
1359 |
val_tmp_boolean = 0; |
1360 |
} |
1361 |
boolean_proc(instance,val_tmp_boolean); |
1362 |
} |
1363 |
} else { |
1364 |
for (i=0;i<num_vars;i++) { |
1365 |
index = vp[i].index; |
1366 |
instance = vp[i].instance; |
1367 |
fgets(buffer,16,fp); |
1368 |
val_tmp = atof(buffer); |
1369 |
proc(instance,val_tmp); |
1370 |
} |
1371 |
} |
1372 |
} else { |
1373 |
FPRINTF(stderr, |
1374 |
"Number of elements in input file and solver are not equal.\n"); |
1375 |
FPRINTF(stderr,"File not read.\n"); |
1376 |
FPRINTF(stderr,"file length = %i, num_vars = %i\n",check,num_vars); |
1377 |
} |
1378 |
|
1379 |
Asc_CodeGenShutDown(); |
1380 |
} |
1381 |
|
1382 |
int Asc_CodeGenWriteCmd(ClientData cdata, Tcl_Interp *interp, |
1383 |
int argc, CONST84 char *argv[]) |
1384 |
{ |
1385 |
FILE *fp; |
1386 |
int result = 0; |
1387 |
char *filename = NULL; |
1388 |
struct CGFormat format; |
1389 |
slv_system_t sys = g_solvsys_cur; |
1390 |
if ( argc != 3 ) { |
1391 |
Tcl_AppendResult(interp,"wrong # args : ", |
1392 |
"Usage __codegen_write filename output_parameter", |
1393 |
(char *)NULL); |
1394 |
return TCL_ERROR; |
1395 |
} |
1396 |
|
1397 |
filename = (char *)ascmalloc((strlen(argv[1])+8)*sizeof(char)); |
1398 |
strcpy(filename,argv[1]); |
1399 |
result = CodeGen_CheckSystem(interp,sys); |
1400 |
if (result) { |
1401 |
return TCL_ERROR; |
1402 |
} |
1403 |
|
1404 |
/* |
1405 |
* Set up the file pointer |
1406 |
*/ |
1407 |
|
1408 |
if (strncmp(argv[2],"value",3)==0) { |
1409 |
sprintf(filename,"%s.fast%s",filename,"val"); |
1410 |
} else if (strncmp(argv[2],"nominal",3)==0) { |
1411 |
sprintf(filename,"%s.fast%s",filename,"nom"); |
1412 |
} else if (strncmp(argv[2],"lower_bound",3)==0) { |
1413 |
sprintf(filename,"%s.fast%s",filename,"low"); |
1414 |
} else if (strncmp(argv[2],"upper_bound",3)==0) { |
1415 |
sprintf(filename,"%s.fast%s",filename,"up"); |
1416 |
} else if (strncmp(argv[2],"fixed",3)==0) { |
1417 |
sprintf(filename,"%s.fast%s",filename,"fix"); |
1418 |
} else { |
1419 |
Tcl_SetResult(interp, |
1420 |
"Must specify output type to be value," |
1421 |
" nominal, lower_bound, upper_bound, or fixed." |
1422 |
TCL_VOLATILE); |
1423 |
if (filename) { |
1424 |
ascfree(filename); |
1425 |
} |
1426 |
return TCL_ERROR; |
1427 |
} |
1428 |
|
1429 |
fp = fopen(filename,"w"); |
1430 |
if (!fp) { |
1431 |
Tcl_SetResult(interp, |
1432 |
"__codegen_write file open failed. system not written.", |
1433 |
TCL_STATIC); |
1434 |
result = TCL_ERROR; |
1435 |
goto error; |
1436 |
} |
1437 |
|
1438 |
CodeGen_Write_Values_Fast(sys,fp,argv[1],argv[2]); |
1439 |
|
1440 |
error: |
1441 |
if (filename) { |
1442 |
ascfree(filename); |
1443 |
} |
1444 |
if (fp) { |
1445 |
fclose(fp); |
1446 |
} |
1447 |
return (result!=0) ? TCL_ERROR : TCL_OK; |
1448 |
} |
1449 |
|
1450 |
int Asc_CodeGenReadCmd(ClientData cdata, Tcl_Interp *interp, |
1451 |
int argc, CONST84 char *argv[]) |
1452 |
{ |
1453 |
FILE *fp; |
1454 |
int result = 0; |
1455 |
char *filename = NULL; |
1456 |
struct CGFormat format; |
1457 |
slv_system_t sys = g_solvsys_cur; |
1458 |
if ( argc != 3 ) { |
1459 |
Tcl_AppendResult(interp,"wrong # args : ", |
1460 |
"Usage __codegen_read filename input_parameter", |
1461 |
(char *)NULL); |
1462 |
return TCL_ERROR; |
1463 |
} |
1464 |
|
1465 |
filename = (char *)ascmalloc((strlen(argv[1])+8)*sizeof(char)); |
1466 |
strcpy(filename,argv[1]); |
1467 |
result = CodeGen_CheckSystem(interp,sys); |
1468 |
if (result) { |
1469 |
return TCL_ERROR; |
1470 |
} |
1471 |
|
1472 |
/* |
1473 |
* Set up the file pointer |
1474 |
*/ |
1475 |
|
1476 |
if (strncmp(argv[2],"value",3)==0) { |
1477 |
sprintf(filename,"%s.fast%s",filename,"val"); |
1478 |
} else if (strncmp(argv[2],"nominal",3)==0) { |
1479 |
sprintf(filename,"%s.fast%s",filename,"nom"); |
1480 |
} else if (strncmp(argv[2],"lower_bound",3)==0) { |
1481 |
sprintf(filename,"%s.fast%s",filename,"low"); |
1482 |
} else if (strncmp(argv[2],"upper_bound",3)==0) { |
1483 |
sprintf(filename,"%s.fast%s",filename,"up"); |
1484 |
} else if (strncmp(argv[2],"fixed",3)==0) { |
1485 |
sprintf(filename,"%s.fast%s",filename,"fix"); |
1486 |
} else { |
1487 |
Tcl_SetResult(interp, |
1488 |
"Must specify input type to be value," |
1489 |
" nominal, lower_bound, upper_bound, or fixed.", |
1490 |
TCL_VOLATILE); |
1491 |
if (filename) { |
1492 |
ascfree(filename); |
1493 |
} |
1494 |
return TCL_ERROR; |
1495 |
} |
1496 |
|
1497 |
fp = fopen(filename,"r"); |
1498 |
if (!fp) { |
1499 |
Tcl_SetResult(interp, |
1500 |
"__codegen_read file open failed. system not written.", |
1501 |
TCL_STATIC); |
1502 |
result = TCL_ERROR; |
1503 |
goto error; |
1504 |
} |
1505 |
|
1506 |
CodeGen_Read_Values_Fast(sys,fp,argv[1],argv[2]); |
1507 |
|
1508 |
error: |
1509 |
if (filename) { |
1510 |
ascfree(filename); |
1511 |
} |
1512 |
if (fp) { |
1513 |
fclose(fp); |
1514 |
} |
1515 |
return ((result!=0) ? TCL_ERROR : TCL_OK); |
1516 |
} |
1517 |
|