/[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 394 - (show annotations) (download) (as text)
Thu Mar 30 14:50:35 2006 UTC (18 years, 2 months ago) by wangym
File MIME type: text/x-csrc
File size: 17567 byte(s)
move the function call after the variable define, a compile bug fix
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 #ifndef DYNAMIC_PACKAGES
37 # error "WHERE IS THE DYNAMICS PACKAGES #DEF?!"
38 #endif
39
40 #include <math.h>
41 #include <ctype.h> /* was compiler/actype.h */
42 #include "utilities/ascConfig.h"
43 #include "compiler/compiler.h"
44 #include "utilities/ascMalloc.h"
45 #include "general/list.h"
46 #include "compiler/symtab.h"
47 #include "compiler/fractions.h"
48 #include "compiler/dimen.h"
49 #include "compiler/functype.h"
50 #include "compiler/types.h"
51 #include "compiler/extcall.h"
52 #include "compiler/mathinst.h"
53 #include "compiler/instance_enum.h"
54 #include "compiler/instquery.h"
55 #include "compiler/atomvalue.h"
56 #include "compiler/find.h"
57 #include "compiler/relation_type.h"
58 #include "compiler/relation.h"
59 #include "compiler/safe.h"
60 #include "compiler/relation_util.h"
61 #include "compiler/extfunc.h"
62 #include "packages/sensitivity.h"
63 #include "packages/ascFreeAllVars.h"
64 #include "compiler/module.h"
65 #include "compiler/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 {
91 char *buffer;
92 int len;
93 symchar *result;
94
95 len = strlen(prefix);
96 buffer = (char *)ascmalloc(len+40);
97
98 #ifdef __WIN32__
99 sprintf(buffer,"%s.dll",prefix);
100 #elif defined(linux)
101 sprintf(buffer,"lib%s.so",prefix); /* changed from .o to .so -- JP */
102 #elif defined(sun) || defined(solaris)
103 sprintf(buffer,"%s.so.1.0",prefix);
104 #elif defined(__hpux)
105 sprintf(buffer,"%s.sl",prefix);
106 #elif defined(_SGI_SOURCE)
107 sprintf(buffer,"%s.so",prefix);
108 #else
109 sprintf(buffer,"%s.so.1.0",prefix);
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 = CreateUserFunction("asc_free_all_variables"
136 ,(ExtEvalFunc *)NULL
137 ,(ExtEvalFunc **)Asc_FreeAllVars
138 ,(ExtEvalFunc **)NULL
139 ,(ExtEvalFunc **)NULL
140 ,1, 0, "Unset 'fixed' flag of all items of type 'solver_var'");
141 #endif
142 return result;
143 }
144
145 /*---------------------------------------------
146 DYNAMIC_PACKAGES code only...
147 */
148 # ifdef DYNAMIC_PACKAGES
149 static char path_var[PATH_MAX];
150
151 /**
152 Search the archive library path for a file matching the given
153 (platform specific, with extension?) library filename.
154
155 @return a pointer to a string space holding the full path
156 name of the file to be opened. The returned pointer may be NULL
157
158 @TODO won't work correctly on windows
159 @deprecated { see packages.h }
160 */
161 static
162 char *SearchArchiveLibraryPath(CONST char *name, char *dpath, char *envv)
163 {
164 register char *path,*result;
165 register CONST char *t;
166 register unsigned length;
167 register FILE *f;
168 /* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Env var for user packages is '%s'\n",envv); */
169 /* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Search path for user packages is '%s'\n",getenv(envv)); */
170 if ((path=getenv(envv))==NULL)
171 path=dpath;
172 while(isspace(*path)) path++;
173 while(*path!='\0'){
174 if (*path==':') path++;
175 else{
176 length = 0;
177 /* copy next directory into array */
178 while((*path!=':')&&(*path!='\0')&&(!isspace(*path)))
179 path_var[length++] = *(path++);
180 if (path_var[length-1]!='/')
181 path_var[length++]='/';
182
183 /* copy file name into array */
184 for(t=name;*t!='\0';){
185 path_var[length++] = *(t++);
186 }
187 path_var[length]='\0';
188
189 /* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Searching for for '%s' at '%s'\n",name, path_var); */
190
191 if ((f= fopen(path_var,"r"))!=NULL){
192 result = path_var;
193 fclose(f);
194 return result;
195 }
196 }
197 while(isspace(*path)) path++;
198 }
199 return NULL;
200 }
201 #endif /* DYNAMIC_PACKAGES */
202 /*
203 END of DYNAMIC_PACKAGES-specific code
204 ------------------------------------------*/
205
206 int LoadArchiveLibrary(CONST char *name, CONST char *initfunc)
207 {
208 #ifdef NO_PACKAGES
209 /** avoid compiler warnings on params: */
210 (void) name; (void) initfunc;
211
212 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"LoadArchiveLibrary disabled: NO_PACKAGES");
213 return 1;
214
215 #elif defined(DYNAMIC_PACKAGES)
216
217 symchar *name_with_extn;
218
219 int result;
220 char *default_path = ".";
221 char *env = PATHENVIRONMENTVAR;
222 char *full_file_name = NULL;
223 extern int Asc_DynamicLoad(CONST char *,CONST char *);
224
225 char initfunc_generated_name[255];
226
227 name_with_extn = MakeArchiveLibraryName(name);
228
229 full_file_name = SearchArchiveLibraryPath(name_with_extn,default_path,env);
230 if (!full_file_name) {
231 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"The named library '%s' was not found in the search path",name_with_extn);
232 return 1;
233 }
234
235 if(initfunc==NULL){
236 CONSOLE_DEBUG("GENERATING NAME OF INITFUNC");
237 CONSOLE_DEBUG("NAME STEM = %s",name);
238 sprintf(initfunc_generated_name,"%s",name);
239 strcat(initfunc_generated_name,"_register");
240 CONSOLE_DEBUG("GENERATED NAME = %s",initfunc_generated_name);
241 result = Asc_DynamicLoad(full_file_name,initfunc_generated_name);
242 }else{
243 result = Asc_DynamicLoad(full_file_name,initfunc);
244 }
245
246 if (result) {
247 return 1;
248 }
249 if(initfunc==NULL){
250 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc_generated_name,name);
251 }else{
252 ERROR_REPORTER_DEBUG("Successfully ran '%s' from dynamic package '%s'\n",initfunc,name);
253 }
254 return 0;
255
256 #elif defined(STATIC_PACKAGES)
257
258 /* avoid compiler warnings on params: */
259 (void) name; (void) initfunc;
260
261 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"LoadArchiveLibrary disabled: STATIC_PACKAGES, no need to load dynamically.\n");
262 return 0;
263
264 #else /* unknown flags */
265
266 # error "Invalid package linking flags"
267 (void) name; (void) initfunc;
268 return 1;
269
270 #endif
271 }
272
273 /*---------------------------------------------
274 STATIC_PACKAGES code only...
275
276 Declare the functions which we are expected to be able to call.
277 */
278 #ifndef NO_PACKAGES
279 # ifdef STATIC_PACKAGES
280
281 /* kvalues.c */
282 extern int kvalues_preslv(struct Slv_Interp *,struct Instance *, struct gl_list_t *);
283 extern int kvalues_fex(struct Slv_Interp *, int, int, double *, double *, double *);
284
285 /* bisect.c */
286 extern int do_set_values_eval(struct Slv_Interp *,struct Instance *, struct gl_list_t *);
287 extern int do_bisection_eval(struct Slv_Interp *,struct Instance *,struct gl_list_t *);
288
289 /* sensitivity.c */
290 extern int do_sensitivity_eval(struct Slv_Interp *,struct Instance *, struct gl_list_t *);
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 = CreateUserFunction("do_solve",
314 (ExtEvalFunc *)NULL,
315 (ExtEvalFunc **)do_solve_eval,
316 (ExtEvalFunc **)NULL,
317 (ExtEvalFunc **)NULL,
318 2,0,NULL);
319 result += CreateUserFunction("do_finite_difference",
320 (ExtEvalFunc *)NULL,
321 (ExtEvalFunc **)do_finite_diff_eval,
322 (ExtEvalFunc **)NULL,
323 (ExtEvalFunc **)NULL,
324 4,0,NULL);
325 result += CreateUserFunction("do_sensitivity",
326 (ExtEvalFunc *)NULL,
327 (ExtEvalFunc **)do_sensitivity_eval,
328 (ExtEvalFunc **)NULL,
329 (ExtEvalFunc **)NULL,
330 4,0,sensitivity_help);
331 result += CreateUserFunction("do_sensitivity_all",
332 (ExtEvalFunc *)NULL,
333 (ExtEvalFunc **)do_sensitivity_eval_all,
334 (ExtEvalFunc **)NULL,
335 (ExtEvalFunc **)NULL,
336 4,0,"See do_sensitivity for details");
337
338 return result;
339 }
340 #endif
341
342 /**
343 This is a general purpose function that will load whatever user
344 functions are required according to the compile-time settings.
345
346 If NO_PACKAGES, nothing will be loaded. If DYNAMIC_PACKAGES, then
347 just the builtin packages will be loaded. If STATIC_PACKAGES then
348 builtin plus those called in 'StaticPackages_Init' will be loaded.
349 */
350 void AddUserFunctions(void)
351 {
352 #ifdef NO_PACKAGES
353 # ifdef __GNUC__
354 # warning "EXTERNAL PACKAGES ARE BEING DISABLED"
355 # endif
356 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"AddUserFunctions disabled at compile-time.");
357 #else
358
359 /* Builtins are always statically linked */
360 if (Builtins_Init()) {
361 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in Builtins_Init: Some user functions not created");
362 }
363
364 # ifdef DYNAMIC_PACKAGES
365 /* do nothing */
366
367 # elif defined(STATIC_PACKAGES)
368 # ifdef __GNUC__
369 # warning "STATIC PACKAGES"
370 # endif
371
372 /*The following need to be reimplemented but are basically useful as is. */
373 if (StaticPackages_Init()) {
374 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in StaticPackages_Init(): Some user functions not created");
375 }
376
377 # endif
378 #endif
379 }
380
381 /*---------------------------------------
382 TESTING FUNCTIONS
383
384 The following functions may be called someone desirous of testing
385 an external relation provided as a package. They are here
386 for convenience, and should be really in a separate file.
387 */
388
389 /**
390 What's this do? -- JP
391 */
392 static void LoadInputVector(struct gl_list_t *arglist,
393 double *inputs,
394 unsigned ninputs,
395 unsigned long n_input_args)
396 {
397 struct Instance *inst;
398 struct gl_list_t *input_list;
399 unsigned long c,len;
400
401 input_list = LinearizeArgList(arglist,1,n_input_args);
402
403 if(!input_list)return;
404
405 len = gl_length(input_list);
406
407 if(len!=ninputs)return; /* somehow we had inconsistent data */
408
409 for (c=1;c<=len;c++) {
410 inst = (struct Instance *)gl_fetch(input_list,c);
411 inputs[c-1] = RealAtomValue(inst);
412 }
413 gl_destroy(input_list);
414 }
415
416 /**
417 What's a black box, and what's a glass box? -- JP
418 */
419 int CallBlackBox(struct Instance *inst,
420 CONST struct relation *rel)
421 {
422 struct Instance *data;
423
424 struct Slv_Interp slv_interp;
425 struct ExternalFunc *efunc;
426 struct ExtCallNode *ext;
427 struct gl_list_t *arglist;
428 unsigned long n_input_args, n_output_args;
429 int nok = 0;
430
431 unsigned long ninputs, noutputs;
432 double *inputs = NULL, *outputs = NULL;
433 double *jacobian = NULL;
434
435 /* All these desperately need a typedef in a header someplace */
436 /* now typedefs in solver/extfunc.h - 1/22/2006 - jds
437 int (*init_func) (struct Slv_Interp *,
438 struct Instance *,
439 struct gl_list_t *);
440
441 int (*eval_func)(struct Slv_Interp *,
442 int, // n_inputs
443 int, // n_outputs
444 double *, // inputs
445 double * , // outputs
446 double * ); // jacobian
447
448 int (*deriv_func)(struct Slv_Interp *,
449 int, // n_inputs
450 int , // n_outputs
451 double *, // inputs
452 double * , // outputs
453 double * ); // jacobian
454 */
455 ExtBBoxInitFunc *init_func;
456 ExtBBoxFunc *eval_func;
457 ExtBBoxFunc *deriv_func;
458
459 /*------------------------------
460 After this point everything should be ok.
461 <-- says who? when? -- JP
462 */
463
464 /* Visual C doesn't like this before the func ptr defs. */
465 UNUSED_PARAMETER(inst);
466
467 ext = BlackBoxExtCall(rel);
468 arglist = ExternalCallArgList(ext);
469 data = ExternalCallDataInstance(ext);
470 efunc = ExternalCallExtFunc(ext);
471 init_func = GetInitFunc(efunc);
472 eval_func = GetValueFunc(efunc);
473 deriv_func = GetDerivFunc(efunc);
474
475 if (init_func && eval_func) {
476
477 /* set up the interpreter. */
478 Init_Slv_Interp(&slv_interp);
479 slv_interp.check_args = (unsigned)1;
480 slv_interp.first_call = (unsigned)1;
481 slv_interp.last_call = (unsigned)0;
482 slv_interp.nodestamp = ExternalCallNodeStamp(ext);
483 n_input_args = NumberInputArgs(efunc);
484 n_output_args = NumberOutputArgs(efunc);
485 ninputs = CountNumberOfArgs(arglist,1,n_input_args);
486 noutputs = CountNumberOfArgs(arglist,n_input_args + 1,
487 n_input_args+n_output_args);
488
489 /* Create the work vectors. Load the input vector from the instance tree. */
490 inputs = (double *)asccalloc(ninputs,sizeof(double));
491 outputs = (double *)asccalloc(ninputs,sizeof(double));
492 jacobian = (double *)asccalloc(ninputs*noutputs,sizeof(double));
493 LoadInputVector(arglist,inputs,ninputs,n_input_args);
494
495 /*
496 * Call the init function.
497 */
498 nok = (*init_func)(&slv_interp,data,arglist);
499 if (nok) goto error;
500 /*
501 * Call the evaluation function.
502 */
503 nok = (*eval_func)(&slv_interp,ninputs,noutputs,
504 inputs,outputs,jacobian);
505 if (nok) goto error;
506 /*
507 * Call the derivative routine.
508 */
509 if (deriv_func) {
510 nok = (*deriv_func)(&slv_interp,ninputs,noutputs,
511 inputs,outputs,jacobian);
512 if (nok) goto error;
513 }
514 /*
515 * Call the init function to shut down
516 */
517 slv_interp.first_call = (unsigned)0;
518 slv_interp.last_call = (unsigned)1;
519 nok = (*init_func)(&slv_interp,data,arglist);
520 if (nok) goto error;
521 }
522 else{
523 FPRINTF(ASCERR,"External function not loaded\n");
524 return 1;
525 }
526
527 error:
528 if (inputs) ascfree((char *)inputs);
529 if (outputs) ascfree((char *)outputs);
530 if (jacobian) ascfree((char *)outputs);
531 if (nok)
532 return 1;
533 else
534 return 0;
535 }
536
537 /**
538 When glassbox are registered, they must register a pointer
539 to their function jump table. In other words, they must
540 register a pointer to an 'array of pointers to functions'.
541 This typedef just makes life a little cleaner.
542
543 <-- what typedef?? -- JP
544 */
545 int CallGlassBox(struct Instance *relinst, CONST struct relation *rel)
546 {
547 CONST struct gl_list_t *incidence;
548 struct Instance *var;
549 struct ExternalFunc *efunc;
550 int index;
551 long i;
552 double *f, *x, *g;
553 int m,mode,result;
554 int n;
555
556 ExtEvalFunc **evaltable, *eval_func;
557 ExtEvalFunc **derivtable, *deriv_func;
558
559 (void) relinst;
560 incidence = RelationVarList(rel);
561 if (!incidence) {
562 FPRINTF(ASCERR,"Incidence list is empty -- nothing to evaluate\n");
563 return 0;
564 }
565 index = GlassBoxRelIndex(rel);
566 efunc = GlassBoxExtFunc(rel);
567 evaltable = GetValueJumpTable(efunc);
568 eval_func = evaltable[index];
569 derivtable = GetDerivJumpTable(efunc);
570 deriv_func = derivtable[index];
571
572 m = 0; /* FIX not sure what this should be !!! */
573 n = gl_length(incidence);
574 f = (double *)asccalloc((1 + 2*n),sizeof(double));
575 x = &f[1];
576 g = &f[n+1];
577
578 for (i=0;i<n;i++) {
579 var = (struct Instance *)gl_fetch(incidence,i+1);
580 x[i] = RealAtomValue(var);
581 }
582 result = (*eval_func)(&mode,&m,&n,x,NULL,f,g);
583 result += (*deriv_func)(&mode,&m,&n,x,NULL,f,g);
584
585 ascfree((char *)f);
586 return result;
587 }
588
589 /**
590 No idea what this does. It's referenced in 'interface.c' only, so it
591 appears to be defunct -- JP
592 */
593 int CallExternalProcs(struct Instance *inst)
594 {
595 CONST struct relation *rel;
596 enum Expr_enum reltype;
597
598 if (inst==NULL){
599 FPRINTF(ASCERR,"Instance does not exist for callprocs\n");
600 return 1;
601 }
602 if (InstanceKind(inst)!=REL_INST){
603 FPRINTF(ASCERR,"Instance is not a relation\n");
604 return 1;
605 }
606 rel = GetInstanceRelation(inst,&reltype);
607 if (!rel) {
608 FPRINTF(ASCERR,"Relation structure is NULL\n");
609 return 1;
610 }
611 switch (reltype) {
612 case e_blackbox:
613 return CallBlackBox(inst,rel);
614 case e_glassbox:
615 return CallGlassBox(inst,rel);
616 default:
617 FPRINTF(ASCERR,"Invalid relation type in CallExternalProc\n");
618 return 1;
619 }
620 }

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