/[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 804 - (show annotations) (download) (as text)
Fri Aug 4 05:54:34 2006 UTC (13 years, 5 months ago) by johnpye
File MIME type: text/x-csrc
File size: 13026 byte(s)
In slv9, made changes to keep CONOPT from complaining. CMSlv still not working as expected though.
Decreased required version of Bison to 2.0.
Switched search path for CONOPT on Linux to the CONOPT_PATH env var
(LD_LIBRARY_PATH was being interfered with when ASC_DEV=1).
Some other debug message changes.
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 CONSOLE_DEBUG("Searching for external library '%s'",partialname);
133
134 file = SearchArchiveLibraryPath(partialname, ASC_DEFAULTPATH, PATHENVIRONMENTVAR);
135 if(file==NULL){
136 ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"External library '%s' not found.",partialname);
137 return 1;
138 }
139
140 fp1 = ospath_new_from_posix(partialname);
141 stem = ospath_getfilestem(fp1);
142 if(stem==NULL){
143 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"What is the stem of named library '%s'???",partialname);
144 free(stem);
145 ospath_free(fp1);
146 return 1;
147 }
148
149 if(initfunc==NULL){
150 strncpy(auto_initfunc,stem,PATH_MAX);
151 strncat(auto_initfunc,"_register",PATH_MAX-strlen(auto_initfunc));
152 result = Asc_DynamicLoad(file,auto_initfunc);
153 }else{
154 result = Asc_DynamicLoad(file,initfunc);
155 }
156
157 if(result){
158 CONSOLE_DEBUG("FAILED TO LOAD LIBRARY '%s' (error %d)",partialname,result);
159 result = 1;
160 }else{
161 if(initfunc==NULL){
162 CONSOLE_DEBUG("Successfully ran '%s' from dynamic package '%s'",auto_initfunc,file);
163 }else{
164 CONSOLE_DEBUG("Successfully ran '%s' from dynamic package '%s'",initfunc,file);
165 }
166 }
167
168 free(stem);
169 ospath_free(fp1);
170 return result;
171
172 #else
173
174 DISUSED_PARAMETER(name); DISUSED_PARAMETER(initfunc);
175
176 # if defined(STATIC_PACKAGES)
177 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"LoadArchiveLibrary disabled: STATIC_PACKAGES, no need to load dynamically.\n");
178 return 0;
179 # elif defined(NO_PACKAGES)
180 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"LoadArchiveLibrary disabled: NO_PACKAGES");
181 return 1;
182 # else
183 # error "Invalid package linking flags"
184 # endif
185
186 #endif
187 }
188
189 /*---------------------------------------------
190 STATIC_PACKAGES code only...
191
192 Declare the functions which we are expected to be able to call.
193 */
194 #ifndef NO_PACKAGES
195 # ifdef STATIC_PACKAGES
196
197 #include <packages/kvalues.h>
198 #include <packages/bisect.h>
199 #include <packages/sensitivity.h>
200
201 # endif
202 #endif
203
204 #ifdef STATIC_PACKAGES
205 /**
206 Load all statically-linked packages
207
208 @return 0 on success, >0 if any CreateUserFunction calls failed.
209 */
210 static int StaticPackages_Init(void){
211 int result = 0;
212
213 result += sensitivity_register();
214 result += kvalues_register();
215
216 return result;
217 }
218 #endif
219
220 /**
221 This is a general purpose function that will load whatever user
222 functions are required according to the compile-time settings.
223
224 If NO_PACKAGES, nothing will be loaded. If DYNAMIC_PACKAGES, then
225 just the builtin packages will be loaded. If STATIC_PACKAGES then
226 builtin plus those called in 'StaticPackages_Init' will be loaded.
227 */
228 void AddUserFunctions(void)
229 {
230 #ifdef NO_PACKAGES
231 # ifdef __GNUC__
232 # warning "EXTERNAL PACKAGES ARE BEING DISABLED"
233 # endif
234 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"AddUserFunctions disabled at compile-time.");
235 #else
236
237 /* Builtins are always statically linked */
238 if (Builtins_Init()) {
239 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in Builtins_Init: Some user functions not created");
240 }
241
242 # ifdef DYNAMIC_PACKAGES
243 /* do nothing */
244
245 # elif defined(STATIC_PACKAGES)
246 # ifdef __GNUC__
247 # warning "STATIC PACKAGES"
248 # endif
249
250 /*The following need to be reimplemented but are basically useful as is. */
251 if (StaticPackages_Init()) {
252 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Problem in StaticPackages_Init(): Some user functions not created");
253 }
254
255 # endif
256 #endif
257 }
258
259 /*---------------------------------------
260 TESTING FUNCTIONS
261
262 The following functions may be called someone desirous of testing
263 an external relation provided as a package. They are here
264 for convenience, and should be really in a separate file.
265 */
266
267 /**
268 Get the real values of each struct Instance pointed to in the gl_list
269 'arglist' and put it into the 'inputs' array of doubles.
270
271 For example, use this to evaluate the input arguments for a Black Box relation.
272 */
273 static void LoadInputVector(struct gl_list_t *arglist,
274 double *inputs,
275 unsigned ninputs,
276 unsigned long n_input_args
277 ){
278 struct Instance *inst;
279 struct gl_list_t *input_list;
280 unsigned long c,len;
281
282 input_list = LinearizeArgList(arglist,1,n_input_args);
283
284 if(!input_list)return;
285
286 len = gl_length(input_list);
287
288 if(len!=ninputs)return; /* somehow we had inconsistent data */
289
290 for (c=1;c<=len;c++) {
291 inst = (struct Instance *)gl_fetch(input_list,c);
292 inputs[c-1] = RealAtomValue(inst);
293 }
294 gl_destroy(input_list);
295 }
296
297 /**
298 What's a black box, and what's a glass box? -- JP
299 See Abbott thesis. - baa
300 This function is, of course, a mess.
301
302 This seems to be duplicated over in rel.c as ExtRel_Evaluate_RHS.
303 */
304 int CallBlackBox(struct Instance *inst,
305 CONST struct relation *rel)
306 {
307 struct Instance *data;
308
309 struct Slv_Interp slv_interp;
310 struct ExternalFunc *efunc;
311 struct ExtCallNode *ext;
312 struct gl_list_t *arglist;
313 unsigned long n_input_args, n_output_args;
314 int nok = 0;
315
316 unsigned long ninputs, noutputs;
317 double *inputs = NULL, *outputs = NULL;
318 double *jacobian = NULL;
319
320 ExtBBoxInitFunc *init_func;
321 ExtBBoxInitFunc *final_func;
322 ExtBBoxFunc *eval_func;
323 ExtBBoxFunc *deriv_func;
324
325 UNUSED_PARAMETER(inst);
326
327 ext = BlackBoxExtCall(rel);
328 arglist = ExternalCallArgList(ext);
329 data = ExternalCallDataInstance(ext);
330 efunc = ExternalCallExtFunc(ext);
331 init_func = GetInitFunc(efunc);
332 final_func = GetFinalFunc(efunc);
333 eval_func = GetValueFunc(efunc);
334 deriv_func = GetDerivFunc(efunc);
335
336 if (init_func && eval_func) {
337
338 /* set up the interpreter. */
339 Init_Slv_Interp(&slv_interp);
340 /*
341 slv_interp.check_args = (unsigned)1;
342 slv_interp.first_call = (unsigned)1;
343 slv_interp.last_call = (unsigned)0;
344 */
345 slv_interp.nodestamp = ExternalCallNodeStamp(ext);
346 n_input_args = NumberInputArgs(efunc);
347 n_output_args = NumberOutputArgs(efunc);
348 ninputs = CountNumberOfArgs(arglist,1,n_input_args);
349 noutputs = CountNumberOfArgs(arglist,n_input_args + 1,
350 n_input_args+n_output_args);
351
352 /* Create the work vectors. Load the input vector from the instance tree. */
353 inputs = ASC_NEW_ARRAY_CLEAR(double,ninputs);
354 outputs = ASC_NEW_ARRAY_CLEAR(double,ninputs);
355 jacobian = ASC_NEW_ARRAY_CLEAR(double,ninputs*noutputs);
356 LoadInputVector(arglist,inputs,ninputs,n_input_args);
357
358 /*
359 * Call the init function.
360 */
361 slv_interp.task = bb_first_call;
362 nok = (*init_func)(&slv_interp,data,arglist);
363 if (nok) goto error;
364 /*
365 * Call the evaluation function.
366 */
367 slv_interp.task = bb_func_eval;
368 nok = (*eval_func)(&slv_interp,ninputs,noutputs,
369 inputs,outputs,jacobian);
370 if (nok) goto error;
371 /*
372 * Call the derivative routine.
373 */
374 if (deriv_func) {
375 slv_interp.task = bb_deriv_eval;
376 nok = (*deriv_func)(&slv_interp,ninputs,noutputs,
377 inputs,outputs,jacobian);
378 if (nok) goto error;
379 }
380 /*
381 * Call the init function to shut down
382 */
383 if (final_func) {
384 /*
385 slv_interp.first_call = (unsigned)0;
386 slv_interp.last_call = (unsigned)1;
387 */
388 slv_interp.task = bb_last_call;
389 nok = (*final_func)(&slv_interp,data,arglist);
390 if (nok) goto error;
391 }
392 }
393 else{
394 FPRINTF(ASCERR,"External function not loaded\n");
395 return 1;
396 }
397
398 error:
399 if (inputs) ascfree((char *)inputs);
400 if (outputs) ascfree((char *)outputs);
401 if (jacobian) ascfree((char *)outputs);
402 if (nok)
403 return 1;
404 else
405 return 0;
406 }
407
408 /**
409 When glassbox are registered, they must register a pointer
410 to their function jump table. In other words, they must
411 register a pointer to an 'array of pointers to functions'.
412 This typedef just makes life a little cleaner.
413
414 <-- what typedef?? -- JP
415 */
416 int CallGlassBox(struct Instance *relinst, CONST struct relation *rel)
417 {
418 CONST struct gl_list_t *incidence;
419 struct Instance *var;
420 struct ExternalFunc *efunc;
421 int index;
422 long i;
423 double *f, *x, *g;
424 int m,mode,result;
425 int n;
426
427 ExtEvalFunc **evaltable, *eval_func;
428 ExtEvalFunc **derivtable, *deriv_func;
429
430 (void) relinst;
431 incidence = RelationVarList(rel);
432 if (!incidence) {
433 FPRINTF(ASCERR,"Incidence list is empty -- nothing to evaluate\n");
434 return 0;
435 }
436 index = GlassBoxRelIndex(rel);
437 efunc = GlassBoxExtFunc(rel);
438 evaltable = GetValueJumpTable(efunc);
439 eval_func = evaltable[index];
440 derivtable = GetDerivJumpTable(efunc);
441 deriv_func = derivtable[index];
442
443 m = 0; /* FIX not sure what this should be !!! */
444 n = gl_length(incidence);
445 f = ASC_NEW_ARRAY_CLEAR(double,1 + 2*n);
446 x = &f[1];
447 g = &f[n+1];
448
449 for (i=0;i<n;i++) {
450 var = (struct Instance *)gl_fetch(incidence,i+1);
451 x[i] = RealAtomValue(var);
452 }
453 result = (*eval_func)(&mode,&m,&n,x,NULL,f,g);
454 result += (*deriv_func)(&mode,&m,&n,x,NULL,f,g);
455
456 ascfree((char *)f);
457 return result;
458 }
459
460 /**
461 No idea what this does. It's referenced in 'interface.c' only, so it
462 appears to be defunct -- JP
463 */
464 int CallExternalProcs(struct Instance *inst)
465 {
466 CONST struct relation *rel;
467 enum Expr_enum reltype;
468
469 if (inst==NULL){
470 FPRINTF(ASCERR,"Instance does not exist for callprocs\n");
471 return 1;
472 }
473 if (InstanceKind(inst)!=REL_INST){
474 FPRINTF(ASCERR,"Instance is not a relation\n");
475 return 1;
476 }
477 rel = GetInstanceRelation(inst,&reltype);
478 if (!rel) {
479 FPRINTF(ASCERR,"Relation structure is NULL\n");
480 return 1;
481 }
482 switch (reltype) {
483 case e_blackbox:
484 return CallBlackBox(inst,rel);
485 case e_glassbox:
486 return CallGlassBox(inst,rel);
487 default:
488 FPRINTF(ASCERR,"Invalid relation type in CallExternalProc\n");
489 return 1;
490 }
491 }

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