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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (show annotations) (download) (as text)
Wed Dec 7 15:44:43 2005 UTC (14 years ago) by johnpye
File MIME type: text/x-csrc
File size: 72048 byte(s)
Small changes to eliminate GCC warnings
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 #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 #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 #ifdef HAVE_ERF
983 case F_ERF: count += FPRINTF(f,"Erf["); break;
984 #endif
985 case F_LNM: count += FPRINTF(f,"Log["); break;
986 case F_SINH: count += FPRINTF(f,"Sinh["); break;
987 case F_COSH: count += FPRINTF(f,"Cosh["); break;
988 case F_TANH: count += FPRINTF(f,"Tanh["); break;
989 case F_ARCSINH: count += FPRINTF(f,"ArcSinh["); break;
990 case F_ARCCOSH: count += FPRINTF(f,"ArcCosh["); break;
991 case F_ARCTANH: count += FPRINTF(f,"ArcTanh["); break;
992 case F_CBRT:
993 count += FPRINTF(f,"Power[");
994 count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
995 count += FPRINTF(f,",1/3]");
996 return;
997 }
998 count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
999 PUTC(']',f);
1000 break;
1001 case CG_gams:
1002 switch(FuncId(TermFunc(term))) {
1003 /*
1004 * All cases which do *return* rather than *break* are
1005 * special cases which need to be handled. Those that *break*,
1006 * get closing brackets written after the switch.
1007 */
1008 case F_LOG: count += FPRINTF(f,"LOG10("); break;
1009 case F_LN: count += FPRINTF(f,"LOG("); break;
1010 case F_EXP: count += FPRINTF(f,"EXP("); break;
1011 case F_SIN: count += FPRINTF(f,"SIN("); break;
1012 case F_COS: count += FPRINTF(f,"COS("); break;
1013 case F_TAN: count += FPRINTF(f,"SIN(");
1014 count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1015 count = FPRINTF(f,")/COS("); break;
1016 case F_ARCSIN: count += FPRINTF(f,"1/SIN("); break;
1017 case F_ARCCOS: count += FPRINTF(f,"1/COS("); break;
1018 case F_ARCTAN: count += FPRINTF(f,"COS(");
1019 count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
1020 count = FPRINTF(f,")/SIN("); break;
1021 case F_SQR: count += FPRINTF(f,"SQR("); break;
1022 case F_SQRT: count += FPRINTF(f,"SQRT("); break;
1023 #ifdef HAVE_ERF
1024 case F_ERF: count += FPRINTF(f,"ERF("); break;
1025 #endif
1026 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