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

Annotation of /trunk/tcltk/generic/interface/CodeGen2.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 708 - (hide annotations) (download) (as text)
Tue Jun 27 07:34:31 2006 UTC (18 years ago) by johnpye
File MIME type: text/x-csrc
File size: 41916 byte(s)
Replaced some references to ascmalloc with ASC_NEW_ARRAY
1 johnpye 571 /*
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 johnpye 708 buffer = ASC_NEW_ARRAY(char,16);
1347 johnpye 571 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