/[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 40 - (hide annotations) (download) (as text)
Sat Jan 22 14:22:13 2005 UTC (15 years, 9 months ago) by jds
File MIME type: text/x-csrc
File size: 72005 byte(s)
Initial commit of WinVC7 and jam build files.  jam builds Ascend base libs and tcltk98 executable on Windows using msvc, borland, mingw, and watcom (watcom can't yet link executable due to lack of isnan() and copysign() functions).

Also includes minor source updates to compile & run on Windows.
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     case F_ERF: count += FPRINTF(f,"Erf["); break;
983     case F_LNM: count += FPRINTF(f,"Log["); break;
984     case F_SINH: count += FPRINTF(f,"Sinh["); break;
985     case F_COSH: count += FPRINTF(f,"Cosh["); break;
986     case F_TANH: count += FPRINTF(f,"Tanh["); break;
987     case F_ARCSINH: count += FPRINTF(f,"ArcSinh["); break;
988     case F_ARCCOSH: count += FPRINTF(f,"ArcCosh["); break;
989     case F_ARCTANH: count += FPRINTF(f,"ArcTanh["); break;
990     case F_CBRT:
991     count += FPRINTF(f,"Power[");
992     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
993     count += FPRINTF(f,",1/3]");
994     return;
995     }
996     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
997     PUTC(']',f);
998     break;
999     case CG_gams:
1000     switch(FuncId(TermFunc(term))) {
1001     /*
1002     * All cases which do *return* rather than *break* are
1003     * special cases which need to be handled. Those that *break*,
1004     * get closing brackets written after the switch.
1005     */
1006     case F_LOG: count += FPRINTF(f,"LOG10("); break;
1007     case F_LN: count += FPRINTF(f,"LOG("); break;
1008     case F_EXP: count += FPRINTF(f,"EXP("); break;
1009     case F_SIN: count += FPRINTF(f,"SIN("); break;
1010     case F_COS: count += FPRINTF(f,"COS("); break;
1011     case F_TAN: count += FPRINTF(f,"SIN(");
1012     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1013     count = FPRINTF(f,")/COS("); break;
1014     case F_ARCSIN: count += FPRINTF(f,"1/SIN("); break;
1015     case F_ARCCOS: count += FPRINTF(f,"1/COS("); break;
1016     case F_ARCTAN: count += FPRINTF(f,"COS(");
1017     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1018     count = FPRINTF(f,")/SIN("); break;
1019     case F_SQR: count += FPRINTF(f,"SQR("); break;
1020     case F_SQRT: count += FPRINTF(f,"SQRT("); break;
1021     case F_ERF: count += FPRINTF(f,"ERF("); break;
1022     case F_LNM: count += FPRINTF(f,"LOG"); break;
1023     /* WARNING: lnm not implemented here */
1024     case F_SINH: count += FPRINTF(f,"0.5*(EXP(");
1025     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1026     count += FPRINTF(f,")-EXP(-(");
1027     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1028     count += FPRINTF(f,")))");
1029     return;
1030     case F_COSH: count += FPRINTF(f,"0.5*(EXP(");
1031     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1032     count += FPRINTF(f,")+EXP(-(");
1033     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1034     count += FPRINTF(f,")))");
1035     return;
1036     case F_TANH: count += FPRINTF(f,"(EXP(");
1037     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1038     count += FPRINTF(f,")-EXP(-(");
1039     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1040     count += FPRINTF(f,")))/");
1041     count += FPRINTF(f,"(EXP(");
1042     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1043     count += FPRINTF(f,")+EXP(-(");
1044     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1045     count += FPRINTF(f,")))");
1046     return;
1047     case F_ARCSINH: count += FPRINTF(f,"2/(EXP(");
1048     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1049     count += FPRINTF(f,")-EXP(-(");
1050     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1051     count += FPRINTF(f,")))");
1052     return;
1053     case F_ARCCOSH: count += FPRINTF(f,"0.5*(EXP(");
1054     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1055     count += FPRINTF(f,")+EXP(-(");
1056     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1057     count += FPRINTF(f,")))");
1058     return;
1059     case F_ARCTANH: count += FPRINTF(f,"(EXP(");
1060     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1061     count += FPRINTF(f,")+EXP(-(");
1062     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1063     count += FPRINTF(f,")))/");
1064     count += FPRINTF(f,"(EXP(");
1065     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1066     count += FPRINTF(f,")-EXP(-(");
1067     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1068     count += FPRINTF(f,")))");
1069     return;
1070     case F_CUBE:
1071     count += FPRINTF(f,"(");
1072     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1073     count += FPRINTF(f,")**(3)");
1074     return;
1075     case F_CBRT:
1076     count += FPRINTF(f,"(");
1077     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1078     count += FPRINTF(f,")**(1/3)");
1079     return;
1080     }
1081     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1082     PUTC(')',f);
1083     break;
1084     case CG_ascend:
1085     case CG_c:
1086     case CG_linear:
1087     default:
1088     count += FPRINTF(f,"%s(",FuncName(TermFunc(term)));
1089     count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1090     PUTC(')',f);
1091     break;
1092     }
1093     return count;
1094     }
1095    
1096     int CodeGen_WriteSide(FILE *f, Term *term,
1097     RelationINF *r,
1098     struct CGFormat *format,
1099     int nchars)
1100     {
1101     enum Expr_enum t;
1102     int parens;
1103     int count;
1104    
1105     count = nchars;
1106     if (count>=70) { /* allow anyone to break lines */
1107     CodeGen_BreakLines(f,format);
1108     count = 0;
1109     }
1110     switch(t = RelationTermType(term)) {
1111     case e_var:
1112     count += WriteName(f,term,r,format);
1113     break;
1114     case e_int:
1115     (TermInteger(term) < 0) ?
1116     (count += FPRINTF(f,"(%ld)",TermInteger(term))) :
1117     (count += FPRINTF(f,"%ld",TermInteger(term)));
1118     break;
1119     case e_real:
1120     (TermReal(term) < 0) ?
1121     (count += FPRINTF(f,"(%g)",TermReal(term))) :
1122     (count += FPRINTF(f,"%g",TermReal(term)));
1123     break;
1124     case e_func:
1125     count = CodeGen_WriteBuiltInFuncs(f,term,r,format,count);
1126     break;
1127     case e_uminus:
1128     FPRINTF(f,"(-(");
1129     count = CodeGen_WriteSide(f,TermUniLeft(term),r,format,count) + 2;
1130     FPRINTF(f,"))");
1131     break;
1132     case e_plus:
1133     case e_minus:
1134     case e_times:
1135     case e_divide:
1136     if (parens = NeedParen(t,RelationTermType(TermBinLeft(term)),0)) {
1137     PUTC('(',f);
1138     }
1139     count = CodeGen_WriteSide(f,TermBinLeft(term),r,format,count) + 2;
1140     if (parens) {
1141     PUTC(')',f);
1142     }
1143     WriteOp(f,t);
1144     if (parens = NeedParen(t,RelationTermType(TermBinRight(term)),1)) {
1145     PUTC('(',f);
1146     }
1147     count = CodeGen_WriteSide(f,TermBinRight(term),r,format,count) + 2;
1148     if (parens) {
1149     PUTC(')',f);
1150     }
1151     break;
1152     case e_power:
1153     case e_ipower:
1154     count = WritePower(f,term,r,format,count);
1155     break;
1156     default:
1157     FPRINTF(f,"***");
1158     break;
1159     }
1160     return count;
1161     }
1162    
1163    
1164    
1165     /*
1166     **********************************************************************
1167     * At this point it is assumed that the parameter list,
1168     * the variable list, and the relations have been appropriately
1169     * marked. We are now going to get the incidence pattern for
1170     * the variables and relations that are needed to do a computation.
1171     *
1172     * This module will eventually support mulitple sparse matrix
1173     * formats. We are implementing the code for both the linked list
1174     * format, on which the Harwell format is based, as well as the CSR
1175     * format. Eventaully the JDS format will supported. At the moment all
1176     * the formatting will be written for C-style indexing. We might later
1177     * generate fortran style indexing.
1178     *
1179     * We write out the *entire* matrix pattern of computable variables.
1180     * By this we mean anything that passes the solver_var filter will be
1181     * written out. Relations obtained from the ASCEND compiler store
1182     * information what will not pass the solver var filter. We weed those
1183     * out here.
1184     *
1185     * The first thing to be written out is the vector "ha". Given below
1186     * is an orignal set of relations and the corresponding ha and ka.
1187     * ka is dependent upon the matrix format which is chosen; the example
1188     * below shows what ka looks like for two formats.
1189     *
1190     * solver_vars x4,x3; (x2 fails solver_var filter)
1191     * x4.index = 10,
1192     * x3.index = 6 (x2 would not have a variable index)
1193     *
1194     * x4 * x2 + x3 = 5; (relation 1)
1195     * x2 * x3 = 1; (relation 2)
1196     *
1197     * ka = [1,3] -- CSR format.
1198     * ka = [1,1,2] -- LL format.
1199     * ha = [10,6,6]
1200     *
1201     **********************************************************************
1202     */
1203    
1204     /*
1205     * There should be a 1 to 1 mapping between the relations list
1206     * and the incident_var_count list. What we do for the LL matrix
1207     * format is to write out the relation ndx as many times as there
1208     * are incidences; this will give the required row, col indexing on
1209     * the incident variables. I know it seems a little twisted.
1210     */
1211     int CodeGen_WriteKA_LL(FILE *fp, slv_system_t sys,
1212     int *incident_var_count)
1213     {
1214     int *ip,i,j;
1215     int num_rels,ndx,count=0;
1216     struct rel_relation **rp;
1217    
1218     ip = incident_var_count;
1219     rp = g_cgdata.rels.rel_list;
1220     num_rels = g_cgdata.rels.num_rels;
1221    
1222     CodeGen_ResetPrettyPrinter();
1223     CG("static int ka[] = {\n");
1224     for (i=0;i<num_rels;i++) {
1225     ndx = rel_index(rp[i]);
1226     count = ip[i];
1227     for (j=0;j<count;j++) {
1228     CodeGen_PrettyPrintInteger(fp,ndx);
1229     }
1230     }
1231     CodeGen_ResetPrettyPrinter();
1232     CG("-1\n};"); /* Write a -1 as a safety check on the end of ka */
1233     CG("\n\n");
1234    
1235     FFLUSH(fp);
1236     return 0;
1237     }
1238    
1239     /*
1240     * This particular piece of code will need modification
1241     * if support a fortran style indexing. At the moment life
1242     * starts at 0. The incident_var_count vector should be
1243     * provided and deallocated by the caller, as should be
1244     * terminated with a -1.
1245     */
1246     int CodeGen_WriteKA_CSR(FILE *fp, slv_system_t sys,
1247     int *incident_var_count)
1248     {
1249     int *ip;
1250     int count=0;
1251     struct rel_relation **rlist;
1252    
1253     rlist = g_cgdata.rels.rel_list;
1254    
1255     CG("static int ka[] = {\n");
1256     CodeGen_PrettyPrintInteger(fp,0); /* start the ball a rollin' */
1257     for (ip = incident_var_count; *ip != -1; ip++) {
1258     count += *ip;
1259     CodeGen_PrettyPrintInteger(fp,count);
1260     }
1261     CodeGen_ResetPrettyPrinter();
1262     CG("-1\n};"); /* I am writing a -1 as a safety check on the end of ka */
1263     CG("\n\n");
1264    
1265     FFLUSH(fp);
1266     return 0;
1267     }
1268    
1269     int CodeGen_WriteIncidence(FILE *fp,slv_system_t sys)
1270     {
1271     int32 maxrel,maxvar;
1272     struct rel_relation **rp;
1273     enum Expr_enum type; /* type of the relation */
1274     int var_count = 0; /* var count per relation */
1275     int tot_var_count = 0; /* totalized variable count */
1276     int *incident_var_count = NULL;
1277    
1278     struct CGVar *cgvar;
1279     struct Instance *var_inst;
1280     struct Instance *rel_inst;
1281     CONST struct relation *r;
1282     unsigned long n_varsinrel,i,j;
1283     int *ip;
1284     int result;
1285    
1286     maxrel = g_cgdata.filtered.num_rels;
1287     maxvar = g_cgdata.filtered.num_vars;
1288    
1289     /*
1290     * make a list of size maxrel+1 to hold the count of incident
1291     * variables for each relation. This list will be used by ka.
1292     * set the first element of this list to 1. We will be using
1293     * fortran style indexing. Terminate the list with a -1 so that
1294     * we know when we are done.
1295     */
1296    
1297     ip = incident_var_count = (int *)calloc((maxrel+1),sizeof(int));
1298    
1299     rp = g_cgdata.rels.rel_list;
1300     CG("static int ha[] = {\n");
1301     for (i=0;i<maxrel;i++) {
1302     rel_inst = rel_instance(rp[i]);
1303     r = GetInstanceRelation(rel_inst,&type);
1304     n_varsinrel = NumberVariables(r);
1305     var_count = 0;
1306     for (j=1;j<=n_varsinrel;j++) {
1307     var_inst = RelationVariable(r,j);
1308     if (solver_var(var_inst)) { /* see expr.h */
1309     cgvar = Asc_CGInstanceVar(var_inst);
1310     CodeGen_PrettyPrintInteger(fp,cgvar->index);
1311     var_count++; /* update the number of incident solver_vars */
1312     tot_var_count++;
1313     }
1314     }
1315     *ip++ = var_count; /* update the incident_var_count list */
1316     }
1317    
1318     *ip = -1; /* terminate */
1319     g_cgdata.filtered.num_incidences = tot_var_count; /* cache info */
1320     CodeGen_ResetPrettyPrinter();
1321     CG("-1\n};"); /* I am writing a -1 as a safety check on the end of ha */
1322     CG("\n\n");
1323    
1324     /*
1325     * Let us go for ka. In processing 'ha' we have cached away the
1326     * count of variables so that we dont have grab the incidence list
1327     * for each relation again. So just process that list now.
1328     */
1329    
1330     switch(g_cgdata.matrix_type) {
1331     case CG_ll:
1332     result = CodeGen_WriteKA_LL(fp,sys,incident_var_count);
1333     FPRINTF(fp,"/*\n");
1334     result = CodeGen_WriteKA_CSR(fp,sys,incident_var_count);
1335     FPRINTF(fp," */\n");
1336     break;
1337     case CG_csr:
1338     result = CodeGen_WriteKA_CSR(fp,sys,incident_var_count);
1339     break;
1340     case CG_jds:
1341     FPRINTF(stderr,"JDS Format not yet supported\n");
1342     break;
1343     default:
1344     result = CodeGen_WriteKA_LL(fp,sys,incident_var_count);
1345     break;
1346     }
1347    
1348     if (incident_var_count) {
1349     free(incident_var_count);
1350     }
1351     return result;
1352     }
1353    
1354     int CodeGen_WriteInputVarIndices(FILE *fp, char *file_prefix)
1355     {
1356     unsigned long ninputs,c;
1357     int index;
1358     struct CGVar *cgvar;
1359     struct Instance *inst;
1360    
1361     if (g_cgdata.input_list == NULL) {
1362     ninputs = 0;
1363     } else {
1364     ninputs = gl_length(g_cgdata.input_list);
1365     }
1366    
1367     CodeGen_ResetPrettyPrinter();
1368     FPRINTF(fp,"static int inputs[] = {\n");
1369    
1370     for (c=1;c<=ninputs;c++) { /* remember gl_lists number from 1 */
1371     inst = (struct Instance *)gl_fetch(g_cgdata.input_list,c);
1372     cgvar = Asc_CGInstanceVar(inst);
1373     CodeGen_PrettyPrintInteger(fp,cgvar->index);
1374     }
1375     FPRINTF(fp,"-1\n");
1376     FPRINTF(fp,"};\n");
1377     CodeGen_ResetPrettyPrinter();
1378     }
1379    
1380     int CodeGen_WriteOutputVarIndices(FILE *fp, char *file_prefix)
1381     {
1382     unsigned long noutputs,c;
1383     int index;
1384     struct CGVar *cgvar;
1385     struct Instance *inst;
1386    
1387     if (g_cgdata.output_list == NULL) {
1388     noutputs = 0;
1389     } else {
1390     noutputs = gl_length(g_cgdata.output_list);
1391     }
1392    
1393     CodeGen_ResetPrettyPrinter();
1394     FPRINTF(fp,"static int outputs[] = {\n");
1395    
1396     for (c=1;c<=noutputs;c++) { /* remember gl_lists number from 1 */
1397     inst = (struct Instance *)gl_fetch(g_cgdata.output_list,c);
1398     cgvar = Asc_CGInstanceVar(inst);
1399     CodeGen_PrettyPrintInteger(fp,cgvar->index);
1400     }
1401     FPRINTF(fp,"-1\n");
1402     FPRINTF(fp,"};\n");
1403     CodeGen_ResetPrettyPrinter();
1404     }
1405    
1406    
1407     /*
1408     * Write out the variable types array. This is an integer array
1409     * saying whether the variable is:
1410     * 0 - free,
1411     * 1 - fixed and internal,
1412     * 2 - fixed but input, (interface variable).
1413     * At the moment we are assuming that it is *illegal* for a variable
1414     * to be both CG_INPUT and CG_OUTPUT. We deal with output variables
1415     * elsewhere. It is the job of SetUpVariables to ensure that we
1416     * have good data at this point.
1417     */
1418    
1419     int CodeGen_WriteVarTypes(FILE *fp, char *file_prefix)
1420     {
1421     int num_vars, c;
1422     unsigned int filter = 0x0;
1423     unsigned int MASK;
1424     struct CGVar *cgvarlist;
1425    
1426     num_vars = g_cgdata.vars.num_vars;
1427     cgvarlist = g_cgdata.vars.var_list;
1428    
1429     CodeGen_ResetPrettyPrinter();
1430     FPRINTF(fp,"static int vartypes[] = {\n");
1431    
1432     for (c=0;c<num_vars;c++) {
1433     filter = cgvarlist[c].flags;
1434     if (filter & CG_FIXED) { /* fixed variables */
1435     MASK = CG_INPUT | CG_OUTPUT;
1436     filter = filter & MASK;
1437     switch(filter) {
1438     case CG_INPUT:
1439     CodeGen_PrettyPrintInteger(fp,-2); /* input fixed var */
1440     break;
1441     case CG_OUTPUT:
1442     FPRINTF(stderr,"Warning: fixed variable is both input and output\n");
1443     CodeGen_PrettyPrintInteger(fp,-2); /* mark as input */
1444     break;
1445     default:
1446     CodeGen_PrettyPrintInteger(fp,1); /* normal fixed var */
1447     break;
1448     }
1449     } else { /* free var */
1450     CodeGen_PrettyPrintInteger(fp,0);
1451     }
1452     }
1453     FPRINTF(fp,"-99\n");
1454     FPRINTF(fp,"};\n");
1455     CodeGen_ResetPrettyPrinter();
1456     }
1457    
1458     int CodeGen_WriteRelTypes(FILE *fp, char *file_prefix)
1459     {
1460     int num_rels,c;
1461     unsigned int filter = 0x0;
1462     unsigned int MASK;
1463     struct rel_relation **rlist;
1464    
1465     num_rels = g_cgdata.rels.num_rels;
1466     rlist = g_cgdata.rels.rel_list;
1467    
1468     CodeGen_ResetPrettyPrinter();
1469     FPRINTF(fp,"\nstatic int reltypes[] = {\n",file_prefix);
1470    
1471     for (c=0;c<num_rels;c++) {
1472     filter = rlist[c]->flags;
1473     if (filter & CG_INCLUDED) {
1474     MASK = CG_LESS | CG_GREATER;
1475     filter = filter & MASK; /* filter unwanteds so that we
1476     * can switch over the rest */
1477     switch(filter) {
1478     case CG_LESS:
1479     CodeGen_PrettyPrintInteger(fp,1);
1480     break;
1481     case CG_GREATER:
1482     CodeGen_PrettyPrintInteger(fp,-1);
1483     break;
1484     case CG_EQUAL:
1485     default:
1486     CodeGen_PrettyPrintInteger(fp,0);
1487     break;
1488     }
1489     } else { /* not included */
1490     CodeGen_PrettyPrintInteger(fp,-2);
1491     }
1492     }
1493     FPRINTF(fp,"-99\n");
1494     FPRINTF(fp,"};\n");
1495     CodeGen_ResetPrettyPrinter();
1496     }
1497    
1498    
1499    
1500     /*
1501     * This function will attempt to write out as much as information
1502     * as a client/solver would need to be able to set up the problem.
1503     * Later on it will take a prefix, so as to give some name space
1504     * protection, or maybe use a structure. The convention is that a
1505     * value for any size less than 0, is garbage.
1506     */
1507    
1508     int CodeGen_WriteProblemHeader(char *file_prefix)
1509     {
1510     char *headerfile = NULL;
1511     FILE *hdr;
1512     headerfile = (char *)ascmalloc((strlen(file_prefix)+4)*sizeof(char));
1513     sprintf(headerfile,"%s.h",file_prefix);
1514     hdr = fopen(headerfile,"w");
1515     if (!hdr) {
1516     FPRINTF(stderr,"Error in opening file %s.h\n",file_prefix);
1517     if (headerfile) {
1518     ascfree(headerfile);
1519     }
1520     return 1;
1521     }
1522    
1523     FPRINTF(hdr,"/***************** ");
1524     FPRINTF(hdr,"This file was generated by Ascend *************/\n\n");
1525     PUTC('\n',hdr);
1526     FPRINTF(hdr,"#ifndef __%s_H_SEEN__\n",file_prefix);
1527     FPRINTF(hdr,"#define __%s_H_SEEN__\n",file_prefix);
1528     FPRINTF(hdr,"#include \"codegen_support.h\"\n\n");
1529     FPRINTF(hdr,"extern struct CG_Problem %s__problem;\n",file_prefix);
1530     PUTC('\n',hdr);
1531    
1532     FPRINTF(hdr,"extern void %s__Initialize();\n",file_prefix);
1533     FPRINTF(hdr,"\t/* double *x, double *u, double *lower,\n");
1534     FPRINTF(hdr,"\t double *upper, double *nominal */\n");
1535     FPRINTF(hdr,"extern ExtEvalFunc *%s__FuncTable[];\n",file_prefix);
1536     FPRINTF(hdr,"extern ExtEvalFunc *%s__GradTable[];\n",file_prefix);
1537     PUTC('\n',hdr);
1538     FPRINTF(hdr,"#endif \t/* __%s_H_SEEN__ */\n",file_prefix);
1539     fclose(hdr);
1540     if (headerfile) {
1541     ascfree(headerfile);
1542     }
1543     return 0;
1544     }
1545    
1546    
1547     void CodeGen_WriteDriver(char *file_prefix)
1548     {
1549     FILE *dfile;
1550     char *filename=NULL;
1551    
1552     filename = (char *)ascmalloc((strlen(file_prefix)+32)*sizeof(char));
1553     sprintf(filename,"%s_driver.c",file_prefix);
1554     dfile = fopen(filename,"w");
1555     if (dfile==NULL) {
1556     FPRINTF(stderr,"Error in opening %s_driver.c\n",file_prefix);
1557     goto error;
1558     }
1559    
1560     FPRINTF(dfile,"#include <stdio.h>\n");
1561     FPRINTF(dfile,"#include <stdlib.h>\n");
1562     FPRINTF(dfile,"#include <math.h>\n");
1563     FPRINTF(dfile,"#include \"codegen_support.h\"\n");
1564     FPRINTF(dfile,"#include \"%s.h\"\n",file_prefix);
1565    
1566     FPRINTF(dfile,"\n\n");
1567     FPRINTF(dfile,"main()\n");
1568     FPRINTF(dfile,"{\n");
1569     FPRINTF(dfile," int i;\n");
1570     FPRINTF(dfile," int result = 0;\n\n");
1571     FPRINTF(dfile," int mode,m,n;\n");
1572     FPRINTF(dfile," int sizeof_x_vector, sizeof_u_vector;\n");
1573     FPRINTF(dfile," int sizeof_f_vector, sizeof_g_vector;\n");
1574     FPRINTF(dfile," double *lower, *upper, *nominal;\n");
1575     FPRINTF(dfile," double *x, *u, *f, *g;\n");
1576     FPRINTF(dfile," ExtEvalFunc *func;\n\n");
1577    
1578    
1579     FPRINTF(dfile," m = %s__problem.number_variables;\n",file_prefix);
1580     FPRINTF(dfile," n = %s__problem.number_relations;\n",file_prefix);
1581     FPRINTF(dfile," sizeof_x_vector = %s__problem.sizeof_x_vector;\n",
1582     file_prefix);
1583     FPRINTF(dfile," sizeof_u_vector = %s__problem.sizeof_u_vector;\n",
1584     file_prefix);
1585     FPRINTF(dfile," sizeof_f_vector = %s__problem.sizeof_f_vector;\n",
1586     file_prefix);
1587     FPRINTF(dfile," sizeof_g_vector = %s__problem.sizeof_g_vector;\n",
1588     file_prefix);
1589     FPRINTF(dfile," mode = 2;\n\n");
1590    
1591     FPRINTF(dfile,
1592     " x = (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1593     FPRINTF(dfile,
1594     " u = (double*)calloc((sizeof_u_vector+1),sizeof(double));\n");
1595     FPRINTF(dfile,
1596     " f = (double*)calloc((sizeof_f_vector+1),sizeof(double));\n");
1597     FPRINTF(dfile,
1598     " g = (double*)calloc((sizeof_g_vector+1),sizeof(double));\n");
1599     FPRINTF(dfile,
1600     " lower = (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1601     FPRINTF(dfile,
1602     " upper= (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1603     FPRINTF(dfile,
1604     " nominal = "
1605     "(double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
1606     PUTC('\n',dfile);
1607    
1608     FPRINTF(dfile," %s__Initialize(x,u,lower,upper,nominal);\n",
1609     file_prefix);
1610    
1611     FPRINTF(dfile," for (i=0;i<m;i++) {\n");
1612     FPRINTF(dfile," func = %s__FuncTable[i];\n",file_prefix);
1613     FPRINTF(dfile," result += (*func)(&mode,&m,&n,x,u,f,g);\n");
1614     FPRINTF(dfile," }\n");
1615     FPRINTF(dfile,"}\n\n");
1616    
1617     error:
1618     if (dfile) {
1619     fclose(dfile);
1620     }
1621     if (filename) {
1622     ascfree(filename);
1623     }
1624     }
1625    
1626    
1627     /*
1628     * The initialization code here has to be updated whenever
1629     * the CG_problem definition changes.
1630     */
1631     void CodeGen_WriteProblemStats(FILE *fp, char *file_prefix)
1632     {
1633     int num_inputs, num_outputs;
1634    
1635     if (g_cgdata.input_list) {
1636     num_inputs = (int)gl_length(g_cgdata.input_list);
1637     } else {
1638     num_inputs = 0;
1639     }
1640     if (g_cgdata.output_list) {
1641     num_outputs = (int)gl_length(g_cgdata.output_list);
1642     } else {
1643     num_outputs = 0;
1644     }
1645    
1646    
1647     PUTC('\n',fp);
1648     FPRINTF(fp,"struct CG_Problem %s__problem = {\n",file_prefix);
1649     FPRINTF(fp," %d, \t/* num_rels */\n",g_cgdata.filtered.num_rels);
1650     FPRINTF(fp," %d, \t/* num_vars */\n",g_cgdata.filtered.num_vars);
1651     FPRINTF(fp," %d, \t/* num_incidences */\n",
1652     g_cgdata.filtered.num_incidences);
1653     FPRINTF(fp," %d, \t/* num_inputs */\n",num_inputs);
1654     FPRINTF(fp," %d, \t/* num_outputs */\n",num_outputs);
1655    
1656     FPRINTF(fp," %d, \t/* tot_num_vars */\n",g_cgdata.vars.num_vars);
1657     FPRINTF(fp," %d, \t/* tot_num_pars */\n",g_cgdata.pars.num_pars);
1658     FPRINTF(fp," %d, \t/* tot_num_rels */\n",g_cgdata.rels.num_rels);
1659     FPRINTF(fp," %d, \t/* num_incidences */\n",
1660     g_cgdata.filtered.num_incidences);
1661     FPRINTF(fp," \t/*\n");
1662     FPRINTF(fp," \t * Other stuff\n");
1663     FPRINTF(fp," \t */\n");
1664     FPRINTF(fp," ha, \t/* row indexes */\n");
1665     FPRINTF(fp," ka, \t/* column indexes */\n");
1666     FPRINTF(fp," vartypes,\t/* variable types */\n");
1667     FPRINTF(fp," reltypes,\t/* relation types */\n");
1668     FPRINTF(fp," inputs, \t/* input indices */\n");
1669     FPRINTF(fp," outputs, \t/* output_indices */\n");
1670     FPRINTF(fp," NULL, \t/* u_vector */\n");
1671     FPRINTF(fp," NULL \t/* wild_hook for user_data */\n");
1672     FPRINTF(fp,"};\n");
1673     PUTC('\n',fp);
1674     }
1675    
1676    
1677    
1678     static int CG_Classify(struct Instance *inst)
1679     {
1680     return 1;
1681     }
1682    
1683     int CodeGen_WriteFunctions1(FILE *fp, int gradients,
1684     struct CGFormat *format)
1685     {
1686     struct rel_relation **rp, *rel_tmp;
1687     struct CGVar *var_list;
1688     struct Instance *rel_inst, *var_inst;
1689     RelationINF *r, *derivative;
1690     enum Expr_enum type;
1691     Term *lhs,*rhs;
1692     int nchars = 0;
1693    
1694     int num_rels,num_vars;
1695     unsigned long n_varsinrel;
1696     unsigned long i,j;
1697     int a_index=0;
1698    
1699     var_list = g_cgdata.vars.var_list;
1700     num_rels = g_cgdata.rels.num_rels;
1701     rel_tmp = rp = g_cgdata.rels.rel_list;
1702    
1703     for (i=0;i<num_rels;i++) {
1704     if (Asc_CGRelIncluded(rp[i])) { /* get status */
1705     rel_inst = rel_instance(rp[i]); /* get instance*/
1706     r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel struct */
1707     if (type!=e_token) {
1708     FPRINTF(stderr,"rel type not supported in CodeGen_WriteFunctions1\n");
1709     continue;
1710     }
1711     FPRINTF(fp,"\tf[%d] = ",rel_index(rp[i])); /* write label */
1712     if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */
1713     nchars = CodeGen_WriteSide(fp,lhs,r,format,0); /* write lhs */
1714     }
1715     if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */
1716     FPRINTF(fp," - (");
1717     nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars);/* write rhs */
1718     PUTC(')',fp);
1719     }
1720     FPRINTF(fp,";\n"); /* terminate func */
1721     }
1722     }
1723    
1724     /*
1725     * Now go for the gradients
1726     */
1727     FPRINTF(fp,"\tif (*mode!=2) {return 0;}\n");
1728     if(!gradients) {
1729     return 0;
1730     }
1731    
1732     PrepareDerivatives(1,1,1000); /* 1 buffer, 2000 blocks */
1733    
1734     a_index = 1;
1735     for (i=0;i<num_rels;i++) {
1736     if (Asc_CGRelIncluded(rp[i])) {
1737     rel_inst = rel_instance(rp[i]);
1738     r = (RelationINF *)GetInstanceRelation(rel_inst,&type);
1739     if (type!=e_token) {
1740     FPRINTF(stderr,"rel type not supported in CodeGen_WriteFunctions1\n");
1741     continue;
1742     }
1743     n_varsinrel = NumberVariables(r);
1744     for (j=1;j<=n_varsinrel;j++) {
1745     var_inst = RelationVariable(r,j);
1746     if (solver_var(var_inst)) {
1747     derivative = RelDeriveSloppy(r,j,CG_Classify);
1748     FPRINTF(fp,"\tg[%d] = ",a_index);
1749     if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
1750     nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
1751     }
1752     if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
1753     FPRINTF(fp," - (");
1754     nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
1755     PUTC(')',fp);
1756     }
1757     FPRINTF(fp,";\n");
1758     RelDestroySloppy(derivative);
1759     a_index++;
1760     }
1761     }
1762     }
1763     }
1764     ShutDownDerivatives();
1765     }
1766    
1767     /*
1768     **********************************************************************
1769     * CodeGen__WriteFunctions2
1770     *
1771     * This function writes a function that will compute the
1772     * residuals and the gradients for a given relation. It
1773     * returns 1 in the event of a problem, 0 otherwise.
1774     * NOTE, it takes as an arguement "ndx_offset", from which
1775     * it should start for indexing its gradients. E.g,
1776     * if ndx_offset = 5, and 3 gradients are written, they should
1777     * have indices 6,7,8 and ndx_offset should be updated to 8.
1778     **********************************************************************
1779     */
1780     int CodeGen__WriteFunctions2(FILE *fp, struct rel_relation *rel,
1781     struct CGFormat *format)
1782     {
1783     struct Instance *rel_inst, *var_inst;
1784     RelationINF *r;
1785     enum Expr_enum type;
1786     Term *lhs,*rhs;
1787     int nchars;
1788    
1789     rel_inst = rel_instance(rel);
1790     r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */
1791     if (type!=e_token) {
1792     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteFunctions2\n");
1793     return;
1794     }
1795    
1796     /* write label */
1797     FPRINTF(fp,"\tf[%d] = ",rel_index(rel)); /* FIX FIX FIX */
1798     if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */
1799     nchars = CodeGen_WriteSide(fp,lhs,r,format,0); /* write lhs */
1800     }
1801     if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */
1802     FPRINTF(fp," - (");
1803     nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars); /* write rhs */
1804     PUTC(')',fp);
1805     }
1806     FPRINTF(fp,";\n\n"); /* terminate func */
1807     return 0;
1808     }
1809    
1810     int CodeGen__WriteGradients2(FILE *fp, struct rel_relation *rel,
1811     struct CGFormat *format,
1812     int *ndx_offset)
1813     {
1814     struct Instance *rel_inst, *var_inst;
1815     RelationINF *r, *derivative;
1816     enum Expr_enum type;
1817     Term *lhs,*rhs;
1818     int a_index;
1819     int nchars;
1820     unsigned long n_varsinrel,j;
1821    
1822     a_index = *ndx_offset;
1823    
1824     rel_inst = rel_instance(rel);
1825     r = (RelationINF *)GetInstanceRelation(rel_inst,&type);
1826     if (type!=e_token) {
1827     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteGradients2\n");
1828     return;
1829     }
1830    
1831     n_varsinrel = NumberVariables(r);
1832     for (j=1;j<=n_varsinrel;j++) {
1833     var_inst = RelationVariable(r,j);
1834     if (solver_var(var_inst)) {
1835     derivative = RelDeriveSloppy(r,j,CG_Classify);
1836     FPRINTF(fp,"\tg[%d] = ",++a_index); /* FIX FIX FIX */
1837     if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
1838     nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
1839     }
1840     if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
1841     FPRINTF(fp," - (");
1842     nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
1843     PUTC(')',fp);
1844     }
1845     FPRINTF(fp,";\n");
1846     RelDestroySloppy(derivative);
1847     }
1848     }
1849     *ndx_offset = a_index; /* set up for return */
1850     return 0;
1851     }
1852    
1853    
1854    
1855     /*
1856     **********************************************************************
1857     * CodeGen__WriteFunctions3
1858     *
1859     * This code need some rationalization with CodeGen__WriteFunctions2.
1860     * The only difference between CodeGen__WriteFunctions2 and this code,
1861     * is the format of the indexing for the functions, gradients, and
1862     * the x vector. Also a u vector is *not* supported. This code is
1863     * essentially for generating glassbox relations, whereas the
1864     * CodeGen__WriteFunctions2, code is for blackbox relations.
1865     *
1866     **********************************************************************
1867     */
1868    
1869     int CodeGen__WriteFunctions3(FILE *fp, struct rel_relation *rel,
1870     struct CGFormat *format)
1871     {
1872     struct Instance *rel_inst, *var_inst;
1873     RelationINF *r;
1874     enum Expr_enum type;
1875     Term *lhs,*rhs;
1876     int nchars;
1877    
1878     rel_inst = rel_instance(rel);
1879     r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */
1880     if (type!=e_token) {
1881     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteFunctions3\n");
1882     return;
1883     }
1884    
1885     FPRINTF(fp,"\tf[0] = "); /* all index from 0 */
1886     if ((lhs = RelationINF_Lhs(r))!=NULL) { /* get lhs */
1887     nchars = CodeGen_WriteSide(fp,lhs,r,format,0); /* write lhs */
1888     }
1889     if ((rhs = RelationINF_Rhs(r))!=NULL) { /* get rhs */
1890     FPRINTF(fp," - (");
1891     nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars); /* write rhs */
1892     PUTC(')',fp);
1893     }
1894     FPRINTF(fp,";\n\n"); /* terminate func */
1895     return 0;
1896     }
1897    
1898     int CodeGen__WriteGradients3(FILE *fp, struct rel_relation *rel,
1899     struct CGFormat *format)
1900     {
1901     struct Instance *relinst, *inst;
1902     struct CGVar *cgvar;
1903     RelationINF *r, *derivative;
1904     enum Expr_enum type;
1905     Term *lhs,*rhs;
1906     int nchars;
1907     int n_varsinrel,j;
1908     unsigned int filter;
1909    
1910     relinst = rel_instance(rel);
1911     r = (RelationINF *)GetInstanceRelation(relinst,&type);
1912     if (type!=e_token) {
1913     FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteGradients3\n");
1914     return;
1915     }
1916    
1917     n_varsinrel = (int)NumberVariables(r);
1918     if (n_varsinrel) {
1919     for (j=0;j<n_varsinrel;j++) {
1920     inst = RelationVariable(r,j+1);
1921     cgvar = (struct CGVar *)GetInterfacePtr(inst);
1922     assert(cgvar); /* desperate integrity check */
1923     /*
1924     * only do derivatives for open variables i.e. potential
1925     * solver_vars, and for variables that are already solver_vars.
1926     */
1927     filter = cgvar->flags;
1928     if (filter & CG_SLV_CONST) {
1929     continue;
1930     }
1931     derivative = RelDeriveSloppy(r,j+1,CG_Classify);
1932     FPRINTF(fp,"\tg[%d] = ",j);
1933     if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
1934     nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
1935     }
1936     if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
1937     FPRINTF(fp," - (");
1938     nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
1939     PUTC(')',fp);
1940     }
1941     FPRINTF(fp,";\n");
1942     RelDestroySloppy(derivative);
1943     }
1944     }
1945     return 0;
1946     }
1947    
1948    
1949     /*
1950     * This writes out the code for the functable,
1951     * which is a static array of pointers to funcs.
1952     */
1953    
1954     int CodeGen_WriteFuncTable(FILE *fp,char *file_prefix)
1955     {
1956     struct rel_relation **rp = g_cgdata.rels.rel_list;
1957     int num_rels = g_cgdata.rels.num_rels;
1958     int i, num_chars=0;
1959     char str[80];
1960    
1961     sprintf(str,"&%s",CG_CFUNCNAME);
1962     CodeGen_ResetPrettyPrinter();
1963     PUTC('\n',fp);
1964     FPRINTF(fp,"ExtEvalFunc *%s__FuncTable[] = {\n",file_prefix);
1965     for (i=0;i<num_rels;i++) {
1966     CodeGen_PrettyPrintStr(fp,str,rel_index(rp[i]));
1967     }
1968     CG("NULL\n};");
1969     CG("\n\n");
1970     CodeGen_ResetPrettyPrinter();
1971     }
1972    
1973     int CodeGen_WriteGradTable(FILE *fp,char *file_prefix)
1974     {
1975     struct rel_relation **rp = g_cgdata.rels.rel_list;
1976     int num_rels = g_cgdata.rels.num_rels;
1977     int i, num_chars=0;
1978     char str[80];
1979    
1980     sprintf(str,"&%s",CG_CGRADNAME);
1981     CodeGen_ResetPrettyPrinter();
1982     PUTC('\n',fp);
1983     FPRINTF(fp,"ExtEvalFunc *%s__GradTable[] = {\n",file_prefix);
1984     for (i=0;i<num_rels;i++) {
1985     CodeGen_PrettyPrintStr(fp,str,rel_index(rp[i]));
1986     }
1987     CG("NULL\n};");
1988     CG("\n\n");
1989     CodeGen_ResetPrettyPrinter();
1990     }
1991    
1992     int CodeGen_WriteLoadCode(FILE *fp,char *file_prefix)
1993     {
1994     FPRINTF(fp,"#ifdef ASCEND\n");
1995     FPRINTF(fp,"extern int CreateUserFunction();\n");
1996    
1997     FPRINTF(fp,"int %s_Init(void)\n",file_prefix);
1998     FPRINTF(fp,"{\n");
1999     FPRINTF(fp," int result;\n");
2000     FPRINTF(fp," char %s_help[] = \"%s glassbox model\";\n",
2001     file_prefix,file_prefix);
2002     FPRINTF(fp," result = CreateUserFunction(\"%s\", NULL,\n",file_prefix);
2003     FPRINTF(fp," %s__FuncTable,\n",file_prefix);
2004     FPRINTF(fp," %s__GradTable,\n",file_prefix);
2005     FPRINTF(fp," NULL,1,1,%s_help);\n",
2006     file_prefix);
2007     FPRINTF(fp," return result;\n");
2008     FPRINTF(fp,"}\n");
2009     FPRINTF(fp,"#endif\n");
2010     }
2011    
2012    
2013    
2014    
2015     int CodeGen_WriteFunctions(FILE *fp, int gradients,
2016     struct CGFormat *format)
2017     {
2018     struct rel_relation **rp;
2019     int num_rels;
2020     int i,offset;
2021     int result;
2022    
2023     offset = CG_OFFSET-1;
2024     num_rels = g_cgdata.rels.num_rels;
2025     rp = g_cgdata.rels.rel_list;
2026    
2027     if (gradients) {
2028     PrepareDerivatives(1,1,1000);
2029     }
2030    
2031     switch (format->names) {
2032     case CG_blackbox:
2033     for (i=0;i<num_rels;i++) {
2034     CodeGen_WriteFuncHeader2(fp,i); /* write *all* relations */
2035     CodeGen__WriteFunctions2(fp,rp[i],format);
2036     CodeGen_WriteFuncFooter(fp);
2037     if (gradients) {
2038     CodeGen_WriteGradHeader2(fp,i); /* write *all* relations */
2039     CodeGen__WriteGradients2(fp,rp[i],format,&offset);
2040     CodeGen_WriteFuncFooter(fp);
2041     PUTC('\n',fp);
2042     }
2043     }
2044     break;
2045     case CG_glassbox:
2046     for (i=0;i<num_rels;i++) {
2047     CodeGen_WriteFuncHeader2(fp,i); /* write *all* relations */
2048     CodeGen__WriteFunctions3(fp,rp[i],format);
2049     CodeGen_WriteFuncFooter(fp);
2050     if (gradients) {
2051     CodeGen_WriteGradHeader2(fp,i); /* write *all* relations */
2052     CodeGen__WriteGradients3(fp,rp[i],format);
2053     CodeGen_WriteFuncFooter(fp);
2054     PUTC('\n',fp);
2055     }
2056     }
2057     break;
2058     case CG_minos:
2059     CodeGen_WriteFuncHeader1(fp);
2060     CodeGen_WriteFuncDecln(fp);
2061     CodeGen_WriteFunctions1(fp,gradients,format);
2062     CodeGen_WriteFuncFooter(fp);
2063     break;
2064     }
2065     if (gradients) {
2066     ShutDownDerivatives();
2067     }
2068     return 0;
2069     }
2070    
2071     int CodeGen_BlackBox(slv_system_t sys,
2072     FILE *fp, char *file_prefix, struct CGFormat *format,
2073     int do_gradients,
2074     struct gl_list_t *inputs,
2075     struct gl_list_t *outputs,
2076     struct gl_list_t *parameters)
2077     {
2078     int result;
2079    
2080     result = CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0,
2081     inputs,outputs);
2082     result += CodeGen_CheckData();
2083     CodeGen_WriteIncidence(fp,sys);
2084     CodeGen_WriteInputVarIndices(fp,file_prefix);
2085     CodeGen_WriteOutputVarIndices(fp,file_prefix);
2086     CodeGen_WriteVarTypes(fp,file_prefix);
2087     CodeGen_WriteRelTypes(fp,file_prefix);
2088     if (result = CodeGen_WriteProblemHeader(file_prefix)) {
2089     goto error;
2090     }
2091     CodeGen_WriteDriver(file_prefix);
2092     CodeGen_WriteProblemStats(fp,file_prefix);
2093     CodeGen_WriteInitValues(fp,file_prefix);
2094     CodeGen_WriteFunctions(fp,do_gradients,format);
2095     CodeGen_WriteFuncTable(fp,file_prefix);
2096     CodeGen_WriteGradTable(fp,file_prefix);
2097    
2098     error:
2099     Asc_CodeGenShutDown();
2100     return result;
2101    
2102     }
2103    
2104     int CodeGen_GlassBox(slv_system_t sys,
2105     FILE *fp, char *file_prefix, struct CGFormat *format,
2106     int do_gradients,
2107     struct gl_list_t *inputs,
2108     struct gl_list_t *outputs,
2109     struct gl_list_t *parameters)
2110     {
2111     struct Instance *root;
2112     struct gl_list_t *list = NULL;
2113     struct CGVar *cgvarlist;
2114     int nvars;
2115     int result;
2116    
2117     root = g_solvinst_cur; /* see interface1.h */
2118     list = PreProcessVars(root);
2119     cgvarlist = Asc_CodeGenSetUpVariables3(list);
2120     nvars = (int)gl_length(list);
2121     result = CodeGen_SetupCodeGen(sys, cgvarlist,nvars, NULL,0, NULL,0, NULL,0,
2122     inputs,outputs);
2123     result += CodeGen_CheckData();
2124     CodeGen_WriteIncidence(fp,sys);
2125     CodeGen_WriteInputVarIndices(fp,file_prefix);
2126     CodeGen_WriteOutputVarIndices(fp,file_prefix);
2127     CodeGen_WriteVarTypes(fp,file_prefix);
2128     CodeGen_WriteRelTypes(fp,file_prefix);
2129     if (result = CodeGen_WriteProblemHeader(file_prefix)) {
2130     goto error;
2131     }
2132     CodeGen_WriteDriver(file_prefix);
2133     CodeGen_WriteProblemStats(fp,file_prefix);
2134     CodeGen_WriteFunctions(fp,do_gradients,format);
2135     CodeGen_WriteFuncTable(fp,file_prefix);
2136     CodeGen_WriteGradTable(fp,file_prefix);
2137     CodeGen_WriteLoadCode(fp,file_prefix);
2138    
2139     error:
2140     if (list) {
2141     gl_destroy(list);
2142     }
2143     Asc_CodeGenShutDown();
2144     return result;
2145     }
2146    
2147    
2148     /*
2149     **********************************************************************
2150     * CodeGen_ParseData
2151     *
2152     * This function takes a string list -- a Tcl list -- of instance
2153     * names, and returns a gl_list_t of the correspoding instances.
2154     * If there are any errors, a NULL is returned. We will also return
2155     * the count of elements that tcl found.
2156     **********************************************************************
2157     */
2158     struct gl_list_t *CodeGen_ParseData(Tcl_Interp *interp, char *strlist,
2159     int *found_count)
2160     {
2161     struct gl_list_t *list;
2162     struct Instance *i;
2163     char **argv=NULL; /* the split list of strings */
2164     int len,c;
2165     int error = 0;
2166    
2167     if (Tcl_SplitList(interp,strlist,found_count,&argv) != TCL_OK) {
2168     return NULL;
2169     }
2170     if (*found_count==0) { /* parsed ok, but was a zero length list */
2171     if (argv) {
2172     Tcl_Free((char *)argv);
2173     }
2174     return NULL;
2175     }
2176     len = *found_count;
2177     list = gl_create((unsigned long)len);
2178     /*
2179     * Search for each instance in turn. Qlfdid will leave
2180     * g_search_inst looking at the found instance.
2181     */
2182     for (c=0;c<len;c++) {
2183     if (Asc_QlfdidSearch3(argv[c])==0,0) {
2184     gl_append_ptr(list,(char *)g_search_inst);
2185     } else {
2186     FPRINTF(stderr,"Error in finding instance %s\n",argv[c]);
2187     error++;
2188     break;
2189     }
2190     }
2191     if (error) {
2192     gl_destroy(list);
2193     if (argv != NULL) {
2194     Tcl_Free((char *)argv);
2195     }
2196     return NULL;
2197     } else {
2198     if (argv !=NULL) {
2199     Tcl_Free((char *)argv);
2200     }
2201     return list;
2202     }
2203     }
2204    
2205    
2206     /*
2207     **********************************************************************
2208     * CodeGen_Check Routines
2209     *
2210     * This function checks the input, output and hopefully
2211     * the parameter list. Input and utput variables, must
2212     * be of type solver_var. At the moment we are only requring
2213     * that parameters be of type solver_par/REAL_ATOM_INST.
2214     **********************************************************************
2215     */
2216     static struct gl_list_t *CodeGen_CheckList(struct gl_list_t *list)
2217     {
2218     struct Instance *inst;
2219     unsigned long len,c;
2220    
2221     if (!list) {
2222     return NULL;
2223     }
2224     len = gl_length(list);
2225     for (c=1;c<=len;c++) {
2226     inst = (struct Instance *)gl_fetch(list,c);
2227     if (!solver_var(inst)) {
2228     return NULL;
2229     }
2230     }
2231     return list;
2232     }
2233    
2234     int CodeGen_CheckData(void)
2235     {
2236     int bad_instances = 0;
2237     struct gl_list_t *result, *list;
2238    
2239     list = g_cgdata.input_list;
2240     if (list) {
2241     result = CodeGen_CheckList(list);
2242     if (result != list) {
2243     FPRINTF(stderr,"Input Variables must be \"solver_vars\"\n");
2244     gl_destroy(list);
2245     g_cgdata.input_list = NULL;
2246     bad_instances = 1;
2247     }
2248     }
2249    
2250     list = g_cgdata.output_list;
2251     if (list) {
2252     result = CodeGen_CheckList(list);
2253     if (result != list) {
2254     FPRINTF(stderr,"Output Variables must be \"solver_vars\"\n");
2255     gl_destroy(list);
2256     g_cgdata.output_list = NULL;
2257     bad_instances = 1;
2258     }
2259     }
2260     return bad_instances;
2261     }
2262    
2263    
2264     int CodeGen_CheckSystem(Tcl_Interp *interp,slv_system_t sys)
2265     {
2266     struct rel_relation **rp, *rel_tmp;
2267     struct var_variable **vp, *var_tmp;
2268     if (sys==NULL) {
2269     Tcl_SetResult(interp, "__codegen_c called without slv_system", TCL_STATIC);
2270     return 1;
2271     }
2272     var_tmp = vp = slv_get_master_var_list(sys);
2273     if (vp==NULL) {
2274     Tcl_SetResult(interp, "__codegen_c called without varlist", TCL_STATIC);
2275     return 1;
2276     }
2277     rel_tmp = rp =slv_get_master_rel_list(sys);
2278     if (rp==NULL) {
2279     Tcl_SetResult(interp, "__codegen_c called with NULL rellist", TCL_STATIC);
2280     }
2281     if (rp==NULL) {/* THIS SHOULD BE THE OBJECTIVE !!! */
2282     Tcl_SetResult(interp, "__codegen_c called without constraints or obj",
2283     TCL_STATIC);
2284     return 1;
2285     }
2286     return 0;
2287     }
2288    
2289    
2290     int Asc_CodeGenParseDataCmd(ClientData cdata, Tcl_Interp *interp,
2291     int argc, CONST84 char *argv[])
2292     {
2293     char *strlist;
2294     struct gl_list_t *list;
2295     int count = -1;
2296     unsigned long len;
2297     char buffer[256];
2298    
2299     if ( argc != 2 ) {
2300     Tcl_SetResult(interp, "wrong # args : Usage __codegen_parsedata list",
2301     TCL_STATIC);
2302     return TCL_ERROR;
2303     }
2304     strlist = argv[1];
2305     list = CodeGen_ParseData(interp,strlist,&count);
2306     if (count>=0) {
2307     if (count==0) {
2308     /* case of an empty list: the list should be NULL -- dont free */
2309     Tcl_SetResult(interp, "0", TCL_STATIC);
2310     return TCL_OK;
2311     }
2312     if (list==NULL) {
2313     Tcl_SetResult(interp, "error in finding instances", TCL_STATIC);
2314     return TCL_ERROR;
2315     } else {
2316     sprintf(buffer,"%lu",gl_length(list));
2317     Tcl_SetResult(interp, buffer, TCL_VOLATILE);
2318     gl_destroy(list);
2319     return TCL_OK;
2320     }
2321     } else {
2322     Tcl_SetResult(interp, "error in parsing data", TCL_STATIC);
2323     return TCL_ERROR;
2324     }
2325     }
2326    
2327    
2328     int Asc_CodeGenCCmd(ClientData cdata, Tcl_Interp *interp,
2329     int argc, CONST84 char *argv[])
2330     {
2331     FILE *fp;
2332     char *filename = NULL;
2333     int do_gradients = 0;
2334     int result;
2335     int count = -1;
2336     slv_system_t sys = g_solvsys_cur; /* this might me made more general */
2337     struct CGFormat format;
2338     struct gl_list_t *inputs, *outputs, *parameters;
2339    
2340     if ( argc != 7 ) {
2341     Tcl_AppendResult(interp,"wrong # args : ",
2342     "Usage __codegen_c filename ?grad?nograd?\n",
2343     "?minos?blackbox?glassbox?, "
2344     "inputlist outputlist parameterlist",
2345     (char *)NULL);
2346     return TCL_ERROR;
2347     }
2348     result = CodeGen_CheckSystem(interp,sys);
2349     if (result) {
2350     return TCL_ERROR;
2351     }
2352    
2353     filename = (char *)ascmalloc((strlen(argv[1])+4)*sizeof(char));
2354     sprintf(filename,"%s.c",argv[1]);
2355     fp = fopen(filename,"w");
2356     if (!fp) {
2357     Tcl_SetResult(interp, "__codegen_c file open failed. system not written.",
2358     TCL_STATIC);
2359     result = TCL_ERROR;
2360     goto error;
2361     }
2362    
2363     /*
2364     * Check gradient args.
2365     */
2366     if (strncmp(argv[2],"gradients",4)==0) {
2367     do_gradients = 1;
2368     }
2369     format = C_Format;
2370    
2371     /*
2372     * Check the subformat args.
2373     */
2374     if (strncmp(argv[3],"minos",4)==0) {
2375     format.names = CG_minos;
2376     } else if (strncmp(argv[3],"blackbox",4)==0) {
2377     format.names = CG_blackbox;
2378     } else {
2379     format.names = CG_glassbox;
2380     }
2381    
2382     /*
2383     * Write out necessary header information and global data,
2384     * which is common to all code generation formats.
2385     */
2386     CodeGen_WriteIncludes(fp,argv[1]);
2387     CodeGen_WriteGlobals(fp);
2388     CodeGen_WriteSupportFuncs_Log(fp);
2389     CodeGen_WriteSupportFuncs_Cube(fp);
2390     CodeGen_WriteSupportFuncs_Sqr(fp);
2391    
2392     /*
2393     * First parse the inputs, outputs and parameters strings
2394     * and set up their gl_lists. We dont need to check if
2395     * the lists are NULL; someone else will handle that.
2396     */
2397     inputs = CodeGen_ParseData(interp,argv[4],&count);
2398     outputs = CodeGen_ParseData(interp,argv[5],&count);
2399     parameters = CodeGen_ParseData(interp,argv[6],&count); /**** FIX ***/
2400    
2401     /*
2402     * Call the appropriate routines to generate the code.
2403     */
2404     switch (format.names) {
2405     case CG_blackbox: case CG_minos:
2406     result = CodeGen_BlackBox(sys,fp,argv[1],&format,
2407     do_gradients,
2408     inputs,outputs,parameters);
2409     break;
2410     case CG_glassbox:
2411     result = CodeGen_GlassBox(sys,fp,argv[1],&format,
2412     do_gradients,
2413     inputs,outputs,parameters);
2414     break;
2415     }
2416    
2417     /*
2418     * Cleanup.
2419     */
2420     error:
2421     if (filename) {
2422     ascfree(filename);
2423     }
2424     if (fp) {
2425     fclose(fp);
2426     }
2427     return (result!=0) ? TCL_ERROR : TCL_OK;
2428     }
2429    
2430     #endif
2431    
2432    
2433    
2434    

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