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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 669 - (show annotations) (download) (as text)
Wed Jun 21 07:00:45 2006 UTC (13 years, 8 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 /*
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 #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 #include "expr_types.h"
39 #include "extinst.h"
40 #include "mathinst.h"
41 #include "extcall.h"
42
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