/[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 40 - (show annotations) (download) (as text)
Sat Jan 22 14:22:13 2005 UTC (15 years, 8 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 /*
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 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