/[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 508 - (show annotations) (download) (as text)
Wed Apr 19 04:48:32 2006 UTC (13 years, 9 months ago) by johnpye
File MIME type: text/x-csrc
File size: 16880 byte(s)
More fixes for compiling and running on ubuntu 5.10 with GCC:
gcc version 4.0.2 20050808 (prerelease) (Ubuntu 4.0.1-4ubuntu9)

Added ASC_SHLIBSUFFIX and ASC_SHLIBPREFIX which are used in packages.c in preference to platform-specific #ifdefs.

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

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