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

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