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

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