/[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 534 - (show annotations) (download) (as text)
Tue Apr 25 13:25:04 2006 UTC (14 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 16318 byte(s)
Working on platform-independent pathnames for the IMPORT command.
Added 'ospath.c' to base/generic/general for this purpose.
Patched kvalues and sensitivity to use the 'IMPORT "libname";' syntax
instead of 'IMPORT registerfn FROM libname;'.
Fixed pathnames in create.nsi.
Added GPL header to coupla files.
Added quoting to 'IMPORT' syntax in ascParse.y.
Removed 'PackageOption' from Tcl/Tk related Scons options so that missing Tcl/Tk
doesn't cause breakage.
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 #ifdef __WIN32__
151 # define ASC_PATHSEP ';'
152 # define ASC_SLASH '\\'
153 #else
154 # define ASC_PATHSEP ':'
155 # define ASC_SLASH '/'
156 #endif
157
158 /**
159 Search the archive library path for a file matching the given
160 (platform specific, with extension?) library filename.
161
162 @return a pointer to a string space holding the full path
163 name of the file to be opened. The returned pointer may be NULL
164
165 @TODO won't work correctly on windows
166 @deprecated { see packages.h }
167 */
168 static
169 char *SearchArchiveLibraryPath(CONST char *name, char *dpath, char *envv)
170 {
171 register char *path,*result;
172 register CONST char *t;
173 register unsigned length;
174 register FILE *f;
175 CONSOLE_DEBUG("NAME = %s",name);
176 CONSOLE_DEBUG("Library being searched for is '%s'\n",name);
177 CONSOLE_DEBUG("Env var for user packages is '%s'\n",envv);
178 CONSOLE_DEBUG("Search path for user packages is '%s'\n",getenv(envv));
179 if ((path=getenv(envv))==NULL)
180 path=dpath;
181 while(isspace(*path)) path++;
182 while(*path!='\0'){
183 if (*path==ASC_PATHSEP) path++;
184 else{
185 length = 0;
186 /* copy next directory into array */
187 while((*path!=ASC_PATHSEP)&&(*path!='\0')&&(!isspace(*path))){
188 if(*path=='/'){
189 path_var[length++] = ASC_SLASH; path++;
190 }else{
191 path_var[length++] = *(path++);
192 }
193 }
194
195 /* add a trailing slash to the path component */
196 if (path_var[length-1]!='/')
197 path_var[length++]=ASC_SLASH;
198
199 /* copy file name into array */
200 for(t=name;*t!='\0';){
201 if(*t=='/'){
202 path_var[length++] = ASC_SLASH; t++;
203 }else{
204 path_var[length++] = *(t++);
205 }
206 }
207 path_var[length]='\0';
208
209 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Searching for '%s' at '%s'\n",name, path_var);
210
211 if ((f= fopen(path_var,"r"))!=NULL){
212 result = path_var;
213 fclose(f);
214 return result;
215 }
216 }
217 while(isspace(*path)) path++;
218 }
219 return NULL;
220 }
221 #endif /* DYNAMIC_PACKAGES */
222 /*
223 END of DYNAMIC_PACKAGES-specific code
224 ------------------------------------------*/
225
226 int LoadArchiveLibrary(CONST char *name, CONST char *initfunc)
227 {
228 #ifdef NO_PACKAGES
229 /** avoid compiler warnings on params: */
230 (void) name; (void) initfunc;
231
232 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"LoadArchiveLibrary disabled: NO_PACKAGES");
233 return 1;
234
235 #elif defined(DYNAMIC_PACKAGES)
236
237 symchar *name_with_extn;
238
239 int result;
240 char *default_path = ".";
241 char *env = PATHENVIRONMENTVAR;
242 char *full_file_name = NULL;
243 extern int Asc_DynamicLoad(CONST char *,CONST char *);
244
245 char initfunc_generated_name[255];
246
247 name_with_extn = MakeArchiveLibraryName(name);
248
249 full_file_name = SearchArchiveLibraryPath(SCP(name_with_extn),default_path,env);
250 if (!full_file_name) {
251 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"The named library '%s' was not found in the search path.",name_with_extn);
252 return 1;
253 }
254
255 if(initfunc==NULL){
256 CONSOLE_DEBUG("GENERATING NAME OF INITFUNC");
257 CONSOLE_DEBUG("NAME STEM = %s",name);
258 sprintf(initfunc_generated_name,"%s",name);
259 strcat(initfunc_generated_name,"_register");
260 CONSOLE_DEBUG("GENERATED NAME = %s",initfunc_generated_name);
261 result = Asc_DynamicLoad(full_file_name,initfunc_generated_name);
262 }else{
263 result = Asc_DynamicLoad(full_file_name,initfunc);
264 }
265
266 if (result) {
267 return 1;
268 }
269 if(initfunc==NULL){
270 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc_generated_name,name);
271 }else{
272 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc,name);
273 }
274 return 0;
275
276 #elif defined(STATIC_PACKAGES)
277
278 /* avoid compiler warnings on params: */
279 (void) name; (void) initfunc;
280
281 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"LoadArchiveLibrary disabled: STATIC_PACKAGES, no need to load dynamically.\n");
282 return 0;
283
284 #else /* unknown flags */
285
286 # error "Invalid package linking flags"
287 (void) name; (void) initfunc;
288 return 1;
289
290 #endif
291 }
292
293 /*---------------------------------------------
294 STATIC_PACKAGES code only...
295
296 Declare the functions which we are expected to be able to call.
297 */
298 #ifndef NO_PACKAGES
299 # ifdef STATIC_PACKAGES
300
301 #include <packages/kvalues.h>
302 #include <packages/bisect.h>
303 #include <packages/sensitivity.h>
304
305 # endif
306 #endif
307
308 #ifdef STATIC_PACKAGES
309 /**
310 Load all statically-linked packages
311
312 @return 0 on success, >0 if any CreateUserFunction calls failed.
313 */
314 static
315 int StaticPackages_Init(void)
316 {
317 int result = 0;
318
319 result += sensitivity_register();
320 result += kvalues_register();
321
322 return result;
323 }
324 #endif
325
326 /**
327 This is a general purpose function that will load whatever user
328 functions are required according to the compile-time settings.
329
330 If NO_PACKAGES, nothing will be loaded. If DYNAMIC_PACKAGES, then
331 just the builtin packages will be loaded. If STATIC_PACKAGES then
332 builtin plus those called in 'StaticPackages_Init' will be loaded.
333 */
334 void AddUserFunctions(void)
335 {
336 #ifdef NO_PACKAGES
337 # ifdef __GNUC__
338 # warning "EXTERNAL PACKAGES ARE BEING DISABLED"
339 # endif
340 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"AddUserFunctions disabled at compile-time.");
341 #else
342
343 /* Builtins are always statically linked */
344 if (Builtins_Init()) {
345 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in Builtins_Init: Some user functions not created");
346 }
347
348 # ifdef DYNAMIC_PACKAGES
349 /* do nothing */
350
351 # elif defined(STATIC_PACKAGES)
352 # ifdef __GNUC__
353 # warning "STATIC PACKAGES"
354 # endif
355
356 /*The following need to be reimplemented but are basically useful as is. */
357 if (StaticPackages_Init()) {
358 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in StaticPackages_Init(): Some user functions not created");
359 }
360
361 # endif
362 #endif
363 }
364
365 /*---------------------------------------
366 TESTING FUNCTIONS
367
368 The following functions may be called someone desirous of testing
369 an external relation provided as a package. They are here
370 for convenience, and should be really in a separate file.
371 */
372
373 /**
374 What's this do? -- JP
375 */
376 static void LoadInputVector(struct gl_list_t *arglist,
377 double *inputs,
378 unsigned ninputs,
379 unsigned long n_input_args)
380 {
381 struct Instance *inst;
382 struct gl_list_t *input_list;
383 unsigned long c,len;
384
385 input_list = LinearizeArgList(arglist,1,n_input_args);
386
387 if(!input_list)return;
388
389 len = gl_length(input_list);
390
391 if(len!=ninputs)return; /* somehow we had inconsistent data */
392
393 for (c=1;c<=len;c++) {
394 inst = (struct Instance *)gl_fetch(input_list,c);
395 inputs[c-1] = RealAtomValue(inst);
396 }
397 gl_destroy(input_list);
398 }
399
400 /**
401 What's a black box, and what's a glass box? -- JP
402 */
403 int CallBlackBox(struct Instance *inst,
404 CONST struct relation *rel)
405 {
406 struct Instance *data;
407
408 struct Slv_Interp slv_interp;
409 struct ExternalFunc *efunc;
410 struct ExtCallNode *ext;
411 struct gl_list_t *arglist;
412 unsigned long n_input_args, n_output_args;
413 int nok = 0;
414
415 unsigned long ninputs, noutputs;
416 double *inputs = NULL, *outputs = NULL;
417 double *jacobian = NULL;
418
419 /* All these desperately need a typedef in a header someplace */
420 /* now typedefs in solver/extfunc.h - 1/22/2006 - jds
421 int (*init_func) (struct Slv_Interp *,
422 struct Instance *,
423 struct gl_list_t *);
424
425 int (*eval_func)(struct Slv_Interp *,
426 int, // n_inputs
427 int, // n_outputs
428 double *, // inputs
429 double * , // outputs
430 double * ); // jacobian
431
432 int (*deriv_func)(struct Slv_Interp *,
433 int, // n_inputs
434 int , // n_outputs
435 double *, // inputs
436 double * , // outputs
437 double * ); // jacobian
438 */
439 ExtBBoxInitFunc *init_func;
440 ExtBBoxFunc *eval_func;
441 ExtBBoxFunc *deriv_func;
442
443 /*------------------------------
444 After this point everything should be ok.
445 <-- says who? when? -- JP
446 */
447
448 /* Visual C doesn't like this before the func ptr defs. */
449 UNUSED_PARAMETER(inst);
450
451 ext = BlackBoxExtCall(rel);
452 arglist = ExternalCallArgList(ext);
453 data = ExternalCallDataInstance(ext);
454 efunc = ExternalCallExtFunc(ext);
455 init_func = GetInitFunc(efunc);
456 eval_func = GetValueFunc(efunc);
457 deriv_func = GetDerivFunc(efunc);
458
459 if (init_func && eval_func) {
460
461 /* set up the interpreter. */
462 Init_Slv_Interp(&slv_interp);
463 slv_interp.check_args = (unsigned)1;
464 slv_interp.first_call = (unsigned)1;
465 slv_interp.last_call = (unsigned)0;
466 slv_interp.nodestamp = ExternalCallNodeStamp(ext);
467 n_input_args = NumberInputArgs(efunc);
468 n_output_args = NumberOutputArgs(efunc);
469 ninputs = CountNumberOfArgs(arglist,1,n_input_args);
470 noutputs = CountNumberOfArgs(arglist,n_input_args + 1,
471 n_input_args+n_output_args);
472
473 /* Create the work vectors. Load the input vector from the instance tree. */
474 inputs = (double *)asccalloc(ninputs,sizeof(double));
475 outputs = (double *)asccalloc(ninputs,sizeof(double));
476 jacobian = (double *)asccalloc(ninputs*noutputs,sizeof(double));
477 LoadInputVector(arglist,inputs,ninputs,n_input_args);
478
479 /*
480 * Call the init function.
481 */
482 nok = (*init_func)(&slv_interp,data,arglist);
483 if (nok) goto error;
484 /*
485 * Call the evaluation function.
486 */
487 nok = (*eval_func)(&slv_interp,ninputs,noutputs,
488 inputs,outputs,jacobian);
489 if (nok) goto error;
490 /*
491 * Call the derivative routine.
492 */
493 if (deriv_func) {
494 nok = (*deriv_func)(&slv_interp,ninputs,noutputs,
495 inputs,outputs,jacobian);
496 if (nok) goto error;
497 }
498 /*
499 * Call the init function to shut down
500 */
501 slv_interp.first_call = (unsigned)0;
502 slv_interp.last_call = (unsigned)1;
503 nok = (*init_func)(&slv_interp,data,arglist);
504 if (nok) goto error;
505 }
506 else{
507 FPRINTF(ASCERR,"External function not loaded\n");
508 return 1;
509 }
510
511 error:
512 if (inputs) ascfree((char *)inputs);
513 if (outputs) ascfree((char *)outputs);
514 if (jacobian) ascfree((char *)outputs);
515 if (nok)
516 return 1;
517 else
518 return 0;
519 }
520
521 /**
522 When glassbox are registered, they must register a pointer
523 to their function jump table. In other words, they must
524 register a pointer to an 'array of pointers to functions'.
525 This typedef just makes life a little cleaner.
526
527 <-- what typedef?? -- JP
528 */
529 int CallGlassBox(struct Instance *relinst, CONST struct relation *rel)
530 {
531 CONST struct gl_list_t *incidence;
532 struct Instance *var;
533 struct ExternalFunc *efunc;
534 int index;
535 long i;
536 double *f, *x, *g;
537 int m,mode,result;
538 int n;
539
540 ExtEvalFunc **evaltable, *eval_func;
541 ExtEvalFunc **derivtable, *deriv_func;
542
543 (void) relinst;
544 incidence = RelationVarList(rel);
545 if (!incidence) {
546 FPRINTF(ASCERR,"Incidence list is empty -- nothing to evaluate\n");
547 return 0;
548 }
549 index = GlassBoxRelIndex(rel);
550 efunc = GlassBoxExtFunc(rel);
551 evaltable = GetValueJumpTable(efunc);
552 eval_func = evaltable[index];
553 derivtable = GetDerivJumpTable(efunc);
554 deriv_func = derivtable[index];
555
556 m = 0; /* FIX not sure what this should be !!! */
557 n = gl_length(incidence);
558 f = (double *)asccalloc((1 + 2*n),sizeof(double));
559 x = &f[1];
560 g = &f[n+1];
561
562 for (i=0;i<n;i++) {
563 var = (struct Instance *)gl_fetch(incidence,i+1);
564 x[i] = RealAtomValue(var);
565 }
566 result = (*eval_func)(&mode,&m,&n,x,NULL,f,g);
567 result += (*deriv_func)(&mode,&m,&n,x,NULL,f,g);
568
569 ascfree((char *)f);
570 return result;
571 }
572
573 /**
574 No idea what this does. It's referenced in 'interface.c' only, so it
575 appears to be defunct -- JP
576 */
577 int CallExternalProcs(struct Instance *inst)
578 {
579 CONST struct relation *rel;
580 enum Expr_enum reltype;
581
582 if (inst==NULL){
583 FPRINTF(ASCERR,"Instance does not exist for callprocs\n");
584 return 1;
585 }
586 if (InstanceKind(inst)!=REL_INST){
587 FPRINTF(ASCERR,"Instance is not a relation\n");
588 return 1;
589 }
590 rel = GetInstanceRelation(inst,&reltype);
591 if (!rel) {
592 FPRINTF(ASCERR,"Relation structure is NULL\n");
593 return 1;
594 }
595 switch (reltype) {
596 case e_blackbox:
597 return CallBlackBox(inst,rel);
598 case e_glassbox:
599 return CallGlassBox(inst,rel);
600 default:
601 FPRINTF(ASCERR,"Invalid relation type in CallExternalProc\n");
602 return 1;
603 }
604 }

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