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

Annotation of /trunk/tcltk98/generic/interface/CodeGen.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (hide annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (15 years, 11 months ago) by aw0a
Original Path: trunk/tcltk98/interface/CodeGen.c
File MIME type: text/x-csrc
File size: 72007 byte(s)
try again to commit moving tcl stuff
1 aw0a 1 /*
2     * CodeGen.c
3     * by Kirk Abbott and Ben Allan
4     * Created: 1/94
5     * Version: $Revision: 1.24 $
6     * Version control file: $RCSfile: CodeGen.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    
31     #ifndef lint
32     static CONST char CodeGenID[] = "$Id: CodeGen.c,v 1.24 2003/08/23 18:43:05 ballan Exp $";
33     #endif
34    
35    
36     /*
37     * CodeGeneration Routines
38     * by Kirk Andre Abbott.
39     * January 4, 1995.
40     * Version: $Revision: 1.24 $
41     * Date last modified: $Date: 2003/08/23 18:43:05 $
42     * Copyright (C) 1995 Kirk Andre Abbott, CMU.
43     */
44     #include <math.h>
45     #include "tcl.h"
46     #include "tk.h"
47     #include "utilities/ascConfig.h"
48     #include "utilities/ascMalloc.h"
49     #include "general/dstring.h"
50     #include "compiler/instance_io.h"
51     #include "compiler/instance_enum.h"
52     #include "compiler/module.h"
53     #include "compiler/library.h"
54     #include "compiler/exprsym.h"
55     #include "compiler/relation_util.h"
56     #include "compiler/relation_io.h"
57     #include "solver/system.h"
58     #include "interface/Qlfdid.h"
59     #include "interface/CodeGen.h"
60    
61     #define REIMPLEMENT 0
62    
63     /* This file has to be totally rewritten */
64    
65     #if REIMPLEMENT
66    
67     struct CGFormat C_Format = {
68     CG_c,CG_squarebracket,CG_func_power,CG_c,CG_c
69     };
70    
71     #define CG(str) FPRINTF(fp,str)
72     #define CGTAB " "
73     #define CG_OFFSET 0
74    
75     static char CG_CFUNCNAME[] = "slvf__";
76     static char CG_CGRADNAME[] = "slvg__";
77    
78     /*
79     * The main working structure. It is not made static
80     * so that all the CodeGen* files may see it. We might
81     * modify all the code here so that we pass it around a
82     * pointer to it as the first parameter, to all functions
83     * that require it.
84     */
85     struct CGData g_cgdata = {
86     NULL,NULL,CG_ll,{0,NULL},{0,NULL},{0,NULL},{0,NULL},{0,0,0,0,0}
87     };
88    
89     int Asc_CGRelIncluded(struct rel_relation *rp)
90     {
91     unsigned flags;
92     flags = rel_flags(rp);
93     if (flags & CG_INCLUDED) {
94     return 1;
95     }
96     return 0;
97     }
98    
99     int Asc_CGVarFixed(struct CGVar *cgvar)
100     {
101     unsigned flags;
102     flags = cgvar->flags;
103     if (flags & CG_FIXED) {
104     return 1;
105     }
106     return 0;
107     }
108    
109     struct Instance *Asc_CGVarInstance(struct CGVar *cgvar)
110     {
111     return cgvar->instance;
112     }
113    
114     struct CGVar *Asc_CGInstanceVar(struct Instance *instance)
115     {
116     struct CGVar *result;
117     result = (struct CGVar *)GetInterfacePtr(instance);
118     return result;
119     }
120    
121     struct var_variable *Asc_CGInstancePar(struct Instance *instance)
122     {
123     struct var_variable *result;
124     result = (struct var_variable *)GetInterfacePtr(instance);
125     return result;
126     }
127    
128     /*
129     * The rel_equal function in rel.[ch] is hosed. So here
130     * is my version.
131     */
132     int CG_rel_equal(struct rel_relation *rel)
133     {
134     enum Expr_enum type;
135     if (RelationRelop(GetInstanceRelation(rel->instance,&type))==e_equal) {
136     return 1;
137     } else {
138     return 0;
139     }
140     }
141    
142    
143     /*
144     * Boiler plate routines,for code generation.
145     */
146     void CodeGen_WriteIncludes(FILE *fp,char *file_prefix)
147     {
148     CG("/***************** This file was generated by Ascend *************/\n");
149     CG("#include <stdio.h>\n");
150     CG("#include <stdlib.h>\n");
151     CG("#include <math.h>\n");
152     CG("#include \"codegen_support.h\"\n");
153     FPRINTF(fp,"#include \"%s.h\"\n",file_prefix);
154     CG("\n\n");
155     }
156    
157     void CodeGen_WriteGlobals(FILE *fp)
158     {
159     CG("\n");
160     }
161    
162     void CodeGen_WriteSupportFuncs_Log(FILE *fp)
163     {
164     CG("static double ln(double x)\n");
165     CG("{\n");
166     CG(" return log(x);\n");
167     CG("}\n\n");
168     }
169    
170     void CodeGen_WriteSupportFuncs_Cube(FILE *fp)
171     {
172     CG("static double cube(double x)\n");
173     CG("{\n");
174     CG(" return x*x*x;\n");
175     CG("}\n\n");
176     }
177    
178     void CodeGen_WriteSupportFuncs_Sqr(FILE *fp)
179     {
180     CG("static double sqr(double x)\n");
181     CG("{\n");
182     CG(" return x*x;\n");
183     CG("}\n\n");
184     }
185    
186     void CodeGen_WriteFuncHeader1(FILE *fp)
187     {
188     CG("int slv0_funcon(mode,m,n,x,u,f,g)\n");
189     CG("int *mode;\n");
190     CG("int *m;\n");
191     CG("int *n;\n");
192     CG("double *x;\n");
193     CG("double *u;\n");
194     CG("double *f;\n");
195     CG("double *g;\n");
196     CG("{\n");
197     }
198    
199     void CodeGen_WriteFuncHeader2(FILE *fp,int function_ndx)
200     {
201     FPRINTF(fp,"static int %s%d(mode,m,n,x,u,f,g)\n",CG_CFUNCNAME,function_ndx);
202     CG("\tint *mode; int *m; int *n;\n");
203     CG("\tdouble *x; double *u; double *f; double *g;\n");
204     CG("{\n");
205     }
206    
207     void CodeGen_WriteGradHeader2(FILE *fp,int function_ndx)
208     {
209     FPRINTF(fp,"static int %s%d(mode,m,n,x,u,f,g)\n",CG_CGRADNAME,function_ndx);
210     CG("\tint *mode; int *m; int *n;\n");
211     CG("\tdouble *x; double *u; double *f; double *g;\n");
212     CG("{\n");
213     }
214    
215     void CodeGen_WriteFuncDecln(FILE *fp)
216     {
217     CG("\n");
218     return;
219     }
220    
221     void CodeGen_WriteFuncFooter(FILE *fp)
222     {
223     CG("\treturn 0;\n");
224     CG("}\n");
225     }
226    
227    
228     /*
229     **********************************************************************
230     * The below code assumes the following:
231     * 1) presolve has been done and a valid slv_system_t exists.
232     * 2) the relations and variables have been numbered during the
233     * presolve.
234     *
235     * NOTE: no special order is being enforced at the moment and objectives
236     * are not being handled. THIS WILL BE FIXED.
237     **********************************************************************
238     */
239    
240     void CodeGen_WriteInitValues(FILE *fp,char *file_prefix)
241     {
242     struct CGVar *vp;
243     struct var_variable *pp;
244     /* par_parameter_t *pp; */
245     struct Instance *instance;
246     int num_vars,num_pars,i;
247    
248     int index;
249     double value,lower_bound,upper_bound,nominal;
250    
251     FPRINTF(fp,"void %s__Initialize(x,u,lower,upper,nominal)\n",file_prefix);
252     CG(" double *x;\n");
253     CG(" double *u;\n");
254     CG(" double *lower;\n");
255     CG(" double *upper;\n");
256     CG(" double *nominal;\n");
257     CG("{\n");
258     vp = g_cgdata.vars.var_list;
259     num_vars = g_cgdata.vars.num_vars;
260     for (i=0;i<num_vars;i++) {
261     index = vp[i].index;
262     instance = vp[i].instance;
263     value = var_value(instance);
264     lower_bound = var_lower_bound(instance);
265     upper_bound = var_upper_bound(instance);
266     nominal = var_nominal(instance);
267     FPRINTF(fp,"x[%d] = %12.8g; nominal[%d] = %12.8g;\n",
268     index,value,index,nominal);
269     FPRINTF(fp,"lower[%d] = %12.8g; upper[%d] = %12.8g;\n\n",
270     index,lower_bound,index,upper_bound);
271     }
272    
273     /*
274     * Write out the values of the parameters.
275     * NOTE: No Filtering is done here. Once I figure out how
276     * to cruch the arrays down with confusing myself we will.
277     */
278     FPRINTF(fp,"\n\n");
279     pp = g_cgdata.pars.par_list;
280     num_pars = g_cgdata.pars.num_pars;
281     for (i=0;i<num_pars;i++) {
282     index = par_index(pp[i]);
283     value = par_value(pp[i]);
284     FPRINTF(fp,"u[%d] = %12.8g;\n",index,value);
285     }
286     CG("}\n\n");
287     }
288    
289    
290     /*
291     * Will take the *raw* list of parameters and classify
292     * the list i.e., ensure that the parameters are parametric
293     * and mark them as such. At the same time will index the
294     * parameter list. It will return the number of parameters
295     * found.
296     */
297     struct var_variable *CodeGen_SetUpParameters(struct var_variable *pp,
298     int num_pars)
299     /*par_parameter_t *CodeGen_SetUpParameters(par_parameter_t *pp,
300     int num_pars) */
301     {
302     /* par_parameter_t par; */
303     struct var_variable *par;
304     struct Instance *inst;
305     int c, num_parametric =0;
306    
307     if (num_pars==0) {
308     FPRINTF(stderr,"(IndexParameters) no parameters found\n");
309     return NULL;
310     }
311     for (c=0;c<num_pars;c++) {
312     par = pp[c];
313     inst = par_instance(par);
314     par_set_index(par,c);
315     if (is_inst_aparameter(inst)) {
316     par_set_parametric(par);
317     num_parametric++;
318     }
319     }
320    
321     FPRINTF(stderr,"(IndexParameters) %d parameters found\n",num_parametric);
322     g_cgdata.filtered.num_pars = num_parametric;
323     return pp;
324     }
325    
326    
327    
328    
329     /*
330     **********************************************************************
331     *
332     * We dont want to iterate over the varlist more than we have to; So we
333     * play the 'run and shoot'. First build a filter to apply to each
334     * item in the raw varlist. Based on the result set the flags on our
335     * variables. We will not set the input/output/internal flag bits here,
336     * as that would involve linear time search over the input and
337     * output lists, for each var. We will do that later.
338     * Do for all vars in the list.
339     *
340     * One final note. Instance interfaceptrs are a shared resource.
341     * We will be polite and save the state of instance as we found it
342     * and restore it when we are done. We expect that the same courtesy
343     * will be extended to us.
344     *
345     **********************************************************************
346     */
347    
348     struct CGVar *Asc_CodeGenSetUpVariables(struct var_variable **vp,
349     int num_vars)
350     {
351     struct CGVar *cgvarlist; /* an array of CGVar structs */
352     unsigned int filter = 0x0;
353     int c,num_free=0;
354    
355     if (num_vars==0) {
356     FPRINTF(stderr,"(IndexVariables) no variables found\n");
357     return NULL;
358     }
359     cgvarlist = (struct CGVar *)ascmalloc((num_vars+1)*sizeof(struct CGVar));
360     if (!cgvarlist) {
361     /* this is a real possibility with big problems */
362     Asc_Panic(1, "CodeGen_IndexVariables",
363     "Memory failure in (CodeGen_IndexVariables)\n");
364     }
365     for (c=0;c<num_vars;c++) {
366     cgvarlist[c].instance = vp[c];
367     cgvarlist[c].prev_instanceinfo = GetInterfacePtr(vp[c]); /* save data */
368     SetInterfacePtr(vp[c],(VOIDPTR)&cgvarlist[c]);
369     cgvarlist[c].index = c;
370     cgvarlist[c].cmplr_index = -1; /* dont set the compiler index */
371     cgvarlist[c].flags = 0x0;
372     if (var_fixed(vp[c])) {
373     cgvarlist[c].flags |= CG_FIXED;
374     } else {
375     num_free++;
376     }
377     }
378     cgvarlist[num_vars].instance = NULL; /* terminate with a sentinel */
379     cgvarlist[num_vars].flags = 0x0;
380     cgvarlist[num_vars].index = -1;
381     cgvarlist[c].cmplr_index = -1;
382    
383     g_cgdata.filtered.num_vars = num_free;
384     return cgvarlist;
385     }
386    
387    
388     unsigned int PotentialSolverVar(struct Instance *inst)
389     {
390     struct TypeDescription *realtype,*type;
391     if (solver_var(inst)) {
392     return CG_SLV_REAL;
393     }
394     realtype = FindType("real");
395     type = InstanceTypeDesc(inst);
396     if (type!=realtype) { /* already off the type hierarchy */
397     return CG_SLV_CONST;
398     } else { /* is a real, so is potentially a solver_var */
399     return 0x0;
400     }
401     }
402    
403     static void CollectVars(struct Instance *inst, VOIDPTR data)
404     {
405     struct gl_list_t *list = (struct gl_list_t *)data;
406     if (inst) {
407     switch(InstanceKind(inst)) {
408     case REAL_ATOM_INST:
409     gl_append_ptr(list,(char *)inst);
410     return;
411     }
412     }
413     }
414    
415     struct gl_list_t *PreProcessVars(struct Instance *root)
416     {
417     struct gl_list_t *list = gl_create(256L);
418     VisitInstanceTreeTwo(root,CollectVars,1,0,(VOIDPTR)list);
419     return list;
420     }
421    
422    
423     struct CGVar *Asc_CodeGenSetUpVariables3(struct gl_list_t *list)
424     {
425     struct Instance *var;
426     struct CGVar *cgvarlist; /* an array of CGVar structs */
427     unsigned int filter = 0x0;
428     int num_vars; /* number of compiler vars */
429     int num_solver_vars = 0; /* number of solver vars */
430     int c,num_free=0;
431     unsigned int status;
432    
433     num_vars = (int)gl_length(list);
434     if (num_vars==0) {
435     FPRINTF(stderr,"(IndexVariables) no variables found\n");
436     return NULL;
437     }
438     cgvarlist = (struct CGVar *)ascmalloc((num_vars+1)*sizeof(struct CGVar));
439     if (!cgvarlist) {
440     Asc_Panic(1, "Asc_CodeGenSetUpVariables3",
441     "Memory failure in (Asc_CodeGenSetUpVariables3)\n");
442     }
443     for (c=0;c<num_vars;c++) {
444     var = (struct Instance*)gl_fetch(list,c+1);
445     cgvarlist[c].instance = var;
446     cgvarlist[c].prev_instanceinfo = GetInterfacePtr(var); /* save data */
447     SetInterfacePtr(var,(VOIDPTR)&cgvarlist[c]);
448     cgvarlist[c].flags = 0x0;
449     cgvarlist[c].cmplr_index = c;
450    
451     status = PotentialSolverVar(var);
452     switch (status) {
453     case CG_SLV_OPEN: /* potentially a solver_var */
454     cgvarlist[c].flags |= CG_SLV_OPEN;
455     cgvarlist[c].index = -1;
456     break;
457     case CG_SLV_CONST: /* never will be a solver_var */
458     cgvarlist[c].flags |= CG_SLV_CONST;
459     cgvarlist[c].index = -1;
460     break;
461     case CG_SLV_REAL: /* is already a solver_var */
462     cgvarlist[c].flags |= CG_SLV_REAL;
463     cgvarlist[c].index = num_solver_vars++;
464     if (var_fixed(var)) {
465     cgvarlist[c].flags |= CG_FIXED;
466     } else {
467     num_free++;
468     }
469     break;
470     default:
471     FPRINTF(stderr,
472     "Unknown variable type in (Asc_CodeGenSetUpVariables3)\n");
473     break;
474     }
475     }
476     cgvarlist[num_vars].instance = NULL; /* terminate with a sentinel */
477     cgvarlist[num_vars].flags = 0x0;
478     cgvarlist[num_vars].index = -1;
479    
480     g_cgdata.filtered.num_vars = num_free;
481     return cgvarlist;
482     }
483    
484    
485     /*
486     * By default anything not marked by this routine is classified
487     * as being internal. It is possible for a user to have a variable
488     * being both CG_INPUT and CG_OUTPUT. It is not our job only to *warn*
489     * of such occurrences. The user may later decide to uninclude the
490     * relevant output equation.
491     */
492     void CodeGen_I_O_Internal(void)
493     {
494     unsigned long len,c=0;
495     int num_vars;
496     struct Instance *inst;
497     struct gl_list_t *list;
498     struct CGVar *vlist, *self, *tmp;
499    
500     num_vars = g_cgdata.vars.num_vars;
501     vlist = g_cgdata.vars.var_list;
502     list = g_cgdata.input_list; /* process the input list if given */
503     if (list) {
504     len = gl_length(list);
505     assert((int)len <= num_vars);
506     for (c=1;c<=len;c++) {
507     inst = (struct Instance *)gl_fetch(list,c);
508     self = (struct CGVar*)GetInterfacePtr(inst);
509     tmp = &vlist[c-1];
510     assert(tmp==self); /* desperate integrity check */
511     self->flags |= CG_INPUT;
512     }
513     }
514    
515     list = g_cgdata.output_list; /* process the output list if given */
516     if (list) {
517     len = gl_length(list);
518    
519     assert(len<=num_vars);
520     for (c=1;c<=len;c++) {
521     inst = (struct Instance *)gl_fetch(list,c);
522     self = (struct CGVar*)GetInterfacePtr(inst);
523     tmp = &vlist[c-1];
524     assert(tmp==self); /* desperate integrity check */
525     self->flags |= CG_OUTPUT;
526     }
527     }
528     }
529    
530    
531     /*
532     **********************************************************************
533     *
534     * We run through the original relations list and mark everything
535     * as being included, equality, lessthan, greaterthan.
536     * Relationn as currently implememted already have structure, so
537     * we need not create any here.
538     *
539     **********************************************************************
540     */
541     struct rel_relation **Asc_CodeGenSetUpRelations(struct rel_relation * *rp,
542     int num_rels)
543     {
544     int i;
545     int num_included = 0;
546     unsigned int flags;
547    
548     for (i=0;i<num_rels;i++) {
549     flags = 0x0;
550     rel_set_index(rp[i],i);
551     if (rel_included(rp[i]) && rel_active(rp[i]) ) {
552     flags |= CG_INCLUDED;
553     num_included++;
554     }
555     if (CG_rel_equal(rp[i])) {
556     flags |= CG_EQUAL;
557     } else if (rel_less(rp[i])) {
558     flags |= CG_LESS;
559     } else if (rel_greater(rp[i])) {
560     flags |= CG_GREATER;
561     }
562     rel_set_flags(rp[i],flags);
563     }
564     g_cgdata.filtered.num_rels = num_included;
565     return rp;
566     }
567    
568     struct rel_relation **Asc_CodeGenSetUpObjectives(struct rel_relation * *op,
569     int num_objs)
570     {
571     int i;
572     int num_included = 0;
573     unsigned int flags;
574    
575     for (i=0;i<num_objs;i++) {
576     flags = 0x0;
577     rel_set_index(op[i],i);
578     if (rel_included(op[i])) {
579     flags |= CG_INCLUDED;
580     num_included++;
581     }
582     }
583     g_cgdata.filtered.num_objs = num_included;
584     return op;
585     }
586    
587    
588    
589     /*
590     * Remember to unify the treatment of parameters.
591     * i.e. treat them in the same way that we treat variables
592     * and relations. !! FIX !! kaa
593     */
594     /*
595     * remember to ditch treatment of parameters. baa */
596     /* codegen uses the master lists from the slv_system_t because we
597     need repeatability across ascend runs */
598     /* int CodeGen_SetupCodeGen(slv_system_t sys,
599     struct CGVar *cgvarlist, int nvars,
600     struct rel_relation **rp, int nrels,
601     struct rel_relation **op, int nobjs,
602     par_parameter_t *pp, int npars,
603     struct gl_list_t *inputs,
604     struct gl_list_t *outputs) */
605     int CodeGen_SetupCodeGen(slv_system_t sys,
606     struct CGVar *cgvarlist, int nvars,
607     struct rel_relation **rp, int nrels,
608     struct rel_relation **op, int nobjs,
609     struct var_variable *pp, int npars,
610     struct gl_list_t *inputs,
611     struct gl_list_t *outputs)
612     {
613     int num;
614     struct var_variable **vp;
615    
616     if (!sys) {
617     return 1;
618     }
619     /*
620     * Variables.
621     */
622     if (cgvarlist) {
623     g_cgdata.vars.var_list = cgvarlist;
624     g_cgdata.vars.num_vars = nvars;
625     } else {
626     vp = slv_get_master_var_list(sys);
627     num = slv_get_num_master_vars(sys);
628     g_cgdata.vars.var_list = Asc_CodeGenSetUpVariables(vp,num);
629     g_cgdata.vars.num_vars = num;
630     }
631    
632     /*
633     * Parameters.
634     */
635     if (pp) {
636     g_cgdata.pars.par_list = CodeGen_SetUpParameters(pp,npars);
637     g_cgdata.pars.num_pars = npars;
638     } else {
639     num = slv_get_num_pars(sys);
640     pp = slv_get_par_list(sys);
641     g_cgdata.pars.par_list = CodeGen_SetUpParameters(pp,num);
642     g_cgdata.pars.num_pars = num;
643     }
644    
645     /*
646     * Relations
647     */
648     if (rp) {
649     g_cgdata.rels.rel_list = rp;
650     g_cgdata.rels.num_rels = nrels;
651     } else {
652     rp = slv_get_master_rel_list(sys);
653     num = slv_get_num_master_rels(sys);
654     g_cgdata.rels.rel_list = Asc_CodeGenSetUpRelations(rp,num);
655     g_cgdata.rels.num_rels = num;
656     }
657    
658     /*
659     * Objectives
660     */
661     if (op) {
662     g_cgdata.objs.obj_list = op;
663     g_cgdata.objs.num_objs = nobjs;
664     } else {
665     op = slv_get_objrel_list(sys);
666     num = slv_get_num_objrels(sys);
667     g_cgdata.objs.obj_list = Asc_CodeGenSetUpObjectives(op,num);
668     g_cgdata.objs.num_objs = num;
669     }
670    
671     g_cgdata.input_list = inputs; /* process the output list if given */
672     g_cgdata.output_list = outputs; /* process the output list if given */
673     CodeGen_I_O_Internal();
674     return 0;
675     }
676    
677     /*
678     * We need to deallocate any memory that we created; at the moment
679     * this is the cgvars. First we need to reset the interfaceptrs
680     * to the state that we found them in. We pulled g_cgdata of the
681     * heap. All we need to do is ensure that the pointers are nulled,
682     * and the counters are set to -1. NOTE: At the moment I am not sure
683     * where the input list came from. For the moment let us assume that
684     * we own it, so that we will deallocate it as well.
685     */
686     void Asc_CodeGenShutDown(void)
687     {
688     int i,num;
689     struct CGVar *cgvarlist;
690    
691     if (g_cgdata.input_list!=NULL) {
692     gl_destroy(g_cgdata.input_list);
693     }
694     if (g_cgdata.output_list!=NULL) {
695     gl_destroy(g_cgdata.output_list);
696     }
697     if ((cgvarlist = g_cgdata.vars.var_list)!=NULL) {
698     num = g_cgdata.vars.num_vars;
699     for (i=0;i<num;i++) {
700     SetInterfacePtr(cgvarlist[i].instance,
701     (VOIDPTR)cgvarlist[i].prev_instanceinfo);
702     }
703     ascfree((char *)cgvarlist);
704     g_cgdata.vars.var_list = NULL;
705     g_cgdata.vars.num_vars = -1;
706     }
707     g_cgdata.pars.par_list = NULL;
708     g_cgdata.pars.num_pars = -1;
709     g_cgdata.rels.rel_list = NULL;
710     g_cgdata.rels.num_rels = -1;
711     g_cgdata.filtered.num_vars = -1;
712     g_cgdata.filtered.num_pars = -1;
713     g_cgdata.filtered.num_rels = -1;
714     g_cgdata.filtered.num_incidences = -1;
715     }
716    
717    
718     /*
719     * These are support routines for writing out data.
720     * Included is the capability to support different output
721     * file formats. The default format will be the "C-format"
722     * Other formats include an "Ascend-format", a "Gams-format"
723     * a "Mathematica-format"
724     */
725     static int printer_num_chars = 0;
726    
727     static void CodeGen_PrettyPrintInteger(FILE *fp,int value)
728     {
729     printer_num_chars += FPRINTF(fp,"%d,",value);
730     if (printer_num_chars >= 74) { /* 80 columns less 6 chars */
731     FPRINTF(fp,"\n");
732     printer_num_chars = 0;
733     }
734     }
735    
736     static void CodeGen_PrettyPrintReal(FILE *fp,double value)
737     {
738     printer_num_chars += FPRINTF(fp,"%.8f,",value);
739     if (printer_num_chars >= 72) { /* 80 columns less 8 chars */
740     FPRINTF(fp,"\n");
741     printer_num_chars = 0;
742     }
743     }
744    
745     static void CodeGen_PrettyPrintStr(FILE *fp,char *prefix,
746     int value)
747     {
748     printer_num_chars += FPRINTF(fp,"%s%d,",prefix,value);
749     if (printer_num_chars >= 68) { /* 80 columns less 12 chars */
750     FPRINTF(fp,"\n");
751     printer_num_chars = 0;
752     }
753     }
754    
755     static void CodeGen_ResetPrettyPrinter(void)
756     {
757     printer_num_chars = 0;
758     }
759    
760    
761     int CodeGen_WriteSide(FILE *,Term *,
762     RelationINF *,struct CGFormat *,int);
763    
764     static void WriteOp(FILE *f, enum Expr_enum t)
765     {
766     switch(t) {
767     case e_plus: FPRINTF(f," + "); break;
768     case e_uminus: PUTC('-',f); break;
769     case e_minus: FPRINTF(f," - "); break;
770     case e_times: PUTC('*',f); break;
771     case e_divide: PUTC('/',f); break;
772     case e_power: PUTC('^',f); break;
773     case e_ipower: PUTC('^',f); break;
774     case e_equal: PUTC('=',f); break;
775     case e_notequal: FPRINTF(f,"<>"); break;
776     case e_less: PUTC('<',f); break;
777     case e_greater: PUTC('>',f); break;
778     case e_lesseq: FPRINTF(f,"<="); break;
779     case e_greatereq: FPRINTF(f,">="); break;
780     case e_maximize: FPRINTF(f,"MAXIMIZE"); break;
781     case e_minimize: FPRINTF(f,"MINIMIZE"); break;
782     default:
783     FPRINTF(stderr,"Unknown term in WriteOp.\n");
784     FPRINTF(f,"***");
785     }
786     }
787    
788     static int WritePower(FILE *f, Term *term,
789     RelationINF *r,
790     struct CGFormat *format,
791     int nchars)
792     {
793     int parens;
794     int count;
795     enum Expr_enum t = RelationTermType(term);
796     Term *left = TermBinLeft(term); /* we know that it is binary term */
797     Term *right = TermBinRight(term);
798    
799     count = nchars;
800     switch(format->main_format) {
801     case CG_ascend:
802     case CG_linear:
803     if (parens = NeedParen(t,RelationTermType(left),0)) {
804     PUTC('(',f);
805     }
806     count = CodeGen_WriteSide(f,left,r,format,count);
807     if (parens) {
808     PUTC(')',f);
809     }
810     WriteOp(f,t);
811     if (parens = NeedParen(t,RelationTermType(right),1)) {
812     PUTC('(',f);
813     }
814     count = CodeGen_WriteSide(f,right,r,format,count) + 2;
815     if (parens) {
816     PUTC(')',f);
817     }
818     break;
819     case CG_math:
820     FPRINTF(f,"Power[");
821     count = CodeGen_WriteSide(f,left,r,format,count) + 5;
822     PUTC(',',f);
823     count = CodeGen_WriteSide(f,right,r,format,count) + 2;
824     FPRINTF(f,"]");
825     break;
826     case CG_gams:
827     FPRINTF(f,"(");
828     count = CodeGen_WriteSide(f,left,r,format,count);
829     FPRINTF(f,")");
830     FPRINTF(f,"**(");
831     count = CodeGen_WriteSide(f,right,r,format,count) + 3;
832     FPRINTF(f,")");
833     break;
834     case CG_c:
835     default:
836     FPRINTF(f,"pow(");
837     count = CodeGen_WriteSide(f,left,r,format,count) + 5;
838     PUTC(',',f);
839     count = CodeGen_WriteSide(f,right,r,format,count) + 2;
840     FPRINTF(f,")");
841     break;
842     }
843     return count;
844     }
845    
846     /*
847     * WriteName is invoked on whatever ASCEND considers a var, i.e,
848     * an expression node of type e_var, which *all* REAL_ATOM_INSTances
849     * have. We filter this var, to determine whether it is a
850     * solver_var, solver_par, or constant. We now have to decide
851     * whether a *fixed* solver_var is written as its numeric value,
852     * or as symbol to be substituted. The same applies for parameters.
853     * We *will* leave it as a symbolic name. We might allow a field
854     * in the format parameter to tell us what to do here.
855     */
856     static int WriteName(FILE *f, Term *term,
857     RelationINF *r,
858     struct CGFormat *format)
859     {
860     struct Instance *cur_var;
861     struct CGVar *cgvar;
862     par_parameter_t par;
863     int count = 0;
864    
865     switch(format->names) {
866     case CG_ascend:
867     cur_var = RelationVariable(r,TermVarNumber(term));
868     WriteInstanceName(f,cur_var,NULL);
869     return 20; /* need to hack this to get the correct count */
870     case CG_gams:
871     case CG_math:
872     /*
873     * Mathematica needs special handling for writing out
874     * floating point numbers and variable names. Because
875     * we are doing this for debugging we are *not* going to do
876     * constant folding, i.e., variable values will not be
877     * substituted.
878     */
879     cur_var = RelationVariable(r,TermVarNumber(term));
880     if (solver_var(cur_var)) {
881     cgvar = Asc_CGInstanceVar(cur_var);
882     count = FPRINTF(f,"x%d",cgvar->index);
883     } else if (solver_par(cur_var)) {
884     par = Asc_CGInstancePar(cur_var);
885     count = FPRINTF(f,"u%d",par_index(par));
886     } else {
887     count = FPRINTF(f,"(%.8f)",RealAtomValue(cur_var));
888     }
889     return count;
890     case CG_linear:
891     case CG_blackbox:
892     case CG_minos:
893     /*
894     * NOTE: This code is doing variable substitution !!!
895     * For computational speed we should. We also have the notion
896     * of inputs, outputs and parameters. This does not exist
897     * for the glassbox format.
898     */
899     cur_var = RelationVariable(r,TermVarNumber(term));
900     if (solver_var(cur_var)) {
901     cgvar = Asc_CGInstanceVar(cur_var);
902     if (Asc_CGVarFixed(cgvar)) {
903     count = FPRINTF(f,"%.8g",RealAtomValue(cur_var)); /* SUBSITITUTION */
904     } else {
905     count = FPRINTF(f,"x[%d]",cgvar->index);
906     }
907     } else if (solver_par(cur_var)) {
908     par = Asc_CGInstancePar(cur_var);
909     if (!par_parametric(par)) {
910     count = FPRINTF(f,"%.8g",RealAtomValue(cur_var));
911     } else {
912     count = FPRINTF(f,"u[%d]",par_index(par));
913     }
914     } else {
915     count = FPRINTF(f,"%.8g",RealAtomValue(cur_var));
916     }
917     return count;
918     case CG_glassbox:
919     /*
920     * NOTE 1: This code is *not doing any* variable substitution !!!
921     * As these are glassbox relations, we write out everybody
922     * that the *compiler* considers to be a variable, which at this
923     * time is REAL_ATOM_INST or greater.
924     * This is *very* different from the minos/blackbox case.
925     * NOTE 2: This code uses a different indexing scheme than the
926     * minos and blackbox formats, as each relation generated needs
927     * to be standalone. In fact it uses the TermVarNumber.
928     */
929     count = FPRINTF(f,"x[%lu]",TermVarNumber(term)-1);
930     return count;
931     }
932     }
933    
934    
935     void CodeGen_BreakLines(FILE *f, struct CGFormat *format)
936     {
937     switch(format->main_format) {
938     case CG_c:
939     case CG_math:
940     FPRINTF(f," \\\n ");
941     return;
942     case CG_ascend:
943     case CG_linear:
944     case CG_gams:
945     default:
946     FPRINTF(f,"\n\t");
947     return;
948     }
949     }
950    
951     int CodeGen_WriteBuiltInFuncs(FILE *f, Term *term,
952     RelationINF *r,
953     struct CGFormat *format,
954     int nchars)
955     {
956     int count = nchars;
957     switch(format->main_format) {
958     case CG_math:
959     switch(FuncId(TermFunc(term))) {
960     /*
961     * All cases which do *return* rather than *break* are
962     * special cases which need to be handled. Those that *break*,
963     * get closing brackets written after the switch.
964     */
965     case F_LOG:
966     count += FPRINTF(f,"Log[");
967     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
968     count += FPRINTF(f,",10]");
969     return;
970     case F_LN: count += FPRINTF(f,"Log["); break;
971     case F_EXP: count += FPRINTF(f,"Exp["); break;
972     case F_SIN: count += FPRINTF(f,"Sin["); break;
973     case F_COS: count += FPRINTF(f,"Cos["); break;
974     case F_TAN: count += FPRINTF(f,"Tan["); break;
975     case F_ARCSIN: count += FPRINTF(f,"ArcSin["); break;
976     case F_ARCCOS: count += FPRINTF(f,"ArcCos["); break;
977     case F_ARCTAN: count += FPRINTF(f,"ArcTan["); break;
978     case F_SQR:
979     count += FPRINTF(f,"Power[");
980     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
981     count += FPRINTF(f,",2]");
982     return;
983     case F_SQRT: count += FPRINTF(f,"Sqrt["); break;
984     case F_ERF: count += FPRINTF(f,"Erf["); break;
985     case F_LNM: count += FPRINTF(f,"Log["); break;
986     case F_SINH: count += FPRINTF(f,"Sinh["); break;
987     case F_COSH: count += FPRINTF(f,"Cosh["); break;
988     case F_TANH: count += FPRINTF(f,"Tanh["); break;
989     case F_ARCSINH: count += FPRINTF(f,"ArcSinh["); break;
990     case F_ARCCOSH: count += FPRINTF(f,"ArcCosh["); break;
991     case F_ARCTANH: count += FPRINTF(f,"ArcTanh["); break;
992     case F_CBRT:
993     count += FPRINTF(f,"Power[");
994     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
995     count += FPRINTF(f,",1/3]");
996     return;
997     }
998     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
999     PUTC(']',f);
1000     break;
1001     case CG_gams:
1002     switch(FuncId(TermFunc(term))) {
1003     /*
1004     * All cases which do *return* rather than *break* are
1005     * special cases which need to be handled. Those that *break*,
1006     * get closing brackets written after the switch.
1007     */
1008     case F_LOG: count += FPRINTF(f,"LOG10("); break;
1009     case F_LN: count += FPRINTF(f,"LOG("); break;
1010     case F_EXP: count += FPRINTF(f,"EXP("); break;
1011     case F_SIN: count += FPRINTF(f,"SIN("); break;
1012     case F_COS: count += FPRINTF(f,"COS("); break;
1013     case F_TAN: count += FPRINTF(f,"SIN(");
1014     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1015     count = FPRINTF(f,")/COS("); break;
1016     case F_ARCSIN: count += FPRINTF(f,"1/SIN("); break;
1017     case F_ARCCOS: count += FPRINTF(f,"1/COS("); break;
1018     case F_ARCTAN: count += FPRINTF(f,"COS(");
1019     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1020     count = FPRINTF(f,")/SIN("); break;
1021     case F_SQR: count += FPRINTF(f,"SQR("); break;
1022     case F_SQRT: count += FPRINTF(f,"SQRT("); break;
1023     case F_ERF: count += FPRINTF(f,"ERF("); break;
1024     case F_LNM: count += FPRINTF(f,"LOG"); break;
1025     /* WARNING: lnm not implemented here */
1026     case F_SINH: count += FPRINTF(f,"0.5*(EXP(");
1027     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1028     count += FPRINTF(f,")-EXP(-(");
1029     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1030     count += FPRINTF(f,")))");
1031     return;
1032     case F_COSH: count += FPRINTF(f,"0.5*(EXP(");
1033     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1034     count += FPRINTF(f,")+EXP(-(");
1035     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1036     count += FPRINTF(f,")))");
1037     return;
1038     case F_TANH: count += FPRINTF(f,"(EXP(");
1039     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1040     count += FPRINTF(f,")-EXP(-(");
1041     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1042     count += FPRINTF(f,")))/");
1043     count += FPRINTF(f,"(EXP(");
1044     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1045     count += FPRINTF(f,")+EXP(-(");
1046     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1047     count += FPRINTF(f,")))");
1048     return;
1049     case F_ARCSINH: count += FPRINTF(f,"2/(EXP(");
1050     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1051     count += FPRINTF(f,")-EXP(-(");
1052     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1053     count += FPRINTF(f,")))");
1054     return;
1055     case F_ARCCOSH: count += FPRINTF(f,"0.5*(EXP(");
1056     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1057     count += FPRINTF(f,")+EXP(-(");
1058     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1059     count += FPRINTF(f,")))");
1060     return;
1061     case F_ARCTANH: count += FPRINTF(f,"(EXP(");
1062     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1063     count += FPRINTF(f,")+EXP(-(");
1064     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1065     count += FPRINTF(f,")))/");
1066     count += FPRINTF(f,"(EXP(");
1067     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1068     count += FPRINTF(f,")-EXP(-(");
1069     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1070     count += FPRINTF(f,")))");
1071     return;
1072     case F_CUBE:
1073     count += FPRINTF(f,"(");
1074     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1075     count += FPRINTF(f,")**(3)");
1076     return;
1077     case F_CBRT:
1078     count += FPRINTF(f,"(");
1079     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1080     count += FPRINTF(f,")**(1/3)");
1081     return;
1082     }
1083     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1084     PUTC(')',f);
1085     break;
1086     case CG_ascend:
1087     case CG_c:
1088     case CG_linear:
1089     default:
1090     count += FPRINTF(f,"%s(",FuncName(TermFunc(term)));
1091     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1092     PUTC(')',f);
1093     break;
1094     }
1095     return count;
1096     }
1097    
1098     int CodeGen_WriteSide(FILE *f, Term *term,
1099     RelationINF *r,
1100     struct CGFormat *format,
1101     int nchars)
1102     {
1103     enum Expr_enum t;
1104     int parens;
1105     int count;
1106    
1107     count = nchars;
1108     if (count>=70) { /* allow anyone to break lines */
1109     CodeGen_BreakLines(f,format);
1110     count = 0;
1111     }
1112     switch(t = RelationTermType(term)) {
1113     case e_var:
1114     count += WriteName(f,term,r,format);
1115     break;
1116     case e_int:
1117     (TermInteger(term) < 0) ?
1118     (count += FPRINTF(f,"(%ld)",TermInteger(term))) :
1119     (count += FPRINTF(f,"%ld",TermInteger(term)));
1120     break;
1121     case e_real:
1122     (TermReal(term) < 0) ?
1123     (count += FPRINTF(f,"(%g)",TermReal(term))) :
1124     (count += FPRINTF(f,"%g",TermReal(term)));
1125     break;
1126     case e_func:
1127     count = CodeGen_WriteBuiltInFuncs(f,term,r,format,count);
1128     break;
1129     case e_uminus:
1130     FPRINTF(f,"(-(");
1131     count = CodeGen_WriteSide(f,TermUniLeft(term),r,format,count) + 2;
1132     FPRINTF(f,"))");
1133     break;
1134     case e_plus:
1135     case e_minus:
1136     case e_times:
1137     case e_divide:
1138     if (parens = NeedParen(t,RelationTermType(TermBinLeft(term)),0)) {
1139     PUTC('(',f);
1140     }
1141     count = CodeGen_WriteSide(f,TermBinLeft(term),r,format,count) + 2;
1142     if (parens) {
1143     PUTC(')',f);
1144     }
1145     WriteOp(f,t);
1146     if (parens = NeedParen(t,RelationTermType(TermBinRight(term)),1)) {
1147     PUTC('(',f);
1148     }
1149     count = CodeGen_WriteSide(f,TermBinRight(term),r,format,count) + 2;
1150     if (parens) {
1151     PUTC(')',f);
1152     }
1153     break;
1154     case e_power:
1155     case e_ipower:
1156     count = WritePower(f,term,r,format,count);
1157     break;
1158     default:
1159     FPRINTF(f,"***");
1160     break;
1161     }
1162     return count;
1163     }
1164    
1165    
1166    
1167     /*
1168     **********************************************************************
1169     * At this point it is assumed that the parameter list,
1170     * the variable list, and the relations have been appropriately
1171     * marked. We are now going to get the incidence pattern for
1172     * the variables and relations that are needed to do a computation.
1173     *
1174     * This module will eventually support mulitple sparse matrix
1175     * formats. We are implementing the code for both the linked list
1176     * format, on which the Harwell format is based, as well as the CSR
1177     * format. Eventaully the JDS format will supported. At the moment all
1178     * the formatting will be written for C-style indexing. We might later
1179     * generate fortran style indexing.
1180     *
1181     * We write out the *entire* matrix pattern of computable variables.
1182     * By this we mean anything that passes the solver_var filter will be
1183     * written out. Relations obtained from the ASCEND compiler store
1184     * information what will not pass the solver var filter. We weed those
1185     * out here.
1186     *
1187     * The first thing to be written out is the vector "ha". Given below
1188     * is an orignal set of relations and the corresponding ha and ka.
1189     * ka is dependent upon the matrix format which is chosen; the example
1190     * below shows what ka looks like for two formats.
1191     *
1192     * solver_vars x4,x3; (x2 fails solver_var filter)
1193     * x4.index = 10,
1194     * x3.index = 6 (x2 would not have a variable index)
1195     *
1196     * x4 * x2 + x3 = 5; (relation 1)
1197     * x2 * x3 = 1; (relation 2)
1198     *
1199     * ka = [1,3] -- CSR format.
1200     * ka = [1,1,2] -- LL format.
1201     * ha = [10,6,6]
1202     *
1203     **********************************************************************
1204     */
1205    
1206     /*
1207     * There should be a 1 to 1 mapping between the relations list
1208     * and the incident_var_count list. What we do for the LL matrix
1209     * format is to write out the relation ndx as many times as there
1210     * are incidences; this will give the required row, col indexing on
1211     * the incident variables. I know it seems a little twisted.
1212     */
1213     int CodeGen_WriteKA_LL(FILE *fp, slv_system_t sys,
1214     int *incident_var_count)
1215     {
1216     int *ip,i,j;
1217     int num_rels,ndx,count=0;
1218     struct rel_relation **rp;
1219    
1220     ip = incident_var_count;
1221     rp = g_cgdata.rels.rel_list;
1222     num_rels = g_cgdata.rels.num_rels;
1223    
1224     CodeGen_ResetPrettyPrinter();
1225     CG("static int ka[] = {\n");
1226     for (i=0;i<num_rels;i++) {
1227     ndx = rel_index(rp[i]);
1228     count = ip[i];
1229     for (j=0;j<count;j++) {
1230     CodeGen_PrettyPrintInteger(fp,ndx);
1231     }
1232     }
1233     CodeGen_ResetPrettyPrinter();
1234     CG("-1\n};"); /* Write a -1 as a safety check on the end of ka */
1235     CG("\n\n");
1236    
1237     FFLUSH(fp);
1238     return 0;
1239     }
1240    
1241     /*
1242     * This particular piece of code will need modification
1243     * if support a fortran style indexing. At the moment life
1244     * starts at 0. The incident_var_count vector should be
1245     * provided and deallocated by the caller, as should be
1246     * terminated with a -1.
1247     */
1248     int CodeGen_WriteKA_CSR(FILE *fp, slv_system_t sys,
1249     int *incident_var_count)
1250     {
1251     int *ip;
1252     int count=0;
1253     struct rel_relation **rlist;
1254    
1255     rlist = g_cgdata.rels.rel_list;
1256    
1257     CG("static int ka[] = {\n");
1258     CodeGen_PrettyPrintInteger(fp,0); /* start the ball a rollin' */
1259     for (ip = incident_var_count; *ip != -1; ip++) {
1260     count += *ip;
1261     CodeGen_PrettyPrintInteger(fp,count);
1262     }
1263     CodeGen_ResetPrettyPrinter();
1264     CG("-1\n};"); /* I am writing a -1 as a safety check on the end of ka */
1265     CG("\n\n");
1266    
1267     FFLUSH(fp);
1268     return 0;
1269     }
1270    
1271     int CodeGen_WriteIncidence(FILE *fp,slv_system_t sys)
1272     {
1273     int32 maxrel,maxvar;
1274     struct rel_relation **rp;
1275     enum Expr_enum type; /* type of the relation */
1276     int var_count = 0; /* var count per relation */
1277     int tot_var_count = 0; /* totalized variable count */
1278     int *incident_var_count = NULL;
1279    
1280     struct CGVar *cgvar;
1281     struct Instance *var_inst;
1282     struct Instance *rel_inst;
1283     CONST struct relation *r;
1284     unsigned long n_varsinrel,i,j;
1285     int *ip;
1286     int result;
1287    
1288     maxrel = g_cgdata.filtered.num_rels;
1289     maxvar = g_cgdata.filtered.num_vars;
1290    
1291     /*
1292     * make a list of size maxrel+1 to hold the count of incident
1293     * variables for each relation. This list will be used by ka.
1294     * set the first element of this list to 1. We will be using
1295     * fortran style indexing. Terminate the list with a -1 so that
1296     * we know when we are done.
1297     */
1298    
1299     ip = incident_var_count = (int *)calloc((maxrel+1),sizeof(int));
1300    
1301     rp = g_cgdata.rels.rel_list;
1302     CG("static int ha[] = {\n");
1303     for (i=0;i<maxrel;i++) {
1304     rel_inst = rel_instance(rp[i]);
1305     r = GetInstanceRelation(rel_inst,&type);
1306     n_varsinrel = NumberVariables(r);
1307     var_count = 0;
1308     for (j=1;j<=n_varsinrel;j++) {
1309     var_inst = RelationVariable(r,j);
1310     if (solver_var(var_inst)) { /* see expr.h */
1311     cgvar = Asc_CGInstanceVar(var_inst);
1312     CodeGen_PrettyPrintInteger(fp,cgvar->index);
1313     var_count++; /* update the number of incident solver_vars */
1314     tot_var_count++;
1315     }
1316     }
1317     *ip++ = var_count; /* update the incident_var_count list */
1318     }
1319    
1320     *ip = -1; /* terminate */
1321     g_cgdata.filtered.num_incidences = tot_var_count; /* cache info */
1322     CodeGen_ResetPrettyPrinter();
1323     CG("-1\n};"); /* I am writing a -1 as a safety check on the end of ha */
1324     CG("\n\n");
1325    
1326     /*
1327     * Let us go for ka. In processing 'ha' we have cached away the
1328     * count of variables so that we dont have grab the incidence list
1329     * for each relation again. So just process that list now.
1330     */
1331    
1332     switch(g_cgdata.matrix_type) {
1333     case CG_ll:
1334     result = CodeGen_WriteKA_LL(fp,sys,incident_var_count);
1335     FPRINTF(fp,"/*\n");
1336     result = CodeGen_WriteKA_CSR(fp,sys,incident_var_count);
1337     FPRINTF(fp," */\n");
1338     break;
1339     case CG_csr:
1340     result = CodeGen_WriteKA_CSR(fp,sys,incident_var_count);
1341     break;
1342     case CG_jds:
1343     FPRINTF(stderr,"JDS Format not yet supported\n");
1344     break;
1345     default:
1346     result = CodeGen_WriteKA_LL(fp,sys,incident_var_count);
1347     break;
1348     }
1349    
1350     if (incident_var_count) {
1351     free(incident_var_count);
1352     }
1353     return result;
1354     }
1355    
1356     int CodeGen_WriteInputVarIndices(FILE *fp, char *file_prefix)
1357     {
1358     unsigned long ninputs,c;
1359     int index;
1360     struct CGVar *cgvar;
1361     struct Instance *inst;
1362    
1363     if (g_cgdata.input_list == NULL) {
1364     ninputs = 0;
1365     } else {
1366     ninputs = gl_length(g_cgdata.input_list);
1367     }
1368    
1369     CodeGen_ResetPrettyPrinter();
1370     FPRINTF(fp,"static int inputs[] = {\n");
1371    
1372     for (c=1;c<=ninputs;c++) { /* remember gl_lists number from 1 */
1373     inst = (struct Instance *)gl_fetch(g_cgdata.input_list,c);
1374     cgvar = Asc_CGInstanceVar(inst);
1375     CodeGen_PrettyPrintInteger(fp,cgvar->index);
1376     }
1377     FPRINTF(fp,"-1\n");
1378     FPRINTF(fp,"};\n");
1379     CodeGen_ResetPrettyPrinter();
1380     }
1381    
1382     int CodeGen_WriteOutputVarIndices(FILE *fp, char *file_prefix)
1383     {
1384     unsigned long noutputs,c;
1385     int index;
1386     struct CGVar *cgvar;
1387     struct Instance *inst;
1388    
1389     if (g_cgdata.output_list == NULL) {
1390     noutputs = 0;
1391     } else {
1392     noutputs = gl_length(g_cgdata.output_list);
1393     }
1394    
1395     CodeGen_ResetPrettyPrinter();
1396     FPRINTF(fp,"static int outputs[] = {\n");
1397    
1398     for (c=1;c<=noutputs;c++) { /* remember gl_lists number from 1 */
1399     inst = (struct Instance *)gl_fetch(g_cgdata.output_list,c);
1400     cgvar = Asc_CGInstanceVar(inst);
1401     CodeGen_PrettyPrintInteger(fp,cgvar->index);
1402     }
1403     FPRINTF(fp,"-1\n");
1404     FPRINTF(fp,"};\n");
1405     CodeGen_ResetPrettyPrinter();
1406     }
1407    
1408    
1409     /*
1410     * Write out the variable types array. This is an integer array
1411     * saying whether the variable is:
1412     * 0 - free,
1413     * 1 - fixed and internal,
1414     * 2 - fixed but input, (interface variable).
1415     * At the moment we are assuming that it is *illegal* for a variable
1416     * to be both CG_INPUT and CG_OUTPUT. We deal with output variables
1417     * elsewhere. It is the job of SetUpVariables to ensure that we
1418     * have good data at this point.
1419     */
1420    
1421     int CodeGen_WriteVarTypes(FILE *fp, char *file_prefix)
1422     {
1423     int num_vars, c;
1424     unsigned int filter = 0x0;
1425     unsigned int MASK;
1426     struct CGVar *cgvarlist;
1427    
1428     num_vars = g_cgdata.vars.num_vars;
1429     cgvarlist = g_cgdata.vars.var_list;
1430    
1431     CodeGen_ResetPrettyPrinter();
1432     FPRINTF(fp,"static int vartypes[] = {\n");
1433    
1434     for (c=0;c<num_vars;c++) {
1435     filter = cgvarlist[c].flags;
1436     if (filter & CG_FIXED) { /* fixed variables */
1437     MASK = CG_INPUT | CG_OUTPUT;
1438     filter = filter & MASK;
1439     switch(filter) {
1440     case CG_INPUT:
1441     CodeGen_PrettyPrintInteger(fp,-2); /* input fixed var */
1442     break;
1443     case CG_OUTPUT:
1444     FPRINTF(stderr,"Warning: fixed variable is both input and output\n");
1445     CodeGen_PrettyPrintInteger(fp,-2); /* mark as input */
1446     break;
1447     default:
1448     CodeGen_PrettyPrintInteger(fp,1); /* normal fixed var */
1449     break;
1450     }
1451     } else { /* free var */
1452     CodeGen_PrettyPrintInteger(fp,0);
1453     }
1454     }
1455     FPRINTF(fp,"-99\n");
1456     FPRINTF(fp,"};\n");
1457     CodeGen_ResetPrettyPrinter();
1458     }
1459    
1460     int CodeGen_WriteRelTypes(FILE *fp, char *file_prefix)
1461     {
1462     int num_rels,c;
1463     unsigned int filter = 0x0;
1464     unsigned int MASK;
1465     struct rel_relation **rlist;
1466    
1467     num_rels = g_cgdata.rels.num_rels;
1468     rlist = g_cgdata.rels.rel_list;
1469    
1470     CodeGen_ResetPrettyPrinter();
1471     FPRINTF(fp,"\nstatic int reltypes[] = {\n",file_prefix);
1472    
1473     for (c=0;c<num_rels;c++) {
1474     filter = rlist[c]->flags;
1475     if (filter & CG_INCLUDED) {
1476     MASK = CG_LESS | CG_GREATER;
1477     filter = filter & MASK; /* filter unwanteds so that we
1478     * can switch over the rest */
1479     switch(filter) {
1480     case CG_LESS:
1481     CodeGen_PrettyPrintInteger(fp,1);
1482     break;
1483     case CG_GREATER:
1484     CodeGen_PrettyPrintInteger(fp,-1);
1485     break;
1486     case CG_EQUAL:
1487     default:
1488     CodeGen_PrettyPrintInteger(fp,0);
1489     break;
1490     }
1491     } else { /* not included */
1492     CodeGen_PrettyPrintInteger(fp,-2);
1493     }
1494     }
1495     FPRINTF(fp,"-99\n");
1496     FPRINTF(fp,"};\n");
1497     CodeGen_ResetPrettyPrinter();
1498     }
1499    
1500    
1501    
1502     /*
1503     * This function will attempt to write out as much as information
1504     * as a client/solver would need to be able to set up the problem.
1505     * Later on it will take a prefix, so as to give some name space
1506     * protection, or maybe use a structure. The convention is that a
1507     * value for any size less than 0, is garbage.
1508     */
1509    
1510     int CodeGen_WriteProblemHeader(char *file_prefix)
1511     {
1512     char *headerfile = NULL;
1513     FILE *hdr;
1514     headerfile = (char *)ascmalloc((strlen(file_prefix)+4)*sizeof(char));
1515     sprintf(headerfile,"%s.h",file_prefix);
1516     hdr = fopen(headerfile,"w");
1517     if (!hdr) {
1518     FPRINTF(stderr,"Error in opening file %s.h\n",file_prefix);
1519     if (headerfile) {
1520     ascfree(headerfile);
1521     }
1522     return 1;
1523     }
1524    
1525     FPRINTF(hdr,"/***************** ");
1526     FPRINTF(hdr,"This file was generated by Ascend *************/\n\n");
1527     PUTC('\n',hdr);
1528     FPRINTF(hdr,"#ifndef __%s_H_SEEN__\n",file_prefix);
1529     FPRINTF(hdr,"#define __%s_H_SEEN__\n",file_prefix);
1530     FPRINTF(hdr,"#include \"codegen_support.h\"\n\n");
1531     FPRINTF(hdr,"extern struct CG_Problem %s__problem;\n",file_prefix);
1532     PUTC('\n',hdr);
1533    
1534     FPRINTF(hdr,"extern void %s__Initialize();\n",file_prefix);
1535     FPRINTF(hdr,"\t/* double *x, double *u, double *lower,\n");
1536     FPRINTF(hdr,"\t double *upper, double *nominal */\n");
1537     FPRINTF(hdr,"extern ExtEvalFunc *%s__FuncTable[];\n",file_prefix);
1538     FPRINTF(hdr,"extern ExtEvalFunc *%s__GradTable[];\n",file_prefix);
1539     PUTC('\n',hdr);
1540     FPRINTF(hdr,"#endif \t/* __%s_H_SEEN__ */\n",file_prefix);
1541     fclose(hdr);
1542     if (headerfile) {
1543     ascfree(headerfile);
1544     }
1545     return 0;
1546     }
1547    
1548    
1549     void CodeGen_WriteDriver(char *file_prefix)
1550     {
1551     FILE *dfile;
1552     char *filename=NULL;
1553    
1554     filename = (char *)ascmalloc((strlen(file_prefix)+32)*sizeof(char));
1555     sprintf(filename,"%s_driver.c",file_prefix);
1556     dfile = fopen(filename,"w");
1557     if (dfile==NULL) {
1558     FPRINTF(stderr,"Error in opening %s_driver.c\n",file_prefix);
1559     goto error;
1560     }
1561    
1562     FPRINTF(dfile,"#include <stdio.h>\n");
1563     FPRINTF(dfile,"#include <stdlib.h>\n");
1564     FPRINTF(dfile,"#include <math.h>\n");
1565     FPRINTF(dfile,"#include \"codegen_support.h\"\n");
1566     FPRINTF(dfile,"#include \"%s.h\"\n",file_prefix);
1567    
1568     FPRINTF(dfile,"\n\n");
1569     FPRINTF(dfile,"main()\n");
1570     FPRINTF(dfile,"{\n");
1571     FPRINTF(dfile," int i;\n");
1572     FPRINTF(dfile," int result = 0;\n\n");
1573     FPRINTF(dfile," int mode,m,n;\n");
1574     FPRINTF(dfile," int sizeof_x_vector, sizeof_u_vector;\n");
1575     FPRINTF(dfile," int sizeof_f_vector, sizeof_g_vector;\n");
1576     FPRINTF(dfile," double *lower, *upper, *nominal;\n");
1577     FPRINTF(dfile," double *x, *u, *f, *g;\n");
1578     FPRINTF(dfile," ExtEvalFunc *func;\n\n");
1579    
1580    
1581     FPRINTF(dfile," m = %s__problem.number_variables;\n",file_prefix);
1582     FPRINTF(dfile," n = %s__problem.number_relations;\n",file_prefix);
1583     FPRINTF(dfile," sizeof_x_vector = %s__problem.sizeof_x_vector;\n",
1584     file_prefix);
1585     FPRINTF(dfile," sizeof_u_vector = %s__problem.sizeof_u_vector;\n",
1586     file_prefix);
1587     FPRINTF(dfile," sizeof_f_vector = %s__problem.sizeof_f_vector;\n",
1588     file_prefix);
1589     FPRINTF(dfile," sizeof_g_vector = %s__problem.sizeof_g_vector;\n",
1590     file_prefix);
1591     FPRINTF(dfile," mode = 2;\n\n");
1592    
1593     FPRINTF(dfile,
1594     " x = (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1595     FPRINTF(dfile,
1596     " u = (double*)calloc((sizeof_u_vector+1),sizeof(double));\n");
1597     FPRINTF(dfile,
1598     " f = (double*)calloc((sizeof_f_vector+1),sizeof(double));\n");
1599     FPRINTF(dfile,
1600     " g = (double*)calloc((sizeof_g_vector+1),sizeof(double));\n");
1601     FPRINTF(dfile,
1602     " lower = (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1603     FPRINTF(dfile,
1604     " upper= (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1605     FPRINTF(dfile,
1606     " nominal = "
1607     "(double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1608     PUTC('\n',dfile);
1609    
1610     FPRINTF(dfile," %s__Initialize(x,u,lower,upper,nominal);\n",
1611     file_prefix);
1612    
1613     FPRINTF(dfile," for (i=0;i<m;i++) {\n");
1614     FPRINTF(dfile," func = %s__FuncTable[i];\n",file_prefix);
1615     FPRINTF(dfile," result += (*func)(&mode,&m,&n,x,u,f,g);\n");
1616     FPRINTF(dfile," }\n");
1617     FPRINTF(dfile,"}\n\n");
1618    
1619     error:
1620     if (dfile) {
1621     fclose(dfile);
1622     }
1623     if (filename) {
1624     ascfree(filename);
1625     }
1626     }
1627    
1628    
1629     /*
1630     * The initialization code here has to be updated whenever
1631     * the CG_problem definition changes.
1632     */
1633     void CodeGen_WriteProblemStats(FILE *fp, char *file_prefix)
1634     {
1635     int num_inputs, num_outputs;
1636    
1637     if (g_cgdata.input_list) {
1638     num_inputs = (int)gl_length(g_cgdata.input_list);
1639     } else {
1640     num_inputs = 0;
1641     }
1642     if (g_cgdata.output_list) {
1643     num_outputs = (int)gl_length(g_cgdata.output_list);
1644     } else {
1645     num_outputs = 0;
1646     }
1647    
1648    
1649     PUTC('\n',fp);
1650     FPRINTF(fp,"struct CG_Problem %s__problem = {\n",file_prefix);
1651     FPRINTF(fp," %d, \t/* num_rels */\n",g_cgdata.filtered.num_rels);
1652     FPRINTF(fp," %d, \t/* num_vars */\n",g_cgdata.filtered.num_vars);
1653     FPRINTF(fp," %d, \t/* num_incidences */\n",
1654     g_cgdata.filtered.num_incidences);
1655     FPRINTF(fp," %d, \t/* num_inputs */\n",num_inputs);
1656     FPRINTF(fp," %d, \t/* num_outputs */\n",num_outputs);
1657    
1658     FPRINTF(fp," %d, \t/* tot_num_vars */\n",g_cgdata.vars.num_vars);
1659     FPRINTF(fp," %d, \t/* tot_num_pars */\n",g_cgdata.pars.num_pars);
1660     FPRINTF(fp," %d, \t/* tot_num_rels */\n",g_cgdata.rels.num_rels);
1661     FPRINTF(fp," %d, \t/* num_incidences */\n",
1662     g_cgdata.filtered.num_incidences);
1663     FPRINTF(fp," \t/*\n");
1664     FPRINTF(fp," \t * Other stuff\n");
1665     FPRINTF(fp," \t */\n");
1666     FPRINTF(fp," ha, \t/* row indexes */\n");
1667     FPRINTF(fp," ka, \t/* column indexes */\n");
1668     FPRINTF(fp," vartypes,\t/* variable types */\n");
1669     FPRINTF(fp," reltypes,\t/* relation types */\n");
1670     FPRINTF(fp," inputs, \t/* input indices */\n");
1671     FPRINTF(fp," outputs, \t/* output_indices */\n");
1672     FPRINTF(fp," NULL, \t/* u_vector */\n");
1673     FPRINTF(fp," NULL \t/* wild_hook for user_data */\n");
1674     FPRINTF(fp,"};\n");
1675     PUTC('\n',fp);
1676     }
1677    
1678    
1679    
1680     static int CG_Classify(struct Instance *inst)
1681     {
1682     return 1;
1683     }
1684    
1685     int CodeGen_WriteFunctions1(FILE *fp, int gradients,
1686     struct CGFormat *format)
1687     {
1688     struct rel_relation **rp, *rel_tmp;
1689     struct CGVar *var_list;
1690     struct Instance *rel_inst, *var_inst;
1691     RelationINF *r, *derivative;
1692     enum Expr_enum type;
1693     Term *lhs,*rhs;
1694     int nchars = 0;
1695    
1696     int num_rels,num_vars;
1697     unsigned long n_varsinrel;
1698     unsigned long i,j;
1699     int a_index=0;
1700    
1701     var_list = g_cgdata.vars.var_list;
1702     num_rels = g_cgdata.rels.num_rels;
1703     rel_tmp = rp = g_cgdata.rels.rel_list;
1704    
1705     for (i=0;i<num_rels;i++) {
1706     if (Asc_CGRelIncluded(rp[i])) { /* get status */
1707     rel_inst = rel_instance(rp[i]); /* get instance*/
1708     r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel struct */
1709     if (type!=e_token) {
1710     FPRINTF(stderr,"rel type not supported in CodeGen_WriteFunctions1\n");
1711     continue;
1712     }
1713     FPRINTF(fp,"\tf[%d] = ",rel_index(rp[i])); /* write label */
1714     if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */
1715     nchars = CodeGen_WriteSide(fp,lhs,r,format,0); /* write lhs */
1716     }
1717     if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */
1718     FPRINTF(fp," - (");
1719     nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars);/* write rhs */
1720     PUTC(')',fp);
1721     }
1722     FPRINTF(fp,";\n"); /* terminate func */
1723     }
1724     }
1725    
1726     /*
1727     * Now go for the gradients
1728     */
1729     FPRINTF(fp,"\tif (*mode!=2) {return 0;}\n");
1730     if(!gradients) {
1731     return 0;
1732     }
1733    
1734     PrepareDerivatives(1,1,1000); /* 1 buffer, 2000 blocks */
1735    
1736     a_index = 1;
1737     for (i=0;i<num_rels;i++) {
1738     if (Asc_CGRelIncluded(rp[i])) {
1739     rel_inst = rel_instance(rp[i]);
1740     r = (RelationINF *)GetInstanceRelation(rel_inst,&type);
1741     if (type!=e_token) {
1742     FPRINTF(stderr,"rel type not supported in CodeGen_WriteFunctions1\n");
1743     continue;
1744     }
1745     n_varsinrel = NumberVariables(r);
1746     for (j=1;j<=n_varsinrel;j++) {
1747     var_inst = RelationVariable(r,j);
1748     if (solver_var(var_inst)) {
1749     derivative = RelDeriveSloppy(r,j,CG_Classify);
1750     FPRINTF(fp,"\tg[%d] = ",a_index);
1751     if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
1752     nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
1753     }
1754     if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
1755     FPRINTF(fp," - (");
1756     nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
1757     PUTC(')',fp);
1758     }
1759     FPRINTF(fp,";\n");
1760     RelDestroySloppy(derivative);
1761     a_index++;
1762     }
1763     }
1764     }
1765     }
1766     ShutDownDerivatives();
1767     }
1768    
1769     /*
1770     **********************************************************************
1771     * CodeGen__WriteFunctions2
1772     *
1773     * This function writes a function that will compute the
1774     * residuals and the gradients for a given relation. It
1775     * returns 1 in the event of a problem, 0 otherwise.
1776     * NOTE, it takes as an arguement "ndx_offset", from which
1777     * it should start for indexing its gradients. E.g,
1778     * if ndx_offset = 5, and 3 gradients are written, they should
1779     * have indices 6,7,8 and ndx_offset should be updated to 8.
1780     **********************************************************************
1781     */
1782     int CodeGen__WriteFunctions2(FILE *fp, struct rel_relation *rel,
1783     struct CGFormat *format)
1784     {
1785     struct Instance *rel_inst, *var_inst;
1786     RelationINF *r;
1787     enum Expr_enum type;
1788     Term *lhs,*rhs;
1789     int nchars;
1790    
1791     rel_inst = rel_instance(rel);
1792     r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */
1793     if (type!=e_token) {
1794     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteFunctions2\n");
1795     return;
1796     }
1797    
1798     /* write label */
1799     FPRINTF(fp,"\tf[%d] = ",rel_index(rel)); /* FIX FIX FIX */
1800     if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */
1801     nchars = CodeGen_WriteSide(fp,lhs,r,format,0); /* write lhs */
1802     }
1803     if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */
1804     FPRINTF(fp," - (");
1805     nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars); /* write rhs */
1806     PUTC(')',fp);
1807     }
1808     FPRINTF(fp,";\n\n"); /* terminate func */
1809     return 0;
1810     }
1811    
1812     int CodeGen__WriteGradients2(FILE *fp, struct rel_relation *rel,
1813     struct CGFormat *format,
1814     int *ndx_offset)
1815     {
1816     struct Instance *rel_inst, *var_inst;
1817     RelationINF *r, *derivative;
1818     enum Expr_enum type;
1819     Term *lhs,*rhs;
1820     int a_index;
1821     int nchars;
1822     unsigned long n_varsinrel,j;
1823    
1824     a_index = *ndx_offset;
1825    
1826     rel_inst = rel_instance(rel);
1827     r = (RelationINF *)GetInstanceRelation(rel_inst,&type);
1828     if (type!=e_token) {
1829     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteGradients2\n");
1830     return;
1831     }
1832    
1833     n_varsinrel = NumberVariables(r);
1834     for (j=1;j<=n_varsinrel;j++) {
1835     var_inst = RelationVariable(r,j);
1836     if (solver_var(var_inst)) {
1837     derivative = RelDeriveSloppy(r,j,CG_Classify);
1838     FPRINTF(fp,"\tg[%d] = ",++a_index); /* FIX FIX FIX */
1839     if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
1840     nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
1841     }
1842     if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
1843     FPRINTF(fp," - (");
1844     nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
1845     PUTC(')',fp);
1846     }
1847     FPRINTF(fp,";\n");
1848     RelDestroySloppy(derivative);
1849     }
1850     }
1851     *ndx_offset = a_index; /* set up for return */
1852     return 0;
1853     }
1854    
1855    
1856    
1857     /*
1858     **********************************************************************
1859     * CodeGen__WriteFunctions3
1860     *
1861     * This code need some rationalization with CodeGen__WriteFunctions2.
1862     * The only difference between CodeGen__WriteFunctions2 and this code,
1863     * is the format of the indexing for the functions, gradients, and
1864     * the x vector. Also a u vector is *not* supported. This code is
1865     * essentially for generating glassbox relations, whereas the
1866     * CodeGen__WriteFunctions2, code is for blackbox relations.
1867     *
1868     **********************************************************************
1869     */
1870    
1871     int CodeGen__WriteFunctions3(FILE *fp, struct rel_relation *rel,
1872     struct CGFormat *format)
1873     {
1874     struct Instance *rel_inst, *var_inst;
1875     RelationINF *r;
1876     enum Expr_enum type;
1877     Term *lhs,*rhs;
1878     int nchars;
1879    
1880     rel_inst = rel_instance(rel);
1881     r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */
1882     if (type!=e_token) {
1883     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteFunctions3\n");
1884     return;
1885     }
1886    
1887     FPRINTF(fp,"\tf[0] = "); /* all index from 0 */
1888     if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */
1889     nchars = CodeGen_WriteSide(fp,lhs,r,format,0); /* write lhs */
1890     }
1891     if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */
1892     FPRINTF(fp," - (");
1893     nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars); /* write rhs */
1894     PUTC(')',fp);
1895     }
1896     FPRINTF(fp,";\n\n"); /* terminate func */
1897     return 0;
1898     }
1899    
1900     int CodeGen__WriteGradients3(FILE *fp, struct rel_relation *rel,
1901     struct CGFormat *format)
1902     {
1903     struct Instance *relinst, *inst;
1904     struct CGVar *cgvar;
1905     RelationINF *r, *derivative;
1906     enum Expr_enum type;
1907     Term *lhs,*rhs;
1908     int nchars;
1909     int n_varsinrel,j;
1910     unsigned int filter;
1911    
1912     relinst = rel_instance(rel);
1913     r = (RelationINF *)GetInstanceRelation(relinst,&type);
1914     if (type!=e_token) {
1915     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteGradients3\n");
1916     return;
1917     }
1918    
1919     n_varsinrel = (int)NumberVariables(r);
1920     if (n_varsinrel) {
1921     for (j=0;j<n_varsinrel;j++) {
1922     inst = RelationVariable(r,j+1);
1923     cgvar = (struct CGVar *)GetInterfacePtr(inst);
1924     assert(cgvar); /* desperate integrity check */
1925     /*
1926     * only do derivatives for open variables i.e. potential
1927     * solver_vars, and for variables that are already solver_vars.
1928     */
1929     filter = cgvar->flags;
1930     if (filter & CG_SLV_CONST) {
1931     continue;
1932     }
1933     derivative = RelDeriveSloppy(r,j+1,CG_Classify);
1934     FPRINTF(fp,"\tg[%d] = ",j);
1935     if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
1936     nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
1937     }
1938     if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
1939     FPRINTF(fp," - (");
1940     nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
1941     PUTC(')',fp);
1942     }
1943     FPRINTF(fp,";\n");
1944     RelDestroySloppy(derivative);
1945     }
1946     }
1947     return 0;
1948     }
1949    
1950    
1951     /*
1952     * This writes out the code for the functable,
1953     * which is a static array of pointers to funcs.
1954     */
1955    
1956     int CodeGen_WriteFuncTable(FILE *fp,char *file_prefix)
1957     {
1958     struct rel_relation **rp = g_cgdata.rels.rel_list;
1959     int num_rels = g_cgdata.rels.num_rels;
1960     int i, num_chars=0;
1961     char str[80];
1962    
1963     sprintf(str,"&%s",CG_CFUNCNAME);
1964     CodeGen_ResetPrettyPrinter();
1965     PUTC('\n',fp);
1966     FPRINTF(fp,"ExtEvalFunc *%s__FuncTable[] = {\n",file_prefix);
1967     for (i=0;i<num_rels;i++) {
1968     CodeGen_PrettyPrintStr(fp,str,rel_index(rp[i]));
1969     }
1970     CG("NULL\n};");
1971     CG("\n\n");
1972     CodeGen_ResetPrettyPrinter();
1973     }
1974    
1975     int CodeGen_WriteGradTable(FILE *fp,char *file_prefix)
1976     {
1977     struct rel_relation **rp = g_cgdata.rels.rel_list;
1978     int num_rels = g_cgdata.rels.num_rels;
1979     int i, num_chars=0;
1980     char str[80];
1981    
1982     sprintf(str,"&%s",CG_CGRADNAME);
1983     CodeGen_ResetPrettyPrinter();
1984     PUTC('\n',fp);
1985     FPRINTF(fp,"ExtEvalFunc *%s__GradTable[] = {\n",file_prefix);
1986     for (i=0;i<num_rels;i++) {
1987     CodeGen_PrettyPrintStr(fp,str,rel_index(rp[i]));
1988     }
1989     CG("NULL\n};");
1990     CG("\n\n");
1991     CodeGen_ResetPrettyPrinter();
1992     }
1993    
1994     int CodeGen_WriteLoadCode(FILE *fp,char *file_prefix)
1995     {
1996     FPRINTF(fp,"#ifdef ASCEND\n");
1997     FPRINTF(fp,"extern int CreateUserFunction();\n");
1998    
1999     FPRINTF(fp,"int %s_Init(void)\n",file_prefix);
2000     FPRINTF(fp,"{\n");
2001     FPRINTF(fp," int result;\n");
2002     FPRINTF(fp," char %s_help[] = \"%s glassbox model\";\n",
2003     file_prefix,file_prefix);
2004     FPRINTF(fp," result = CreateUserFunction(\"%s\", NULL,\n",file_prefix);
2005     FPRINTF(fp," %s__FuncTable,\n",file_prefix);
2006     FPRINTF(fp," %s__GradTable,\n",file_prefix);
2007     FPRINTF(fp," NULL,1,1,%s_help);\n",
2008     file_prefix);
2009     FPRINTF(fp," return result;\n");
2010     FPRINTF(fp,"}\n");
2011     FPRINTF(fp,"#endif\n");
2012     }
2013    
2014    
2015    
2016    
2017     int CodeGen_WriteFunctions(FILE *fp, int gradients,
2018     struct CGFormat *format)
2019     {
2020     struct rel_relation **rp;
2021     int num_rels;
2022     int i,offset;
2023     int result;
2024    
2025     offset = CG_OFFSET-1;
2026     num_rels = g_cgdata.rels.num_rels;
2027     rp = g_cgdata.rels.rel_list;
2028    
2029     if (gradients) {
2030     PrepareDerivatives(1,1,1000);
2031     }
2032    
2033     switch (format->names) {
2034     case CG_blackbox:
2035     for (i=0;i<num_rels;i++) {
2036     CodeGen_WriteFuncHeader2(fp,i); /* write *all* relations */
2037     CodeGen__WriteFunctions2(fp,rp[i],format);
2038     CodeGen_WriteFuncFooter(fp);
2039     if (gradients) {
2040     CodeGen_WriteGradHeader2(fp,i); /* write *all* relations */
2041     CodeGen__WriteGradients2(fp,rp[i],format,&offset);
2042     CodeGen_WriteFuncFooter(fp);
2043     PUTC('\n',fp);
2044     }
2045     }
2046     break;
2047     case CG_glassbox:
2048     for (i=0;i<num_rels;i++) {
2049     CodeGen_WriteFuncHeader2(fp,i); /* write *all* relations */
2050     CodeGen__WriteFunctions3(fp,rp[i],format);
2051     CodeGen_WriteFuncFooter(fp);
2052     if (gradients) {
2053     CodeGen_WriteGradHeader2(fp,i); /* write *all* relations */
2054     CodeGen__WriteGradients3(fp,rp[i],format);
2055     CodeGen_WriteFuncFooter(fp);
2056     PUTC('\n',fp);
2057     }
2058     }
2059     break;
2060     case CG_minos:
2061     CodeGen_WriteFuncHeader1(fp);
2062     CodeGen_WriteFuncDecln(fp);
2063     CodeGen_WriteFunctions1(fp,gradients,format);
2064     CodeGen_WriteFuncFooter(fp);
2065     break;
2066     }
2067     if (gradients) {
2068     ShutDownDerivatives();
2069     }
2070     return 0;
2071     }
2072    
2073     int CodeGen_BlackBox(slv_system_t sys,
2074     FILE *fp, char *file_prefix, struct CGFormat *format,
2075     int do_gradients,
2076     struct gl_list_t *inputs,
2077     struct gl_list_t *outputs,
2078     struct gl_list_t *parameters)
2079     {
2080     int result;
2081    
2082     result = CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0,
2083     inputs,outputs);
2084     result += CodeGen_CheckData();
2085     CodeGen_WriteIncidence(fp,sys);
2086     CodeGen_WriteInputVarIndices(fp,file_prefix);
2087     CodeGen_WriteOutputVarIndices(fp,file_prefix);
2088     CodeGen_WriteVarTypes(fp,file_prefix);
2089     CodeGen_WriteRelTypes(fp,file_prefix);
2090     if (result = CodeGen_WriteProblemHeader(file_prefix)) {
2091     goto error;
2092     }
2093     CodeGen_WriteDriver(file_prefix);
2094     CodeGen_WriteProblemStats(fp,file_prefix);
2095     CodeGen_WriteInitValues(fp,file_prefix);
2096     CodeGen_WriteFunctions(fp,do_gradients,format);
2097     CodeGen_WriteFuncTable(fp,file_prefix);
2098     CodeGen_WriteGradTable(fp,file_prefix);
2099    
2100     error:
2101     Asc_CodeGenShutDown();
2102     return result;
2103    
2104     }
2105    
2106     int CodeGen_GlassBox(slv_system_t sys,
2107     FILE *fp, char *file_prefix, struct CGFormat *format,
2108     int do_gradients,
2109     struct gl_list_t *inputs,
2110     struct gl_list_t *outputs,
2111     struct gl_list_t *parameters)
2112     {
2113     struct Instance *root;
2114     struct gl_list_t *list = NULL;
2115     struct CGVar *cgvarlist;
2116     int nvars;
2117     int result;
2118    
2119     root = g_solvinst_cur; /* see interface1.h */
2120     list = PreProcessVars(root);
2121     cgvarlist = Asc_CodeGenSetUpVariables3(list);
2122     nvars = (int)gl_length(list);
2123     result = CodeGen_SetupCodeGen(sys, cgvarlist,nvars, NULL,0, NULL,0, NULL,0,
2124     inputs,outputs);
2125     result += CodeGen_CheckData();
2126     CodeGen_WriteIncidence(fp,sys);
2127     CodeGen_WriteInputVarIndices(fp,file_prefix);
2128     CodeGen_WriteOutputVarIndices(fp,file_prefix);
2129     CodeGen_WriteVarTypes(fp,file_prefix);
2130     CodeGen_WriteRelTypes(fp,file_prefix);
2131     if (result = CodeGen_WriteProblemHeader(file_prefix)) {
2132     goto error;
2133     }
2134     CodeGen_WriteDriver(file_prefix);
2135     CodeGen_WriteProblemStats(fp,file_prefix);
2136     CodeGen_WriteFunctions(fp,do_gradients,format);
2137     CodeGen_WriteFuncTable(fp,file_prefix);
2138     CodeGen_WriteGradTable(fp,file_prefix);
2139     CodeGen_WriteLoadCode(fp,file_prefix);
2140    
2141     error:
2142     if (list) {
2143     gl_destroy(list);
2144     }
2145     Asc_CodeGenShutDown();
2146     return result;
2147     }
2148    
2149    
2150     /*
2151     **********************************************************************
2152     * CodeGen_ParseData
2153     *
2154     * This function takes a string list -- a Tcl list -- of instance
2155     * names, and returns a gl_list_t of the correspoding instances.
2156     * If there are any errors, a NULL is returned. We will also return
2157     * the count of elements that tcl found.
2158     **********************************************************************
2159     */
2160     struct gl_list_t *CodeGen_ParseData(Tcl_Interp *interp, char *strlist,
2161     int *found_count)
2162     {
2163     struct gl_list_t *list;
2164     struct Instance *i;
2165     char **argv=NULL; /* the split list of strings */
2166     int len,c;
2167     int error = 0;
2168    
2169     if (Tcl_SplitList(interp,strlist,found_count,&argv) != TCL_OK) {
2170     return NULL;
2171     }
2172     if (*found_count==0) { /* parsed ok, but was a zero length list */
2173     if (argv) {
2174     Tcl_Free((char *)argv);
2175     }
2176     return NULL;
2177     }
2178     len = *found_count;
2179     list = gl_create((unsigned long)len);
2180     /*
2181     * Search for each instance in turn. Qlfdid will leave
2182     * g_search_inst looking at the found instance.
2183     */
2184     for (c=0;c<len;c++) {
2185     if (Asc_QlfdidSearch3(argv[c])==0,0) {
2186     gl_append_ptr(list,(char *)g_search_inst);
2187     } else {
2188     FPRINTF(stderr,"Error in finding instance %s\n",argv[c]);
2189     error++;
2190     break;
2191     }
2192     }
2193     if (error) {
2194     gl_destroy(list);
2195     if (argv != NULL) {
2196     Tcl_Free((char *)argv);
2197     }
2198     return NULL;
2199     } else {
2200     if (argv !=NULL) {
2201     Tcl_Free((char *)argv);
2202     }
2203     return list;
2204     }
2205     }
2206    
2207    
2208     /*
2209     **********************************************************************
2210     * CodeGen_Check Routines
2211     *
2212     * This function checks the input, output and hopefully
2213     * the parameter list. Input and utput variables, must
2214     * be of type solver_var. At the moment we are only requring
2215     * that parameters be of type solver_par/REAL_ATOM_INST.
2216     **********************************************************************
2217     */
2218     static struct gl_list_t *CodeGen_CheckList(struct gl_list_t *list)
2219     {
2220     struct Instance *inst;
2221     unsigned long len,c;
2222    
2223     if (!list) {
2224     return NULL;
2225     }
2226     len = gl_length(list);
2227     for (c=1;c<=len;c++) {
2228     inst = (struct Instance *)gl_fetch(list,c);
2229     if (!solver_var(inst)) {
2230     return NULL;
2231     }
2232     }
2233     return list;
2234     }
2235    
2236     int CodeGen_CheckData(void)
2237     {
2238     int bad_instances = 0;
2239     struct gl_list_t *result, *list;
2240    
2241     list = g_cgdata.input_list;
2242     if (list) {
2243     result = CodeGen_CheckList(list);
2244     if (result != list) {
2245     FPRINTF(stderr,"Input Variables must be \"solver_vars\"\n");
2246     gl_destroy(list);
2247     g_cgdata.input_list = NULL;
2248     bad_instances = 1;
2249     }
2250     }
2251    
2252     list = g_cgdata.output_list;
2253     if (list) {
2254     result = CodeGen_CheckList(list);
2255     if (result != list) {
2256     FPRINTF(stderr,"Output Variables must be \"solver_vars\"\n");
2257     gl_destroy(list);
2258     g_cgdata.output_list = NULL;
2259     bad_instances = 1;
2260     }
2261     }
2262     return bad_instances;
2263     }
2264    
2265    
2266     int CodeGen_CheckSystem(Tcl_Interp *interp,slv_system_t sys)
2267     {
2268     struct rel_relation **rp, *rel_tmp;
2269     struct var_variable **vp, *var_tmp;
2270     if (sys==NULL) {
2271     Tcl_SetResult(interp, "__codegen_c called without slv_system", TCL_STATIC);
2272     return 1;
2273     }
2274     var_tmp = vp = slv_get_master_var_list(sys);
2275     if (vp==NULL) {
2276     Tcl_SetResult(interp, "__codegen_c called without varlist", TCL_STATIC);
2277     return 1;
2278     }
2279     rel_tmp = rp =slv_get_master_rel_list(sys);
2280     if (rp==NULL) {
2281     Tcl_SetResult(interp, "__codegen_c called with NULL rellist", TCL_STATIC);
2282     }
2283     if (rp==NULL) {/* THIS SHOULD BE THE OBJECTIVE !!! */
2284     Tcl_SetResult(interp, "__codegen_c called without constraints or obj",
2285     TCL_STATIC);
2286     return 1;
2287     }
2288     return 0;
2289     }
2290    
2291    
2292     int Asc_CodeGenParseDataCmd(ClientData cdata, Tcl_Interp *interp,
2293     int argc, CONST84 char *argv[])
2294     {
2295     char *strlist;
2296     struct gl_list_t *list;
2297     int count = -1;
2298     unsigned long len;
2299     char buffer[256];
2300    
2301     if ( argc != 2 ) {
2302     Tcl_SetResult(interp, "wrong # args : Usage __codegen_parsedata list",
2303     TCL_STATIC);
2304     return TCL_ERROR;
2305     }
2306     strlist = argv[1];
2307     list = CodeGen_ParseData(interp,strlist,&count);
2308     if (count>=0) {
2309     if (count==0) {
2310     /* case of an empty list: the list should be NULL -- dont free */
2311     Tcl_SetResult(interp, "0", TCL_STATIC);
2312     return TCL_OK;
2313     }
2314     if (list==NULL) {
2315     Tcl_SetResult(interp, "error in finding instances", TCL_STATIC);
2316     return TCL_ERROR;
2317     } else {
2318     sprintf(buffer,"%lu",gl_length(list));
2319     Tcl_SetResult(interp, buffer, TCL_VOLATILE);
2320     gl_destroy(list);
2321     return TCL_OK;
2322     }
2323     } else {
2324     Tcl_SetResult(interp, "error in parsing data", TCL_STATIC);
2325     return TCL_ERROR;
2326     }
2327     }
2328    
2329    
2330     int Asc_CodeGenCCmd(ClientData cdata, Tcl_Interp *interp,
2331     int argc, CONST84 char *argv[])
2332     {
2333     FILE *fp;
2334     char *filename = NULL;
2335     int do_gradients = 0;
2336     int result;
2337     int count = -1;
2338     slv_system_t sys = g_solvsys_cur; /* this might me made more general */
2339     struct CGFormat format;
2340     struct gl_list_t *inputs, *outputs, *parameters;
2341    
2342     if ( argc != 7 ) {
2343     Tcl_AppendResult(interp,"wrong # args : ",
2344     "Usage __codegen_c filename ?grad?nograd?\n",
2345     "?minos?blackbox?glassbox?, "
2346     "inputlist outputlist parameterlist",
2347     (char *)NULL);
2348     return TCL_ERROR;
2349     }
2350     result = CodeGen_CheckSystem(interp,sys);
2351     if (result) {
2352     return TCL_ERROR;
2353     }
2354    
2355     filename = (char *)ascmalloc((strlen(argv[1])+4)*sizeof(char));
2356     sprintf(filename,"%s.c",argv[1]);
2357     fp = fopen(filename,"w");
2358     if (!fp) {
2359     Tcl_SetResult(interp, "__codegen_c file open failed. system not written.",
2360     TCL_STATIC);
2361     result = TCL_ERROR;
2362     goto error;
2363     }
2364    
2365     /*
2366     * Check gradient args.
2367     */
2368     if (strncmp(argv[2],"gradients",4)==0) {
2369     do_gradients = 1;
2370     }
2371     format = C_Format;
2372    
2373     /*
2374     * Check the subformat args.
2375     */
2376     if (strncmp(argv[3],"minos",4)==0) {
2377     format.names = CG_minos;
2378     } else if (strncmp(argv[3],"blackbox",4)==0) {
2379     format.names = CG_blackbox;
2380     } else {
2381     format.names = CG_glassbox;
2382     }
2383    
2384     /*
2385     * Write out necessary header information and global data,
2386     * which is common to all code generation formats.
2387     */
2388     CodeGen_WriteIncludes(fp,argv[1]);
2389     CodeGen_WriteGlobals(fp);
2390     CodeGen_WriteSupportFuncs_Log(fp);
2391     CodeGen_WriteSupportFuncs_Cube(fp);
2392     CodeGen_WriteSupportFuncs_Sqr(fp);
2393    
2394     /*
2395     * First parse the inputs, outputs and parameters strings
2396     * and set up their gl_lists. We dont need to check if
2397     * the lists are NULL; someone else will handle that.
2398     */
2399     inputs = CodeGen_ParseData(interp,argv[4],&count);
2400     outputs = CodeGen_ParseData(interp,argv[5],&count);
2401     parameters = CodeGen_ParseData(interp,argv[6],&count); /**** FIX ***/
2402    
2403     /*
2404     * Call the appropriate routines to generate the code.
2405     */
2406     switch (format.names) {
2407     case CG_blackbox: case CG_minos:
2408     result = CodeGen_BlackBox(sys,fp,argv[1],&format,
2409     do_gradients,
2410     inputs,outputs,parameters);
2411     break;
2412     case CG_glassbox:
2413     result = CodeGen_GlassBox(sys,fp,argv[1],&format,
2414     do_gradients,
2415     inputs,outputs,parameters);
2416     break;
2417     }
2418    
2419     /*
2420     * Cleanup.
2421     */
2422     error:
2423     if (filename) {
2424     ascfree(filename);
2425     }
2426     if (fp) {
2427     fclose(fp);
2428     }
2429     return (result!=0) ? TCL_ERROR : TCL_OK;
2430     }
2431    
2432     #endif
2433    
2434    
2435    
2436    

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