/[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 864 - (show annotations) (download) (as text)
Thu Sep 28 13:39:16 2006 UTC (15 years, 9 months ago) by johnpye
File MIME type: text/x-csrc
File size: 13077 byte(s)
ImportHandler seems to be working, tested with datareader/testtmy.a4c and extfn/testextfn.a4c.
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 <compiler/importhandler.h>
53 #include <utilities/ascPanic.h>
54 #include <general/list.h>
55 #include "symtab.h"
56 #include "fractions.h"
57 #include "dimen.h"
58 #include "functype.h"
59 #include "expr_types.h"
60 #include "extcall.h"
61 #include "mathinst.h"
62 #include "instance_enum.h"
63 #include "instquery.h"
64 #include "atomvalue.h"
65 #include "find.h"
66 #include "relation_type.h"
67 #include "relation.h"
68 #include "safe.h"
69 #include "relation_util.h"
70 #include "extfunc.h"
71 #include <packages/sensitivity.h>
72 #include <packages/ascFreeAllVars.h>
73 #include "module.h"
74 #include "packages.h"
75
76 /*
77 Initialise the slv data structures used when calling external fns
78 */
79 void Init_Slv_Interp(struct Slv_Interp *slv_interp)
80 {
81 if (slv_interp){
82 slv_interp->nodestamp = 0;
83 slv_interp->status = calc_all_ok;
84 slv_interp->user_data = NULL;
85 slv_interp->task = bb_none;
86 /*
87 slv_interp->first_call = (unsigned)0; // gone away
88 slv_interp->last_call = (unsigned)0; // gone away
89 slv_interp->check_args = (unsigned)0; // gone away
90 slv_interp->recalculate = (unsigned)0; // gone away
91 slv_interp->func_eval = (unsigned)0; // gone away
92 slv_interp->deriv_eval = (unsigned)0; // gone away
93 slv_interp->single_step = (unsigned)0; // gone away
94 */
95 }
96 }
97
98 /*---------------------------------------------
99 BUILT-IN PACKAGES...
100 */
101
102 /**
103 Load builtin packages, unless NO_PACKAGES.
104
105 @return 0 if success, 1 if failure.
106 */
107 static
108 int Builtins_Init(void)
109 {
110 int result = 0;
111
112 #ifdef NO_PACKAGES
113 ERROR_REPORTER_HERE(ASC_USER_WARNING,"Builtins_Init: DISABLED at compile-time");
114 #else
115 /* ERROR_REPORTER_DEBUG("Loading function asc_free_all_variables\n"); */
116 result = CreateUserFunctionMethod("asc_free_all_variables",
117 Asc_FreeAllVars,
118 1,
119 "Unset 'fixed' flag of all items of type 'solver_var'");
120 #endif
121 return result;
122 }
123
124 /* return 0 on success */
125 int LoadArchiveLibrary(CONST char *partialpath, CONST char *initfunc){
126
127 #ifdef DYNAMIC_PACKAGES
128 struct FilePath *fp1;
129 int result;
130 struct ImportHandler *handler=NULL;
131
132 /**
133 @TODO
134 * modify SearchArchiveLibraryPath to use the ImportHandler array
135 in each directory in the path.
136 * when a file is found, return information about which ImportHandler
137 should be used to open it, then make the call.
138 */
139
140 CONSOLE_DEBUG("Searching for external library '%s'",partialpath);
141
142 importhandler_createlibrary();
143
144 fp1 = importhandler_findinpath(
145 partialpath, ASC_DEFAULTPATH, PATHENVIRONMENTVAR,&handler
146 );
147 if(fp1==NULL){
148 CONSOLE_DEBUG("External library '%s' not found",partialpath);
149 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"External library '%s' not found.",partialpath);
150 return 1; /* failure */
151 }
152
153 asc_assert(handler!=NULL);
154
155 CONSOLE_DEBUG("About to import external library...");
156 /* note the import handler will deal with all the initfunc execution, etc etc */
157 result = (*(handler->importfn))(fp1,initfunc,partialpath);
158 if(result){
159 CONSOLE_DEBUG("Error %d when importing external library of type '%s'",result,handler->name);
160 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"Error importing external library '%s'",partialpath);
161 ospath_free(fp1);
162 return 1;
163 }
164
165 ospath_free(fp1);
166 return 0;
167 #else
168
169 DISUSED_PARAMETER(name); DISUSED_PARAMETER(initfunc);
170
171 # if defined(STATIC_PACKAGES)
172 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"LoadArchiveLibrary disabled: STATIC_PACKAGES, no need to load dynamically.\n");
173 return 0;
174 # elif defined(NO_PACKAGES)
175 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"LoadArchiveLibrary disabled: NO_PACKAGES");
176 return 1;
177 # else
178 # error "Invalid package linking flags"
179 # endif
180
181 #endif
182 }
183
184 /*---------------------------------------------
185 STATIC_PACKAGES code only...
186
187 Declare the functions which we are expected to be able to call.
188 */
189 #ifndef NO_PACKAGES
190 # ifdef STATIC_PACKAGES
191
192 #include <packages/kvalues.h>
193 #include <packages/bisect.h>
194 #include <packages/sensitivity.h>
195
196 # endif
197 #endif
198
199 #ifdef STATIC_PACKAGES
200 /**
201 Load all statically-linked packages
202
203 @return 0 on success, >0 if any CreateUserFunction calls failed.
204 */
205 static int StaticPackages_Init(void){
206 int result = 0;
207
208 result += sensitivity_register();
209 result += kvalues_register();
210
211 return result;
212 }
213 #endif
214
215 /**
216 This is a general purpose function that will load whatever user
217 functions are required according to the compile-time settings.
218
219 If NO_PACKAGES, nothing will be loaded. If DYNAMIC_PACKAGES, then
220 just the builtin packages will be loaded. If STATIC_PACKAGES then
221 builtin plus those called in 'StaticPackages_Init' will be loaded.
222 */
223 void AddUserFunctions(void)
224 {
225 #ifdef NO_PACKAGES
226 # ifdef __GNUC__
227 # warning "EXTERNAL PACKAGES ARE BEING DISABLED"
228 # endif
229 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"AddUserFunctions disabled at compile-time.");
230 #else
231
232 /* Builtins are always statically linked */
233 if (Builtins_Init()) {
234 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in Builtins_Init: Some user functions not created");
235 }
236
237 # ifdef DYNAMIC_PACKAGES
238 /* do nothing */
239
240 # elif defined(STATIC_PACKAGES)
241 # ifdef __GNUC__
242 # warning "STATIC PACKAGES"
243 # endif
244
245 /*The following need to be reimplemented but are basically useful as is. */
246 if (StaticPackages_Init()) {
247 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in StaticPackages_Init(): Some user functions not created");
248 }
249
250 # endif
251 #endif
252 }
253
254 /*---------------------------------------
255 TESTING FUNCTIONS
256
257 The following functions may be called someone desirous of testing
258 an external relation provided as a package. They are here
259 for convenience, and should be really in a separate file.
260 */
261
262 /**
263 Get the real values of each struct Instance pointed to in the gl_list
264 'arglist' and put it into the 'inputs' array of doubles.
265
266 For example, use this to evaluate the input arguments for a Black Box relation.
267 */
268 static void LoadInputVector(struct gl_list_t *arglist,
269 double *inputs,
270 unsigned ninputs,
271 unsigned long n_input_args
272 ){
273 struct Instance *inst;
274 struct gl_list_t *input_list;
275 unsigned long c,len;
276
277 input_list = LinearizeArgList(arglist,1,n_input_args);
278
279 if(!input_list)return;
280
281 len = gl_length(input_list);
282
283 if(len!=ninputs)return; /* somehow we had inconsistent data */
284
285 for (c=1;c<=len;c++) {
286 inst = (struct Instance *)gl_fetch(input_list,c);
287 inputs[c-1] = RealAtomValue(inst);
288 }
289 gl_destroy(input_list);
290 }
291
292 /**
293 What's a black box, and what's a glass box? -- JP
294 See Abbott thesis. - baa
295 This function is, of course, a mess.
296
297 This seems to be duplicated over in rel.c as ExtRel_Evaluate_RHS.
298 */
299 int CallBlackBox(struct Instance *inst,
300 CONST struct relation *rel)
301 {
302 struct Instance *data;
303
304 struct Slv_Interp slv_interp;
305 struct ExternalFunc *efunc;
306 struct ExtCallNode *ext;
307 struct gl_list_t *arglist;
308 unsigned long n_input_args, n_output_args;
309 int nok = 0;
310
311 unsigned long ninputs, noutputs;
312 double *inputs = NULL, *outputs = NULL;
313 double *jacobian = NULL;
314
315 ExtBBoxInitFunc *init_func;
316 ExtBBoxInitFunc *final_func;
317 ExtBBoxFunc *eval_func;
318 ExtBBoxFunc *deriv_func;
319
320 UNUSED_PARAMETER(inst);
321
322 ext = BlackBoxExtCall(rel);
323 arglist = ExternalCallArgList(ext);
324 data = ExternalCallDataInstance(ext);
325 efunc = ExternalCallExtFunc(ext);
326 init_func = GetInitFunc(efunc);
327 final_func = GetFinalFunc(efunc);
328 eval_func = GetValueFunc(efunc);
329 deriv_func = GetDerivFunc(efunc);
330
331 if (init_func && eval_func) {
332
333 /* set up the interpreter. */
334 Init_Slv_Interp(&slv_interp);
335 /*
336 slv_interp.check_args = (unsigned)1;
337 slv_interp.first_call = (unsigned)1;
338 slv_interp.last_call = (unsigned)0;
339 */
340 slv_interp.nodestamp = ExternalCallNodeStamp(ext);
341 n_input_args = NumberInputArgs(efunc);
342 n_output_args = NumberOutputArgs(efunc);
343 ninputs = CountNumberOfArgs(arglist,1,n_input_args);
344 noutputs = CountNumberOfArgs(arglist,n_input_args + 1,
345 n_input_args+n_output_args);
346
347 /* Create the work vectors. Load the input vector from the instance tree. */
348 inputs = ASC_NEW_ARRAY_CLEAR(double,ninputs);
349 outputs = ASC_NEW_ARRAY_CLEAR(double,ninputs);
350 jacobian = ASC_NEW_ARRAY_CLEAR(double,ninputs*noutputs);
351 LoadInputVector(arglist,inputs,ninputs,n_input_args);
352
353 /*
354 * Call the init function.
355 */
356 slv_interp.task = bb_first_call;
357 nok = (*init_func)(&slv_interp,data,arglist);
358 if (nok) goto error;
359 /*
360 * Call the evaluation function.
361 */
362 slv_interp.task = bb_func_eval;
363 nok = (*eval_func)(&slv_interp,ninputs,noutputs,
364 inputs,outputs,jacobian);
365 if (nok) goto error;
366 /*
367 * Call the derivative routine.
368 */
369 if (deriv_func) {
370 slv_interp.task = bb_deriv_eval;
371 nok = (*deriv_func)(&slv_interp,ninputs,noutputs,
372 inputs,outputs,jacobian);
373 if (nok) goto error;
374 }
375 /*
376 * Call the init function to shut down
377 */
378 if (final_func) {
379 /*
380 slv_interp.first_call = (unsigned)0;
381 slv_interp.last_call = (unsigned)1;
382 */
383 slv_interp.task = bb_last_call;
384 nok = (*final_func)(&slv_interp,data,arglist);
385 if (nok) goto error;
386 }
387 }
388 else{
389 FPRINTF(ASCERR,"External function not loaded\n");
390 return 1;
391 }
392
393 error:
394 if (inputs) ascfree((char *)inputs);
395 if (outputs) ascfree((char *)outputs);
396 if (jacobian) ascfree((char *)outputs);
397 if (nok)
398 return 1;
399 else
400 return 0;
401 }
402
403 /**
404 When glassbox are registered, they must register a pointer
405 to their function jump table. In other words, they must
406 register a pointer to an 'array of pointers to functions'.
407 This typedef just makes life a little cleaner.
408
409 <-- what typedef?? -- JP
410 */
411 int CallGlassBox(struct Instance *relinst, CONST struct relation *rel)
412 {
413 CONST struct gl_list_t *incidence;
414 struct Instance *var;
415 struct ExternalFunc *efunc;
416 int index;
417 long i;
418 double *f, *x, *g;
419 int m,mode,result;
420 int n;
421
422 ExtEvalFunc **evaltable, *eval_func;
423 ExtEvalFunc **derivtable, *deriv_func;
424
425 (void) relinst;
426 incidence = RelationVarList(rel);
427 if (!incidence) {
428 FPRINTF(ASCERR,"Incidence list is empty -- nothing to evaluate\n");
429 return 0;
430 }
431 index = GlassBoxRelIndex(rel);
432 efunc = GlassBoxExtFunc(rel);
433 evaltable = GetValueJumpTable(efunc);
434 eval_func = evaltable[index];
435 derivtable = GetDerivJumpTable(efunc);
436 deriv_func = derivtable[index];
437
438 m = 0; /* FIX not sure what this should be !!! */
439 n = gl_length(incidence);
440 f = ASC_NEW_ARRAY_CLEAR(double,1 + 2*n);
441 x = &f[1];
442 g = &f[n+1];
443
444 for (i=0;i<n;i++) {
445 var = (struct Instance *)gl_fetch(incidence,i+1);
446 x[i] = RealAtomValue(var);
447 }
448 result = (*eval_func)(&mode,&m,&n,x,NULL,f,g);
449 result += (*deriv_func)(&mode,&m,&n,x,NULL,f,g);
450
451 ascfree((char *)f);
452 return result;
453 }
454
455 /**
456 No idea what this does. It's referenced in 'interface.c' only, so it
457 appears to be defunct -- JP
458 */
459 int CallExternalProcs(struct Instance *inst)
460 {
461 CONST struct relation *rel;
462 enum Expr_enum reltype;
463
464 if (inst==NULL){
465 FPRINTF(ASCERR,"Instance does not exist for callprocs\n");
466 return 1;
467 }
468 if (InstanceKind(inst)!=REL_INST){
469 FPRINTF(ASCERR,"Instance is not a relation\n");
470 return 1;
471 }
472 rel = GetInstanceRelation(inst,&reltype);
473 if (!rel) {
474 FPRINTF(ASCERR,"Relation structure is NULL\n");
475 return 1;
476 }
477 switch (reltype) {
478 case e_blackbox:
479 return CallBlackBox(inst,rel);
480 case e_glassbox:
481 return CallGlassBox(inst,rel);
482 default:
483 FPRINTF(ASCERR,"Invalid relation type in CallExternalProc\n");
484 return 1;
485 }
486 }

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