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

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