/[ascend]/trunk/tcltk98/generic/interface/CodeGen2.c
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/CodeGen2.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 389 - (show annotations) (download) (as text)
Thu Mar 30 06:24:10 2006 UTC (16 years, 2 months ago) by johnpye
File MIME type: text/x-csrc
File size: 41928 byte(s)
Cleaning up #includes in the Tcl/Tk interface. Doing this
all as a group so that it can be reversed out if necessary.
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

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22