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

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