/[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 692 - (show annotations) (download) (as text)
Thu Jun 22 02:45:47 2006 UTC (16 years, 5 months ago) by johnpye
File MIME type: text/x-csrc
File size: 16349 byte(s)
Fixed up behaviour of default ASCENDLIBRARY in python interface (for the case
where you're using ascpy without using the PyGTK GUI).
Removed some debug output when loading external libraries.
Fixed up the 'extfntest' example & SConscript file.
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
40 #include <utilities/ascConfig.h>
41 #include <utilities/config.h> /* NEW */
42
43 #ifndef ASC_DEFAULTPATH
44 # error "Where is ASC_DEFAULTPATH???"
45 #endif
46
47 #include <general/ospath.h>
48
49 #include "compiler.h"
50 #include <utilities/ascMalloc.h>
51 #include <general/list.h>
52 #include "symtab.h"
53 #include "fractions.h"
54 #include "dimen.h"
55 #include "functype.h"
56 #include "expr_types.h"
57 #include "extcall.h"
58 #include "mathinst.h"
59 #include "instance_enum.h"
60 #include "instquery.h"
61 #include "atomvalue.h"
62 #include "find.h"
63 #include "relation_type.h"
64 #include "relation.h"
65 #include "safe.h"
66 #include "relation_util.h"
67 #include "extfunc.h"
68 #include <packages/sensitivity.h>
69 #include <packages/ascFreeAllVars.h>
70 #include "module.h"
71 #include "packages.h"
72
73 /*
74 Initialise the slv data structures used when calling external fns
75 */
76 void Init_Slv_Interp(struct Slv_Interp *slv_interp)
77 {
78 if (slv_interp){
79 slv_interp->nodestamp = 0;
80 slv_interp->status = calc_all_ok;
81 slv_interp->user_data = NULL;
82 slv_interp->task = bb_none;
83 /*
84 slv_interp->first_call = (unsigned)0; // gone away
85 slv_interp->last_call = (unsigned)0; // gone away
86 slv_interp->check_args = (unsigned)0; // gone away
87 slv_interp->recalculate = (unsigned)0; // gone away
88 slv_interp->func_eval = (unsigned)0; // gone away
89 slv_interp->deriv_eval = (unsigned)0; // gone away
90 slv_interp->single_step = (unsigned)0; // gone away
91 */
92 }
93 }
94
95 /*---------------------------------------------
96 BUILT-IN PACKAGES...
97 */
98
99 /**
100 Load builtin packages, unless NO_PACKAGES.
101
102 @return 0 if success, 1 if failure.
103 */
104 static
105 int Builtins_Init(void)
106 {
107 int result = 0;
108
109 #ifdef NO_PACKAGES
110 ERROR_REPORTER_HERE(ASC_USER_WARNING,"Builtins_Init: DISABLED at compile-time");
111 #else
112 ERROR_REPORTER_DEBUG("Builtins_Init: Loading function asc_free_all_variables\n");
113 result = CreateUserFunctionMethod("asc_free_all_variables",
114 Asc_FreeAllVars,
115 1,
116 "Unset 'fixed' flag of all items of type 'solver_var'");
117 #endif
118 return result;
119 }
120
121 /*---------------------------------------------
122 DYNAMIC_PACKAGES code only...
123 */
124 # ifdef DYNAMIC_PACKAGES
125 static char path_var[PATH_MAX];
126
127 /**
128 A little structure to help with searching for libraries
129
130 @see test_librarysearch
131 */
132 struct LibrarySearch{
133 struct FilePath *partialpath;
134 char fullpath[PATH_MAX];
135 };
136
137 FilePathTestFn test_librarysearch;
138
139 /**
140 A 'test' function for passing to the ospath_searchpath_iterate function.
141 This test function will return a match when a library having the required
142 name is present in the fully resolved path.
143 */
144 int test_librarysearch(struct FilePath *path, void *userdata){
145 /* user data = the relative path, plus a place
146 to store the full path when found */
147 struct LibrarySearch *ls = (struct LibrarySearch *)userdata;
148
149 struct FilePath *fp = ospath_concat(path,ls->partialpath);
150 FILE *f;
151
152 ospath_strcpy(fp,ls->fullpath,PATH_MAX);
153 /* CONSOLE_DEBUG("SEARCHING FOR %s",ls->fullpath); */
154
155 f = ospath_fopen(fp,"r");
156 if(f==NULL){
157 ospath_free(fp);
158 return 0;
159 }
160 fclose(f);
161
162 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"FOUND! %s\n",ls->fullpath);
163 return 1;
164 }
165
166 /**
167 Search the archive library path for a file matching the given
168 (platform specific, with extension?) library filename.
169
170 @param name Name of library being searched for
171 @param envv Name of environment var containing the ASCEND search path
172 @param dpath Default search path for the case where the env var is not defined
173
174 @return a pointer to a string space holding the full path
175 name of the file to be opened. The returned pointer may be NULL
176
177 If the returned pointer is not NULL, then it points to space that must be
178 freed when no longer needed.
179 */
180 static
181 char *SearchArchiveLibraryPath(CONST char *name, char *dpath, char *envv){
182 struct FilePath *fp1, *fp2, *fp3; /* relative path */
183 char *s1;
184 char buffer[PATH_MAX];
185
186 struct LibrarySearch ls;
187 struct FilePath **sp;
188 extern char path_var[PATH_MAX];
189 char *path;
190
191 fp1 = ospath_new_from_posix(name);
192 fp2 = ospath_getdir(fp1);
193 s1 = ospath_getfilestem(fp1);
194 if(s1==NULL){
195 /* not a file, so fail... */
196 return NULL;
197 }
198
199 /* CONSOLE_DEBUG("FILESTEM = '%s'",s1); */
200
201 #if defined(ASC_SHLIBSUFFIX) && defined(ASC_SHLIBPREFIX)
202 snprintf(buffer,PATH_MAX,"%s%s%s",ASC_SHLIBPREFIX,s1,ASC_SHLIBSUFFIX);
203 #else
204 # ifdef __WIN32__
205 snprintf(buffer,PATH_MAX,"%s.dll",s1);
206 # elif defined(linux)
207 snprintf(buffer,PATH_MAX,"lib%s.so",s1); /* changed from .o to .so -- JP */
208 # elif defined(sun) || defined(solaris)
209 snprintf(buffer,PATH_MAX,"%s.so.1.0",s1);
210 # elif defined(__hpux)
211 snprintf(buffer,PATH_MAX,"%s.sl",s1);
212 # elif defined(_SGI_SOURCE)
213 snprintf(buffer,PATH_MAX,"%s.so",s1);
214 # else
215 # error "Please #define ASC_SHLIBSUFFIX and ASC_SHLIBPREFIX or pass as compiler flags to packages.c"
216 # endif
217 #endif
218
219 fp3 = ospath_new(buffer);
220 ospath_free(fp1);
221 fp1 = ospath_concat(fp2,fp3);
222 ospath_free(fp2);
223 ospath_free(fp3);
224 free(s1);
225
226 ls.partialpath = fp1;
227
228 /* CONSOLE_DEBUG("ENV VAR = '%s'",envv); */
229
230 /* CONSOLE_DEBUG("GETTING SEARCH PATH FROM ENVIRONMENT VAR '%s'",envv); */
231 path=getenv(envv);
232 if(path==NULL){
233 CONSOLE_DEBUG("ENV VAR NOT FOUND, FALLING BACK TO DEFAULT SEARCH PATH = '%s'",dpath);
234 path=ASC_DEFAULTPATH;
235 }
236
237 /* CONSOLE_DEBUG("SEARCHPATH = '%s'",path); */
238
239 sp = ospath_searchpath_new(path);
240
241 if(NULL==ospath_searchpath_iterate(sp,&test_librarysearch,&ls)){
242 return NULL;
243 }
244
245 strncpy(path_var,ls.fullpath,PATH_MAX);
246
247 ospath_free(fp1);
248
249 return path_var;
250 }
251
252 #endif /* DYNAMIC_PACKAGES */
253 /*
254 END of DYNAMIC_PACKAGES-specific code
255 ------------------------------------------*/
256
257 int LoadArchiveLibrary(CONST char *partialname, CONST char *initfunc){
258
259 #ifdef DYNAMIC_PACKAGES
260 char *file;
261 char auto_initfunc[PATH_MAX];
262 char *stem;
263 struct FilePath *fp1;
264 int result;
265
266 CONSOLE_DEBUG("Searching for external library '%s'",partialname);
267
268 file = SearchArchiveLibraryPath(partialname, ASC_DEFAULTPATH, PATHENVIRONMENTVAR);
269 if(file==NULL){
270 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"The named library '%s' was not found in the search path.",partialname);
271 return 1;
272 }
273
274 fp1 = ospath_new_from_posix(partialname);
275 stem = ospath_getfilestem(fp1);
276 if(stem==NULL){
277 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"What is the stem of named library '%s'???",partialname);
278 free(stem);
279 ospath_free(fp1);
280 return 1;
281 }
282
283 if(initfunc==NULL){
284 strncpy(auto_initfunc,stem,PATH_MAX);
285 strncat(auto_initfunc,"_register",PATH_MAX-strlen(auto_initfunc));
286 result = Asc_DynamicLoad(file,auto_initfunc);
287 }else{
288 result = Asc_DynamicLoad(file,initfunc);
289 }
290
291 if (result) {
292 CONSOLE_DEBUG("FAILED TO LOAD LIBRARY '%s' (error %d)",partialname,result);
293 result = 1;
294 }else{
295 if(initfunc==NULL){
296 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",auto_initfunc,file);
297 }else{
298 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc,file);
299 }
300 }
301
302 free(stem);
303 ospath_free(fp1);
304 return result;
305
306 #else
307
308 DISUSED_PARAMETER(name); DISUSED_PARAMETER(initfunc);
309
310 # if defined(STATIC_PACKAGES)
311 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"LoadArchiveLibrary disabled: STATIC_PACKAGES, no need to load dynamically.\n");
312 return 0;
313 # elif defined(NO_PACKAGES)
314 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"LoadArchiveLibrary disabled: NO_PACKAGES");
315 return 1;
316 # else
317 # error "Invalid package linking flags"
318 # endif
319
320 #endif
321 }
322
323 /*---------------------------------------------
324 STATIC_PACKAGES code only...
325
326 Declare the functions which we are expected to be able to call.
327 */
328 #ifndef NO_PACKAGES
329 # ifdef STATIC_PACKAGES
330
331 #include <packages/kvalues.h>
332 #include <packages/bisect.h>
333 #include <packages/sensitivity.h>
334
335 # endif
336 #endif
337
338 #ifdef STATIC_PACKAGES
339 /**
340 Load all statically-linked packages
341
342 @return 0 on success, >0 if any CreateUserFunction calls failed.
343 */
344 static
345 int StaticPackages_Init(void)
346 {
347 int result = 0;
348
349 result += sensitivity_register();
350 result += kvalues_register();
351
352 return result;
353 }
354 #endif
355
356 /**
357 This is a general purpose function that will load whatever user
358 functions are required according to the compile-time settings.
359
360 If NO_PACKAGES, nothing will be loaded. If DYNAMIC_PACKAGES, then
361 just the builtin packages will be loaded. If STATIC_PACKAGES then
362 builtin plus those called in 'StaticPackages_Init' will be loaded.
363 */
364 void AddUserFunctions(void)
365 {
366 #ifdef NO_PACKAGES
367 # ifdef __GNUC__
368 # warning "EXTERNAL PACKAGES ARE BEING DISABLED"
369 # endif
370 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"AddUserFunctions disabled at compile-time.");
371 #else
372
373 /* Builtins are always statically linked */
374 if (Builtins_Init()) {
375 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in Builtins_Init: Some user functions not created");
376 }
377
378 # ifdef DYNAMIC_PACKAGES
379 /* do nothing */
380
381 # elif defined(STATIC_PACKAGES)
382 # ifdef __GNUC__
383 # warning "STATIC PACKAGES"
384 # endif
385
386 /*The following need to be reimplemented but are basically useful as is. */
387 if (StaticPackages_Init()) {
388 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in StaticPackages_Init(): Some user functions not created");
389 }
390
391 # endif
392 #endif
393 }
394
395 /*---------------------------------------
396 TESTING FUNCTIONS
397
398 The following functions may be called someone desirous of testing
399 an external relation provided as a package. They are here
400 for convenience, and should be really in a separate file.
401 */
402
403 /**
404 What's this do? -- JP
405 */
406 static void LoadInputVector(struct gl_list_t *arglist,
407 double *inputs,
408 unsigned ninputs,
409 unsigned long n_input_args)
410 {
411 struct Instance *inst;
412 struct gl_list_t *input_list;
413 unsigned long c,len;
414
415 input_list = LinearizeArgList(arglist,1,n_input_args);
416
417 if(!input_list)return;
418
419 len = gl_length(input_list);
420
421 if(len!=ninputs)return; /* somehow we had inconsistent data */
422
423 for (c=1;c<=len;c++) {
424 inst = (struct Instance *)gl_fetch(input_list,c);
425 inputs[c-1] = RealAtomValue(inst);
426 }
427 gl_destroy(input_list);
428 }
429
430 /**
431 What's a black box, and what's a glass box? -- JP
432 See Abbott thesis. - baa
433 This function is, of course, a mess.
434 */
435 int CallBlackBox(struct Instance *inst,
436 CONST struct relation *rel)
437 {
438 struct Instance *data;
439
440 struct Slv_Interp slv_interp;
441 struct ExternalFunc *efunc;
442 struct ExtCallNode *ext;
443 struct gl_list_t *arglist;
444 unsigned long n_input_args, n_output_args;
445 int nok = 0;
446
447 unsigned long ninputs, noutputs;
448 double *inputs = NULL, *outputs = NULL;
449 double *jacobian = NULL;
450
451 ExtBBoxInitFunc *init_func;
452 ExtBBoxInitFunc *final_func;
453 ExtBBoxFunc *eval_func;
454 ExtBBoxFunc *deriv_func;
455
456 UNUSED_PARAMETER(inst);
457
458 ext = BlackBoxExtCall(rel);
459 arglist = ExternalCallArgList(ext);
460 data = ExternalCallDataInstance(ext);
461 efunc = ExternalCallExtFunc(ext);
462 init_func = GetInitFunc(efunc);
463 final_func = GetFinalFunc(efunc);
464 eval_func = GetValueFunc(efunc);
465 deriv_func = GetDerivFunc(efunc);
466
467 if (init_func && eval_func) {
468
469 /* set up the interpreter. */
470 Init_Slv_Interp(&slv_interp);
471 /*
472 slv_interp.check_args = (unsigned)1;
473 slv_interp.first_call = (unsigned)1;
474 slv_interp.last_call = (unsigned)0;
475 */
476 slv_interp.nodestamp = ExternalCallNodeStamp(ext);
477 n_input_args = NumberInputArgs(efunc);
478 n_output_args = NumberOutputArgs(efunc);
479 ninputs = CountNumberOfArgs(arglist,1,n_input_args);
480 noutputs = CountNumberOfArgs(arglist,n_input_args + 1,
481 n_input_args+n_output_args);
482
483 /* Create the work vectors. Load the input vector from the instance tree. */
484 inputs = ASC_NEW_ARRAY_CLEAR(double,ninputs);
485 outputs = ASC_NEW_ARRAY_CLEAR(double,ninputs);
486 jacobian = (double *)asccalloc(ninputs*noutputs,sizeof(double));
487 LoadInputVector(arglist,inputs,ninputs,n_input_args);
488
489 /*
490 * Call the init function.
491 */
492 slv_interp.task = bb_first_call;
493 nok = (*init_func)(&slv_interp,data,arglist);
494 if (nok) goto error;
495 /*
496 * Call the evaluation function.
497 */
498 slv_interp.task = bb_func_eval;
499 nok = (*eval_func)(&slv_interp,ninputs,noutputs,
500 inputs,outputs,jacobian);
501 if (nok) goto error;
502 /*
503 * Call the derivative routine.
504 */
505 if (deriv_func) {
506 slv_interp.task = bb_deriv_eval;
507 nok = (*deriv_func)(&slv_interp,ninputs,noutputs,
508 inputs,outputs,jacobian);
509 if (nok) goto error;
510 }
511 /*
512 * Call the init function to shut down
513 */
514 if (final_func) {
515 /*
516 slv_interp.first_call = (unsigned)0;
517 slv_interp.last_call = (unsigned)1;
518 */
519 slv_interp.task = bb_last_call;
520 nok = (*final_func)(&slv_interp,data,arglist);
521 if (nok) goto error;
522 }
523 }
524 else{
525 FPRINTF(ASCERR,"External function not loaded\n");
526 return 1;
527 }
528
529 error:
530 if (inputs) ascfree((char *)inputs);
531 if (outputs) ascfree((char *)outputs);
532 if (jacobian) ascfree((char *)outputs);
533 if (nok)
534 return 1;
535 else
536 return 0;
537 }
538
539 /**
540 When glassbox are registered, they must register a pointer
541 to their function jump table. In other words, they must
542 register a pointer to an 'array of pointers to functions'.
543 This typedef just makes life a little cleaner.
544
545 <-- what typedef?? -- JP
546 */
547 int CallGlassBox(struct Instance *relinst, CONST struct relation *rel)
548 {
549 CONST struct gl_list_t *incidence;
550 struct Instance *var;
551 struct ExternalFunc *efunc;
552 int index;
553 long i;
554 double *f, *x, *g;
555 int m,mode,result;
556 int n;
557
558 ExtEvalFunc **evaltable, *eval_func;
559 ExtEvalFunc **derivtable, *deriv_func;
560
561 (void) relinst;
562 incidence = RelationVarList(rel);
563 if (!incidence) {
564 FPRINTF(ASCERR,"Incidence list is empty -- nothing to evaluate\n");
565 return 0;
566 }
567 index = GlassBoxRelIndex(rel);
568 efunc = GlassBoxExtFunc(rel);
569 evaltable = GetValueJumpTable(efunc);
570 eval_func = evaltable[index];
571 derivtable = GetDerivJumpTable(efunc);
572 deriv_func = derivtable[index];
573
574 m = 0; /* FIX not sure what this should be !!! */
575 n = gl_length(incidence);
576 f = (double *)asccalloc((1 + 2*n),sizeof(double));
577 x = &f[1];
578 g = &f[n+1];
579
580 for (i=0;i<n;i++) {
581 var = (struct Instance *)gl_fetch(incidence,i+1);
582 x[i] = RealAtomValue(var);
583 }
584 result = (*eval_func)(&mode,&m,&n,x,NULL,f,g);
585 result += (*deriv_func)(&mode,&m,&n,x,NULL,f,g);
586
587 ascfree((char *)f);
588 return result;
589 }
590
591 /**
592 No idea what this does. It's referenced in 'interface.c' only, so it
593 appears to be defunct -- JP
594 */
595 int CallExternalProcs(struct Instance *inst)
596 {
597 CONST struct relation *rel;
598 enum Expr_enum reltype;
599
600 if (inst==NULL){
601 FPRINTF(ASCERR,"Instance does not exist for callprocs\n");
602 return 1;
603 }
604 if (InstanceKind(inst)!=REL_INST){
605 FPRINTF(ASCERR,"Instance is not a relation\n");
606 return 1;
607 }
608 rel = GetInstanceRelation(inst,&reltype);
609 if (!rel) {
610 FPRINTF(ASCERR,"Relation structure is NULL\n");
611 return 1;
612 }
613 switch (reltype) {
614 case e_blackbox:
615 return CallBlackBox(inst,rel);
616 case e_glassbox:
617 return CallGlassBox(inst,rel);
618 default:
619 FPRINTF(ASCERR,"Invalid relation type in CallExternalProc\n");
620 return 1;
621 }
622 }

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