/[ascend]/trunk/base/generic/compiler/packages.c
ViewVC logotype

Contents of /trunk/base/generic/compiler/packages.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 529 - (show annotations) (download) (as text)
Sat Apr 22 06:26:23 2006 UTC (14 years, 2 months ago) by johnpye
File MIME type: text/x-csrc
File size: 16644 byte(s)
Working of debugging the mysterious PyGTK bug. Seems to be coming from a wrong
char *filename in an error_reporter call from the DEBUG_RELS sections of the
compiler code.
Also renamed the WSEM and WSNM macros for clarity, removed unused file pointer.
1 /* ASCEND modelling environment
2 Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly, Kirk Abbott.
3 Copyright (C) 2006 Carnegie Mellon University
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
8 any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place - Suite 330,
18 Boston, MA 02111-1307, USA.
19 *//**
20 Code to support dynamic and static loading of user packages.
21
22 The default state is to have packages. As such it takes an explicit
23 definition of NO_PACKAGES, if packages are not to be handled.
24 An explicit definition of STATIC_PACKAGES or DYNAMIC_PACKAGES is also
25 required.
26 *//*
27 User Packages
28 by Kirk Abbott
29 Created: July 4, 1994
30 Last rev in old CVS: 1.14 ballan 1998/03/06 15:47:14
31 */
32
33 #if !defined(DYNAMIC_PACKAGES) && !defined(STATIC_PACKAGES) && !defined(NO_PACKAGES)
34 # error "Package linking option not set!"
35 #endif
36
37 #include <math.h>
38 #include <ctype.h> /* was compiler/actype.h */
39 #include <utilities/ascConfig.h>
40 #include "compiler.h"
41 #include <utilities/ascMalloc.h>
42 #include <general/list.h>
43 #include "symtab.h"
44 #include "fractions.h"
45 #include "dimen.h"
46 #include "functype.h"
47 #include "types.h"
48 #include "extcall.h"
49 #include "mathinst.h"
50 #include "instance_enum.h"
51 #include "instquery.h"
52 #include "atomvalue.h"
53 #include "find.h"
54 #include "relation_type.h"
55 #include "relation.h"
56 #include "safe.h"
57 #include "relation_util.h"
58 #include "extfunc.h"
59 #include <packages/sensitivity.h>
60 #include <packages/ascFreeAllVars.h>
61 #include "module.h"
62 #include "packages.h"
63
64 /*
65 Initialise the slv data structures used when calling external fns
66 */
67 void Init_Slv_Interp(struct Slv_Interp *slv_interp)
68 {
69 if (slv_interp){
70 slv_interp->nodestamp = 0;
71 slv_interp->status = calc_all_ok;
72 slv_interp->user_data = NULL;
73 slv_interp->first_call = (unsigned)0;
74 slv_interp->last_call = (unsigned)0;
75 slv_interp->check_args = (unsigned)0;
76 slv_interp->recalculate = (unsigned)0;
77 slv_interp->func_eval = (unsigned)0;
78 slv_interp->deriv_eval = (unsigned)0;
79 slv_interp->single_step = (unsigned)0;
80 }
81 }
82
83 /*
84 @deprecated, @see packages.h
85 */
86 symchar *MakeArchiveLibraryName(CONST char *prefix){
87 char *buffer;
88 int len;
89 symchar *result;
90
91 len = strlen(prefix);
92 buffer = (char *)ascmalloc(len+40);
93
94 #if defined(ASC_SHLIBSUFFIX) && defined(ASC_SHLIBPREFIX)
95 sprintf(buffer,"%s%s%s",ASC_SHLIBPREFIX,prefix,ASC_SHLIBSUFFIX);
96 #else
97 # ifdef __WIN32__
98 sprintf(buffer,"%s.dll",prefix);
99 # elif defined(linux)
100 sprintf(buffer,"lib%s.so",prefix); /* changed from .o to .so -- JP */
101 # elif defined(sun) || defined(solaris)
102 sprintf(buffer,"%s.so.1.0",prefix);
103 # elif defined(__hpux)
104 sprintf(buffer,"%s.sl",prefix);
105 # elif defined(_SGI_SOURCE)
106 sprintf(buffer,"%s.so",prefix);
107 # else
108 # error "Please #define ASC_SHLIBSUFFIX and ASC_SHLIBPREFIX or pass as compiler flags to packages.c"
109 # endif
110 #endif
111
112 result = AddSymbol(buffer); /* the main symbol table */
113 ascfree(buffer);
114 return result; /* owns the string */
115 }
116
117 /*---------------------------------------------
118 BUILT-IN PACKAGES...
119 */
120
121 /**
122 Load builtin packages, unless NO_PACKAGES.
123
124 @return 0 if success, 1 if failure.
125 */
126 static
127 int Builtins_Init(void)
128 {
129 int result = 0;
130
131 #ifdef NO_PACKAGES
132 ERROR_REPORTER_HERE(ASC_USER_WARNING,"Builtins_Init: DISABLED at compile-time");
133 #else
134 ERROR_REPORTER_DEBUG("Builtins_Init: Loading function asc_free_all_variables\n");
135 result = CreateUserFunctionMethod("asc_free_all_variables",
136 Asc_FreeAllVars,
137 1,
138 "Unset 'fixed' flag of all items of type 'solver_var'");
139 #endif
140 return result;
141 }
142
143 /*---------------------------------------------
144 DYNAMIC_PACKAGES code only...
145 */
146 # ifdef DYNAMIC_PACKAGES
147 static char path_var[PATH_MAX];
148
149 /**
150 Search the archive library path for a file matching the given
151 (platform specific, with extension?) library filename.
152
153 @return a pointer to a string space holding the full path
154 name of the file to be opened. The returned pointer may be NULL
155
156 @TODO won't work correctly on windows
157 @deprecated { see packages.h }
158 */
159 static
160 char *SearchArchiveLibraryPath(CONST char *name, char *dpath, char *envv)
161 {
162 register char *path,*result;
163 register CONST char *t;
164 register unsigned length;
165 register FILE *f;
166 /* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Env var for user packages is '%s'\n",envv); */
167 /* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Search path for user packages is '%s'\n",getenv(envv)); */
168 if ((path=getenv(envv))==NULL)
169 path=dpath;
170 while(isspace(*path)) path++;
171 while(*path!='\0'){
172 if (*path==':') path++;
173 else{
174 length = 0;
175 /* copy next directory into array */
176 while((*path!=':')&&(*path!='\0')&&(!isspace(*path)))
177 path_var[length++] = *(path++);
178 if (path_var[length-1]!='/')
179 path_var[length++]='/';
180
181 /* copy file name into array */
182 for(t=name;*t!='\0';){
183 path_var[length++] = *(t++);
184 }
185 path_var[length]='\0';
186
187 /* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Searching for for '%s' at '%s'\n",name, path_var); */
188
189 if ((f= fopen(path_var,"r"))!=NULL){
190 result = path_var;
191 fclose(f);
192 return result;
193 }
194 }
195 while(isspace(*path)) path++;
196 }
197 return NULL;
198 }
199 #endif /* DYNAMIC_PACKAGES */
200 /*
201 END of DYNAMIC_PACKAGES-specific code
202 ------------------------------------------*/
203
204 int LoadArchiveLibrary(CONST char *name, CONST char *initfunc)
205 {
206 #ifdef NO_PACKAGES
207 /** avoid compiler warnings on params: */
208 (void) name; (void) initfunc;
209
210 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"LoadArchiveLibrary disabled: NO_PACKAGES");
211 return 1;
212
213 #elif defined(DYNAMIC_PACKAGES)
214
215 symchar *name_with_extn;
216
217 int result;
218 char *default_path = ".";
219 char *env = PATHENVIRONMENTVAR;
220 char *full_file_name = NULL;
221 extern int Asc_DynamicLoad(CONST char *,CONST char *);
222
223 char initfunc_generated_name[255];
224
225 name_with_extn = MakeArchiveLibraryName(name);
226
227 full_file_name = SearchArchiveLibraryPath(SCP(name_with_extn),default_path,env);
228 if (!full_file_name) {
229 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"The named library '%s' was not found in the search path.",name_with_extn);
230 return 1;
231 }
232
233 if(initfunc==NULL){
234 CONSOLE_DEBUG("GENERATING NAME OF INITFUNC");
235 CONSOLE_DEBUG("NAME STEM = %s",name);
236 sprintf(initfunc_generated_name,"%s",name);
237 strcat(initfunc_generated_name,"_register");
238 CONSOLE_DEBUG("GENERATED NAME = %s",initfunc_generated_name);
239 result = Asc_DynamicLoad(full_file_name,initfunc_generated_name);
240 }else{
241 result = Asc_DynamicLoad(full_file_name,initfunc);
242 }
243
244 if (result) {
245 return 1;
246 }
247 if(initfunc==NULL){
248 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc_generated_name,name);
249 }else{
250 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc,name);
251 }
252 return 0;
253
254 #elif defined(STATIC_PACKAGES)
255
256 /* avoid compiler warnings on params: */
257 (void) name; (void) initfunc;
258
259 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"LoadArchiveLibrary disabled: STATIC_PACKAGES, no need to load dynamically.\n");
260 return 0;
261
262 #else /* unknown flags */
263
264 # error "Invalid package linking flags"
265 (void) name; (void) initfunc;
266 return 1;
267
268 #endif
269 }
270
271 /*---------------------------------------------
272 STATIC_PACKAGES code only...
273
274 Declare the functions which we are expected to be able to call.
275 */
276 #ifndef NO_PACKAGES
277 # ifdef STATIC_PACKAGES
278
279 #include <packages/kvalues.h>
280 #include <packages/bisect.h>
281 #include <packages/sensitivity.h>
282
283 # endif
284 #endif
285
286 #ifdef STATIC_PACKAGES
287 /**
288 Load all statically-linked packages
289
290 @return 0 on success, >0 if any CreateUserFunction calls failed.
291 */
292 static
293 int StaticPackages_Init(void)
294 {
295 int result = 0;
296
297 char sensitivity_help[] =
298 "This function does sensitivity analysis dy/dx. It requires 4 args:\n"
299 " 1. name: name of a reference instance or SELF.\n"
300 " 2. x: x, where x is an array of > solver_var.\n"
301 " 3. y: where y is an array of > solver_var.\n"
302 " 4. dy/dx: which dy_dx[1..n_y][1..n_x].";
303
304 result = CreateUserFunctionMethod("do_solve",
305 do_solve_eval,
306 2,NULL); /* was 2,0,null */
307 result += CreateUserFunctionMethod("do_finite_difference",
308 do_finite_diff_eval,
309 4,NULL); /* 4,0,null */
310 result += CreateUserFunctionMethod("do_sensitivity",
311 do_sensitivity_eval,
312 4,sensitivity_help);
313 result += CreateUserFunctionMethod("do_sensitivity_all",
314 do_sensitivity_eval_all,
315 4,"See do_sensitivity_eval for details");
316
317 result += KValues_Init();
318
319 return result;
320 }
321 #endif
322
323 /**
324 This is a general purpose function that will load whatever user
325 functions are required according to the compile-time settings.
326
327 If NO_PACKAGES, nothing will be loaded. If DYNAMIC_PACKAGES, then
328 just the builtin packages will be loaded. If STATIC_PACKAGES then
329 builtin plus those called in 'StaticPackages_Init' will be loaded.
330 */
331 void AddUserFunctions(void)
332 {
333 #ifdef NO_PACKAGES
334 # ifdef __GNUC__
335 # warning "EXTERNAL PACKAGES ARE BEING DISABLED"
336 # endif
337 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"AddUserFunctions disabled at compile-time.");
338 #else
339
340 /* Builtins are always statically linked */
341 if (Builtins_Init()) {
342 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in Builtins_Init: Some user functions not created");
343 }
344
345 # ifdef DYNAMIC_PACKAGES
346 /* do nothing */
347
348 # elif defined(STATIC_PACKAGES)
349 # ifdef __GNUC__
350 # warning "STATIC PACKAGES"
351 # endif
352
353 /*The following need to be reimplemented but are basically useful as is. */
354 if (StaticPackages_Init()) {
355 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in StaticPackages_Init(): Some user functions not created");
356 }
357
358 # endif
359 #endif
360 }
361
362 /*---------------------------------------
363 TESTING FUNCTIONS
364
365 The following functions may be called someone desirous of testing
366 an external relation provided as a package. They are here
367 for convenience, and should be really in a separate file.
368 */
369
370 /**
371 What's this do? -- JP
372 */
373 static void LoadInputVector(struct gl_list_t *arglist,
374 double *inputs,
375 unsigned ninputs,
376 unsigned long n_input_args)
377 {
378 struct Instance *inst;
379 struct gl_list_t *input_list;
380 unsigned long c,len;
381
382 input_list = LinearizeArgList(arglist,1,n_input_args);
383
384 if(!input_list)return;
385
386 len = gl_length(input_list);
387
388 if(len!=ninputs)return; /* somehow we had inconsistent data */
389
390 for (c=1;c<=len;c++) {
391 inst = (struct Instance *)gl_fetch(input_list,c);
392 inputs[c-1] = RealAtomValue(inst);
393 }
394 gl_destroy(input_list);
395 }
396
397 /**
398 What's a black box, and what's a glass box? -- JP
399 */
400 int CallBlackBox(struct Instance *inst,
401 CONST struct relation *rel)
402 {
403 struct Instance *data;
404
405 struct Slv_Interp slv_interp;
406 struct ExternalFunc *efunc;
407 struct ExtCallNode *ext;
408 struct gl_list_t *arglist;
409 unsigned long n_input_args, n_output_args;
410 int nok = 0;
411
412 unsigned long ninputs, noutputs;
413 double *inputs = NULL, *outputs = NULL;
414 double *jacobian = NULL;
415
416 /* All these desperately need a typedef in a header someplace */
417 /* now typedefs in solver/extfunc.h - 1/22/2006 - jds
418 int (*init_func) (struct Slv_Interp *,
419 struct Instance *,
420 struct gl_list_t *);
421
422 int (*eval_func)(struct Slv_Interp *,
423 int, // n_inputs
424 int, // n_outputs
425 double *, // inputs
426 double * , // outputs
427 double * ); // jacobian
428
429 int (*deriv_func)(struct Slv_Interp *,
430 int, // n_inputs
431 int , // n_outputs
432 double *, // inputs
433 double * , // outputs
434 double * ); // jacobian
435 */
436 ExtBBoxInitFunc *init_func;
437 ExtBBoxFunc *eval_func;
438 ExtBBoxFunc *deriv_func;
439
440 /*------------------------------
441 After this point everything should be ok.
442 <-- says who? when? -- JP
443 */
444
445 /* Visual C doesn't like this before the func ptr defs. */
446 UNUSED_PARAMETER(inst);
447
448 ext = BlackBoxExtCall(rel);
449 arglist = ExternalCallArgList(ext);
450 data = ExternalCallDataInstance(ext);
451 efunc = ExternalCallExtFunc(ext);
452 init_func = GetInitFunc(efunc);
453 eval_func = GetValueFunc(efunc);
454 deriv_func = GetDerivFunc(efunc);
455
456 if (init_func && eval_func) {
457
458 /* set up the interpreter. */
459 Init_Slv_Interp(&slv_interp);
460 slv_interp.check_args = (unsigned)1;
461 slv_interp.first_call = (unsigned)1;
462 slv_interp.last_call = (unsigned)0;
463 slv_interp.nodestamp = ExternalCallNodeStamp(ext);
464 n_input_args = NumberInputArgs(efunc);
465 n_output_args = NumberOutputArgs(efunc);
466 ninputs = CountNumberOfArgs(arglist,1,n_input_args);
467 noutputs = CountNumberOfArgs(arglist,n_input_args + 1,
468 n_input_args+n_output_args);
469
470 /* Create the work vectors. Load the input vector from the instance tree. */
471 inputs = (double *)asccalloc(ninputs,sizeof(double));
472 outputs = (double *)asccalloc(ninputs,sizeof(double));
473 jacobian = (double *)asccalloc(ninputs*noutputs,sizeof(double));
474 LoadInputVector(arglist,inputs,ninputs,n_input_args);
475
476 /*
477 * Call the init function.
478 */
479 nok = (*init_func)(&slv_interp,data,arglist);
480 if (nok) goto error;
481 /*
482 * Call the evaluation function.
483 */
484 nok = (*eval_func)(&slv_interp,ninputs,noutputs,
485 inputs,outputs,jacobian);
486 if (nok) goto error;
487 /*
488 * Call the derivative routine.
489 */
490 if (deriv_func) {
491 nok = (*deriv_func)(&slv_interp,ninputs,noutputs,
492 inputs,outputs,jacobian);
493 if (nok) goto error;
494 }
495 /*
496 * Call the init function to shut down
497 */
498 slv_interp.first_call = (unsigned)0;
499 slv_interp.last_call = (unsigned)1;
500 nok = (*init_func)(&slv_interp,data,arglist);
501 if (nok) goto error;
502 }
503 else{
504 FPRINTF(ASCERR,"External function not loaded\n");
505 return 1;
506 }
507
508 error:
509 if (inputs) ascfree((char *)inputs);
510 if (outputs) ascfree((char *)outputs);
511 if (jacobian) ascfree((char *)outputs);
512 if (nok)
513 return 1;
514 else
515 return 0;
516 }
517
518 /**
519 When glassbox are registered, they must register a pointer
520 to their function jump table. In other words, they must
521 register a pointer to an 'array of pointers to functions'.
522 This typedef just makes life a little cleaner.
523
524 <-- what typedef?? -- JP
525 */
526 int CallGlassBox(struct Instance *relinst, CONST struct relation *rel)
527 {
528 CONST struct gl_list_t *incidence;
529 struct Instance *var;
530 struct ExternalFunc *efunc;
531 int index;
532 long i;
533 double *f, *x, *g;
534 int m,mode,result;
535 int n;
536
537 ExtEvalFunc **evaltable, *eval_func;
538 ExtEvalFunc **derivtable, *deriv_func;
539
540 (void) relinst;
541 incidence = RelationVarList(rel);
542 if (!incidence) {
543 FPRINTF(ASCERR,"Incidence list is empty -- nothing to evaluate\n");
544 return 0;
545 }
546 index = GlassBoxRelIndex(rel);
547 efunc = GlassBoxExtFunc(rel);
548 evaltable = GetValueJumpTable(efunc);
549 eval_func = evaltable[index];
550 derivtable = GetDerivJumpTable(efunc);
551 deriv_func = derivtable[index];
552
553 m = 0; /* FIX not sure what this should be !!! */
554 n = gl_length(incidence);
555 f = (double *)asccalloc((1 + 2*n),sizeof(double));
556 x = &f[1];
557 g = &f[n+1];
558
559 for (i=0;i<n;i++) {
560 var = (struct Instance *)gl_fetch(incidence,i+1);
561 x[i] = RealAtomValue(var);
562 }
563 result = (*eval_func)(&mode,&m,&n,x,NULL,f,g);
564 result += (*deriv_func)(&mode,&m,&n,x,NULL,f,g);
565
566 ascfree((char *)f);
567 return result;
568 }
569
570 /**
571 No idea what this does. It's referenced in 'interface.c' only, so it
572 appears to be defunct -- JP
573 */
574 int CallExternalProcs(struct Instance *inst)
575 {
576 CONST struct relation *rel;
577 enum Expr_enum reltype;
578
579 if (inst==NULL){
580 FPRINTF(ASCERR,"Instance does not exist for callprocs\n");
581 return 1;
582 }
583 if (InstanceKind(inst)!=REL_INST){
584 FPRINTF(ASCERR,"Instance is not a relation\n");
585 return 1;
586 }
587 rel = GetInstanceRelation(inst,&reltype);
588 if (!rel) {
589 FPRINTF(ASCERR,"Relation structure is NULL\n");
590 return 1;
591 }
592 switch (reltype) {
593 case e_blackbox:
594 return CallBlackBox(inst,rel);
595 case e_glassbox:
596 return CallGlassBox(inst,rel);
597 default:
598 FPRINTF(ASCERR,"Invalid relation type in CallExternalProc\n");
599 return 1;
600 }
601 }

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