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

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