/[ascend]/trunk/ascend/compiler/bintoken.c
ViewVC logotype

Annotation of /trunk/ascend/compiler/bintoken.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2388 - (hide annotations) (download) (as text)
Tue Feb 15 03:36:18 2011 UTC (13 years ago) by jpye
File MIME type: text/x-csrc
File size: 29094 byte(s)
Added test suite for bintokens, now working correctly in test environment.
1 jpye 2045 /* ASCEND modelling environment
2 jpye 2388 Copyright (C) 2006-2011 Carnegie Mellon University
3 johnpye 1046 Copyright (C) 1998 Carnegie Mellon University
4 aw0a 1
5 johnpye 1046 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     By Benjamin A. Allan
21     Jan 7, 1998.
22     Last in CVS:$Revision: 1.12 $ $Date: 1998/06/16 16:38:36 $ $Author: mthomas $
23     */
24    
25 aw0a 1 #if 0
26     TIMESTAMP = -DTIMESTAMP="\"by `whoami`@`hostname`\""
27     #endif
28     /*
29     * binary tokens implementation for real relation instances.
30     * much of this goes in bintoken.h.
31     */
32    
33 jpye 2388 #include <ascend/utilities/config.h>
34 jpye 1684 #include "bintoken.h"
35    
36 johnpye 1142 #include <unistd.h> /* for getpid() */
37    
38 jpye 2323 #include <ascend/general/platform.h>
39 jpye 2322 #include <ascend/general/ascMalloc.h>
40 jpye 2018 #include <ascend/utilities/ascPrint.h>
41     #include <ascend/utilities/ascSignal.h>
42 jpye 2323 #include <ascend/general/panic.h>
43 jpye 2018 #include <ascend/utilities/ascDynaLoad.h>
44     #include <ascend/general/list.h>
45     #include <ascend/general/dstring.h>
46     #include <ascend/general/pretty.h>
47 johnpye 1210
48 johnpye 399 #include "functype.h"
49 johnpye 669 #include "expr_types.h"
50 johnpye 399 #include "stattypes.h"
51     #include "statio.h"
52     #include "instquery.h"
53     #include "instance_io.h"
54     #include "relation_io.h"
55     #include "find.h"
56 johnpye 908 #include "rel_blackbox.h"
57 johnpye 399 #include "relation.h"
58     #include "relation_util.h"
59     #include "mathinst.h"
60 aw0a 1 /* last */
61 jpye 1684
62 jpye 2045 #include <ascend/bintokens/btprolog.h>
63 aw0a 1
64 jpye 2388 #define BINTOKEN_VERBOSE
65 jpye 2329
66 aw0a 1 #define CLINE(a) FPRINTF(fp,"%s\n",(a))
67    
68     enum bintoken_error {
69     BTE_ok,
70     BTE_badrel,
71     BTE_write,
72     BTE_build,
73     BTE_load,
74     BTE_mem
75     };
76    
77     struct bt_table {
78     enum bintoken_kind type;
79     char *name;
80     union TableUnion *tu;
81     int btable; /* check id */
82 jpye 2045 int refcount; /* total number of relation shares with btable = our number */
83 aw0a 1 int size; /* may be larger than refcount. */
84     };
85    
86     /*
87     * slot to manage all the tables from, especially if we'll do
88     * dynamic unloading.
89     */
90     struct bt_data {
91     struct bt_table *tables;
92     int captables;
93     int nextid;
94     /* loading hooks */
95     union TableUnion *newtable;
96     int newtablesize;
97     char regname[256];
98     /* ui set build options */
99     char *srcname;
100     char *objname;
101     char *libname;
102     char *buildcommand;
103     char *unlinkcommand;
104     unsigned long maxrels; /* no more than this many C relations per file */
105     int verbose; /* comments in generated code */
106     int housekeep; /* if !=0, generated src files are deleted sometimes. */
107 ben.allan 14 } g_bt_data = {NULL,0,0,NULL,0,"ERRARCHIVE",NULL,NULL,NULL,NULL,NULL,1,0,0};
108 aw0a 1
109 johnpye 89 /**
110 jds 101 * In the C++ interface, the arguments of BinTokenSetOptions need to be
111     * const char*. But here, new can lose its constness in *ptr = new. - JP
112 johnpye 89 */
113 aw0a 1 static
114 johnpye 1046 int bt_string_replace(CONST char *new, char **ptr){
115     if(*ptr == new){
116     /* no destination specified */
117 johnpye 190 return 0;
118 aw0a 1 }
119 johnpye 1046 if(new == NULL){
120     /* free the current value */
121     if(*ptr != NULL) {
122     ASC_FREE(*ptr);
123 aw0a 1 *ptr = NULL;
124     }
125 johnpye 1046 }else{
126     /* free then reallocate */
127     if(*ptr != NULL){
128     ASC_FREE(*ptr);
129 aw0a 1 }
130 johnpye 1046 *ptr = ASC_NEW_ARRAY(char,strlen(new)+1);
131     strcpy(*ptr,new);
132 aw0a 1 }
133     return 0;
134     }
135 jds 101
136 aw0a 1 /*
137     * Set the configurations for building code.
138     * The string arguments given are kept.
139     * They are freed on the next call which specifies a new string or NULL.
140 ben.allan 45 * strings given should not be allocated from tcl.
141 aw0a 1 */
142 johnpye 62 int BinTokenSetOptions(CONST char *srcname,
143     CONST char *objname,
144     CONST char *libname,
145     CONST char *buildcommand,
146     CONST char *unlinkcommand,
147 aw0a 1 unsigned long maxrels,
148     int verbose,
149     int housekeep)
150     {
151 jpye 2183 /*CONSOLE_DEBUG("...");*/
152 aw0a 1 int err = 0;
153     err += bt_string_replace(srcname,&(g_bt_data.srcname));
154     err += bt_string_replace(objname,&(g_bt_data.objname));
155     err += bt_string_replace(libname,&(g_bt_data.libname));
156     err += bt_string_replace(buildcommand,&(g_bt_data.buildcommand));
157     err += bt_string_replace(unlinkcommand,&(g_bt_data.unlinkcommand));
158     g_bt_data.maxrels = maxrels;
159     g_bt_data.verbose = verbose;
160     g_bt_data.housekeep = housekeep;
161     return err;
162     }
163    
164    
165     /*
166     * grows the table when need be.
167     * note that nextid is the current number of possibly real
168     * entries in the table and we need to insure that nextid+1
169     * exists because we are running this table from 1 instead of 0.
170     */
171     static
172     int BinTokenCheckCapacity()
173     {
174     if (g_bt_data.tables == NULL) {
175     assert(g_bt_data.captables == 0);
176     g_bt_data.tables =
177 johnpye 708 ASC_NEW_ARRAY(struct bt_table,20);
178 aw0a 1 assert(g_bt_data.tables != NULL);
179     g_bt_data.captables = 20;
180     return 0;
181     }
182     if (g_bt_data.nextid >= g_bt_data.captables) {
183     g_bt_data.tables = (struct bt_table *)ascrealloc(g_bt_data.tables,
184     2*sizeof(struct bt_table)*g_bt_data.captables);
185     assert(g_bt_data.tables != NULL);
186     g_bt_data.captables *= 2;
187     }
188     return 0;
189     }
190    
191     /*
192 johnpye 1046 frees global memory.
193     */
194 aw0a 1 void BinTokenClearTables(void)
195     {
196     if (g_bt_data.tables != NULL) {
197 johnpye 1046 ASC_FREE(g_bt_data.tables);
198 aw0a 1 g_bt_data.tables = NULL;
199     }
200     g_bt_data.captables = 0;
201     g_bt_data.nextid = 0;
202     BinTokenSetOptions(NULL,NULL,NULL,NULL,NULL,1,0,0);
203     }
204    
205     /*
206     * when all the references expire, unload the library.
207     * note there is no AddReference since all the references
208     * are made 1 per share at load time.
209     */
210     void BinTokenDeleteReference(int btable)
211     {
212     if (btable < 0 || btable > g_bt_data.nextid ||
213     g_bt_data.tables[btable].type == BT_error) {
214     return;
215     /* relation references a loadfailure library or already deleted
216     * or corrupted memory has made its way here.
217     */
218     }
219     g_bt_data.tables[btable].refcount--;
220     if (g_bt_data.tables[btable].refcount == 0) {
221     /* unload the library if possible here */
222     #if HAVE_DL_UNLOAD
223 johnpye 190 /*ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"UNLOADING %s",g_bt_data.tables[btable].name);*/
224 aw0a 1 Asc_DynamicUnLoad(g_bt_data.tables[btable].name);
225 johnpye 159 #else
226 johnpye 190 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"Dynamic Unloading not available in this build");
227 aw0a 1 #endif /* havedlunload */
228 johnpye 1046 ASC_FREE(g_bt_data.tables[btable].name);
229 aw0a 1 g_bt_data.tables[btable].name = NULL;
230     g_bt_data.tables[btable].tu = NULL;
231     g_bt_data.tables[btable].type = BT_error;
232 johnpye 159 }else{
233     CONSOLE_DEBUG("Deleting one reference...");
234 aw0a 1 }
235     }
236    
237    
238     /*
239     * submodule for reducing string form of equations to uniqueness.
240     * This portion is independent of the generated language.
241     * Ben Allan, 2/98.
242     */
243    
244     struct bintoken_unique_eqn {
245     int indexU; /* Unique function index of this string */
246     int firstrel; /* index of first relation to have this string.
247     * this can give us a relation list index to refer
248     * to for generating unique gradient code, rather than
249     * differentiating all the eqns in the formal rellist.
250     */
251     int refcount;
252     int len; /* strlen of the string form */
253     /* int-sized hole here on long pointer machines intentional */
254     char *str; /* common string form of the eqn */
255     };
256    
257     struct bintoken_eqlist {
258     struct gl_list_t *ue; /* list of unique eqn code strings */
259     int *rel2U;
260     /* array indexed by relindex, giving the corresponding
261     * unique equation indexU.
262     */
263     int nextnew; /* starts at 0. index of the next new unique. */
264     };
265    
266    
267     /* return 1 if error, 0 if ok */
268     static
269     int InitEQData(struct bintoken_eqlist *eql, int len)
270     {
271     eql->nextnew = 0;
272     eql->ue = gl_create(len);
273     if (eql->ue == NULL) {
274     return 1;
275     }
276 johnpye 709 eql->rel2U = ASC_NEW_ARRAY(int,len+1);
277 aw0a 1 if (eql->rel2U == NULL) {
278     gl_destroy( eql->ue );
279     return 1;
280     }
281     return 0;
282     }
283    
284     static
285     void DestroyEQData(struct bintoken_eqlist *eql)
286     {
287     struct bintoken_unique_eqn *u;
288     unsigned long c;
289     for (c=gl_length(eql->ue); c > 0; c--) {
290     u = (struct bintoken_unique_eqn *)gl_fetch(eql->ue,c);
291     if (u != NULL) {
292     if (u->str != NULL) {
293 johnpye 1046 ASC_FREE(u->str);
294 aw0a 1 }
295 johnpye 1046 ASC_FREE(u);
296 aw0a 1 }
297     }
298     gl_destroy(eql->ue);
299 johnpye 1046 ASC_FREE(eql->rel2U);
300 aw0a 1 }
301    
302     /*
303     * This function compares first on string len, secondarily on
304     * str content. knownas is not considered. This function can be
305     * used to search a gl_list of existing unique_eqns to figure
306     * out whether to add a new one or simply extend an existing ones
307     * knownas list.
308     */
309     static
310     int CmpUniqueEqn(struct bintoken_unique_eqn *u1, struct bintoken_unique_eqn *u2)
311     {
312     assert(u1!=NULL);
313     assert(u2!=NULL);
314     assert(u1->len!=0);
315     assert(u2->len!=0);
316     assert(u1->str!=NULL);
317     assert(u2->str!=NULL);
318     if (u1==u2) {
319     /* should never, ever happen */
320     return 0;
321     }
322     if (u1->len != u2->len) {
323     /* I don't know whether this sorts increasing or decreasing len.
324     * not that it really matters. we're sorting on len first to avoid
325     * strcmp calls.
326     */
327     if (u1->len < u2->len) {
328     return -1;
329     } else {
330     return 1;
331     }
332     }
333     return strcmp(u1->str,u2->str);
334     }
335    
336     /*
337     * Finds or inserts a unique eqn in the list eql.
338     * Records the unique index U in eql->rel2U[relindex].
339     * Returns 1 if added a record to eql referencing str.
340     * Returns 0 if str already exists in eql somewhere.
341     * len is the length of str.
342     * relindex is the index of the instance the string
343     * came from in some instance list.
344     */
345     static
346     int BinTokenAddUniqueEqn(struct bintoken_eqlist *eql, int relindex,
347     char *str, int len)
348     {
349     struct bintoken_unique_eqn test, *new, *old;
350     unsigned long pos;
351     assert(eql != NULL);
352     assert(relindex >= 0);
353     assert(str != NULL);
354    
355     test.len = len;
356     test.str = str;
357     pos = gl_search(eql->ue,&test,(CmpFunc)CmpUniqueEqn);
358     if (!pos) {
359     /* create new unique eqn */
360 johnpye 709 new = ASC_NEW(struct bintoken_unique_eqn);
361 aw0a 1 assert(new!=NULL);
362     new->len = test.len;
363     new->firstrel = relindex;
364     new->refcount = 1;
365     eql->rel2U[relindex] = eql->nextnew;
366     new->indexU = (eql->nextnew)++;
367     new->str = str; /* keep string */
368     gl_insert_sorted(eql->ue,new,(CmpFunc)CmpUniqueEqn);
369     return 1;
370     } else {
371     /* saw it already */
372     old = (struct bintoken_unique_eqn *)gl_fetch(eql->ue,pos);
373     old->refcount++;
374     eql->rel2U[relindex] = old->indexU;
375     return 0;
376     }
377     }
378    
379     /*
380     * C code specific stuff
381     */
382    
383     /*
384     * includes the standard headers and any supporting functions
385     * we may require.
386     */
387     static
388     void WritePrologue(FILE *fp, struct Instance *root,
389     unsigned long len, int verbose)
390     {
391     if (verbose) {
392 jpye 2388 CLINE("/*\n\tAuto-generated code from" __FILE__);
393 johnpye 154 FPRINTF(fp,"\t%lu relations in instance '",len);
394 aw0a 1 WriteInstanceName(fp,root,NULL);
395 johnpye 154 CLINE("'\n\t(possibly fewer C functions required)\n*/");
396 aw0a 1 }
397     #ifdef HAVE_ERF
398     /* need to define this for btprolog.h to do the right thing */
399     CLINE("#define HAVE_ERF");
400     #endif
401 johnpye 122
402 jpye 2045 CLINE("#include <ascend/bintokens/btprolog.h>");
403 aw0a 1 }
404    
405     /* this function should be generalized or duplicated to
406     * handle other languages. It's almost there now.
407     */
408     static
409     enum bintoken_error GetResidualString(struct Instance *i,
410     int nrel,
411     struct RXNameData *rd,
412     enum rel_lang_format lang,
413     int *rellen,
414     char **streqn)
415     {
416     assert(i!=NULL);
417     assert(InstanceKind(i)==REL_INST);
418    
419     *streqn = WriteRelationString(i,NULL,(WRSNameFunc)RelationVarXName,
420     rd,lang,rellen);
421     if (*streqn==NULL) {
422     FPRINTF(ASCERR,"Unable to generate code for (%d):\n",nrel);
423     WriteAnyInstanceName(ASCERR,i);
424     return BTE_badrel;
425     }
426     return BTE_ok;
427     }
428    
429     /* this function should be generalized or duplicated to
430     * handle other languages. Should be ok for most C-like languages.
431     * Writes K&R C.
432     */
433     static
434     enum bintoken_error WriteResidualCode(FILE *fp, struct Instance *i,
435     int nrel, int verbose,
436     char *streqn, int timesused)
437     {
438     #define C_INDENT 4
439     #define C_WIDTH 70
440     assert(i!=NULL);
441    
442     if (streqn==NULL) {
443     return BTE_badrel;
444     }
445    
446     if (verbose) {
447     /* put in a little header */
448     CLINE("\n/*");
449 johnpye 89 FPRINTF(fp,"\tRelation used %d times, prototyped from:\n",timesused);
450     FPRINTF(fp,"\t");
451 aw0a 1 /* Use fastest path to a root */
452     WriteAnyInstanceName(fp,i);
453 johnpye 89 CLINE("\n*/");
454 aw0a 1 }
455    
456     CLINE("static");
457 johnpye 95 FPRINTF(fp, "void r_%d(double *x,double *residual){\n", nrel);
458 johnpye 89 CLINE("\t*residual =");
459 aw0a 1 #define FMTNORMAL 1
460     #if FMTNORMAL
461     print_long_string(fp,streqn,C_WIDTH,C_INDENT); /* human readable, sort of */
462     #else
463     FPRINTF(fp,"%s",streqn); /* all on one ugly long line */
464     #endif
465    
466     if (verbose) {
467     FPRINTF(fp, " ; /* eqn %d */\n", nrel);
468     } else {
469     CLINE(" ;");
470     }
471 jpye 2388 #ifdef BINTOKEN_VERBOSE
472     FPRINTF(fp," fprintf(stderr,\"%%s:%%d: residual for '%%s' is %%f.\\n\", __FILE__, __LINE__, \"");
473     WriteAnyInstanceName(fp,i);
474     FPRINTF(fp,"\", *residual);\n");
475     #endif
476 aw0a 1 CLINE("}");
477     return BTE_ok;
478     }
479    
480     /*
481     * t is the array of function pointers. size is number or
482     * relations represented +1 since element 0 is {NULL,NULL}
483     * by convention.
484     */
485 johnpye 485 int ExportBinTokenCTable(struct TableC *t,int size){
486 aw0a 1 if (g_bt_data.newtable != NULL || t == NULL || size < 1) {
487     return 1;
488     }
489     g_bt_data.newtable = (union TableUnion *)t;
490     g_bt_data.newtablesize = size;
491     return 0;
492     }
493    
494     struct reusable_rxnd {
495     struct RXNameData rd;
496     unsigned long cap;
497     };
498    
499     /*
500     * puts an index list in r->rd which is just the shift by 1
501     * so r->rd.indices[j+1] == j.
502     */
503     static
504     void ResizeIndices(struct Instance *rel, struct reusable_rxnd *r)
505     {
506     unsigned long newlen,j;
507     assert(r!=NULL);
508    
509     /* free and return if NULL rel */
510     if (rel == NULL) {
511     if (r->rd.indices != NULL) {
512 johnpye 1046 ASC_FREE(r->rd.indices);
513 aw0a 1 r->rd.indices = NULL;
514     r->cap = 0;
515     }
516     return;
517     }
518    
519     /* get desired size */
520     newlen = NumberVariables(GetInstanceRelationOnly(rel));
521     newlen++; /* gotta remember to allow for indexing from 1 */
522    
523     /* skip out if we have it already */
524     if (newlen <= r->cap) {
525     return;
526     }
527    
528     if (r->rd.indices != NULL) {
529     /* assume we'll grow again and try not to do it often */
530 johnpye 1046 ASC_FREE(r->rd.indices);
531 aw0a 1 r->rd.indices = NULL;
532     newlen *= 2;
533     }
534     /* require min */
535     if (newlen < 100) {
536     newlen = 100;
537     }
538     /* create mem_*/
539 johnpye 669 r->rd.indices = ASC_NEW_ARRAY(int,newlen);
540 aw0a 1 if (r->rd.indices == NULL) {
541 johnpye 1064 ASC_PANIC("out of memory error");
542 aw0a 1 exit(2);
543     }
544     /* set up one-less indices */
545     for (j = 0; j < newlen; j++) {
546     r->rd.indices[j] = (int)j - 1;
547     }
548     r->cap = newlen;
549     }
550    
551     /*
552     * generate code for a table of function pointers and the function
553     * pointers also in an archive load function.
554     * The table is always 1 pair larger than rellist since by convention
555     * index 0 has the NULL functions.
556     */
557     static
558     enum bintoken_error BinTokenSharesToC(struct Instance *root,
559     struct gl_list_t *rellist,
560     char *srcname,
561     int verbose)
562     {
563     int *error;
564     FILE *fp;
565     struct Instance *i;
566     char *str;
567     int slen;
568     struct bintoken_unique_eqn *eqn;
569     struct bintoken_eqlist eql;
570     unsigned long c, len;
571     int pid;
572     int eqns_done;
573     struct reusable_rxnd rrd = {{"x[",NULL,"]"},0};
574    
575     if (root == NULL || rellist == NULL) {
576     return BTE_ok;
577     }
578     len = gl_length(rellist);
579     if (!len) {
580     return BTE_ok;
581     }
582     fp = fopen(srcname,"w+");
583     if (fp == NULL) {
584     return BTE_write;
585     }
586     eqns_done = 0;
587 johnpye 669 error = ASC_NEW_ARRAY(int,len);
588 aw0a 1 WritePrologue(fp,root,len,verbose);
589    
590     /* algorithm to collect eqns:
591     * (at the cost of more string memory, since we keep unique strings while
592     * determining minimum set of C functions to write).
593     * Really, the instantiator could be taking steps to make this less necesssary,
594     * but even then the compiler will miss some similarities arising from
595     * different Statements.
596     */
597    
598     if (InitEQData(&eql,(int)len)!= 0) {
599     fclose(fp);
600     return BTE_mem;
601     }
602    
603     /* get unique set of code strings. */
604     for (c=1; c <= len; c++) {
605     i = gl_fetch(rellist,c);
606     /* make space and configure for subscript translation from 1 to 0 */
607     ResizeIndices(i,&rrd);
608     error[c-1] = GetResidualString(i,(int)c,&(rrd.rd),relio_C,&slen,&str);
609     if (error[c-1] == BTE_ok) {
610     eqns_done++;
611     if (BinTokenAddUniqueEqn(&eql,(int)c,str,slen) == 0) {
612 johnpye 1046 ASC_FREE(str);
613 aw0a 1 } /* else string is kept in eql and killed later */
614     }
615     /* else { eql.rel2U[c] = -1; } needed? */
616     }
617     ResizeIndices(NULL,&rrd);
618     if (!eqns_done) {
619     /* no generable code. clean up and leave. */
620     fclose(fp);
621     DestroyEQData(&eql);
622     return BTE_badrel;
623     }
624     for (c = gl_length(eql.ue); c > 0; c--) {
625     eqn = (struct bintoken_unique_eqn *)gl_fetch(eql.ue,c);
626     i = gl_fetch(rellist,eqn->firstrel);
627     WriteResidualCode(fp,i,eqn->indexU,verbose,eqn->str,eqn->refcount);
628     /* here we could also write gradient code based on i, indexU. */
629     }
630     /* write the registered function name */
631     pid = getpid();
632 johnpye 89 /** @TODO FIXME win32 has getpid but it is bogus as uniquifier. */
633 aw0a 1 /* so long as makefile deletes previous dll, windows is ok though */
634     sprintf(g_bt_data.regname,"BinTokenArch_%d_%d",++(g_bt_data.nextid),(int)pid);
635 jpye 2388 FPRINTF(fp,"\n\nint ASC_EXPORT %s(){\n",g_bt_data.regname);
636 johnpye 89 CLINE("\tint status;");
637     FPRINTF(fp,"\tstatic struct TableC g_ctable[%lu] =\n",len+1);
638     CLINE("\t\t{ {NULL, NULL},");
639 aw0a 1 len--; /* to fudge the final comma */
640     for (c=1; c <= len; c++) {
641     if (error[c-1] == BTE_ok) {
642 johnpye 89 FPRINTF(fp,"\t\t\t{r_%u, NULL},\n",eql.rel2U[c]);
643 aw0a 1 } else {
644 johnpye 89 FPRINTF(fp,"\t\t\t{NULL, NULL},\n");
645 aw0a 1 }
646     }
647     len++;
648     if (error[len-1] == BTE_ok) {
649 johnpye 89 FPRINTF(fp,"\t\t\t{r_%u, NULL}\n",eql.rel2U[c]);
650 aw0a 1 } else {
651 johnpye 89 FPRINTF(fp,"\t\t\t{NULL, NULL}\n");
652 aw0a 1 }
653 johnpye 89 CLINE("\t\t};");
654     FPRINTF(fp,"\tstatus = ExportBinTokenCTable(g_ctable,%lu);\n",len+1);
655     CLINE("\treturn status;");
656 aw0a 1 if (verbose) {
657 johnpye 89 FPRINTF(fp,"\t/* %lu unique equations */\n",gl_length(eql.ue));
658 johnpye 154 FPRINTF(ASCERR,"Prepared %lu external C functions.\n",gl_length(eql.ue));
659 aw0a 1 }
660     CLINE("}");
661    
662 johnpye 1046 ASC_FREE(error);
663 aw0a 1 DestroyEQData(&eql);
664     fclose(fp);
665     return BTE_ok;
666     }
667    
668     static
669     enum bintoken_error BinTokenCompileC(char *buildcommand)
670     {
671     int status;
672 johnpye 190 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"Starting build, command:\n%s\n",buildcommand);
673 aw0a 1 status = system(buildcommand);
674     if (status) {
675 jpye 2388 CONSOLE_DEBUG("BUILD returned %d",status);
676 aw0a 1 return BTE_build;
677     }
678 jpye 2388 #ifdef BINTOKEN_VERBOSE
679     CONSOLE_DEBUG("Build command returned OK, status=%d",status);
680     #endif
681 aw0a 1 return BTE_ok;
682     }
683    
684     static
685     void BinTokenResetHooks()
686     {
687     g_bt_data.tables[g_bt_data.nextid].type = BT_error;
688     g_bt_data.newtable = NULL;
689     g_bt_data.newtablesize = 0;
690     }
691    
692     static
693     void BinTokenHookToTable(int entry, enum bintoken_kind type)
694     {
695     g_bt_data.tables[entry].tu = g_bt_data.newtable;
696     g_bt_data.tables[entry].size = g_bt_data.newtablesize;
697     g_bt_data.tables[entry].btable = entry;
698     g_bt_data.tables[entry].type = type;
699     g_bt_data.newtable = NULL;
700     g_bt_data.newtablesize = 0;
701     }
702    
703     static
704     enum bintoken_error BinTokenLoadC(struct gl_list_t *rellist,
705     char *libname,
706     char *regname)
707     {
708     int status;
709     unsigned long c,len;
710     BinTokenCheckCapacity();
711     status = Asc_DynamicLoad(libname,regname);
712     if (status != 0) {
713 johnpye 159 error_reporter(ASC_PROG_WARNING,libname,0,"Failed to load library (init function %s)",regname);
714 aw0a 1 BinTokenResetHooks();
715     /* could do this maybe, but not needed if we want each
716     * relation to get one shot only..
717     * for (c=1;c <= len; c++) {
718     * RelationSetBinTokens((struct Instance *)gl_fetch(rellist,c),
719     * g_bt_data.nextid,(int)c);
720     * }
721     */
722     return BTE_load;
723     }
724     BinTokenHookToTable(g_bt_data.nextid,BT_C);
725     len = gl_length(rellist);
726     for (c=1;c <= len; c++) {
727     RelationSetBinTokens((struct Instance *)gl_fetch(rellist,c),
728     g_bt_data.nextid,(int)c);
729     }
730     g_bt_data.tables[g_bt_data.nextid].refcount = (int)len;
731 johnpye 1219 g_bt_data.tables[g_bt_data.nextid].name = ASC_STRDUP(libname);
732 aw0a 1 return BTE_ok;
733     }
734    
735     /*
736     * this function should be more helpful.
737     */
738     static
739     void BinTokenErrorMessage(enum bintoken_error err,
740     struct Instance *root,
741     char *filename,
742     char *buildcommand)
743     {
744     char *mess;
745    
746     (void)root;
747     (void)buildcommand;
748    
749     switch(err) {
750     case BTE_ok:
751     mess="A-ok";
752     break;
753     case BTE_badrel:
754     mess="Bad relation found in code generation";
755     break;
756     case BTE_write:
757     mess="Unable to write file";
758     break;
759     case BTE_build:
760     mess="Unable to build binary";
761     break;
762     case BTE_load:
763     mess="Loaded binary does not match code written";
764     break;
765     case BTE_mem:
766     mess="Insufficient memory to write code.";
767     break;
768     default:
769     mess="Unknown error in BinTokenErrorMessage";
770     break;
771     }
772 johnpye 159 error_reporter(ASC_PROG_ERR,filename,0,"%s",mess);
773 aw0a 1 }
774    
775 johnpye 1046 void BinTokensCreate(struct Instance *root, enum bintoken_kind method){
776 aw0a 1 struct gl_list_t *rellist;
777     char *cbuf;
778     enum bintoken_error status;
779     char *srcname = g_bt_data.srcname;
780     char *objname = g_bt_data.objname;
781     char *libname = g_bt_data.libname;
782     char *buildcommand = g_bt_data.buildcommand;
783     char *unlinkcommand = g_bt_data.unlinkcommand;
784     int verbose = g_bt_data.verbose;
785    
786 jpye 2183 /*CONSOLE_DEBUG("...");*/
787 jpye 2045
788 aw0a 1 if (g_bt_data.maxrels == 0) {
789 jpye 2329 #ifdef BINTOKEN_VERBOSE
790 johnpye 1317 ERROR_REPORTER_HERE(ASC_PROG_NOTE,"BinTokensCreate disabled (maxrels=0)\n");
791 jpye 2329 #endif
792 aw0a 1 return;
793     }
794     if (srcname == NULL || buildcommand == NULL || unlinkcommand == NULL) {
795 jpye 2388 #if 0
796 johnpye 1035 ERROR_REPORTER_HERE(ASC_PROG_WARNING,"BinaryTokensCreate called with no options set: ignoring");
797 jpye 2332 #endif
798 aw0a 1 return;
799 johnpye 399 }
800 aw0a 1
801     rellist =
802     CollectTokenRelationsWithUniqueBINlessShares(root,g_bt_data.maxrels);
803     if (rellist==NULL) {
804 johnpye 737 ERROR_REPORTER_HERE(ASC_PROG_WARNING
805     ,"BinaryTokensCreate found 0 or too many unique relations."
806     );
807 aw0a 1 return;
808     }
809    
810 jpye 2045 ERROR_REPORTER_HERE(ASC_USER_NOTE,"Creating bintokens\n");
811     CONSOLE_DEBUG("buildcommand = %s",buildcommand);
812 johnpye 1046
813 aw0a 1 switch (method) {
814     case BT_C:
815     /* generate code */
816     status = BinTokenSharesToC(root,rellist,srcname,verbose);
817     if (status != BTE_ok) {
818     BinTokenErrorMessage(status,root,srcname,buildcommand);
819     break; /* leave source file there if partial */
820     }
821     status = BinTokenCompileC(buildcommand);
822     if (status != BTE_ok) {
823     BinTokenErrorMessage(status,root,objname,buildcommand);
824     break; /* leave source file there to debug */
825     } else {
826     if (g_bt_data.housekeep) {
827     /* trash src */
828 johnpye 709 cbuf = ASC_NEW_ARRAY(char,strlen(unlinkcommand)+1+strlen(srcname)+1);
829 aw0a 1 assert(cbuf!=NULL);
830     sprintf(cbuf,"%s %s",unlinkcommand,srcname);
831     system(cbuf); /* we don't care if the delete fails */
832 johnpye 1046 ASC_FREE(cbuf);
833 aw0a 1 /* trash obj */
834 johnpye 709 cbuf = ASC_NEW_ARRAY(char,strlen(unlinkcommand)+1+strlen(objname)+1);
835 aw0a 1 assert(cbuf!=NULL);
836     sprintf(cbuf,"%s %s",unlinkcommand,objname);
837     system(cbuf); /* we don't care if the delete fails */
838 johnpye 1046 ASC_FREE(cbuf);
839 aw0a 1 }
840 johnpye 190
841 johnpye 62 status = BinTokenLoadC(rellist,libname,g_bt_data.regname);
842     if (status != BTE_ok) {
843     BinTokenErrorMessage(status,root,libname,buildcommand);
844     /* leave source,binary files there to debug */
845 johnpye 76 }/*else{
846 johnpye 62 FPRINTF(ASCERR,"BINTOKENLOADC OK\n");
847 johnpye 76 }*/
848 aw0a 1 }
849     break;
850     default:
851 johnpye 1046 ERROR_REPORTER_HERE(ASC_PROG_ERR,"BinaryTokensCreate called with unavailable method '%d'",(int)method);
852 aw0a 1 break;
853     }
854     gl_destroy(rellist);
855     return;
856     }
857    
858     /*
859     * Returns 1 if can't evaluate function.
860     * Vars is assumed already filled with values.
861     * This function must not malloc or free memory.
862     */
863     int BinTokenCalcResidual(int btable, int bindex, double *vars, double *residual)
864     {
865     if (btable < 1 || bindex < 1) {
866     return 1;
867     }
868     switch (g_bt_data.tables[btable].type) {
869     case BT_error:
870     return 1; /* expired table! */
871     case BT_C: {
872     struct TableC *ctable;
873     BinTokenFPtr func;
874     ctable = (struct TableC *)g_bt_data.tables[btable].tu;
875     assert(ctable != NULL);
876     if (bindex > g_bt_data.tables[btable].size) {
877     return 1;
878     }
879     func = ctable[bindex].F;
880     #if 0 /* setting this to 1 is a major performance hit. */
881     if (func != NULL) {
882 johnpye 997 if (SETJMP(g_fpe_env)==0) {
883 aw0a 1 (*func)(vars,residual);
884     return 0;
885     } else {
886     Asc_SignalRecover();
887     return 1;
888     }
889     }
890     return 1;
891     #else
892     (*func)(vars,residual);
893     return 0;
894     #endif
895     }
896     case BT_F77: {
897     /* this case needs to be cleaned up to match the C case above. */
898     struct TableF *ftable;
899     BinTokenSPtr subroutine;
900     ftable = (struct TableF *)g_bt_data.tables[btable].tu;
901     assert(ftable != NULL);
902     if (bindex < 1 || bindex > g_bt_data.tables[btable].size) {
903     return 1;
904     }
905     subroutine = ftable[0].S; /* its all in func 0 */
906     if (subroutine != NULL) {
907     int ForG,status;
908     ForG = BinTokenRESIDUAL;
909 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
910 aw0a 1 Asc_SignalHandlerPush(SIGFPE,Asc_SignalTrap);
911 johnpye 997 if (SETJMP(g_fpe_env)==0) {
912 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
913 aw0a 1 (*subroutine)(vars,NULL,residual,&ForG,&bindex,&status);
914 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
915 aw0a 1 Asc_SignalHandlerPop(SIGFPE,Asc_SignalTrap);
916 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
917 aw0a 1 return status;
918 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
919 aw0a 1 } else {
920     Asc_SignalHandlerPop(SIGFPE,Asc_SignalTrap);
921     return 1;
922     }
923 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
924 aw0a 1 }
925     return 1;
926     }
927     default:
928     return 1;
929     }
930     }
931    
932     /*
933     * Returns nonzero if can't evaluate gradient.
934     * Vars is assumed already filled with values.
935     */
936     int BinTokenCalcGradient(int btable, int bindex,double *vars,
937     double *residual, double *gradient)
938     {
939     if (btable == 0) {
940     return 1;
941     }
942     switch (g_bt_data.tables[btable].type) {
943     case BT_error:
944     return 1; /* expired table! */
945     case BT_C: {
946     /* signal handling needs to match func above. this is slow here. */
947     struct TableC *ctable;
948     BinTokenGPtr func;
949     ctable = (struct TableC *)g_bt_data.tables[btable].tu;
950     assert(ctable != NULL);
951     if (bindex < 1 || bindex > g_bt_data.tables[btable].size) {
952     return 1;
953     }
954     func = ctable[bindex].G;
955     if (func != NULL) {
956 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
957 aw0a 1 Asc_SignalHandlerPush(SIGFPE,Asc_SignalTrap);
958 johnpye 997 if (SETJMP(g_fpe_env)==0) {
959 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
960 aw0a 1 (*func)(vars,gradient,residual);
961 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
962 aw0a 1 Asc_SignalHandlerPop(SIGFPE,Asc_SignalTrap);
963 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
964 aw0a 1 return 0;
965 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
966 aw0a 1 } else {
967     Asc_SignalHandlerPop(SIGFPE,Asc_SignalTrap);
968     return 1;
969     }
970 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
971 aw0a 1 }
972     return 1;
973     }
974     case BT_F77: {
975     struct TableF *ftable;
976     BinTokenSPtr subroutine;
977     ftable = (struct TableF *)g_bt_data.tables[btable].tu;
978     assert(ftable != NULL);
979     if (bindex < 1 || bindex > g_bt_data.tables[btable].size) {
980     return 1;
981     }
982     subroutine = ftable[0].S; /* its all in func 0 */
983     if (subroutine != NULL) {
984     int ForG,status;
985     ForG = BinTokenGRADIENT;
986 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
987 aw0a 1 Asc_SignalHandlerPush(SIGFPE,Asc_SignalTrap);
988 johnpye 997 if (SETJMP(g_fpe_env)==0) {
989 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
990 aw0a 1 (*subroutine)(vars,gradient,residual,&ForG,&bindex,&status);
991 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
992 aw0a 1 Asc_SignalHandlerPop(SIGFPE,Asc_SignalTrap);
993 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
994 aw0a 1 return status;
995 johnpye 1142 #ifdef ASC_SIGNAL_TRAPS
996 aw0a 1 } else {
997     status = 1;
998     }
999     Asc_SignalHandlerPop(SIGFPE,Asc_SignalTrap);
1000     return status;
1001 johnpye 1142 #endif /* ASC_SIGNAL_TRAPS */
1002 aw0a 1 }
1003     return 1;
1004     }
1005     default:
1006     return 1;
1007     }
1008     }
1009    
1010 johnpye 908 #ifdef UNRELOCATE_TEST_BT
1011 johnpye 716 /* this code may be out of date, but should be saved. */
1012 johnpye 1071 #ifdef RELOCATE_STREAMS
1013 aw0a 1 FILE *g_ascend_errors = stderr;
1014 johnpye 1071 #endif
1015    
1016 johnpye 716 int main() { /* built only if TESTBT defined TRUE in bintoken.c */
1017 aw0a 1 double res;
1018     gl_init_pool();
1019     g_test_list = gl_create(5);
1020     gl_append_ptr(g_test_list,(void *)10);
1021     gl_append_ptr(g_test_list,(void *)20);
1022     gl_append_ptr(g_test_list,(void *)30);
1023     gl_append_ptr(g_test_list,(void *)40);
1024     gl_append_ptr(g_test_list,(void *)50);
1025 johnpye 1046 BinTokenSetOptions(
1026     "/tmp/btsrc.c","/tmp/btsrc.o","/tmp/btsrc.so"
1027     ,"make -f foo/Makefile BTTARGET=/tmp/btsrc /tmp/btsrc"
1028     ,"/bin/rm"
1029     ,1000,1,0
1030     );
1031 aw0a 1 BinTokensCreate((struct Instance *)1, BT_C);
1032     BinTokenCalcResidual(1,1,&res,&res);
1033     FPRINTF(ASCERR,"residual 1 = %g\n",res);
1034     BinTokenClearTables();
1035     gl_destroy(g_test_list);
1036     gl_destroy_pool();
1037     return 0;
1038     }
1039 johnpye 908 #endif /*unrelocate test bt*/
1040 jpye 2045
1041     /* vim: set ts=2 et: */
1042    

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