/[ascend]/trunk/base/generic/compiler/extfunc.c
ViewVC logotype

Annotation of /trunk/base/generic/compiler/extfunc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1039 - (hide annotations) (download) (as text)
Thu Jan 4 23:21:20 2007 UTC (13 years, 6 months ago) by johnpye
File MIME type: text/x-csrc
File size: 14889 byte(s)
Fixed up some #includes in compiler .[ch] files.
Switched instantiate.c to using 'asc_assert' instead of 'assert'.
Added some missing GPL headers in C++ code.
Silenced some slv3.c debug output.
Switch void-return to int-return in slv9_presolve etc (slv9.c)
Attemping to fix solvernotes.py for the commandline environment (browser==None)
Removed redundant solve(SELF) in thermalequilibrium2.a4c.
Some error reporting from addone_calc (extfntest.c).
Expanded test size in extrelfor.a4c.
Big rearrangement of bboxtest.c for top-down style.
Fixed TestFreesteam.testintegrator, added end-value checks.

1 aw0a 1 /*
2 johnpye 707 ASCEND modelling environment
3     Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly, Kirk Andre Abbott
4     Copyright (C) 2006 Carnegie Mellon University
5 aw0a 1
6 johnpye 707 This program is free software; you can redistribute it and/or modify
7     it under the terms of the GNU General Public License as published by
8     the Free Software Foundation; either version 2, or (at your option)
9     any later version.
10    
11     This program is distributed in the hope that it will be useful,
12     but WITHOUT ANY WARRANTY; without even the implied warranty of
13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14     GNU General Public License for more details.
15    
16     You should have received a copy of the GNU General Public License
17     along with this program; if not, write to the Free Software
18     Foundation, Inc., 59 Temple Place - Suite 330,
19     Boston, MA 02111-1307, USA.
20     *//*
21     by Kirk Andre Abbott
22     Created: July 4, 1994.
23     Last in CVS: $Revision: 1.8 $ $Date: 1998/02/05 22:23:26 $ $Author: ballan $
24     */
25    
26 johnpye 1039 #include "extfunc.h"
27    
28 johnpye 399 #include <utilities/ascMalloc.h>
29     #include <utilities/ascPanic.h>
30     #include <general/hashpjw.h>
31     #include <general/list.h>
32     #include <general/table.h>
33     #include <general/dstring.h>
34     #include "compiler.h"
35     #include "symtab.h"
36     #include "instance_enum.h"
37 johnpye 700 #include "instance_io.h"
38 johnpye 699 #include "extcall.h"
39 johnpye 710 #include "atomvalue.h"
40 johnpye 1039 #include "rel_blackbox.h"
41 aw0a 1
42 johnpye 697 /*------------------------------------------------------------------------------
43     forward decls and typedefs etc
44     */
45    
46 johnpye 1031 /* make efdebug 1 if you want spew */
47     #define EFDEBUG 0
48    
49 aw0a 1 #define EXTFUNCHASHSIZE 31
50    
51 johnpye 908 static struct Table *g_ExternalFuncLibrary = NULL;
52 aw0a 1
53 johnpye 697 /*-----------------------------------------------------------------------------
54     BLACK BOX STUFF
55     */
56    
57 johnpye 485 int CreateUserFunctionBlackBox(CONST char *name,
58 johnpye 752 ExtBBoxInitFunc *init,
59     ExtBBoxFunc *value,
60     ExtBBoxFunc *deriv,
61     ExtBBoxFunc *deriv2,
62 johnpye 908 ExtBBoxFinalFunc *final,
63 johnpye 752 CONST unsigned long n_inputs,
64     CONST unsigned long n_outputs,
65 johnpye 908 CONST char *help,
66     double inputTolerance
67 johnpye 752 ){
68 ben.allan 467 struct ExternalFunc *efunc;
69     int isNew = 0;
70 johnpye 752 if(name == NULL){
71 ben.allan 467 return 1;
72 jds 101 }
73 ben.allan 467 efunc = LookupExtFunc(name);
74 johnpye 752 if(efunc != NULL){
75 johnpye 728 /* CONSOLE_DEBUG("Found efunc at %p",efunc); */
76 johnpye 737 /* name has already been seen, so now fill in the details */
77 ben.allan 467 isNew = 0;
78 johnpye 710 }else{
79 ben.allan 467 isNew = 1;
80 johnpye 697 efunc = ASC_NEW(struct ExternalFunc);
81 ben.allan 467 asc_assert(efunc!=NULL);
82     efunc->help = NULL;
83     efunc->name = ascstrdup(SCP(AddSymbol(name)));
84 johnpye 728 /* CONSOLE_DEBUG("Created new efunc at %p",efunc); */
85 ben.allan 467 /* add or find name in symbol table */
86     /* the main symtab owns the string */
87     }
88    
89     efunc->etype = efunc_BlackBox;
90     efunc->n_inputs = n_inputs;
91     efunc->n_outputs = n_outputs;
92 johnpye 1031 if (init != NULL) {
93     efunc->u.black.initial = init;
94     } else {
95     efunc->u.black.initial = DefaultExtBBoxInitFunc;
96     }
97 johnpye 1039 if(!value){
98 johnpye 1031 efunc->u.black.value = ErrorExtBBoxValueFunc;
99 johnpye 1039 }else{
100 johnpye 1031 efunc->u.black.value = value;
101     }
102 johnpye 485 efunc->u.black.deriv = deriv;
103 johnpye 1039 if(!deriv){
104     /*
105     this needs to be set to NULL, since we will automatically apply
106     finite difference if a deriv fn has not explicitly been provided.
107     */
108     efunc->u.black.deriv = NULL;
109 johnpye 1031 }
110 johnpye 485 efunc->u.black.deriv2 = deriv2;
111 johnpye 1039 if(!deriv){
112 johnpye 1031 efunc->u.black.deriv2 = DefaultExtBBoxFuncDeriv2FD;
113     }
114 ben.allan 467 efunc->u.black.final = final;
115 johnpye 1039 if(final != NULL){
116 johnpye 1031 efunc->u.black.final = final;
117 johnpye 1039 }else{
118 johnpye 1031 efunc->u.black.final = DefaultExtBBoxFinalFunc;
119     }
120 johnpye 908 efunc->u.black.inputTolerance = inputTolerance;
121 johnpye 1039 if(help){
122 ben.allan 467 if (efunc->help) ascfree((char *)efunc->help);
123     efunc->help = ascstrdup(help);
124 johnpye 752 }else{
125 ben.allan 467 efunc->help = NULL;
126     }
127    
128 johnpye 752 if(isNew){
129 johnpye 888 /* CONSOLE_DEBUG("NEW BLACKBOX EFUNC %p ('%s', %lu inputs, %lu outputs, type=%d, value func=%p)"
130 johnpye 711 ,efunc, name, n_inputs, n_outputs, (int)efunc->etype, value
131 johnpye 888 ); */
132 ben.allan 467 (void)AddExternalFunc(efunc,1);
133     }
134     return 0;
135 aw0a 1 }
136    
137 johnpye 719 ExtBBoxInitFunc * GetInitFunc(struct ExternalFunc *efunc){
138 johnpye 697 asc_assert(efunc!=NULL);
139     /* return (ExtBBoxInitFunc*)efunc->u.black.init; */
140     return efunc->u.black.initial;
141     }
142    
143 johnpye 1039 ExtBBoxFinalFunc * GetFinalFunc(struct ExternalFunc *efunc){
144 johnpye 697 asc_assert(efunc!=NULL);
145     return efunc->u.black.final;
146     }
147    
148 johnpye 719 ExtBBoxFunc *GetValueFunc(struct ExternalFunc *efunc){
149 johnpye 697 asc_assert(efunc!=NULL);
150 johnpye 710 AssertMemory(efunc->etype);
151    
152 johnpye 719 /* CONSOLE_DEBUG("GETVALUEFUNC efunc = %p, type = %d",efunc,(int)efunc->etype); */
153 johnpye 697 asc_assert(efunc->etype == efunc_BlackBox);
154     return efunc->u.black.value;
155     }
156    
157 johnpye 1039 double GetValueFuncTolerance(struct ExternalFunc *efunc){
158 johnpye 908 asc_assert(efunc!=NULL);
159     asc_assert(efunc->etype == efunc_BlackBox);
160     return efunc->u.black.inputTolerance;
161     }
162 johnpye 697
163 johnpye 1039 ExtBBoxFunc *GetDerivFunc(struct ExternalFunc *efunc){
164 johnpye 697 asc_assert(efunc!=NULL);
165     asc_assert(efunc->etype == efunc_BlackBox);
166     return efunc->u.black.deriv;
167     }
168    
169 johnpye 1039 ExtBBoxFunc *GetDeriv2Func(struct ExternalFunc *efunc){
170 johnpye 697 asc_assert(efunc!=NULL);
171     asc_assert(efunc->etype == efunc_BlackBox);
172     return efunc->u.black.deriv2;
173     }
174    
175 johnpye 1031 int DefaultExtBBoxInitFunc(struct BBoxInterp *interp,
176     struct Instance *data,
177 johnpye 1039 struct gl_list_t *arglist
178     ){
179 johnpye 1031 (void)arglist;
180     (void)data;
181     #if EFDEBUG
182 johnpye 1039 CONSOLE_DEBUG("Default do-nothing DefaultExtBBoxInitFunc called.");
183 johnpye 1031 #endif
184     interp->user_data = NULL;
185     return 0;
186     }
187    
188     int ErrorExtBBoxValueFunc(
189     struct BBoxInterp *interp,
190     int ninputs,
191     int noutputs,
192     double *inputs,
193     double *outputs,
194     double *jacobian
195 johnpye 1039 ){
196 johnpye 1031 (void)interp;
197     (void)ninputs;
198     (void)noutputs;
199     (void)inputs;
200     (void)outputs;
201     (void)jacobian;
202 johnpye 1039 CONSOLE_DEBUG("Do-nothing ErrorExtBBoxValueFunc called.\nBlackbox writer is an idiot or memory corrupted.");
203 johnpye 1031 return -1;
204     }
205    
206 johnpye 1039 void DefaultExtBBoxFinalFunc(struct BBoxInterp *interp){
207 johnpye 1031 #if EFDEBUG
208 johnpye 1039 CONSOLE_DEBUG("Default do-nothing DefaultExtBBoxFinalFunc called.");
209 johnpye 1031 #endif
210     (void)interp;
211     }
212    
213     int DefaultExtBBoxFuncDeriv2FD(
214     struct BBoxInterp *interp,
215     int ninputs,
216     int noutputs,
217     double *inputs,
218     double *outputs,
219     double *jacobian
220 johnpye 1039 ){
221 johnpye 1031 #if EFDEBUG
222 johnpye 1039 CONSOLE_DEBUG("Braindead DefaultExtBBoxFuncDeriv2FD called.");
223 johnpye 1031 #endif
224     (void)interp;
225     (void)ninputs;
226     (void)noutputs;
227     (void)inputs;
228     (void)outputs;
229     (void)jacobian;
230    
231     ERROR_REPORTER_HERE(ASC_PROG_WARNING,"2nd partials merely a dream, returning -1");
232     return -1; /* FIXME */
233     }
234    
235 johnpye 697 /*------------------------------------------------------------------------------
236     GLASS BOX STUFF
237     */
238    
239 johnpye 485 int CreateUserFunctionGlassBox(CONST char *name,
240 aw0a 1 ExtEvalFunc *init,
241     ExtEvalFunc **value,
242     ExtEvalFunc **deriv,
243     ExtEvalFunc **deriv2,
244 ben.allan 467 ExtEvalFunc *final,
245 johnpye 62 CONST unsigned long n_inputs,
246     CONST unsigned long n_outputs,
247     CONST char *help)
248 aw0a 1 {
249     struct ExternalFunc *efunc;
250 ben.allan 467 int isNew = 0;
251 jds 101 if (name == NULL) {
252 aw0a 1 return 1;
253 jds 101 }
254 aw0a 1 efunc = LookupExtFunc(name);
255 jds 101 if (efunc != NULL) { /* name was pre-loaded -- just update the info */
256 ben.allan 467 isNew = 0;
257 aw0a 1 } else {
258 ben.allan 467 isNew = 1;
259 johnpye 697 efunc = ASC_NEW(struct ExternalFunc);
260 jds 101 asc_assert(efunc!=NULL);
261 ben.allan 467 efunc->help = NULL;
262     efunc->name = ascstrdup(SCP(AddSymbol(name)));
263     /* add or find name in symbol table */
264     /* the main symtab owns the string */
265     }
266    
267     efunc->etype = efunc_GlassBox;
268     efunc->n_inputs = n_inputs;
269     efunc->n_outputs = n_outputs;
270     efunc->u.glass.initial = init;
271 johnpye 485 efunc->u.glass.value = value;
272     efunc->u.glass.deriv = deriv;
273     efunc->u.glass.deriv2 = deriv2;
274 ben.allan 467 efunc->u.glass.final = final;
275     if (help) {
276     if (efunc->help) ascfree((char *)efunc->help);
277     efunc->help = ascstrdup(help);
278     } else {
279     efunc->help = NULL;
280     }
281    
282     if (isNew) {
283 aw0a 1 (void)AddExternalFunc(efunc,1);
284     }
285     return 0;
286     }
287    
288 johnpye 697
289     /*
290     * GlassBox relations in particular register not just
291     * a single function but rather a pointer to a jump table
292     * of functions. There will be a jump table ptr for each
293     * of value, deriv, deriv2.
294     */
295    
296     /*
297     * The following means:
298     * GetValue is a function that returning pointer to array[] of
299     * pointer to functions, which take args and return an int.
300     *
301     * int (*(*GetValueJumpTable(struct ExternalFunc *efunc))[])(args)
302     */
303    
304     ExtEvalFunc **GetValueJumpTable(struct ExternalFunc *efunc)
305     {
306     asc_assert(efunc!=NULL);
307     asc_assert(efunc->etype == efunc_GlassBox);
308     return efunc->u.glass.value;
309     }
310    
311     ExtEvalFunc **GetDerivJumpTable(struct ExternalFunc *efunc)
312     {
313     asc_assert(efunc!=NULL);
314     asc_assert(efunc->etype == efunc_GlassBox);
315     return efunc->u.glass.deriv;
316     }
317    
318     ExtEvalFunc **GetDeriv2JumpTable(struct ExternalFunc *efunc)
319     {
320     asc_assert(efunc!=NULL);
321     asc_assert(efunc->etype == efunc_GlassBox);
322     return efunc->u.glass.deriv2;
323     }
324    
325     /*------------------------------------------------------------------------------
326     EXTERNAL METHOD STUFF
327     */
328    
329 johnpye 870 int CreateUserFunctionMethod(CONST char *name
330     ,ExtMethodRun *run
331     ,CONST long n_args
332     ,CONST char *help
333     ,void *user_data
334 johnpye 912 ,ExtMethodDestroyFn *destroyfn
335 johnpye 870 ){
336 ben.allan 467 struct ExternalFunc *efunc;
337     int isNew = 1;
338     if (name == NULL) {
339     return 1;
340     }
341     efunc = LookupExtFunc(name);
342 johnpye 485 if (efunc != NULL) {
343 ben.allan 467 isNew = 0;
344     /* name was pre-loaded -- just update the info. This may cause user
345     insanity if it wasn't a reload of the same thing. */
346     } else {
347     isNew = 1;
348 johnpye 697 efunc = ASC_NEW(struct ExternalFunc);
349 ben.allan 467 asc_assert(efunc!=NULL);
350     efunc->help = NULL;
351     efunc->name = ascstrdup(SCP(AddSymbol(name)));
352     /* add or find name in symbol table, and copy because */
353     /* the main symtab owns the string */
354     }
355     efunc->etype = efunc_Method;
356     efunc->n_inputs = n_args;
357     efunc->n_outputs = 0;
358 johnpye 485 efunc->u.method.run = run;
359 johnpye 912
360 johnpye 874 efunc->u.method.user_data = user_data;
361 johnpye 912 efunc->u.method.destroyfn = destroyfn;
362     asc_assert(efunc->u.method.user_data==NULL || efunc->u.method.destroyfn!=NULL);
363    
364 ben.allan 467 if (help) {
365     if (efunc->help) { ascfree((char *)efunc->help); }
366     efunc->help = ascstrdup(help);
367     } else {
368     efunc->help = NULL;
369     }
370    
371     if (isNew ) {
372     (void)AddExternalFunc(efunc,1);
373     }
374     return 0;
375     }
376    
377 johnpye 697
378    
379 johnpye 870 ExtMethodRun *GetExtMethodRun(struct ExternalFunc *efunc){
380 johnpye 697 asc_assert(efunc!=NULL);
381     asc_assert(efunc->etype == efunc_Method);
382     return efunc->u.method.run;
383     }
384    
385 johnpye 870 void *GetExtMethodUserData(struct ExternalFunc *efunc){
386     asc_assert(efunc!=NULL);
387     asc_assert(efunc->etype == efunc_Method);
388     return efunc->u.method.user_data;
389     }
390    
391 johnpye 697 /*------------------------------------------------------------------------------
392     REGISTRATION AND LOOKUP FUNCTIONS
393     */
394    
395 johnpye 710 void DestroyExternalFunc(struct ExternalFunc *efunc){
396 aw0a 1 struct ExternalFunc *tmp;
397 johnpye 710 if(efunc){
398 johnpye 912 CONSOLE_DEBUG("DESTROYING EFUNC at %p",efunc);
399 aw0a 1 tmp = efunc;
400 ben.allan 467 if (tmp->name ) ascfree((char *)(tmp->name)); /* we own the string */
401     if (tmp->help) ascfree((char *)(tmp->help)); /* we own the string */
402     tmp->name = NULL;
403 aw0a 1 tmp->help = NULL;
404 johnpye 912 /* might want to set null pointers here depending on etype. */
405 ben.allan 467 tmp->etype = efunc_ERR;
406 aw0a 1 ascfree((char *)tmp);
407 johnpye 912 if(efunc->etype == efunc_Method){
408     if(efunc->u.method.destroyfn){
409     (*efunc->u.method.destroyfn)(efunc->u.method.user_data);
410     efunc->u.method.user_data = NULL;
411     }
412     asc_assert(efunc->u.method.user_data==NULL);
413     /* if you allocate to user_data, you must provide a method for freeing it! */
414     }
415 aw0a 1 }
416     }
417    
418 johnpye 912 CONST char *ExternalFuncName(CONST struct ExternalFunc *efunc){
419 jds 101 asc_assert(efunc!=NULL);
420 aw0a 1 return efunc->name;
421     }
422    
423 johnpye 912 unsigned long NumberInputArgs(CONST struct ExternalFunc *efunc){
424 jds 101 asc_assert(efunc!=NULL);
425 aw0a 1 return efunc->n_inputs;
426     }
427    
428 johnpye 912 unsigned long NumberOutputArgs(CONST struct ExternalFunc *efunc){
429 jds 101 asc_assert(efunc!=NULL);
430 aw0a 1 return efunc->n_outputs;
431     }
432    
433 johnpye 710 /*------------------------------------------------------------------------------
434     EXTERNALFUNCLIBRARY TABLE-MANAGEMENT ROUTINES
435     */
436 aw0a 1
437     void InitExternalFuncLibrary(void)
438     {
439     struct Table *result;
440     result = CreateTable(EXTFUNCHASHSIZE); /* this isn't destroyed at end. fix.*/
441 johnpye 908 g_ExternalFuncLibrary = result;
442 aw0a 1 }
443    
444    
445 johnpye 710 int AddExternalFunc(struct ExternalFunc *efunc, int force){
446     struct ExternalFunc *found, *tmp;
447     char *name;
448 aw0a 1
449 johnpye 908 asc_assert(efunc!=NULL);
450     name = (char *)efunc->name;
451     found = (struct ExternalFunc *)LookupTableData(g_ExternalFuncLibrary,name);
452     if (found) { /* function name already exists */
453     if (force==0) {
454     return 0;
455     } else { /* need to update information */
456     tmp = (struct ExternalFunc *)RemoveTableData(g_ExternalFuncLibrary,name);
457     DestroyExternalFunc(tmp);
458     AddTableData(g_ExternalFuncLibrary,(void *)efunc,name);
459     return 1;
460     }
461     }
462     else{ /* need to add function to library */
463     AddTableData(g_ExternalFuncLibrary,(void *)efunc,name);
464     return 1;
465     }
466 aw0a 1 }
467    
468 johnpye 710
469 aw0a 1 struct ExternalFunc *LookupExtFunc(CONST char *funcname)
470     {
471     struct ExternalFunc *found;
472     if (!funcname) {
473     return NULL;
474     }
475 johnpye 908 found = (struct ExternalFunc *)
476     LookupTableData(g_ExternalFuncLibrary,funcname);
477 aw0a 1 if (found) {
478 johnpye 728 /* CONSOLE_DEBUG("Found '%s' in ExternalFuncLibrary at %p",funcname,found); */
479 aw0a 1 return found;
480     } else {
481     return NULL; /* name not found */
482     }
483     }
484    
485     struct ExternalFunc *RemoveExternalFunc(char *funcname)
486     {
487     struct ExternalFunc *found;
488     if (!funcname)
489     return NULL;
490     found = (struct ExternalFunc *)
491 johnpye 908 RemoveTableData(g_ExternalFuncLibrary,funcname);
492 aw0a 1 return found;
493     }
494    
495    
496     static
497     void ExternalFuncDestroyFunc(void *efunc)
498     {
499     struct ExternalFunc *local;
500     local = (struct ExternalFunc *)efunc;
501 johnpye 912 if (local){
502 aw0a 1 DestroyExternalFunc(local);
503 johnpye 912 }
504 aw0a 1 }
505    
506     void DestroyExtFuncLibrary(void)
507     {
508 johnpye 908 TableApplyAll(g_ExternalFuncLibrary,
509 aw0a 1 (TableIteratorOne)ExternalFuncDestroyFunc);
510 johnpye 908 DestroyTable(g_ExternalFuncLibrary,0);
511     g_ExternalFuncLibrary = NULL;
512 aw0a 1 }
513    
514     static
515     void PrintExtFuncLibraryFunc(void *efunc, void *fp)
516     {
517     struct ExternalFunc *local_efunc = (struct ExternalFunc *)efunc;
518    
519     if (local_efunc!=NULL) {
520     FPRINTF(fp,"%s\n",ExternalFuncName(local_efunc));
521     if (local_efunc->help) {
522     FPRINTF(fp,"%s\n",local_efunc->help);
523     } else {
524     FPRINTF(fp,"No help information available for this function\n");
525     }
526     }
527     }
528    
529 johnpye 1039 void PrintExtFuncLibrary(FILE *fp){
530     if(!fp){
531     ERROR_REPORTER_HERE(ASC_PROG_ERR,"Invalid file handle in PrintExtFuncLibrary");
532 aw0a 1 return;
533     }
534 johnpye 908 TableApplyAllTwo(g_ExternalFuncLibrary, PrintExtFuncLibraryFunc,
535 aw0a 1 (void *)fp);
536     }
537    
538     static
539     void WriteExtFuncString(struct ExternalFunc *efunc, Asc_DString *dsPtr)
540     {
541     if (efunc!=NULL) {
542     Asc_DStringAppend(dsPtr,"{{",2);
543     Asc_DStringAppend(dsPtr,ExternalFuncName(efunc),-1);
544     Asc_DStringAppend(dsPtr,"} {",3);
545     if (efunc->help!=NULL) {
546     Asc_DStringAppend(dsPtr,efunc->help,-1);
547     } else {
548     Asc_DStringAppend(dsPtr,"No help available.",18);
549     }
550     Asc_DStringAppend(dsPtr,"}} ",3);
551     }
552     }
553    
554     char *WriteExtFuncLibraryString(void)
555     {
556     char *result;
557     Asc_DString ds, *dsPtr;
558     dsPtr = &ds;
559     Asc_DStringInit(dsPtr);
560 johnpye 908 TableApplyAllTwo(g_ExternalFuncLibrary,(TableIteratorTwo)WriteExtFuncString,
561 aw0a 1 (void *) dsPtr);
562     result = Asc_DStringResult(dsPtr);
563     return result;
564     }
565 johnpye 62
566 johnpye 485 void
567 johnpye 62 TraverseExtFuncLibrary(void (*func)(void *,void *), void *secondparam){
568 johnpye 908 TableApplyAllTwo(g_ExternalFuncLibrary, func, secondparam);
569 johnpye 62 }

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