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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 669 - (hide annotations) (download) (as text)
Wed Jun 21 07:00:45 2006 UTC (13 years, 5 months ago) by johnpye
File MIME type: text/x-csrc
File size: 7078 byte(s)
Merged changes from DAE branch (revisions 702 to 819) back into trunk.
This adds the Integration API to the ASCEND solver (in base/generic).
Also provides pre-alpha support for 'IDA' from the SUNDIALS suite, a DAE solver.
Many other minor code clean-ups, including adoption of new 'ASC_NEW' and friends (to replace 'ascmalloc')
Added some very sketchy stuff providing 'DIFF(...)' syntax, although it is anticipated that this will be removed.
1 aw0a 1 /*
2     * External Call Module
3     * by Kirk Andre Abbott
4     * Created: Jun 1, 1995.
5     * Version: $Revision: 1.9 $
6     * Version control file: $RCSfile: extcall.c,v $
7     * Date last modified: $Date: 1998/02/24 21:44:42 $
8     * Last modified by: $Author: ballan $
9     *
10     * This file is part of the Ascend Language Interpreter.
11     *
12     * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly, Kirk Andre Abbott
13     * Copyright (C) 1995 Kirk Andre' Abbott
14     *
15     * The Ascend Language Interpreter is free software; you can redistribute
16     * it and/or modify it under the terms of the GNU General Public License as
17     * published by the Free Software Foundation; either version 2 of the
18     * License, or (at your option) any later version.
19     *
20     * The Ascend Language Interpreter is distributed in hope that it will be
21     * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22     * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23     * General Public License for more details.
24     *
25     * You should have received a copy of the GNU General Public License
26     * along with the program; if not, write to the Free Software Foundation,
27     * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28     * COPYING.
29     */
30    
31 johnpye 399 #include <utilities/ascConfig.h>
32     #include <utilities/ascMalloc.h>
33     #include "compiler.h"
34     #include <general/list.h>
35     #include "fractions.h"
36     #include "dimen.h"
37     #include "functype.h"
38 johnpye 669 #include "expr_types.h"
39 johnpye 399 #include "extinst.h"
40     #include "mathinst.h"
41     #include "extcall.h"
42 aw0a 1
43    
44     struct Instance *GetSubjectInstance(struct gl_list_t *arglist,
45     unsigned long varndx)
46     {
47     struct Instance *arg;
48     struct gl_list_t *branch;
49     unsigned long len1,c=1L,len2,count=0L;
50     long safetycheck;
51    
52     if (arglist&&varndx) {
53     len1 = gl_length(arglist);
54     while(c<=len1){
55     branch = (struct gl_list_t *)gl_fetch(arglist,c);
56     if (!branch) return NULL;
57     len2 = gl_length(branch);
58     count += len2;
59     if (count>=varndx){
60     safetycheck = len2-count+varndx;
61     if (safetycheck<=0){
62     FPRINTF(ASCERR,"Something really wrong in GetSubjectInstance\n");
63     FPRINTF(ASCERR,"Please report to%s\n",ASC_BIG_BUGMAIL);
64     return NULL;
65     }
66     arg = (struct Instance *)gl_fetch(branch,(unsigned long)safetycheck);
67     return arg;
68     }
69     c++;
70     }
71     }
72     return NULL;
73     }
74    
75     unsigned long GetSubjectIndex(struct gl_list_t *arglist,
76     struct Instance *subject)
77     {
78     unsigned long len1,c1,len2,c2;
79     struct gl_list_t *branch;
80     struct Instance *arg;
81     unsigned long count=0L;
82    
83     if (arglist&&subject){
84     len1 = gl_length(arglist);
85     for(c1=1;c1<=len1;c1++){
86     branch = (struct gl_list_t *)gl_fetch(arglist,c1);
87     if (!branch) return 0L; /* error */
88     len2 = gl_length(branch);
89     for(c2=1;c2<=len2;c2++){
90     count++;
91     arg = (struct Instance *)gl_fetch(branch,c2);
92     if (arg==subject)
93     return count;
94     }
95     }
96     return 0L; /*NOTREACHED*/
97     }
98     return 0L;
99     }
100    
101     unsigned long CountNumberOfArgs(struct gl_list_t *arglist,
102     unsigned long start, unsigned long end)
103     {
104     unsigned long c,count=0L;
105     struct gl_list_t *branch;
106    
107     if (arglist) {
108     assert(start<=end);
109     for (c=start;c<=end;c++){
110     branch = (struct gl_list_t *)gl_fetch(arglist,c);
111     if (!branch) return 0L; /*error*/
112     count += gl_length(branch);
113     }
114     return count;
115     }
116     else
117     return 0L;
118     }
119    
120     struct gl_list_t *LinearizeArgList(struct gl_list_t *arglist,
121     unsigned long start, unsigned long end)
122     {
123     struct gl_list_t *result,*branch;
124     struct Instance *arg;
125     unsigned long c1,len2,c2;
126    
127     if (arglist){
128     assert(start<=end);
129     result = gl_create(20L);
130     for(c1=start;c1<=end;c1++){
131     branch = (struct gl_list_t *)gl_fetch(arglist,c1);
132     if (!branch){
133     gl_destroy(result);
134     return NULL;
135     }
136     len2 = gl_length(branch);
137     for(c2=1;c2<=len2;c2++){
138     arg = (struct Instance *)gl_fetch(branch,c2);
139     gl_append_ptr(result,(VOIDPTR)arg);
140     }
141     }
142     return result;
143     }
144     return NULL;
145     }
146    
147     void DestroySpecialList(struct gl_list_t *list)
148     {
149     unsigned long len,c;
150     struct gl_list_t *branch,*tmp;
151     if (list) {
152     tmp = list;
153     len = gl_length(tmp);
154     for (c=1;c<=len;c++) {
155     branch = (struct gl_list_t *)gl_fetch(tmp,c);
156     if (branch != NULL) {
157     gl_destroy(branch);
158     }
159     }
160     gl_destroy(tmp);
161     list = NULL;
162     }
163     }
164    
165     struct gl_list_t *CopySpecialList(struct gl_list_t *list)
166     {
167     unsigned long len1,c1,len2,c2;
168     struct gl_list_t *result,*branch,*tmp;
169     struct Instance *arg;
170     if (list) {
171     len1 = gl_length(list);
172     result = gl_create(len1);
173     for(c1=1;c1<=len1;c1++) {
174     tmp = (struct gl_list_t *)gl_fetch(list,c1);
175     if (tmp) {
176     len2 = gl_length(tmp);
177     branch = gl_create(len2);
178     for (c2=1;c2<=len2;c2++) {
179     arg = (struct Instance *)gl_fetch(tmp,c2);
180     gl_append_ptr(branch,(VOIDPTR)arg);
181     }
182     }
183     else{
184     DestroySpecialList(result);
185     return NULL;
186     }
187     gl_append_ptr(result,(VOIDPTR)branch);
188     }
189     return result;
190     }
191     return NULL;
192     }
193    
194    
195     struct ExtCallNode *CreateExtCall(struct ExternalFunc *efunc,
196     struct gl_list_t *args,
197     struct Instance *subject,
198     struct Instance *data)
199     {
200     struct ExtCallNode *ext;
201     struct Instance **hndl=NULL;
202     unsigned long pos;
203     int added=0;
204     ext = (struct ExtCallNode *)ascmalloc(sizeof(struct ExtCallNode));
205     ext->efunc = efunc;
206     ext->arglist = args;
207     if (data) {
208     hndl = AddVarToTable(data,&added); /** FIX FIX FIX **/
209     }
210     ext->data = hndl;
211     if (subject) {
212     pos = GetSubjectIndex(args,subject);
213     ext->subject = pos;
214     } else {
215     ext->subject = 0L;
216     }
217     ext->nodestamp = -1;
218     return ext;
219     }
220    
221     void DestroyExtCall(struct ExtCallNode *ext, struct Instance *relinst)
222     {
223     struct Instance *ptr;
224     unsigned long len1, c1;
225     unsigned long len2, c2;
226     struct gl_list_t *arglist, *branch;
227    
228     if (!ext) return;
229     arglist = ext->arglist;
230     if (arglist) {
231     len1 = gl_length(arglist);
232     for (c1=1;c1<=len1;c1++) {
233     branch = (struct gl_list_t *)gl_fetch(arglist,c1);
234     len2 = gl_length(branch);
235     for (c2=len2;c2>=1;c2--) {
236     if ( (ptr = (struct Instance *)gl_fetch(branch,c2)) !=NULL)
237     RemoveRelation(ptr,relinst);
238     }
239     gl_destroy(branch);
240     }
241     gl_destroy(arglist);
242     arglist = NULL;
243     }
244     }
245    
246     struct ExternalFunc *ExternalCallExtFuncF(struct ExtCallNode *ext)
247     {
248     return ext->efunc;
249     }
250    
251     struct gl_list_t *ExternalCallArgListF(struct ExtCallNode *ext)
252     {
253     return ext->arglist;
254     }
255    
256     struct Instance *ExternalCallDataInstance(struct ExtCallNode *ext)
257     {
258     struct Instance **hndl;
259     hndl = ext->data;
260     if (hndl)
261     return *hndl;
262     else
263     return NULL;
264     }
265    
266     int ExternalCallNodeStampF(struct ExtCallNode *ext)
267     {
268     return ext->nodestamp;
269     }
270    
271     void SetExternalCallNodeStamp(struct ExtCallNode *ext,
272     int nodestamp)
273     {
274     if (ext->nodestamp==-1) {
275     ext->nodestamp = nodestamp;
276     }
277     }
278    
279     unsigned long ExternalCallVarIndexF(struct ExtCallNode *ext)
280     {
281     return ext->subject;
282     }
283    
284     struct Instance *ExternalCallVarInstance(struct ExtCallNode *ext)
285     {
286     struct Instance *i;
287     assert(ext->subject);
288     i = GetSubjectInstance(ext->arglist,ext->subject);
289     assert(i!=NULL);
290     return i;
291     }
292    
293    
294    
295    
296    
297    
298    
299    
300    

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