summaryrefslogtreecommitdiffstats
path: root/scilab/modules/intersci/src
diff options
context:
space:
mode:
authorSylvestre Ledru <sylvestre.ledru@scilab-enterprises.com>2012-07-20 02:13:53 +0200
committerAntoine ELIAS <antoine.elias@scilab-enterprises.com>2012-07-23 10:49:16 +0200
commit7d063e7b729ed084a94212d7bab00f3205d12a0a (patch)
tree6fbeec74be1998da331980c0d9958b66c37fae49 /scilab/modules/intersci/src
parentc7ae2f028b18d17a0d47b44f6e48803334a1cd5b (diff)
downloadscilab-7d063e7b729ed084a94212d7bab00f3205d12a0a.zip
scilab-7d063e7b729ed084a94212d7bab00f3205d12a0a.tar.gz
Get ride of intersci.
It has been deprecated for a while Change-Id: I1812e6e5f6a6a320747d4cf50d2ea5306ce5852d
Diffstat (limited to 'scilab/modules/intersci/src')
-rw-r--r--scilab/modules/intersci/src/exe/check.c385
-rw-r--r--scilab/modules/intersci/src/exe/check.h41
-rw-r--r--scilab/modules/intersci/src/exe/crerhs.c559
-rw-r--r--scilab/modules/intersci/src/exe/crerhs.h36
-rw-r--r--scilab/modules/intersci/src/exe/declare.c223
-rw-r--r--scilab/modules/intersci/src/exe/declare.h25
-rw-r--r--scilab/modules/intersci/src/exe/fornames.c241
-rw-r--r--scilab/modules/intersci/src/exe/fornames.h17
-rw-r--r--scilab/modules/intersci/src/exe/getrhs.c569
-rw-r--r--scilab/modules/intersci/src/exe/getrhs.h41
-rw-r--r--scilab/modules/intersci/src/exe/intersci-n.c1093
-rw-r--r--scilab/modules/intersci/src/exe/intersci-n.h399
-rw-r--r--scilab/modules/intersci/src/exe/intersci.c3573
-rw-r--r--scilab/modules/intersci/src/exe/intersci.h221
-rw-r--r--scilab/modules/intersci/src/exe/intersciexe/intersciexe.vcxproj220
-rw-r--r--scilab/modules/intersci/src/exe/intersciexe/intersciexe.vcxproj.filters22
-rw-r--r--scilab/modules/intersci/src/exe/interscin/interscin.vcxproj327
-rw-r--r--scilab/modules/intersci/src/exe/interscin/interscin.vcxproj.filters52
-rw-r--r--scilab/modules/intersci/src/exe/opt.c250
-rw-r--r--scilab/modules/intersci/src/exe/out-e.c450
-rw-r--r--scilab/modules/intersci/src/exe/outext.c480
-rw-r--r--scilab/modules/intersci/src/exe/outext.h34
-rw-r--r--scilab/modules/intersci/src/exe/read.c755
-rw-r--r--scilab/modules/intersci/src/exe/variables.c755
-rw-r--r--scilab/modules/intersci/src/lib/cdoublef.c31
-rw-r--r--scilab/modules/intersci/src/lib/core_Import.def7
-rw-r--r--scilab/modules/intersci/src/lib/cout.c23
-rw-r--r--scilab/modules/intersci/src/lib/intersci.rc97
-rw-r--r--scilab/modules/intersci/src/lib/intersci.vcxproj226
-rw-r--r--scilab/modules/intersci/src/lib/intersci.vcxproj.filters59
-rw-r--r--scilab/modules/intersci/src/lib/libinter.c356
-rw-r--r--scilab/modules/intersci/src/lib/out.c28
32 files changed, 0 insertions, 11595 deletions
diff --git a/scilab/modules/intersci/src/exe/check.c b/scilab/modules/intersci/src/exe/check.c
deleted file mode 100644
index b54f69b..0000000
--- a/scilab/modules/intersci/src/exe/check.c
+++ /dev/null
@@ -1,385 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13#include <stdlib.h>
14
15#include "intersci-n.h"
16#include "check.h"
17
18
19
20CheckRhsTab CHECKTAB[] = {
21 {DIMFOREXT,CheckDIMFOREXT},
22 {COLUMN,CheckCOLUMN},
23 {LIST,CheckLIST},
24 {TLIST,CheckTLIST},
25 {MATRIX,CheckMATRIX},
26 {POLYNOM,CheckPOLYNOM},
27 {ROW,CheckROW},
28 {SCALAR,CheckSCALAR},
29 {SEQUENCE,CheckSEQUENCE},
30 {STRING,CheckSTRING},
31 {WORK,CheckWORK},
32 {EMPTY,CheckEMPTY},
33 {ANY,CheckANY},
34 {VECTOR,CheckVECTOR},
35 {STRINGMAT,CheckSTRINGMAT},
36 {SCIMPOINTER,CheckPOINTER},
37 {IMATRIX,CheckIMATRIX},
38 {SCISMPOINTER,CheckPOINTER},
39 {SCILPOINTER,CheckPOINTER},
40 {BMATRIX,CheckBMATRIX},
41 {SCIBPOINTER,CheckPOINTER},
42 {SCIOPOINTER,CheckPOINTER},
43 {SPARSE,CheckSPARSE}
44};
45
46extern int indent ; /* incremental counter for code indentation */
47extern int pass; /* flag for couting pass on code generation */
48
49static char str1[MAXNAM];
50static char str2[MAXNAM];
51
52/***********************************************
53 * Matrix OK
54 * flag is used for optional variables
55 * f(..... x=val)
56 ***********************************************/
57
58void CheckMATRIX(f,var,flag)
59 FILE *f; VARPTR var ;int flag;
60{
61 CheckCom(f,var,flag);
62 /** str1 was set by CheckCom */
63 CheckOptSquare(f,var,str1);
64 CheckOptDim(f,var,0);
65 CheckOptDim(f,var,1);
66}
67
68/** common function for different data types */
69
70void CheckCom(f,var,flag)
71 FILE *f; VARPTR var ;int flag;
72{
73 int i1 = var->stack_position - basfun->NewMaxOpt +1 ;
74 if ( flag == 1 )
75 sprintf(str2,"k");
76 else
77 sprintf(str2,"%d",i1);
78 if (var->list_el ==0 )
79 {
80 /** A scilab matrix argument **/
81 sprintf(str1,"%d",i1);
82 }
83 else
84 {
85 sprintf(str1,"%de%d",i1,var->list_el);
86 }
87}
88
89
90
91
92/***********************************************
93 * STRING : OK
94 ***********************************************/
95
96void CheckSTRING(f,var,flag) FILE *f; VARPTR var ;int flag;
97{
98 if (var->for_type != CHAR)
99 {
100 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
101 SGetSciType(STRING),SGetForType(var->for_type),var->name);
102 exit(1);
103 }
104
105 CheckCom(f,var,flag);
106 CheckOptDim(f,var,0);
107}
108
109/***********************************************
110 * Boolean matrix OK
111 ***********************************************/
112
113
114void CheckBMATRIX(f,var,flag)
115 FILE *f; VARPTR var ;int flag;
116{
117 if (var->for_type != INT && var->for_type != BOOLEAN)
118 {
119 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
120 SGetSciType(var->type),SGetForType(var->for_type),var->name);
121 exit(1);
122 }
123 var->for_type = BOOLEAN;
124 CheckCom(f,var,flag);
125 /** str1 was set by CheckCom */
126 CheckOptSquare(f,var,str1);
127 CheckOptDim(f,var,0);
128 CheckOptDim(f,var,1);
129}
130
131/***********************************************
132 * Complex Matrix
133 ***********************************************/
134
135void CheckIMATRIX(f,var,flag)
136 FILE *f; VARPTR var ;int flag;
137{
138 int i1= var->stack_position;
139 if ( flag == 1 )
140 sprintf(str2,"k");
141 else
142 sprintf(str2,"%d",i1);
143 if (var->list_el ==0 )
144 sprintf(str1,"%d",i1);
145 else
146 sprintf(str1,"%de%d",i1,var->list_el);
147 /** str1 was set by CheckCom */
148 CheckOptSquare(f,var,str1);
149 CheckOptDim(f,var,0);
150 CheckOptDim(f,var,1);
151}
152
153
154/***********************************************
155 * Sparse Matrix
156 ***********************************************/
157
158void CheckSPARSE(f,var,flag)
159 FILE *f; VARPTR var ;int flag;
160{
161 int i1= var->stack_position;
162 if ( flag == 1 )
163 sprintf(str2,"k");
164 else
165 sprintf(str2,"%d",i1);
166 if (var->list_el ==0 )
167 {
168 sprintf(str1,"%d",i1);
169 }
170 else
171 {
172 sprintf(str1,"%de%d",i1,var->list_el);
173 }
174 /** str1 was set by CheckCom */
175 CheckOptSquare(f,var,str1);
176 CheckOptDim(f,var,0);
177 CheckOptDim(f,var,1);
178}
179
180
181/***********************************************
182 * Stringmat
183 ***********************************************/
184
185void CheckSTRINGMAT(f,var,flag) FILE *f; VARPTR var ;int flag;
186{
187 int i1= var->stack_position;
188 if (var->list_el ==0 )
189 {
190 sprintf(str1,"%d",i1);
191 }
192 else
193 {
194 sprintf(str1,"%de%d",i1,var->list_el);
195 }
196 /* square matrix */
197 CheckOptSquare(f,var,str1);
198 CheckOptDim(f,var,0);
199 CheckOptDim(f,var,1);
200}
201
202/***********************************************
203 * Row
204 ***********************************************/
205
206void CheckROW(f,var,flag) FILE *f; VARPTR var ;int flag;
207{
208 int i1= var->stack_position;
209 CheckCom(f,var,flag);
210 CheckOptDim(f,var,0);
211 Fprintf(f,indent,"CheckRow(%d,m%d,n%d);\n",i1,i1,i1);
212 Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
213 AddDeclare1(DEC_INT,"mn%d",i1);
214}
215
216
217/***********************************************
218 * Column
219 ***********************************************/
220
221void CheckCOLUMN(f,var,flag) FILE *f; VARPTR var ;int flag;
222{
223 int i1= var->stack_position;
224 CheckCom(f,var,flag);
225 CheckOptDim(f,var,0);
226 Fprintf(f,indent,"CheckColumn(%d,m%d,n%d);\n",i1,i1,i1);
227 Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
228 AddDeclare1(DEC_INT,"mn%d",i1);
229}
230
231/***********************************************
232 * Vector
233 ***********************************************/
234
235void CheckVECTOR(f,var,flag) FILE *f; VARPTR var ;int flag;
236{
237 int i1= var->stack_position;
238 CheckCom(f,var,flag);
239 CheckOptDim(f,var,0);
240 Fprintf(f,indent,"CheckVector(%d,m%d,n%d);\n",i1,i1,i1);
241 Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
242 AddDeclare1(DEC_INT,"mn%d",i1);
243}
244
245/***********************************************
246 * Polynom
247 ***********************************************/
248
249void CheckPOLYNOM(f,var,flag) FILE *f; VARPTR var ;int flag;
250{
251 int i1= var->stack_position;
252 if ( flag == 1 )
253 sprintf(str2,"k");
254 else
255 sprintf(str2,"%d",i1);
256 if (var->list_el ==0 )
257 {
258 sprintf(str1,"%d",i1);
259 }
260 else
261 {
262 sprintf(str1,"%de%d",i1,var->list_el);
263 }
264 CheckOptDim(f,var,0);
265}
266
267/***********************************************
268 * Scalar
269 ***********************************************/
270
271void CheckSCALAR(f,var,flag) FILE *f; VARPTR var ;int flag;
272{
273 int i1= var->stack_position;
274 CheckCom(f,var,flag);
275 CheckOptDim(f,var,0);
276 Fprintf(f,indent,"CheckScalar(%d,m%d,n%d);\n",i1,i1,i1);
277}
278
279/***********************************************
280 * Pointers
281 ***********************************************/
282
283void CheckPOINTER(f,var,flag)
284 FILE *f; VARPTR var ;int flag;
285{
286 int i1= var->stack_position;
287 if ( flag == 1 )
288 sprintf(str2,"k");
289 else
290 sprintf(str2,"%d",i1);
291 sprintf(str1,"%d",i1);
292 if (var->list_el ==0 )
293 {
294 sprintf(str1,"%d",i1);
295 }
296 else
297 {
298 fprintf(stderr,"Wrong type opointer inside a list\n");
299 exit(1);
300 }
301 AddDeclare1(DEC_INT,"lr%s",str1);
302}
303
304
305void CheckANY(f,var,flag) FILE *f; VARPTR var ;int flag;{
306 fprintf(stderr,"Wrong type in Check function\n");
307 exit(1);
308}
309
310void CheckLIST(f,var,flag) FILE *f; VARPTR var ;int flag;{
311 fprintf(stderr,"Wrong type in Check function\n");
312 exit(1);
313}
314
315void CheckTLIST(f,var,flag) FILE *f; VARPTR var ;int flag;{
316 fprintf(stderr,"Wrong type in Check function\n");
317 exit(1);
318}
319
320void CheckSEQUENCE(f,var,flag) FILE *f; VARPTR var ;int flag;
321{
322 fprintf(stderr,"Wrong type in Check function\n");
323 exit(1);
324}
325
326void CheckEMPTY(f,var,flag) FILE *f; VARPTR var ;int flag;
327{
328 fprintf(stderr,"Wrong type in Check function\n");
329 exit(1);
330}
331
332void CheckWORK(f,var,flag) FILE *f; VARPTR var ;int flag;
333{
334 fprintf(stderr,"Wrong type in Check function\n");
335 exit(1);
336}
337
338
339void CheckDIMFOREXT(f,var,flag) FILE *f; VARPTR var ;int flag;
340{
341 fprintf(stderr,"Wrong type in Check function\n");
342 exit(1);
343}
344
345
346void CheckOptDim(f,var,nel)
347 FILE *f;
348 int nel;
349 VARPTR var;
350{
351 if (var->el[nel]-1>=0) {
352 VARPTR var1 = variables[var->el[nel]-1];
353 if ( var1->nfor_name == 0)
354 {
355 fprintf(stderr,"Pb with element number %d [%s] of variable %s\n",
356 nel+1, var1->name, var->name);
357 return;
358 }
359 if (isdigit(var1->name[0]) != 0)
360 {
361 /* the dimension of the variable is a constant int */
362 if ( strcmp(var1->for_name[0],var1->name) != 0)
363 {
364 Fprintf(f,indent,"CheckOneDim(opts[%d].position,%d,%s,%s);\n",
365 var->stack_position - basfun->NewMaxOpt +1 ,
366 nel+1,
367 var1->for_name[0],var1->name);
368 }
369 }
370 }
371}
372
373
374
375void CheckOptSquare(FILE *f, VARPTR var, char *str1_)
376{
377 /* XXXXX cas liste ? */
378 if (var->el[0] == var->el[1])
379 {
380 Fprintf(f,indent,"CheckSquare(opts[%d].position,opts[%s].m,opts[%s].n);\n",
381 var->stack_position - basfun->NewMaxOpt +1 ,
382 str1_,str1_);
383 }
384}
385
diff --git a/scilab/modules/intersci/src/exe/check.h b/scilab/modules/intersci/src/exe/check.h
deleted file mode 100644
index 9f5b10a..0000000
--- a/scilab/modules/intersci/src/exe/check.h
+++ /dev/null
@@ -1,41 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2000-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13void CheckMATRIX(FILE *f, VARPTR var, int flag);
14void CheckCom (FILE *f, VARPTR var, int flag);
15void CheckSTRING(FILE *f, VARPTR var, int flag);
16void CheckBMATRIX(FILE *f, VARPTR var, int flag);
17void CheckIMATRIX(FILE *f, VARPTR var, int flag);
18void CheckSPARSE (FILE *f, VARPTR var, int flag);
19void CheckSTRINGMAT(FILE *f, VARPTR var, int flag);
20void CheckROW(FILE *f, VARPTR var, int flag);
21void CheckCOLUMN(FILE *f, VARPTR var, int flag);
22void CheckVECTOR(FILE *f, VARPTR var, int flag);
23void CheckPOLYNOM(FILE *f, VARPTR var, int flag);
24void CheckSCALAR(FILE *f, VARPTR var, int flag);
25void CheckPOINTER(FILE *f, VARPTR var, int flag);
26void CheckANY(FILE *f, VARPTR var, int flag);
27void CheckLIST(FILE *f, VARPTR var, int flag) ;
28void CheckTLIST(FILE *f, VARPTR var, int flag);
29void CheckSEQUENCE(FILE *f, VARPTR var, int flag);
30void CheckEMPTY(FILE *f, VARPTR var, int flag);
31void CheckWORK(FILE *f, VARPTR var, int flag);
32void CheckDIMFOREXT(FILE *f, VARPTR var, int flag);
33void Check(FILE *f, VARPTR var, int nel);
34void CheckSquare(FILE *f, VARPTR var, char *str1,char *);
35
36typedef struct {
37 int type;
38 void (*fonc) (FILE *f, VARPTR var, int flag ) ;} CheckRhsTab ;
39
40extern CheckRhsTab CHECKTAB[];
41
diff --git a/scilab/modules/intersci/src/exe/crerhs.c b/scilab/modules/intersci/src/exe/crerhs.c
deleted file mode 100644
index 789f8ae..0000000
--- a/scilab/modules/intersci/src/exe/crerhs.c
+++ /dev/null
@@ -1,559 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2000-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13#include <stdlib.h>
14#include "intersci-n.h"
15#include "crerhs.h"
16
17/*****************************************************************
18 * For each possible data type we have here a function
19 * which generate the code for <<Creating>> a variable
20 * and checking some properties
21 * if needed check if the variable is square
22 * if needed check if some dimensions must be of fixed sizes
23 * All the possible Getfunction are stored in a function table
24 ******************************************************************/
25
26/**************************************************
27 * A FINIR :
28 * le code qui est ici est utilise a deux fins
29 * Creer des objets ds le stack Scilab
30 * et construire en meme temps
31 * la sequence d'appel pour
32 * le Fortran
33 * Il faudrait sans doute couper cela en deux
34 * et surtout voir si l'on ne peux pas simplifier
35 * le tout :
36 * i.e associer a une variable
37 * des formats qui indiquent comment
38 * on accede aux champs importants pour elle
39 * + un numero unique de variable
40 * un numero ds le stacl etc......
41 **************************************************/
42
43/******************************************************
44 * the functions in the following table must follow the
45 * order given by the type list defined in intersci-n.h
46 * The correct ordering is checked when using this table.
47 * (see intersci.c)
48 ********************************************************/
49
50CreRhsTab CRERHSTAB[] = {
51 {DIMFOREXT,CreDIMFOREXT},
52 {COLUMN,CreCOLUMN},
53 {LIST,CreANY},
54 {TLIST,CreANY},
55 {MATRIX,CreMATRIX},
56 {POLYNOM,CreVECTOR},
57 {ROW,CreVECTOR},
58 {SCALAR,CreSCALAR},
59 {SEQUENCE,CreANY},
60 {STRING,CreSTRING},
61 {WORK,CreVECTOR},
62 {EMPTY,CreANY},
63 {ANY,CreANY},
64 {VECTOR,CreVECTOR},
65 {STRINGMAT,CreSTRINGMAT},
66 {SCIMPOINTER,CrePOINTER},
67 {IMATRIX,CreIMATRIX},
68 {SCISMPOINTER,CrePOINTER},
69 {SCILPOINTER,CrePOINTER},
70 {BMATRIX,CreBMATRIX},
71 {SCIBPOINTER,CrePOINTER},
72 {SCIOPOINTER,CrePOINTER},
73 {SPARSE,CreSPARSE}
74};
75
76
77
78extern int indent ; /* incremental counter for code indentation */
79extern int pass; /* flag for couting pass on code generation */
80
81static char str[MAXNAM];
82static char str1[MAXNAM];
83static char str2[MAXNAM];
84static char str3[MAXNAM];
85static char str4[MAXNAM];
86
87/***********************************************
88 * Matrix XXXXX OK
89 ***********************************************/
90
91void CreMATRIX(f,var)
92 FILE *f;
93 VARPTR var;
94{
95 WriteCallRestCheck(f,var,"mm",1,0) ;
96 GetDim(str3,var->el[1]);
97 WriteCallRestCheck(f,var,"nn",0,0) ;
98 GetDim(str4,var->el[0]);
99 if ( str3[0] == '&' || str3[0] == '(')
100 strcpy(str2,str3);
101 else
102 sprintf(str2,"&%s",str3);
103 if ( str4[0] == '&' || str4[0] == '(')
104 strcpy(str1,str4);
105 else
106 sprintf(str1,"&%s",str4);
107 CreCommon(f,var);
108}
109
110void CreCommon(f,var)
111 FILE *f;
112 VARPTR var;
113{
114 if (var->for_type == EXTERNAL )
115 {
116 Fprintf(f,indent,"/* external variable named %s (xxe%d) */\n",var->name,var->stack_position);
117 AddDeclare1(DEC_INT,"me%d",var->stack_position);
118 AddDeclare1(DEC_INT,"ne%d",var->stack_position);
119 if ( strncmp(var->fexternal,"cintf",4)==0 )
120 AddDeclare1(DEC_IPTR,"le%d",var->stack_position);
121 else if ( strncmp(var->fexternal,"cboolf",5)==0 )
122 AddDeclare1(DEC_IPTR,"le%d",var->stack_position);
123 else if ( strncmp(var->fexternal,"cdoublef",7)==0 )
124 AddDeclare1(DEC_DPTR,"le%d",var->stack_position);
125 else if (strncmp(var->fexternal,"ccharf",5)==0)
126 AddDeclare1(DEC_CPTR,"le%d",var->stack_position);
127 else if (strncmp(var->fexternal,"cfloatf",6)==0 )
128 AddDeclare1(DEC_RPTR,"le%d",var->stack_position);
129 else
130 AddDeclare1(DEC_UL,"le%d",var->stack_position);
131 ChangeForName2(var,"&le%d",var->stack_position);
132 /** List case not considered here **/
133 }
134 else
135 {
136 char *lstr1,*lstr2;
137 if ( strncmp(str1,"&istk(",6)==0 || strncmp(str1,"&cstk(",6)==0 || strncmp(str1,"&rstk(",6)==0
138 || strncmp(str1,"&stk(",5)==0 ) lstr1 = str1+1;
139 else
140 lstr1=str1;
141 if ( strncmp(str2,"&istk(",6)==0 || strncmp(str2,"&cstk(",6)==0 || strncmp(str2,"&rstk(",6)==0
142 || strncmp(str2,"&stk(",5)==0 ) lstr2 = str2+1;
143 else
144 lstr2=str2;
145
146 Fprintf(f,indent,"CreateVar(%d,\"%s\",%s,%s,&l%d);/* named: %s */\n",
147 var->stack_position,
148 SGetForTypeAbrev(var),
149 lstr1,lstr2,var->stack_position,
150 var->name);
151 AddDeclare1(DEC_INT,"l%d",var->stack_position);
152 ChangeForName2(var,"%s(l%d)",SGetForTypeStack(var),
153 var->stack_position);
154 }
155}
156
157/***********************************************
158 * String XXXXX OK
159 ***********************************************/
160
161void CreSTRING(f,var)
162 FILE *f;
163 VARPTR var;
164{
165 if (var->for_type != CHAR && var->for_type != EXTERNAL )
166 {
167 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
168 SGetSciType(STRING),SGetForType(var->for_type),var->name);
169 exit(1);
170 }
171 AddDeclare1(DEC_INT,"n%d",var->stack_position);
172 AddDeclare1(DEC_INIT,"n%d=1",var->stack_position);
173 sprintf(str2,"&n%d",var->stack_position);
174 WriteCallRestCheck(f,var,"nn",0,0) ;
175 GetDim(str1,var->el[0]);
176 CreCommon(f,var);
177}
178
179
180
181/***********************************************
182 * Boolean matrix XXXXX OK
183 ***********************************************/
184
185void CreBMATRIX(f,var)
186 FILE *f;
187 VARPTR var;
188{
189 if (var->for_type == INT ) var->for_type = BOOLEAN;
190 if (var->for_type != BOOLEAN && var->for_type != EXTERNAL )
191 {
192 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
193 SGetSciType(var->type),SGetForType(var->for_type),var->name);
194 exit(1);
195 }
196 CreMATRIX(f,var);
197}
198
199/***********************************************
200 * variable which are dimensions
201 * (of Scilab variables or external)
202 ***********************************************/
203
204void CreDIMFOREXT(f,var)
205 FILE *f;
206 VARPTR var;
207{
208 if (var->nfor_name == 0 && var->for_type != PREDEF)
209 {
210 printf("dimension variable \"%s\" is not defined\n",var->name);
211 exit(1);
212 }
213 switch (var->for_type)
214 {
215 case PREDEF:
216 case 'C':
217 if ( strcmp(var->name,"rhs") == 0)
218 {
219 AddDeclare(DEC_INT,"rhs");
220 Fprintf(f,indent,"rhs=Rhs;\n");
221 sprintf(str,"&rhs");
222 }
223 else
224 {
225 sprintf(str,"&%s",var->name);
226 }
227 ChangeForName1(var,str);
228 break;
229 case 0:
230 case INT:
231 sprintf(str,"&%s",var->for_name[0]);
232 if ( ~isdigit(str[1]))
233 {
234 ChangeForName1(var,str);
235 }
236 else
237 {
238 Fprintf(f,indent,"loc%s= (int) %s;\n",
239 var->for_name[0],var->for_name[0]);
240 sprintf(str,"loc%s",var->for_name[0]);
241 AddDeclare(DEC_INT,str);
242 sprintf(str,"&loc%s",var->for_name[0]);
243 ChangeForName1(var,str);
244 }
245 break;
246 case DOUBLE:
247 Fprintf(f,indent,"loc%s= (double) %s;\n",
248 var->for_name[0],var->for_name[0]);
249 sprintf(str,"loc%s",var->for_name[0]);
250 AddDeclare(DEC_DOUBLE,str);
251 sprintf(str,"&loc%s",var->for_name[0]);
252 ChangeForName1(var,str);
253 break;
254 case REAL:
255 Fprintf(f,indent,"loc%s= (float) %s;\n",var->for_name[0],var->for_name[0]);
256 sprintf(str,"loc%s",var->for_name[0]);
257 AddDeclare(DEC_REAL,str);
258 sprintf(str,"&loc%s",var->for_name[0]);
259 ChangeForName1(var,str);
260 break;
261 case CHAR:
262 case CSTRINGV:
263 printf("a dimension variable cannot have FORTRAN type \"%s\"\n",
264 SGetForType(var->for_type));
265 exit(1);
266 break;
267 }
268}
269
270/***********************************************
271 * Common code for COLUMN, ROW, WORK,POLYNOM,VECTOR
272 ***********************************************/
273
274void CreVECTOR(f,var)
275 FILE *f;
276 VARPTR var;
277{
278 char *lstr1 ;
279 WriteCallRestCheck(f,var,"nn",0,0) ;
280 GetDim(str1,var->el[0]);
281 AddDeclare1(DEC_INT,"un=1");
282 AddDeclare1(DEC_INT,"mn%d",var->stack_position);
283 lstr1 = ( str1[0]== '&' )? str1+1: str1;
284 /** peut-etre un pb si str1 contient des stk istk .. XXXXXX **/
285 if ( strncmp(lstr1,"stk",3) ==0 || strncmp(lstr1,"istk",4)==0
286 || strncmp(lstr1,"rstk",4)==0 || strncmp(lstr1,"cstk",4)==0 )
287 sprintf(str2,"(mn%d=*%s,&mn%d)",var->stack_position,
288 lstr1,var->stack_position);
289 else
290 sprintf(str2,"(mn%d=%s,&mn%d)",var->stack_position,
291 lstr1,var->stack_position);
292 strcpy(str1,"(un=1,&un)");
293 CreCommon(f,var);
294}
295
296void CreCOLUMN(f,var)
297 FILE *f;
298 VARPTR var;
299{
300 char *lstr1 ;
301 WriteCallRestCheck(f,var,"nn",0,0) ;
302 GetDim(str1,var->el[0]);
303 AddDeclare1(DEC_INT,"un=1");
304 AddDeclare1(DEC_INT,"mn%d",var->stack_position);
305 lstr1 = ( str1[0]== '&' )? str1+1: str1;
306 /** peut-etre un pb si str1 contient des stk istk .. XXXXXX **/
307 if ( strncmp(lstr1,"stk",3) ==0 || strncmp(lstr1,"istk",4)==0
308 || strncmp(lstr1,"rstk",4)==0 || strncmp(lstr1,"cstk",4)==0 )
309 sprintf(str2,"(mn%d=*%s,&mn%d)",var->stack_position,
310 lstr1,var->stack_position);
311 else
312 sprintf(str2,"(mn%d=%s,&mn%d)",var->stack_position,
313 lstr1,var->stack_position);
314 strcpy(str1,str2);
315 strcpy(str2,"(un=1,&un)");
316 CreCommon(f,var);
317}
318
319
320/***********************************************
321 * Sparse OK
322 ***********************************************/
323
324void CreSPARSE(f,var)
325 FILE *f;
326 VARPTR var;
327{
328 WriteCallRestCheck(f,var,"mm",1,0) ;
329 GetDim(str2,var->el[1]);
330 WriteCallRestCheck(f,var,"nn",0,0) ;
331 GetDim(str1,var->el[0]);
332 if (var->for_type == EXTERNAL)
333 {
334 AddDeclare1(DEC_SPARSEPTR,"S%d",var->stack_position);
335 ChangeForName2(var,"&S%d",var->stack_position);
336 /** List case not considered here **/
337 }
338 else
339 {
340 VARPTR m,n;
341 int origm,orign;
342 m= variables[var->el[0]-1];
343 n= variables[var->el[1]-1];
344 /* here we must create a sparse variable
345 * but str1 and str2 is not enough to create the matrix
346 * we copy the argument which gives the size
347 */
348 origm = ( m->nfor_name == 0)? -1 : m->for_name_orig[0];
349 orign = ( n->nfor_name == 0)? -1 : n->for_name_orig[0];
350 if ( origm != orign )
351 {
352 fprintf(stderr,"A local sparse matrix can only be built as a copy of a sparse entry\n");
353 exit(1);
354 }
355 AddDeclare1(DEC_SPARSE,"S%d",var->stack_position);
356 Fprintf(f,indent,"CreateVarFromPtr(%d,\"s\",&%s,&%s,&S%d);\n",
357 var->stack_position,
358 str1,str2,origm);
359 Fprintf(f,indent,"GetRhsVar(%d,\"s\",&%s,&%s,&S%d);\n",
360 var->stack_position,
361 str1,str2,var->stack_position);
362 ChangeForName2(var,"&S%d",var->stack_position);
363 }
364}
365
366
367/***********************************************
368 * Complex Matrix OK
369 ***********************************************/
370
371void CreIMATRIX(f,var)
372 FILE *f;
373 VARPTR var;
374{
375 WriteCallRestCheck(f,var,"it",2,0) ;
376 GetDim(str3,var->el[2]);
377 WriteCallRestCheck(f,var,"mm",1,0) ;
378 GetDim(str2,var->el[1]);
379 WriteCallRestCheck(f,var,"nn",0,0) ;
380 GetDim(str1,var->el[0]);
381 if (var->for_type == EXTERNAL)
382 {
383 AddDeclare1(DEC_UL,"ler%d",var->stack_position);
384 AddDeclare1(DEC_UL,"lec%d",var->stack_position);
385 AddDeclare1(DEC_INT,"ite%d",var->stack_position);
386 ChangeForName2(var,"&ler%d,&lec%d,&ite%d",var->stack_position,var->stack_position,var->stack_position);
387 /** List case not considered here **/
388 }
389 else
390 {
391 Fprintf(f,indent,"CreateCVar(%d,\"%s\",&%s,&%s,&%s,&lr%d,&lc%d);\n",
392 var->stack_position,SGetForTypeAbrev(var),
393 str3,str1,str2,var->stack_position,var->stack_position);
394 AddDeclare1(DEC_INT,"lr%d",var->stack_position);
395 AddDeclare1(DEC_INT,"lc%d",var->stack_position);
396 AddDeclare1(DEC_INT,"it%d",var->stack_position);
397 ChangeForName2(var,"%s(lr%d),%s(lc%d),&it%d",
398 SGetForTypeStack(var),
399 var->stack_position,
400 SGetForTypeStack(var),
401 var->stack_position,var->stack_position);
402 }
403}
404
405
406/***********************************************
407 * Pointers
408 ***********************************************/
409
410void CrePOINTER(f,var)
411 FILE *f;
412 VARPTR var;
413{
414 if (var->for_type == EXTERNAL)
415 {
416 AddDeclare1(DEC_UL,"le%d",var->stack_position);
417 ChangeForName2(var,"&le%d",var->stack_position);
418 /** List case not considered here **/
419 }
420 else
421 {
422 Fprintf(f,indent,"CreateOpointer(%d,&lr%d);\n",
423 var->stack_position,var->stack_position);
424 AddDeclare1(DEC_INT,"lr%d",var->stack_position);
425 ChangeForName2(var,"stk(lr%d)",
426 var->stack_position);
427 }
428}
429
430
431/***********************************************
432 * STRINGMAT
433 ***********************************************/
434
435void CreSTRINGMAT(f,var)
436 FILE *f;
437 VARPTR var;
438{
439 if (var->for_type == EXTERNAL || var->for_type == CSTRINGV )
440 {
441 /* for external or cstringv parameters, unknown formal dimensions
442 can be used */
443 WriteCallRestCheck(f,var,"nsmm",0,1) ;
444 WriteCallRestCheck(f,var,"nsnn",1,1) ;
445 sprintf(str,"nsmm%d",var->stack_position);
446 AddForName1(var->el[0],str,NULL,var->stack_position);
447 sprintf(str,"nsnn%d",var->stack_position);
448 AddForName1(var->el[1],str,NULL,var->stack_position);
449 AddDeclare1(DEC_SMAT,"Str%d",var->stack_position);
450 AddDeclare1(DEC_INT,"nsmm%d",var->stack_position);
451 AddDeclare1(DEC_INT,"nsnn%d",var->stack_position);
452 sprintf(str,"&Str%d",var->stack_position);
453 ChangeForName1(var,str);
454 }
455 else
456 {
457 /** XXXX dimensions should be specified **/
458 fprintf(stderr,"WARNING : your code contains a specification\n");
459 fprintf(stderr," not fully implemented in intersci\n");
460 WriteCallRestCheck(f,var,"mm",0,0) ;
461 WriteCallRestCheck(f,var,"nn",1,0) ;
462 AddDeclare(DEC_LOGICAL,"cresmatafaire");
463 Fprintf(f,indent,"if(.not.cresmatafaire(fname,top-rhs+%d,lr%d)) return\n",var->stack_position,var->stack_position);
464 sprintf(str,"stk(lr%d)",var->stack_position);
465 ChangeForName1(var,str);
466 }
467}
468
469
470/***********************************************
471 * Scalar
472 ***********************************************/
473
474void CreSCALAR(f,var)
475 FILE *f;
476 VARPTR var;
477{
478 strcpy(str1,"&un");
479 strcpy(str2,"&un");
480 AddDeclare(DEC_INT,"un=1");
481 CreCommon(f,var);
482}
483
484/***********************************************
485 ** Common code for LIST TLIST SEQUENCE ANY **
486 ***********************************************/
487
488void CreANY(f,var)
489 FILE *f;
490 VARPTR var;
491{
492 printf("work or output FORTRAN argument cannot have\n");
493 printf(" type \"ANY\", \"LIST\", \"TLIST\" or \"SEQUENCE\"\n");
494 exit(1);
495}
496
497/***********************************************
498 * Utility function for WriteCallRest
499 * when flag==1 we acccept undefined dimensions
500 * this is used with stringmat/Cstringv
501 * where dimensions and space are allocated inside
502 * the interfaced function and returned
503 * to the interface
504 *******************************************/
505
506void WriteCallRestCheck(FILE *f,VARPTR var,char *name,int iel,int flag)
507{
508 char sdim[MAXNAM];
509 char lstr[MAXNAM];
510 if (variables[var->el[iel]-1]->nfor_name == 0)
511 {
512 strcpy(lstr,variables[var->el[iel]-1]->name);
513 if (isdigit(lstr[0]) == 0)
514 {
515 if ( variables[var->el[iel]-1]->is_sciarg == 1)
516 {
517 /* dimension of FORTRAN argument is a SCILAB argument */
518 sprintf(sdim,"%s%d",name,var->stack_position);
519 Fprintf(f,indent,"%s= (int) *stk(lr%d));\n",sdim,
520 variables[var->el[iel]-1]->stack_position);
521 AddForName1(var->el[iel],sdim,NULL,var->stack_position);
522 }
523 else if ( flag != 1)
524 {
525 printf("dimension variable \"%s\" is not defined\n",
526 variables[var->el[iel]-1]->name);
527 exit(1);
528 }
529 }
530 else
531 {
532 sprintf(sdim,"%s%d",name,var->stack_position);
533 Fprintf(f,indent,"%s=%s;\n",sdim,lstr);
534 AddForName1(var->el[iel],sdim,NULL,var->stack_position);
535 }
536 }
537}
538
539/** to be finished : Forname2Int is not finished fo C **/
540
541void GetDim(char *lstr,IVAR ivar)
542{
543 char *s;
544 s=Forname2Int(variables[ivar-1],0);
545 if ( strncmp(s,"stk",3)==0 || strncmp(s,"istk",4)==0
546 || strncmp(s,"sstk",4)==0 ||
547 strncmp(s,"cstk",4)==0 )
548 {
549 strcpy(lstr,s);
550 return ;
551 }
552 else
553 {
554 AddDeclare1(DEC_INT,s);
555 strcpy(lstr,s);
556 }
557}
558
559
diff --git a/scilab/modules/intersci/src/exe/crerhs.h b/scilab/modules/intersci/src/exe/crerhs.h
deleted file mode 100644
index 974e32c..0000000
--- a/scilab/modules/intersci/src/exe/crerhs.h
+++ /dev/null
@@ -1,36 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13void CreMATRIX(FILE *f, VARPTR var);
14void CreCommon(FILE *f, VARPTR var);
15void CreSTRING(FILE *f, VARPTR var);
16void CreBMATRIX(FILE *f, VARPTR var);
17void CreDIMFOREXT(FILE *f, VARPTR var);
18void CreVECTOR(FILE *f, VARPTR var);
19void CreCOLUMN(FILE *f, VARPTR var);
20void CreSPARSE(FILE *f, VARPTR var);
21void CreIMATRIX(FILE *f, VARPTR var);
22void CrePOINTER(FILE *f, VARPTR var);
23void CreSTRINGMAT(FILE *f, VARPTR var);
24void CreSCALAR_old(FILE *f, VARPTR var);
25void CreSCALAR(FILE *f, VARPTR var);
26void CreANY(FILE *f, VARPTR var);
27void CreEMPTY (FILE *f, VARPTR var);
28
29
30typedef struct {
31 int type;
32 void (*fonc)(FILE *f, VARPTR var);} CreRhsTab ;
33
34extern CreRhsTab CRERHSTAB[];
35
36
diff --git a/scilab/modules/intersci/src/exe/declare.c b/scilab/modules/intersci/src/exe/declare.c
deleted file mode 100644
index 2c10a94..0000000
--- a/scilab/modules/intersci/src/exe/declare.c
+++ /dev/null
@@ -1,223 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13#include <stdlib.h>
14#include "intersci-n.h"
15#include "declare.h"
16/* global variables */
17
18extern int indent ; /* incremental counter for code indentation */
19extern char target ; /* langage for generation */
20
21/**********************************************************
22 Function to add decaration during the first pass
23 and to print them during code generation pass 2
24**********************************************************/
25
26
27static struct Declare
28{
29 int type;
30 char *nameF; /* Name fortran */
31 char *nameC; /* Name C */
32 char **decls ; /* declaration of logical */
33 int ndecls;
34} Init[] =
35{
36 { DEC_CHAR, "character", "char", (char **) 0, 0},
37 { DEC_INT , "integer", "int", (char **) 0, 0},
38 { DEC_DOUBLE, "double precision", "double", (char **) 0, 0},
39 { DEC_REAL, "real", "float", (char **) 0, 0},
40 { DEC_LOGICAL, "logical", "int", (char **) 0, 0},
41 { DEC_DATA, "data", "static", (char **) 0, 0},
42 { DEC_UL, "double precision", "unsigned long", (char **) 0, 0},
43 { DEC_IPTR, "double precision", "int ", (char **) 0, 0},
44 { DEC_DPTR, "double precision", "double", (char **) 0, 0},
45 { DEC_RPTR, "double precision", "float", (char **) 0, 0},
46 { DEC_CPTR, "double precision", "char", (char **) 0, 0},
47 { DEC_SPARSE, "double precision", "SciSparse", (char **) 0, 0},
48 { DEC_SPARSEPTR, "double precision", "SciSparse", (char **) 0, 0},
49 { DEC_INIT, "", "", (char **) 0, 0},
50 { DEC_SMAT, "Unimplemented", "char ", (char **) 0, 0},
51 { -1 , "void", "void", (char **) 0, 0}
52};
53
54void InitDeclare()
55{
56 int i = 0;
57 while ( Init[i].type != -1)
58 {
59 Init[i].decls = (char **) 0;
60 Init[i].ndecls = 0 ;
61 i++;
62 }
63}
64
65void ResetDeclare()
66{
67 int j = 0;
68 while ( Init[j].type != -1)
69 {
70 if ( Init[j].decls != (char **) 0)
71 {
72 int i;
73 for ( i = 0 ; i < Init[j].ndecls ; i++ )
74 free((char *) Init[j].decls[i]);
75 free (( char *) Init[j].decls );
76 }
77 Init[j].decls = (char **) 0;
78 Init[j].ndecls = 0;
79 j++;
80 }
81}
82
83int CheckDeclare(int type, char *declaration)
84{
85 int j = 0;
86 while ( Init[j].type != -1)
87 {
88 if ( Init[j].type == type )
89 {
90 int i;
91 for ( i = 0 ; i < Init[j].ndecls ; i++ )
92 {
93 if ( strcmp(declaration, Init[j].decls[i]) == 0)
94 return(1);
95 }
96 return(0);
97 }
98 j++;
99 }
100 return(0);
101}
102
103/***************************
104 * AddDeclare1(type,format,arg1,...,argn)
105 ***************************/
106
107#define DECLAREBUF 128
108
109#include <stdarg.h>
110
111void AddDeclare1(int type, char *format, ...)
112{
113 char decbuf[DECLAREBUF];
114 va_list ap;
115 va_start(ap, format);
116
117 vsprintf(decbuf, format, ap);
118 AddDeclare(type, decbuf);
119 va_end(ap);
120}
121
122void AddDeclare(int type, char *declaration)
123{
124 int j = 0;
125 if ( declaration[0] == '&' ) return ;
126 if ( CheckDeclare(type, declaration) == 1) return ;
127 while ( Init[j].type != -1)
128 {
129 if ( Init[j].type == type )
130 {
131 if ( Init[j].decls != (char **) 0)
132 {
133 (Init[j].ndecls)++;
134 Init[j].decls = (char **) realloc((char *) Init[j].decls, (unsigned) (Init[j].ndecls ) * sizeof(char *));
135 }
136 else
137 {
138 (Init[j].ndecls)++;
139 Init[j].decls = (char **) malloc ( (unsigned) (Init[j].ndecls ) * sizeof(char *));
140 }
141 if ( Init[j].decls == ( char **) 0)
142 {
143 fprintf(stderr, "No more space\n");
144 exit(1);
145 }
146 Init[j].decls[Init[j].ndecls - 1] = (char*) malloc((unsigned) (strlen(declaration) + 1) * sizeof(char));
147 if ( Init[j].decls[Init[j].ndecls - 1] == ( char *) 0)
148 {
149 fprintf(stderr, "No more space\n");
150 exit(1);
151 }
152 strcpy( Init[j].decls[Init[j].ndecls - 1], declaration );
153 }
154 j++;
155 }
156}
157
158
159void WriteInitDeclarations(FILE *f)
160{
161 int j = 0;
162 int i;
163 while ( Init[j].type != -1)
164 {
165 if ( Init[j].type == DEC_INIT)
166 {
167 for (i = 0 ; i < Init[j].ndecls ; i++)
168 {
169 Fprintf(f, indent, "%s", Init[j].decls[i]);
170 Fprintf(f, indent, ";\n");
171 }
172 }
173 j++;
174 }
175}
176
177
178void WriteDeclaration(FILE *f)
179{
180 int j = 0;
181 int i;
182 while ( Init[j].type != -1)
183 {
184 if ( Init[j].type == DEC_INIT)
185 {}
186 else if ( Init[j].type == DEC_DATA )
187 {
188 for (i = 0 ; i < Init[j].ndecls ; i++)
189 {
190 Fprintf(f, indent, "%s ", Init[j].nameC);
191 Fprintf(f, indent, "%s", Init[j].decls[i]);
192 Fprintf(f, indent, ";\n");
193 }
194 }
195 else
196 {
197 if ( Init[j].ndecls != 0)
198 Fprintf(f, indent, "%s ", Init[j].nameC);
199 for (i = 0 ; i < Init[j].ndecls ; i++)
200 {
201 if ( Init[j].type >= DEC_IPTR && target == 'C')
202 {
203 /* pointers declaration */
204 Fprintf(f, indent, "*");
205 }
206 else if ( Init[j].type == DEC_SMAT && target == 'C')
207 {
208 Fprintf(f, indent, "**");
209 }
210 Fprintf(f, indent, "%s", Init[j].decls[i]);
211 if ( i != Init[j].ndecls - 1 ) Fprintf(f, indent, ",");
212 else
213 {
214 Fprintf(f, indent, ";\n");
215 }
216 }
217 }
218 j++;
219 }
220
221 WriteInitDeclarations(f);
222}
223
diff --git a/scilab/modules/intersci/src/exe/declare.h b/scilab/modules/intersci/src/exe/declare.h
deleted file mode 100644
index 6d0175e..0000000
--- a/scilab/modules/intersci/src/exe/declare.h
+++ /dev/null
@@ -1,25 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2007-2008 - INRIA - Sylvestre LEDRU
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13/**
14 * TODO : comment
15 * @param type
16 * @param declaration
17 * @return int
18 */
19int CheckDeclare(int type,char *declaration);
20
21/**
22 * TODO : comment
23 * @param f
24 */
25void WriteInitDeclarations(FILE *f);
diff --git a/scilab/modules/intersci/src/exe/fornames.c b/scilab/modules/intersci/src/exe/fornames.c
deleted file mode 100644
index fa914f0..0000000
--- a/scilab/modules/intersci/src/exe/fornames.c
+++ /dev/null
@@ -1,241 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13#include "intersci-n.h"
14#include "fornames.h"
15/*****************************************************************
16 * The main function here is FixForNames
17 * FixForNames is used to give C or Fortran Names to Scilab
18 * input arguments and to external variables
19 * For example if a matrix m n is a Scilab input arguments
20 * a->el[0] points to variable m and a->el[1] points to
21 * variable n
22 * According to the stack_position of a (for example suppose here
23 * that a is the 4th argument) for_names are added to m and n
24 * m -> m4 and n -> n4
25 * If m is a common dimension for a set of variables
26 * then m will have more than one for_names at the end of FixForName
27 * execution
28 ******************************************************************/
29
30extern int indent ; /* incremental counter for code indentation */
31extern int pass; /* flag for couting pass on code generation */
32
33static char str[MAXNAM];
34static char str1[MAXNAM];
35
36void StrGen(char *strl,VARPTR var)
37{
38 if ( var->for_type == EXTERNAL )
39 {
40 /** variables me1 or me1e1 */
41 if ( var->list_el == 0 )
42 sprintf(str,"%se%d",strl,var->stack_position);
43 else
44 sprintf(str,"%se%de%d",strl,var->stack_position,var->list_el);
45 }
46 else
47 {
48 if ( var->list_el == 0 )
49 sprintf(str,"%s%d",strl,var->stack_position);
50 else
51 sprintf(str,"%s%de%d",strl,var->stack_position,var->list_el);
52 }
53}
54
55
56void ForMATRIX(VARPTR var)
57{
58 StrGen("m",var);
59 AddForName1(var->el[0],str,NULL,var->stack_position);
60 StrGen("n",var);
61 AddForName1(var->el[1],str,NULL,var->stack_position);
62}
63
64
65void ForSTRING(VARPTR var)
66{
67 StrGen("m",var);
68 AddForName1(var->el[0],str,NULL,var->stack_position);
69}
70
71
72void ForIMATRIX(VARPTR var)
73{
74 StrGen("m",var);
75 AddForName1(var->el[0],str,NULL,var->stack_position);
76 StrGen("n",var);
77 AddForName1(var->el[1],str,NULL,var->stack_position);
78 StrGen("it",var);
79 AddForName1(var->el[2],str,NULL,var->stack_position);
80}
81
82void ForSPARSE(VARPTR var)
83{
84 StrGen("m",var);
85 AddForName1(var->el[0],str,NULL,var->stack_position);
86 StrGen("n",var);
87 AddForName1(var->el[1],str,NULL,var->stack_position);
88}
89
90
91void ForROW(VARPTR var)
92{
93 StrGen("n",var);
94 AddForName1(var->el[0],str,NULL,var->stack_position);
95}
96
97void ForCOLUMN(VARPTR var)
98{
99 StrGen("m",var);
100 AddForName1(var->el[0],str,NULL,var->stack_position);
101}
102
103void ForVECTOR(VARPTR var)
104{
105 if ( var->for_type == EXTERNAL )
106 {
107 if ( var->list_el == 0 )
108 sprintf(str,"me%d",var->stack_position);
109 else
110 sprintf(str,"l%dme%d",var->stack_position,var->list_el);
111 AddForName1(var->el[0],str,NULL,var->stack_position);
112 }
113 else
114 {
115 if ( var->list_el == 0 )
116 {
117 sprintf(str,"m%d*n%d",var->stack_position,var->stack_position);
118 sprintf(str1,"mn%d",var->stack_position);
119 AddForName1(var->el[0],str,str1,var->stack_position);
120 }
121 else
122 {
123 sprintf(str,"l%dm%d*l%dn%d",var->stack_position,var->list_el,
124 var->stack_position,var->list_el);
125 sprintf(str1,"l%dmn%d",var->stack_position,var->list_el);
126 AddForName1(var->el[0],str,str1,var->stack_position);
127 }
128 }
129}
130
131void ForPOLYNOM(VARPTR var)
132{
133 StrGen("m",var);
134 AddForName1(var->el[0],str,NULL,var->stack_position);
135}
136
137/** special case for scalars : we add a for_name to var itself
138 since var can be used as a dimension of other variables **/
139
140void ForSCALAR(VARPTR var)
141{
142 StrGen("m",var);
143 AddForName1(var->vpos,str,NULL,var->stack_position);
144}
145
146
147void ForPOINTER(VARPTR var)
148{
149}
150
151void ForANY(VARPTR var){}
152
153void ForLIST(VARPTR var){}
154
155void ForTLIST(VARPTR var){}
156
157
158void ForSEQUENCE(VARPTR var)
159{
160 fprintf(stderr,"Wrong type in For function\n");
161}
162
163void ForEMPTY(VARPTR var)
164{
165 fprintf(stderr,"Wrong type in For function\n");
166}
167
168
169void ForWORK(VARPTR var)
170{
171 fprintf(stderr,"Wrong type in For function\n");
172}
173
174void ForDIMFOREXT(VARPTR var)
175{
176
177}
178
179typedef struct {
180 int type;
181 void (*fonc) (VARPTR var);} ForRhsTab ;
182
183
184ForRhsTab FORTAB[] = {
185 {DIMFOREXT,ForDIMFOREXT},
186 {COLUMN,ForCOLUMN},
187 {LIST,ForLIST},
188 {TLIST,ForTLIST},
189 {MATRIX,ForMATRIX},
190 {POLYNOM,ForPOLYNOM},
191 {ROW,ForROW},
192 {SCALAR,ForSCALAR},
193 {SEQUENCE,ForSEQUENCE},
194 {STRING,ForSTRING},
195 {WORK,ForWORK},
196 {EMPTY,ForEMPTY},
197 {ANY,ForANY},
198 {VECTOR,ForVECTOR},
199 {STRINGMAT,ForMATRIX},
200 {SCIMPOINTER,ForPOINTER},
201 {IMATRIX,ForIMATRIX},
202 {SCISMPOINTER,ForPOINTER},
203 {SCILPOINTER,ForPOINTER},
204 {BMATRIX,ForMATRIX},
205 {SCIBPOINTER,ForPOINTER},
206 {SCIOPOINTER,ForPOINTER},
207 {SPARSE,ForSPARSE}
208};
209
210
211void FixForNames()
212{
213 int i;
214 VARPTR var,var1;
215 for (i = 0; i < basfun->nin ; i++)
216 {
217 int j;
218 var = variables[i];
219 (*(FORTAB[var->type].fonc))(var);
220 /** If we have a list we must also explore the list elements **/
221 if ( var->type == LIST || var->type == TLIST )
222 {
223 for ( j = 0 ; j < nVariable ; j++)
224 {
225 var1 = variables[j];
226 if ( var1->stack_position == i+1 && var1->list_el != 0)
227 (*(FORTAB[var1->type].fonc))(var1);
228 }
229 }
230 }
231 for (i = basfun->nin ; i < nVariable ; i++)
232 {
233 var = variables[i];
234 if ( var->for_type == EXTERNAL )
235 {
236 (*(FORTAB[var->type].fonc))(var);
237 }
238 }
239}
240
241
diff --git a/scilab/modules/intersci/src/exe/fornames.h b/scilab/modules/intersci/src/exe/fornames.h
deleted file mode 100644
index a856bb2..0000000
--- a/scilab/modules/intersci/src/exe/fornames.h
+++ /dev/null
@@ -1,17 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2007-2008 - IRNIA - Sylvestre LEDRU
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13/**
14 * TODO : comment
15 *
16 */
17void FixForNames(void);
diff --git a/scilab/modules/intersci/src/exe/getrhs.c b/scilab/modules/intersci/src/exe/getrhs.c
deleted file mode 100644
index d39cc94..0000000
--- a/scilab/modules/intersci/src/exe/getrhs.c
+++ /dev/null
@@ -1,569 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13#include <stdlib.h>
14#include "intersci-n.h"
15#include "getrhs.h"
16
17/*****************************************************************
18 * For each possible data type we have here a function
19 * [1] which generate the code for <<Getting>> a variable
20 * and checking some properties
21 * if needed check if the variable is square
22 * if needed check if some dimensions must be of fixed sizes
23 * [2] generate the code for type convertion if needed
24 * [3] computes the string for the C or Fortran calling sequence
25 * which is stored in the variable structure
26 * All the possible Getfunction are stored in a function table
27 ******************************************************************/
28
29/******************************************************
30 * the functions in the following table must follow the
31 * order given by the type list defined in intersci-n.h
32 * The correct ordering is checked when using this table.
33 * (see intersci.c)
34 ********************************************************/
35
36GetRhsTab RHSTAB[] = {
37 {DIMFOREXT,GetDIMFOREXT},
38 {COLUMN,GetCOLUMN},
39 {LIST,GetLIST},
40 {TLIST,GetTLIST},
41 {MATRIX,GetMATRIX},
42 {POLYNOM,GetPOLYNOM},
43 {ROW,GetROW},
44 {SCALAR,GetSCALAR},
45 {SEQUENCE,GetSEQUENCE},
46 {STRING,GetSTRING},
47 {WORK,GetWORK},
48 {EMPTY,GetEMPTY},
49 {ANY,GetANY},
50 {VECTOR,GetVECTOR},
51 {STRINGMAT,GetSTRINGMAT},
52 {SCIMPOINTER,GetPOINTER},
53 {IMATRIX,GetIMATRIX},
54 {SCISMPOINTER,GetPOINTER},
55 {SCILPOINTER,GetPOINTER},
56 {BMATRIX,GetBMATRIX},
57 {SCIBPOINTER,GetPOINTER},
58 {SCIOPOINTER,GetPOINTER},
59 {SPARSE,GetSPARSE}
60};
61
62extern int indent ; /* incremental counter for code indentation */
63extern int pass; /* flag for couting pass on code generation */
64
65static char str[MAXNAM];
66static char str1[MAXNAM];
67static char str2[MAXNAM];
68
69/***********************************************
70 * Matrix OK
71 * flag is used for optional variables
72 * f(..... x=val)
73 ***********************************************/
74
75void GetMATRIX(FILE *f,VARPTR var,int flag)
76{
77 GetCom(f,var,flag);
78 /** str1 was set by GetCom */
79 CheckSquare(f,var,str1,str2);
80 Check(f,var,0);
81 Check(f,var,1);
82}
83
84/** common function for different data types */
85
86void GetCom(FILE *f,VARPTR var,int flag)
87{
88 static char C[]="GetRhsVar(%s,\"%s\",&m%d,&n%d,&l%d);\n";
89 static char LC[]="GetListRhsVar(%s,%d,\"%s\",&m%s,&n%s,&l%s);\n";
90 int i1= var->stack_position;
91 if ( flag == 1 )
92 sprintf(str2,"k");
93 else
94 sprintf(str2,"%d",i1);
95 if (var->list_el ==0 )
96 {
97 /** A scilab matrix argument **/
98 sprintf(str1,"%d",i1);
99 Fprintf(f,indent,C,str2,SGetForTypeAbrev(var),i1,i1,i1);
100 /* Adding the calling sequence in the for_names */
101 ChangeForName2(var,"%s(l%s)",SGetForTypeStack(var),str1);
102 }
103 else
104 {
105 /** A scilab matrix argument inside a list **/
106 sprintf(str1,"%de%d",i1,var->list_el);
107 Fprintf(f,indent,LC,str2,var->list_el,SGetForTypeAbrev(var),str1,str1,str1,str1);
108 /* Adding the calling sequence in the for_names */
109 ChangeForName2(var,"%s(l%s)",SGetForTypeStack(var),str1);
110 }
111 AddDeclare1(DEC_INT,"m%s",str1);
112 AddDeclare1(DEC_INT,"n%s",str1);
113 AddDeclare1(DEC_INT,"l%s",str1);
114}
115
116
117
118
119/***********************************************
120 * STRING : OK
121 ***********************************************/
122
123void GetSTRING(FILE *f,VARPTR var,int flag)
124{
125 if (var->for_type != CHAR)
126 {
127 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
128 SGetSciType(STRING),SGetForType(var->for_type),var->name);
129 exit(1);
130 }
131 GetCom(f,var,flag);
132 Check(f,var,0);
133}
134
135/***********************************************
136 * Boolean matrix OK
137 ***********************************************/
138
139
140void GetBMATRIX(FILE *f, VARPTR var, int flag)
141
142{
143 if (var->for_type != INT && var->for_type != BOOLEAN)
144 {
145 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
146 SGetSciType(var->type),SGetForType(var->for_type),var->name);
147 exit(1);
148 }
149 var->for_type = BOOLEAN;
150 GetCom(f,var,flag);
151 /** str1 was set by GetCom */
152 CheckSquare(f,var,str1,str2);
153 Check(f,var,0);
154 Check(f,var,1);
155}
156
157/***********************************************
158 * Complex Matrix
159 ***********************************************/
160
161void GetIMATRIX(FILE *f,VARPTR var,int flag)
162{
163 static char C[]="GetRhsCVar(%s,\"%s\",&it%d,&m%d,&n%d,&lr%d,&lc%d);\n";
164 static char LC[]="GetListRhsCVar(%s,%d,\"%s\",&it%s,&m%s,&n%s,&lr%s,&lc%s,&lar%s,&lac%s);\n";
165 int i1= var->stack_position;
166 if ( flag == 1 )
167 sprintf(str2,"k");
168 else
169 sprintf(str2,"%d",i1);
170 if (var->list_el ==0 )
171 {
172 /** A scilab matrix argument **/
173 sprintf(str1,"%d",i1);
174 Fprintf(f,indent,C,str2,SGetForTypeAbrev(var),
175 i1,i1,i1,i1,i1);
176 /* Adding the calling sequence in the for_names */
177 ChangeForName2(var,"%s(lr%s),%s(lc%s),&it%s",
178 SGetForTypeStack(var),str1,
179 SGetForTypeStack(var),str1,str1);
180 }
181 else
182 {
183 /** A scilab matrix argument inside a list **/
184 sprintf(str1,"%de%d",i1,var->list_el);
185 AddDeclare1(DEC_INT,"lar%s",str1);
186 AddDeclare1(DEC_INT,"lac%s",str1);
187 Fprintf(f,indent,LC,str2,var->list_el,SGetForTypeAbrev(var),
188 str1,str1,str1,str1,str1,str1,str1);
189 /* Adding the calling sequence in the for_names */
190 ChangeForName2(var,"%s(lr%s),%s(lc%s),&it%s",
191 SGetForTypeStack(var),str1,
192 SGetForTypeStack(var),str1,str1);
193 }
194
195 AddDeclare1(DEC_INT,"m%s",str1);
196 AddDeclare1(DEC_INT,"n%s",str1);
197 AddDeclare1(DEC_INT,"lr%s",str1);
198 AddDeclare1(DEC_INT,"lc%s",str1);
199 AddDeclare1(DEC_INT,"it%s",str1);
200
201 /** str1 was set by GetCom */
202 CheckSquare(f,var,str1,str2);
203 Check(f,var,0);
204 Check(f,var,1);
205}
206
207
208/***********************************************
209 * Sparse Matrix
210 ***********************************************/
211
212void GetSPARSE(FILE *f,VARPTR var,int flag)
213{
214 static char C[]="GetRhsVar(%s,\"s\",&m%d,&n%d,&S%d);\n";
215 static char LC[]="GetListRhsVar(%s,%d,\"s\",&m%s,&n%s,&S%s);\n";
216 int i1= var->stack_position;
217 if ( flag == 1 )
218 sprintf(str2,"k");
219 else
220 sprintf(str2,"%d",i1);
221 if (var->list_el ==0 )
222 {
223 /** A scilab matrix argument **/
224 sprintf(str1,"%d",i1);
225 Fprintf(f,indent,C,str2, i1,i1,i1);
226 /* Adding the calling sequence in the for_names */
227 ChangeForName2(var,"&S%d",i1);
228 }
229 else
230 {
231 /** A scilab matrix argument inside a list **/
232 sprintf(str1,"%de%d",i1,var->list_el);
233 Fprintf(f,indent,LC,str2,var->list_el, str1,str1,str1);
234 /* Adding the calling sequence in the for_names */
235 ChangeForName2(var,"&S%s",str1);
236 }
237
238 AddDeclare1(DEC_INT,"m%s",str1);
239 AddDeclare1(DEC_INT,"n%s",str1);
240 AddDeclare1(DEC_SPARSE,"S%s",str1);
241
242 /** str1 was set by GetCom */
243 CheckSquare(f,var,str1,str2);
244 Check(f,var,0);
245 Check(f,var,1);
246}
247
248
249
250
251/***********************************************
252 * Stringmat
253 ***********************************************/
254
255void GetSTRINGMAT(FILE *f,VARPTR var,int flag)
256{
257 int i1= var->stack_position;
258 if ( flag == 1 )
259 sprintf(str2,"k");
260 else
261 sprintf(str2,"%d",i1);
262 if (var->list_el ==0 )
263 {
264 AddDeclare1(DEC_SMAT,"Str%d",i1);
265 AddDeclare1(DEC_INT,"m%d",i1);
266 AddDeclare1(DEC_INT,"n%d",i1);
267 Fprintf(f,indent,"GetRhsVar(%s,\"S\",&m%d,&n%d,&Str%d);\n",str2,i1,i1,i1);
268 sprintf(str,"&Str%d",i1);
269 ChangeForName1(var,str);
270 }
271 else
272 {
273 sprintf(str1,"%de%d",i1,var->list_el);
274 AddDeclare1(DEC_SMAT,"Str%s",str1);
275 AddDeclare1(DEC_INT,"m%s",str1);
276 AddDeclare1(DEC_INT,"n%s",str1);
277 Fprintf(f,indent,"GetListRhsVar(%s,%d,\"S\",&m%s,&n%s,&Str%s);\n",str2,var->list_el,
278 str1,str1,str1);
279 sprintf(str,"&Str%s",str1);
280 ChangeForName1(var,str);
281 }
282 /* square matrix */
283 CheckSquare(f,var,str1,str2);
284 Check(f,var,0);
285 Check(f,var,1);
286 if (var->for_type != CSTRINGV)
287 {
288 printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
289 SGetSciType(STRINGMAT),SGetForType(var->for_type),var->name);
290 exit(1);
291 }
292}
293
294/***********************************************
295 * Row
296 ***********************************************/
297
298void GetROW(FILE *f,VARPTR var,int flag)
299{
300 int i1= var->stack_position;
301 GetCom(f,var,flag);
302 Check(f,var,0);
303 if (var->list_el ==0 )
304 {
305 Fprintf(f,indent,"CheckRow(%d,m%d,n%d);\n",i1,i1,i1);
306 Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
307 AddDeclare1(DEC_INT,"mn%d",i1);
308 }
309 else
310 {
311 sprintf(str1,"%de%d",i1,var->list_el);
312 Fprintf(f,indent,"CheckListRow(%d,%d,m%s,n%s);\n",i1,var->list_el,str1,str1);
313 Fprintf(f,indent,"l%dmn%d=m%s*n%s;\n",i1,var->list_el,str1,str1);
314 AddDeclare1(DEC_INT,"l%dmn%d",i1,var->list_el);
315 }
316}
317
318
319/***********************************************
320 * Column
321 ***********************************************/
322
323void GetCOLUMN(FILE *f,VARPTR var,int flag)
324{
325 int i1= var->stack_position;
326 GetCom(f,var,flag);
327 Check(f,var,0);
328 if (var->list_el ==0 )
329 {
330 Fprintf(f,indent,"CheckColumn(%d,m%d,n%d);\n",i1,i1,i1);
331 Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
332 AddDeclare1(DEC_INT,"mn%d",i1);
333 }
334 else
335 {
336 sprintf(str1,"%de%d",i1,var->list_el);
337 Fprintf(f,indent,"CheckListColumn(%d,%d,m%s,n%s);\n",i1,var->list_el,str1,str1);
338 Fprintf(f,indent,"l%dmn%d=m%s*n%s;\n",i1,var->list_el,str1,str1);
339 AddDeclare1(DEC_INT,"l%dmn%d",i1,var->list_el);
340 }
341}
342
343/***********************************************
344 * Vector
345 ***********************************************/
346
347void GetVECTOR(FILE *f,VARPTR var,int flag)
348{
349 int i1= var->stack_position;
350 GetCom(f,var,flag);
351 Check(f,var,0);
352 if (var->list_el ==0 )
353 {
354 Fprintf(f,indent,"CheckVector(%d,m%d,n%d);\n",i1,i1,i1);
355 Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
356 AddDeclare1(DEC_INT,"mn%d",i1);
357 }
358 else
359 {
360 sprintf(str1,"%de%d",i1,var->list_el);
361 Fprintf(f,indent,"CheckListVector(%d,%d,m%s,n%s);\n",i1,var->list_el,str1,str1);
362 Fprintf(f,indent,"l%dmn%d=m%s*n%s;\n",i1,var->list_el,str1,str1);
363 AddDeclare1(DEC_INT,"l%dmn%d",i1,var->list_el);
364 }
365}
366
367/***********************************************
368 * Polynom
369 ***********************************************/
370
371void GetPOLYNOM(FILE *f,VARPTR var,int flag)
372{
373 int i1= var->stack_position;
374 if (var->list_el ==0 )
375 {
376 sprintf(str1,"%d",i1);
377 AddDeclare(DEC_LOGICAL,"getonepoly");
378 AddDeclare(DEC_CHAR,str);
379 Fprintf(f,indent,"if(.not.getonepoly(fname,top,top-rhs+%d,it%d,m%d,namelr%d,namellr%d,lr%d,lc%d)\n",i1,i1,i1,i1,i1,i1,i1);
380 }
381 else
382 {
383 sprintf(str1,"%de%d",i1,var->list_el);
384 AddDeclare(DEC_LOGICAL,"getlistpoly");
385 Fprintf(f,indent,"if(.not.getlistpoly(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,name%s,\n",
386 i1,var->list_el,str1,str1,str1,str1);
387 Fprintf(f,indent,"$ namel%s,ilp%s,lr%s,lc%s)\n",str1,str1,str1,str1);
388 }
389 Check(f,var,0);
390 /* Convertion */
391 switch (var->for_type)
392 {
393 case INT:
394 Fprintf(f,indent,"call entier(n%s,stk(lr%s),istk(iadr(lr%s)))\n",
395 str1,str1,str1);
396 sprintf(str,"istk(iadr(lr%s))",str1);
397 ChangeForName1(var,str);
398 break;
399 case REAL:
400 Fprintf(f,indent,"call simple(n%s,stk(lr%s),stk(lr%s))\n",
401 str1,str1,str1);
402 sprintf(str,"stk(lr%s)",str1);
403 ChangeForName1(var,str);
404 break;
405 case DOUBLE:
406 sprintf(str,"stk(lr%s)",str1);
407 ChangeForName1(var,str);
408 break;
409 default:
410 printf("incompatibility between Scilab and Fortran type for variable \"%s\"\n",
411 var->name);
412 exit(1);
413 }
414}
415
416/***********************************************
417 * Scalar
418 ***********************************************/
419
420void GetSCALAR(FILE *f,VARPTR var,int flag)
421{
422 int i1= var->stack_position;
423 GetCom(f,var,flag);
424 /* Check(f,var,0); */
425 if (var->list_el ==0 )
426 {
427 Fprintf(f,indent,"CheckScalar(%d,m%d,n%d);\n",i1,i1,i1);
428 }
429 else
430 {
431 sprintf(str1,"%de%d",i1,var->list_el);
432 Fprintf(f,indent,"CheckListScalar(%d,%d,m%s,n%s);\n",i1,var->list_el,str1,str1);
433 }
434}
435
436/***********************************************
437 * Pointers
438 ***********************************************/
439
440void GetPOINTER(FILE *f,VARPTR var,int flag)
441{
442 static char C[]="GetRhsOPointer(%s,&lr%d);\n";
443 int i1= var->stack_position;
444 if ( flag == 1 )
445 sprintf(str2,"k");
446 else
447 sprintf(str2,"%d",i1);
448 sprintf(str1,"%d",i1);
449 if (var->list_el ==0 )
450 {
451 /** A scilab matrix argument **/
452 sprintf(str1,"%d",i1);
453 Fprintf(f,indent,C,str2,i1);
454 /* Adding the calling sequence in the for_names */
455 ChangeForName2(var,"stk(lr%s)",str1);
456 }
457 else
458 {
459 fprintf(stderr,"Wrong type opointer inside a list\n");
460 exit(1);
461 }
462 AddDeclare1(DEC_INT,"lr%s",str1);
463
464}
465
466
467void GetANY(FILE *f,VARPTR var,int flag)
468{
469 fprintf(stderr,"Wrong type in Get function\n");
470 exit(1);
471}
472
473void GetLIST(FILE *f,VARPTR var,int flag)
474{
475 fprintf(stderr,"Wrong type in Get function\n");
476 exit(1);
477}
478
479void GetTLIST(FILE *f,VARPTR var,int flag)
480{
481 fprintf(stderr,"Wrong type in Get function\n");
482 exit(1);
483}
484
485void GetSEQUENCE(FILE *f,VARPTR var,int flag)
486{
487 fprintf(stderr,"Wrong type in Get function\n");
488 exit(1);
489}
490
491void GetEMPTY(FILE *f,VARPTR var,int flag)
492{
493 fprintf(stderr,"Wrong type in Get function\n");
494 exit(1);
495}
496
497void GetWORK(FILE *f,VARPTR var,int flag)
498{
499 fprintf(stderr,"Wrong type in Get function\n");
500 exit(1);
501}
502
503
504void GetDIMFOREXT(FILE *f,VARPTR var,int flag)
505{
506 fprintf(stderr,"Wrong type in Get function\n");
507 exit(1);
508}
509
510/***************************************
511 * Utility function for the Getfunctions
512 * Check for fixed sized dimensions
513 ***************************************/
514
515void Check(FILE *f,VARPTR var,int nel)
516{
517 VARPTR var1 = variables[var->el[nel]-1];
518 if ( var1->nfor_name == 0)
519 {
520 fprintf(stderr,"Pb with element number %d [%s] of variable %s\n",
521 nel+1, var1->name, var->name);
522 return;
523 }
524 if (isdigit(var1->name[0]) != 0)
525 {
526 /* the dimension of the variable is a constant int */
527 if ( strcmp(var1->for_name[0],var1->name) != 0)
528 {
529 if (var->list_el ==0 )
530 {
531 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,%s);\n",
532 var->stack_position,
533 nel+1,
534 var1->for_name[0],var1->name);
535 }
536 else
537 {
538 Fprintf(f,indent,"CheckListOneDim(%s,%d,%d,%s,%s);\n",
539 str2,
540 var->list_el,
541 nel+1,
542 var1->for_name[0],var1->name);
543 }
544 }
545 }
546}
547
548
549
550
551void CheckSquare(FILE *f,VARPTR var,char *str1_,char *str2_)
552{
553 if (var->el[0] != var->el[1]) return ;
554 if (var->list_el ==0 )
555 {
556 Fprintf(f,indent,"CheckSquare(%d,m%s,n%s);\n", var->stack_position,str1_,str1_);
557 }
558 else
559 {
560 Fprintf(f,indent,"CheckListSquare(%s,%d,m%s,n%s);\n",str2_, var->list_el,str1_,str1_);
561 }
562}
563
564
565
566
567
568
569
diff --git a/scilab/modules/intersci/src/exe/getrhs.h b/scilab/modules/intersci/src/exe/getrhs.h
deleted file mode 100644
index fd539ed..0000000
--- a/scilab/modules/intersci/src/exe/getrhs.h
+++ /dev/null
@@ -1,41 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13void GetMATRIX (FILE *f, VARPTR var, int flag);
14void GetCom (FILE *f, VARPTR var, int flag);
15void GetSTRING (FILE *f, VARPTR var, int flag);
16void GetBMATRIX (FILE *f, VARPTR var, int flag);
17void GetIMATRIX (FILE *f, VARPTR var, int flag);
18void GetSPARSE (FILE *f, VARPTR var, int flag);
19void GetSTRINGMAT (FILE *f, VARPTR var, int flag);
20void GetROW (FILE *f, VARPTR var, int flag);
21void GetCOLUMN (FILE *f, VARPTR var, int flag);
22void GetVECTOR (FILE *f, VARPTR var, int flag);
23void GetPOLYNOM (FILE *f, VARPTR var, int flag);
24void GetSCALAR (FILE *f, VARPTR var, int flag);
25void GetPOINTER (FILE *f, VARPTR var, int flag);
26void GetANY (FILE *f, VARPTR var, int flag);
27void GetLIST (FILE *f, VARPTR var, int flag );
28void GetTLIST (FILE *f, VARPTR var, int flag);
29void GetSEQUENCE (FILE *f, VARPTR var, int flag);
30void GetEMPTY (FILE *f, VARPTR var, int flag);
31void GetWORK (FILE *f, VARPTR var, int flag);
32void GetDIMFOREXT (FILE *f, VARPTR var, int flag);
33void Check (FILE *f, VARPTR var, int nel);
34void CheckSquare (FILE *f, VARPTR var, char *str1,char *);
35
36typedef struct {
37 int type;
38 void (*fonc)(FILE *f, VARPTR var, int flag ) ;} GetRhsTab ;
39
40extern GetRhsTab RHSTAB[];
41
diff --git a/scilab/modules/intersci/src/exe/intersci-n.c b/scilab/modules/intersci/src/exe/intersci-n.c
deleted file mode 100644
index e3add22..0000000
--- a/scilab/modules/intersci/src/exe/intersci-n.c
+++ /dev/null
@@ -1,1093 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 * Copyright (C) 2010 - DIGITEO - Allan CORNET
5 *
6 * This file must be used under the terms of the CeCILL.
7 * This source file is licensed as described in the file COPYING, which
8 * you should have received as part of this distribution. The terms
9 * are also available at
10 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
11 *
12*/
13
14#include <stdlib.h>
15#ifdef _MSC_VER
16#include <windows.h>
17#endif
18#include <stdio.h>
19#include "intersci-n.h"
20#include "getrhs.h"
21#include "crerhs.h"
22#include "os_strdup.h"
23
24/* global variables */
25
26int icre = 1; /* incremental counter for variable creation */
27int indent = 0; /* incremental counter for code indentation */
28int pass = 0; /* flag for couting pass on code generation */
29char target = 'C'; /* langage for generation */
30
31VARPTR variables[MAXVAR]; /* array of VAR structures */
32int nVariable; /* number of variables */
33BASFUNPTR basfun; /* SCILAB function structure */
34FORSUBPTR forsub; /* FORTRAN subroutine structure */
35int nFun; /* total number of functions in "desc" file */
36char *funNames[MAXFUN]; /* array of function names */
37char str1[4 * MAXNAM];
38char str2[4 * MAXNAM];
39
40static void GenBuilder(char *file, char *files, char *libs);
41void CheckCreateOrder(void);
42
43/* local variables */
44
45int main(int argc, char **argv)
46{
47 char *files, *libs;
48 char *file;
49 int SciLabinterface = 0;
50
51 fprintf(stderr, "WARNING: This program is deprecated and will be removed with Scilab 6.0.0. Please use SWIG ( http://www.swig.org/ ) instead.\n\n");
52
53 switch (argc)
54 {
55 case 2:
56 file = argv[1];
57 target = 'C';
58 SciLabinterface = 0;
59 files = NULL;
60 libs = NULL;
61 break;
62 case 3:
63 file = argv[1];
64 target = 'C';
65 SciLabinterface = 0;
66 files = argv[2];
67 libs = NULL;
68 break;
69 case 4:
70 file = argv[1];
71 target = 'C';
72 SciLabinterface = 0;
73 files = argv[2];
74 libs = argv[3];
75 break;
76 default:
77 printf("Usage: intersci <interface file> 'files' 'libs'\n");
78 printf("intersci is a program for building an interface file between Scilab\n");
79 printf("and C/Fortran functions/subroutines.\n");
80 printf("See : http://www.scilab.org/doc/intersci.pdf\n");
81 exit(1);
82 break;
83 }
84 basfun = BasfunAlloc();
85 if (basfun == 0)
86 {
87 printf("Running out of memory\n");
88 exit(1);
89 }
90 forsub = ForsubAlloc();
91 if (forsub == 0)
92 {
93 printf("Running out of memory\n");
94 exit(1);
95 }
96 Generate(file);
97 GenFundef(file, SciLabinterface);
98 GenBuilder(file, files, libs);
99 exit(0);
100}
101
102/**
103* Produce the interface
104* @param file
105*/
106
107void Generate(char *file)
108{
109 int icrekp;
110 FILE *fin, *fout, *foutv;
111 char filout[MAXNAM];
112 char filin[MAXNAM];
113
114 sprintf(filin, "%s.desc", file);
115 fin = fopen(filin, "rt");
116 if (fin == 0)
117 {
118 printf("Interface file \"%s\" does not exist\n", filin);
119 exit(1);
120 }
121 Copyright();
122 strcpy(filout, file);
123 strcat(filout, (target == 'F') ? ".f" : ".c");
124 fout = fopen(filout, "wt");
125 strcpy(filout, file);
126 strcat(filout, ".tmp");
127 foutv = fopen(filout, "wt");
128 InitDeclare();
129 nFun = 0;
130 Fprintf(fout, indent, "#include \"stack-c.h\"\n");
131 while (ReadFunction(fin))
132 {
133 nFun++;
134 if (nFun > MAXFUN)
135 {
136 printf("Too many SCILAB functions. The maximum is %d\n", MAXFUN);
137 exit(1);
138 }
139 pass = 0;
140 /** changing stack_positions (external variables are not in the stack)**/
141 FixStackPositions();
142 icrekp = icre;
143 FixForNames();
144 ResetDeclare();
145 /** ShowVariables();**/
146 /* first pass to collect declarations */
147 WriteFunctionCode(foutv);
148 /* cleaning added Fornames before pass 2 */
149 ForNameClean();
150 FixForNames();
151 /* scond pass to produce code */
152 pass = 1;
153 icre = icrekp;
154 WriteFunctionCode(fout);
155 /** WriteInfoCode(fout); **/
156 }
157 /* WriteMain(fout,file); */
158 printf("C file \"%s.c\" has been created\n", file);
159 /* WriteAddInter(file) ;
160 * printf("Scilab file \"%s.sce\" has been created\n",file); */
161 fclose(fout);
162 fclose(fin);
163}
164
165/***************************************************************
166* Interface function
167***************************************************************/
168
169void WriteMain(FILE * f, char *file)
170{
171 int i;
172
173 FCprintf(f, "\n/**********************\n");
174 FCprintf(f, " * interface function\n");
175 FCprintf(f, " ********************/\n");
176 Fprintf(f, indent++, "static TabF Tab[]={\n");
177 for (i = 0; i < nFun; i++)
178 {
179 Fprintf(f, indent, "{ ints%s, \"%s\"},\n", funNames[i], funNames[i]);
180 }
181 Fprintf(f, --indent, "};\n\n");
182 Fprintf(f, indent, "int C2F(%s)()\n", file);
183 Fprintf(f, indent++, "{\n");
184 Fprintf(f, indent, "Rhs=Max(0,Rhs);\n");
185 Fprintf(f, indent, "(*(Tab[Fin-1].f))(Tab[Fin-1].name);\n");
186 Fprintf(f, indent, "return 0;\n");
187 Fprintf(f, --indent, "};\n");
188
189}
190
191/***************************************************************
192* Code for addinter
193***************************************************************/
194
195void WriteAddInter(char *file)
196{
197 FILE *fout;
198 int i;
199 char filout[MAXNAM];
200
201 strcpy(filout, file);
202 strcat(filout, ".sce");
203 fout = fopen(filout, "w");
204 if (fout != (FILE *) 0)
205 {
206 fprintf(fout, "// Addinter for file %s\n", file);
207 fprintf(fout, "// for hppa/sun-solaris/linux/dec\n");
208 fprintf(fout, "//--------------------------------\n");
209 fprintf(fout, "//Scilab functions\n");
210 fprintf(fout, "%s_funs=[...\n", file);
211 for (i = 0; i < nFun - 1; i++)
212 fprintf(fout, " '%s';\n", funNames[i]);
213 fprintf(fout, " '%s']\n", funNames[nFun - 1]);
214 fprintf(fout, "// interface file to link: ifile='%s.o'\n", file);
215 fprintf(fout, "// user's files to link: ufiles=['file1.o','file2.o',....]\n");
216 fprintf(fout, "addinter([files],'%s',%s_funs);\n", file, file);
217 fclose(fout);
218 }
219 else
220 fprintf(stderr, "Can't open file %s\n", file);
221}
222
223void Copyright()
224{
225 printf("\nINTERSCI Version %s (%s)\n", VERSION, DATE);
226 printf(" Copyright (C) INRIA/ENPC All rights reserved\n\n");
227}
228
229/***************************************************************
230Code generation
231***************************************************************/
232
233void WriteHeader(FILE * f, char *fname0, char *fname)
234{
235 Fprintf(f, indent, "\nint %s%s(char *fname)\n", fname0, fname);
236 Fprintf(f, indent, "{\n");
237 indent++;
238 WriteDeclaration(f);
239}
240
241void WriteFunctionCode(FILE * f)
242{
243 int i;
244 IVAR ivar;
245
246 if (pass == 1)
247 {
248 printf(" generating C interface for function (%s) Scilab function\"%s\"\n", forsub->name, basfun->name);
249 }
250 FCprintf(f, "/******************************************\n");
251 FCprintf(f, " * SCILAB function : %s, fin = %d\n", basfun->name, nFun);
252 FCprintf(f, " ******************************************/\n");
253
254 WriteHeader(f, "ints", basfun->name);
255
256 /* optional arguments : new style */
257 /** XXXXXX basfun->NewMaxOpt= basfun->maxOpt; */
258 basfun->NewMaxOpt = basfun->maxOpt;
259 if (basfun->NewMaxOpt > 0)
260 {
261 /** optional arguments **/
262 AddDeclare(DEC_INT, "nopt");
263 AddDeclare(DEC_INT, "iopos");
264 Fprintf(f, indent, "nopt=NumOpt();\n");
265 }
266
267 /* rhs argument number checking */
268
269 if (basfun->NewMaxOpt > 0)
270 Fprintf(f, indent, "CheckRhs(%d,%d+nopt);\n", basfun->nin - basfun->maxOpt, basfun->nin - basfun->maxOpt);
271 else
272 Fprintf(f, indent, "CheckRhs(%d,%d);\n", basfun->nin - basfun->maxOpt, basfun->nin);
273
274 /* lhs argument number checking */
275 ivar = basfun->out;
276 if (ivar == 0)
277 {
278 Fprintf(f, indent, "CheckLhs(0,1);\n");
279 }
280 else
281 {
282 if ((variables[ivar - 1]->length == 0) || (variables[ivar - 1]->type == LIST) || (variables[ivar - 1]->type == TLIST))
283 {
284 Fprintf(f, indent, "CheckLhs(1,1);\n");
285 }
286 else
287 {
288 Fprintf(f, indent, "CheckLhs(1,%d);\n", variables[ivar - 1]->length);
289 }
290 }
291 /* SCILAB argument checking */
292 for (i = 0; i < basfun->nin - basfun->NewMaxOpt; i++)
293 {
294 switch (variables[i]->type)
295 {
296 case LIST:
297 WriteListAnalysis(f, i, "l");
298 break;
299 case TLIST:
300 WriteListAnalysis(f, i, "t");
301 break;
302 case MLIST:
303 WriteListAnalysis(f, i, "m");
304 break;
305 default:
306 WriteArgCheck(f, i);
307 break;
308 }
309 }
310
311 if (basfun->NewMaxOpt != 0)
312 {
313 sprintf(str1, "rhs_opts opts[]={\n");
314 for (i = basfun->nin - basfun->NewMaxOpt; i < basfun->nin; i++)
315 {
316 sprintf(str2, "\t{-1,\"%s\",\"%s\",0,0,0},\n", variables[i]->name, SGetForTypeAbrev(variables[i]));
317 strcat(str1, str2);
318 }
319 strcat(str1, "\t{-1,NULL,NULL,NULL,0,0}}");
320 AddDeclare(DEC_DATA, str1);
321 Fprintf(f, indent, "iopos=Rhs;\n");
322 Fprintf(f, indent, "if ( get_optionals(fname,opts) == 0) return 0;\n");
323 for (i = basfun->nin - basfun->NewMaxOpt; i < basfun->nin; i++)
324 {
325 WriteOptArgPhase2(f, i);
326 }
327 }
328
329 /* SCILAB cross checking */
330 WriteCrossCheck(f);
331
332 /* SCILAB equal output variable checking */
333 WriteEqualCheck(f);
334
335 /* FORTRAN call */
336 WriteFortranCall(f);
337
338 /* FORTRAN output to SCILAB */
339 WriteOutput(f);
340}
341
342void WriteInfoCode(FILE * f)
343{
344 int i, iout;
345 IVAR ivar;
346 VARPTR var, vout;
347
348 iout = GetExistOutVar();
349 vout = variables[iout - 1];
350
351 switch (vout->type)
352 {
353 case LIST:
354 case TLIST:
355 /* loop on output variables */
356 printf("list(");
357 for (i = 0; i < vout->length; i++)
358 {
359 ivar = vout->el[i];
360 var = variables[ivar - 1];
361 printf("%s", var->name);
362 if (i != vout->length - 1)
363 printf(",");
364 else
365 printf(")");
366 }
367 break;
368 case SEQUENCE:
369 /* loop on output variables */
370 printf("[");
371 for (i = 0; i < vout->length; i++)
372 {
373 ivar = vout->el[i];
374 var = variables[ivar - 1];
375 printf("%s", var->name);
376 if (i != vout->length - 1)
377 printf(",");
378 else
379 printf("]");
380 }
381 break;
382 case EMPTY:
383 printf("[]\n");
384 break;
385 }
386
387 printf("=%s(", basfun->name);
388 for (i = 0; i < basfun->nin; i++)
389 {
390 printf("%s(%s)", variables[i]->name, SGetSciType(variables[i]->type));
391 if (i != basfun->nin - 1)
392 printf(",");
393 }
394 printf(")\n");
395
396}
397
398/*************************************************************
399* Ckecking and getting infos for data coming from scilab calling
400* sequence ( data on the stack )
401***********************************************************/
402
403void WriteArgCheck(FILE * f, int i)
404{
405 VARPTR var = variables[basfun->in[i] - 1];
406
407
408 Fprintf(f, indent, "/* checking variable %s */\n", var->name);
409
410 if (var->opt_type != 0)
411 {
412 /* Optional Arguments */
413 WriteOptArg(f, var);
414 }
415 else
416 {
417 /**
418 * generate the code for getting a Scilab argument
419 * and check some dimensions property if necessary
420 **/
421 if (RHSTAB[var->type].type != var->type)
422 {
423 fprintf(stderr, "Bug in intersci : Something wrong in RHSTAB\n");
424 }
425 (*(RHSTAB[var->type].fonc)) (f, var, 0);
426 }
427}
428
429/*************************************************************
430* cross checking dimensions
431***********************************************************/
432
433void WriteCrossCheck(FILE * f)
434{
435 int i, j;
436 VARPTR var;
437
438 Fprintf(f, indent, "/* cross variable size checking */\n");
439 for (i = 0; i < nVariable; i++)
440 {
441 var = variables[i];
442 if (var->type == DIMFOREXT)
443 {
444 if (var->nfor_name > 1)
445 {
446 for (j = 1; j < var->nfor_name; j++)
447 {
448 /** we do not check square variables : this is done elsewhere */
449 /* we do not check external values since they are not known here */
450 if ((var->for_name_orig[j] != var->for_name_orig[j - 1]) && (var->for_name[j - 1][1] != 'e' && var->for_name[j][1] != 'e'))
451 {
452 Fprintf(f, indent, "CheckDimProp(%d,%d,%s != %s);\n",
453 var->for_name_orig[j - 1], var->for_name_orig[j], var->for_name[j - 1], var->for_name[j]);
454 }
455 }
456 }
457 }
458 else if (var->type == SCALAR)
459 {
460 /** some dimensions are given by a scalar input argument **/
461 if (var->nfor_name > 1)
462 {
463 for (j = 1; j < var->nfor_name; j++)
464 {
465 int dim = 2;
466
467 if (var->for_name[j][0] == 'm')
468 dim = 1;
469 if (var->for_name[j][1] != 'e') /* do not check external variables */
470 {
471 if (strncmp(var->for_name[0], "istk", 4) == 0)
472 Fprintf(f, indent, "CheckOneDim(%d,%d,%s,*%s);\n", var->for_name_orig[j], dim, var->for_name[j], var->for_name[0]);
473 else
474 Fprintf(f, indent, "CheckOneDim(%d,%d,%s,%s);\n", var->for_name_orig[j], dim, var->for_name[j], var->for_name[0]);
475 }
476 }
477 }
478 }
479 }
480 /*
481 * FCprintf(f,"/ * cross formal parameter checking\n");
482 * FCprintf(f," * not implemented yet * /\n"); */
483}
484
485void WriteEqualCheck(FILE * f)
486{
487 /*Fprintf(f,indent,"/ * cross equal output variable checking\n");
488 * Fprintf(f,indent," not implemented yet* /\n"); */
489}
490
491/***************************************************************
492* Scilab argument of type list
493***************************************************************/
494
495void WriteListAnalysis(FILE * f, int i, char *list_type)
496{
497 int k, i1;
498 VARPTR var;
499
500 i1 = i + 1;
501
502 AddDeclare1(DEC_INT, "m%d", i1);
503 AddDeclare1(DEC_INT, "n%d", i1);
504 AddDeclare1(DEC_INT, "l%d", i1);
505 Fprintf(f, indent, "GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n", i1, list_type, i1, i1, i1);
506 for (k = 0; k < nVariable; k++)
507 {
508 var = variables[k];
509 if ((var->list_el != 0) && (strcmp(var->list_name, variables[i]->name) == 0) && var->present)
510 {
511 Fprintf(f, indent, "/* list element %d %s */\n", var->list_el, var->name);
512 if (RHSTAB[var->type].type != var->type)
513 {
514 fprintf(stderr, "Bug in intersci : Something wrong in RHSTAB\n");
515 }
516 (*(RHSTAB[var->type].fonc)) (f, var, 0);
517 }
518 }
519}
520
521/***************************************************************
522* Create the code for stack creation of
523* variables which are not Scilab argument
524* and gather the code for C or Fortran call
525***************************************************************/
526
527void CheckCreateOrder()
528{
529 int ivar, min = 10000;
530 int i, count = 0;
531
532 if (forsub->narg == 0)
533 return;
534 for (i = 0; i < forsub->narg; i++)
535 {
536 ivar = forsub->arg[i];
537 if (variables[ivar - 1]->list_el == 0
538 && variables[ivar - 1]->is_sciarg == 0 && variables[ivar - 1]->for_type != EXTERNAL && variables[ivar - 1]->for_type != CSTRINGV)
539 {
540 count++;
541 if (min != 10000 && variables[ivar - 1]->stack_position != 0 && variables[ivar - 1]->stack_position < min)
542 {
543 fprintf(stderr, "Error: declaration for local variables\n");
544 fprintf(stderr, "\t must respect the order given in the calling sequence\n");
545 fprintf(stderr, "\t declaration for %s must be moved downward\n", variables[ivar - 1]->name);
546 exit(1);
547 }
548 if (variables[ivar - 1]->stack_position != 0)
549 min = variables[ivar - 1]->stack_position;
550 }
551 }
552}
553
554void WriteFortranCall(FILE * f)
555{
556 int i;
557 IVAR ivar, iivar;
558 char call[MAXCALL];
559
560 sprintf(call, "C2F(%s)(", forsub->name);
561
562 CheckCreateOrder();
563
564 /* loop on FORTRAN arguments */
565
566 for (i = 0; i < forsub->narg; i++)
567 {
568 ivar = forsub->arg[i];
569 if (variables[ivar - 1]->list_el != 0)
570 {
571 /* FORTRAN argument is a list element */
572 iivar = GetExistVar(variables[ivar - 1]->list_name);
573 if (variables[iivar - 1]->is_sciarg == 0)
574 {
575 printf("list or tlist \"%s\" must be an argument of SCILAB function\n", variables[ivar - 1]->list_name);
576 exit(1);
577 }
578 strcat(call, variables[ivar - 1]->for_name[0]);
579 strcat(call, ",");
580 }
581 else
582 {
583 int bCheck = 0;
584
585 if (variables[ivar - 1]->is_sciarg != 1)
586 {
587 /* FORTRAN argument is not a SCILAB argument */
588 /* a new variable is created on the stack for each
589 * Fortran argument */
590 (*(CRERHSTAB[variables[ivar - 1]->type].fonc)) (f, variables[ivar - 1]);
591 }
592#ifdef _MSC_VER
593 _try
594 {
595 bCheck = (variables[ivar - 1]->C_name[0] != NULL);
596 if (bCheck)
597 {
598 char *buffertmp = os_strdup(variables[ivar - 1]->C_name[0]);
599
600 if (buffertmp)
601 {
602 free(buffertmp);
603 buffertmp = NULL;
604 }
605 }
606 }
607 _except(EXCEPTION_EXECUTE_HANDLER)
608 {
609 bCheck = 0;
610 }
611#else
612 bCheck = (variables[ivar - 1]->C_name[0] != NULL);
613#endif
614 if (target == 'C' && bCheck)
615 {
616 strcat(call, "&");
617 strcat(call, variables[ivar - 1]->C_name[0]);
618 }
619 else
620 strcat(call, variables[ivar - 1]->for_name[0]);
621 strcat(call, ",");
622 }
623 }
624 if (forsub->narg == 0)
625 strcat(call, ")");
626 else
627 call[strlen(call) - 1] = ')';
628
629 if (target == 'C')
630 strcat(call, ";\n");
631 Fprintf(f, indent, call);
632
633 for (i = 0; i < nVariable; i++)
634 {
635 if (strcmp(variables[i]->name, "err") == 0)
636 {
637 AddDeclare(DEC_INT, "err=0");
638 Fprintf(f, indent++, "if (err > 0) {\n");
639 Fprintf(f, indent, "Scierror(999,\"%%s: Internal Error \\n\",fname);\n");
640 Fprintf(f, indent, "return 0;\n");
641 Fprintf(f, --indent, "};\n");
642 break;
643 }
644 }
645}
646
647/***************************************************
648* Write the interface code
649* for lhs variables creation
650*****************************************************/
651
652void WriteOutput(FILE * f)
653{
654 IVAR iout, ivar;
655 VARPTR var, vout;
656 int i;
657
658 iout = CheckOutVar();
659
660 if (iout == 0)
661 {
662 Fprintf(f, indent, "LhsVar(1)=0;\n;return 0;\n");
663 }
664 else
665 {
666 vout = variables[iout - 1];
667 switch (vout->type)
668 {
669 case LIST:
670 case TLIST:
671 case MLIST:
672 Fprintf(f, indent, "/* Creation of output %s of length %d*/\n", SGetSciType(vout->type), vout->length);
673 vout->stack_position = icre;
674 icre++;
675 Fprintf(f, indent, "Create%s(%d,%d);\n", SGetSciType(vout->type), vout->stack_position, vout->length);
676 /* loop on output variables */
677 for (i = 0; i < vout->length; i++)
678 {
679 ivar = vout->el[i];
680 var = variables[ivar - 1];
681 Fprintf(f, indent, "/* Element %d: %s*/\n", i + 1, var->name);
682 WriteVariable(f, var, ivar, 1, i + 1);
683 }
684 Fprintf(f, indent, "LhsVar(1)= %d;\nreturn 0;", vout->stack_position);
685 break;
686 case SEQUENCE:
687 /* loop on output variables */
688 for (i = 0; i < vout->length; i++)
689 {
690 ivar = vout->el[i];
691 var = variables[ivar - 1];
692 WriteVariable(f, var, ivar, 0, 0);
693 }
694 Fprintf(f, indent, "return 0;\n");
695 break;
696 case EMPTY:
697 Fprintf(f, indent, "LhsVar(1)=0;\n;return 0;\n");
698 break;
699 }
700 }
701 Fprintf(f, --indent, "}\n");
702}
703
704/***********************************************
705* Output of variable var
706* if variable is outputed inside a list
707* insidelist is set to true (1) and nel is the number
708* of the variable in the list
709***********************************************/
710
711void WriteVariable(FILE * f, VARPTR var, IVAR ivar, int insidelist, int nel)
712{
713 IVAR ivar2, barg, farg;
714 VARPTR var2;
715 int j;
716
717 /* get number of variable in SCILAB calling list */
718
719 barg = GetNumberInScilabCall(ivar);
720
721 /* get number of variable in FORTRAN calling list */
722
723 farg = GetNumberInFortranCall(ivar);
724
725 if (var->for_type == EXTERNAL)
726 {
727 /* external type */
728 if (barg != 0)
729 {
730 printf("output variable with external type \"%s\"\n", var->name);
731 printf(" cannot be an input argument of SCILAB function\n");
732 exit(1);
733 }
734 if (var->equal != 0)
735 {
736 printf("output variable with external type \"%s\"\n", var->name);
737 printf(" cannot have a convertion\n");
738 exit(1);
739 }
740 if (farg == 0)
741 {
742 printf("output variable with external type \"%s\" must be\n", var->name);
743 printf(" an argument of FORTRAN subroutine");
744 exit(1);
745 }
746 WriteExternalVariableOutput(f, var, insidelist, nel);
747 }
748 else
749 {
750 if (insidelist == 0 && var->list_el == 0)
751 {
752 if (var->opt_type != 0)
753 {
754 Fprintf(f, indent, "LhsVar(%d)= opts[%d].position /* %s */;\n",
755 var->out_position, var->stack_position - basfun->NewMaxOpt + 1, var->name);
756 }
757 else
758 {
759
760 if (var->for_type == CSTRINGV)
761 /* variable is recreated fro output */
762 Fprintf(f, indent, "LhsVar(%d)= %d;\n", var->out_position, icre);
763 else
764 Fprintf(f, indent, "LhsVar(%d)= %d;\n", var->out_position, var->stack_position);
765 }
766 }
767 if (var->equal != 0)
768 {
769 /* SCILAB type convertion */
770 if (barg != 0 || farg != 0)
771 {
772 printf("output variable with convertion \"%s\" must not be\n", var->name);
773 printf(" an input variable of SCILAB function or an argument\n");
774 printf(" of FORTRAN subroutine\n");
775 exit(1);
776 }
777 ivar2 = var->equal;
778 var2 = variables[ivar2 - 1];
779 /* get number of equal variable in SCILAB calling list */
780 barg = 0;
781 for (j = 0; j < basfun->nin; j++)
782 {
783 if (ivar2 == basfun->in[j])
784 {
785 barg = j + 1;
786 break;
787 }
788 }
789 if (barg == 0)
790 {
791 printf("output variable with convertion \"%s\" must be\n", var->name);
792 printf(" an input variable of SCILAB function\n");
793 exit(1);
794 }
795 /* get number of equal variable in FORTRAN calling list */
796 farg = 0;
797 for (j = 0; j < forsub->narg; j++)
798 {
799 if (ivar2 == forsub->arg[j])
800 {
801 farg = j + 1;
802 break;
803 }
804 }
805 if (farg == 0)
806 {
807 printf("output variable with convertion \"%s\" must be\n", var->name);
808 printf(" an argument FORTRAN subroutine");
809 exit(1);
810 }
811 var->for_type = var2->for_type;
812 WriteVariableOutput(f, var, 1, insidelist, nel);
813 }
814 else
815 {
816 /* no SCILAB type convertion */
817 if (var->type == LIST || var->type == TLIST)
818 {
819 /** il faut alors verifier la condition pour
820 tous les arguments de la liste **/
821 WriteVariableOutput(f, var, 0, insidelist, nel);
822 return;
823 }
824 if (farg == 0)
825 {
826 printf("variable without convertion \"%s\" must be an argument\n", var->name);
827 printf(" of FORTRAN subroutine\n");
828 exit(1);
829 }
830
831 WriteVariableOutput(f, var, 0, insidelist, nel);
832 }
833 }
834}
835
836int GetNumberInScilabCall(int ivar)
837{
838 int j;
839
840 for (j = 0; j < basfun->nin; j++)
841 {
842 if (ivar == basfun->in[j])
843 {
844 return (j + 1);
845 break;
846 }
847 }
848 return (0);
849}
850
851int GetNumberInFortranCall(int ivar)
852{
853 int j;
854
855 for (j = 0; j < forsub->narg; j++)
856 {
857 if (ivar == forsub->arg[j])
858 {
859 return (j + 1);
860 break;
861 }
862 }
863 return (0);
864}
865
866/********************************************
867* changes string "str" to "int(str)"
868* if str begins with stk or return str unchanged
869********************************************/
870
871char unknown[] = "ukn";
872
873char *Forname2Int(VARPTR var, int i)
874{
875 int l;
876 char *p;
877
878 if (var->for_name[i] == (char *)0)
879 {
880 printf("Error in Forname2Int for variable %s\n", var->name);
881 printf("Maybe an internal variable has a dimension\n");
882 printf("which can't be evaluated\n");
883 abort();
884 return (unknown);
885 }
886 if (var->C_name[i] != (char *)0)
887 return var->C_name[i];
888 if (strncmp(var->for_name[i], "stk", 3) == 0)
889 {
890 l = (int)strlen(var->for_name[i]);
891 p = (char *)malloc((unsigned)(l + 6));
892 sprintf(p, "int(%s)", var->for_name[i]);
893 return p;
894 }
895 else
896 return var->for_name[i];
897}
898
899void GenFundef(char *file, int interf)
900{
901 FILE *fout;
902 char filout[MAXNAM];
903 int i, j;
904
905 if (interf != 0)
906 {
907 strcpy(filout, file);
908 strcat(filout, ".fundef");
909 fout = fopen(filout, "wt");
910 fprintf(fout, "#define IN_%s %.2d\n", file, interf);
911 for (i = 0; i < nFun; i++)
912 {
913 fprintf(fout, "{\"%s\",", funNames[i]);
914 for (j = 0; j < 25 - (int)strlen(funNames[i]); j++)
915 fprintf(fout, " ");
916 fprintf(fout, "\t\tIN_%s,\t%d,\t3},\n", file, i + 1);
917 }
918 printf("\nfile \"%s\" has been created\n", filout);
919 fclose(fout);
920 }
921}
922
923static void GenBuilder(char *file, char *files, char *libs)
924{
925 FILE *fout;
926 char filout[MAXNAM];
927 int i;
928
929 strcpy(filout, file);
930 strcat(filout, "_builder.sce");
931 fout = fopen(filout, "wt");
932 fprintf(fout, "// generated with intersci\n");
933 fprintf(fout, "ilib_name = 'lib%s'\t\t// interface library name\n", file);
934
935 /* files = 'file1.o file2.o ....' delimiter = ' ' */
936 while (files != NULL)
937 {
938 static int first = 1;
939
940 if (first == 1)
941 {
942 fprintf(fout, "files =['%s.o';\n\t'", file);
943 first++;
944 }
945 else
946 {
947 fprintf(fout, "\t'");
948 }
949 while (*files != 0 && *files != ' ')
950 {
951 fprintf(fout, "%c", *files);
952 files++;
953 }
954 while (*files == ' ')
955 files++;
956 if (*files == 0)
957 {
958 fprintf(fout, "'];\n");
959 break;
960 }
961 else
962 {
963 fprintf(fout, "'\n");
964 };
965 }
966
967 while (libs != NULL)
968 {
969 static int first = 1;
970
971 if (first == 1)
972 {
973 fprintf(fout, "libs =['");
974 first++;
975 }
976 else
977 {
978 fprintf(fout, "\t'");
979 }
980 while (*libs != 0 && *libs != ' ')
981 {
982 fprintf(fout, "%c", *libs);
983 libs++;
984 }
985 while (*libs == ' ')
986 libs++;
987 if (*libs == 0)
988 {
989 fprintf(fout, "'];\n");
990 break;
991 }
992 else
993 {
994 fprintf(fout, "'\n");
995 };
996 }
997
998 fprintf(fout, "\ntable =[");
999 i = 0;
1000 if (nFun == 1)
1001 fprintf(fout, "\"%s\",\"ints%s\"];\n", funNames[i], funNames[i]);
1002 else
1003 {
1004 fprintf(fout, "\"%s\",\"ints%s\";\n", funNames[i], funNames[i]);
1005 for (i = 1; i < nFun - 1; i++)
1006 {
1007 fprintf(fout, "\t\"%s\",\"ints%s\";\n", funNames[i], funNames[i]);
1008 }
1009 i = nFun - 1;
1010 fprintf(fout, "\t\"%s\",\"ints%s\"];\n", funNames[i], funNames[i]);
1011 }
1012 fprintf(fout, "ilib_build(ilib_name,table,files,libs);\n");
1013 printf("\nfile \"%s\" has been created\n", filout);
1014 fclose(fout);
1015}
1016
1017/**********************************************************
1018Dealing With Fortran OutPut
1019taking into account indentation and line breaks after column 72
1020***********************************************************/
1021
1022#define MAXBUF 4096
1023char sbuf[MAXBUF];
1024
1025#include <stdarg.h>
1026
1027void Fprintf(FILE * f, int indent2, char *format, ...)
1028{
1029 int i;
1030 static int count = 0;
1031 va_list ap;
1032
1033 va_start(ap, format);
1034
1035 vsprintf(sbuf, format, ap);
1036
1037 for (i = 0; i < (int)strlen(sbuf); i++)
1038 {
1039 if (count == 0)
1040 {
1041 white(f, indent2);
1042 count = indent2;
1043 }
1044 if (count >= 100 && sbuf[i] != '\n' && (sbuf[i] == ' ' || sbuf[i] == ',' || sbuf[i] == ';' || sbuf[i] == '('))
1045 {
1046 fprintf(f, "\n");
1047 white(f, indent2);
1048 count = indent2;
1049 }
1050 if (sbuf[i] == '\n')
1051 count = -1;
1052 fprintf(f, "%c", sbuf[i]);
1053 count++;
1054 }
1055 va_end(ap);
1056}
1057
1058void white(FILE * f, int ind)
1059{
1060 int i;
1061
1062 for (i = 0; i < ind; i++)
1063 fprintf(f, " ");
1064}
1065
1066void FCprintf(FILE * f, char *format, ...)
1067{
1068 va_list ap;
1069
1070 va_start(ap, format);
1071
1072 vfprintf(f, format, ap);
1073 va_end(ap);
1074}
1075
1076/******************************************
1077* memory allocators
1078******************************************/
1079
1080VARPTR VarAlloc()
1081{
1082 return ((VARPTR) malloc(sizeof(VAR)));
1083}
1084
1085BASFUNPTR BasfunAlloc()
1086{
1087 return ((BASFUNPTR) malloc(sizeof(BASFUN)));
1088}
1089
1090FORSUBPTR ForsubAlloc()
1091{
1092 return ((FORSUBPTR) malloc(sizeof(FORSUB)));
1093}
diff --git a/scilab/modules/intersci/src/exe/intersci-n.h b/scilab/modules/intersci/src/exe/intersci-n.h
deleted file mode 100644
index bf1ddc9..0000000
--- a/scilab/modules/intersci/src/exe/intersci-n.h
+++ /dev/null
@@ -1,399 +0,0 @@
1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2000-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution. The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13/* VERSION et DATE */
14#define VERSION "3.0"
15#define DATE "SEP 2000"
16
17/* max dimension for the array: can be modified */
18#define MAXARG 50
19#define MAXCALL 2000
20#define MAXEL 50
21#define MAXLINE 1000
22#define MAXNAM 128
23#define MAXVAR 200
24/* flag for generation of type and element dimension checking for lists:
25 can be modified */
26#define TESTLISTELEMENTS 1
27
28/******************************************/
29/* DO NOT CHANGE ANYTHING BELOW THIS LINE */
30/******************************************/
31#define MAXFUN 99 /* maximum number of SCILAB functions */
32
33#include <stdio.h>
34#include <string.h>
35#include <ctype.h>
36#include <stdlib.h>
37
38
39/* FORTRAN variable types */
40#define CHAR 1
41#define INT 2
42#define DOUBLE 3
43#define REAL 4
44#define EXTERNAL 5
45#define CSTRINGV 6
46#define LOGICAL 7
47#define MPOINTER 8 /* pointer to Mat */
48#define PREDEF 9 /* err,rhs,lhs */
49#define SMPOINTER 9 /* pointer to SMat */
50#define LPOINTER 10 /* pointer to List */
51#define BPOINTER 11 /* pointer to BMat */
52#define OPOINTER 12 /* pointer to OBJ */
53#define BOOLEAN 13 /* as int for boolean matrix **/
54
55/* Fortran Declaration */
56
57#define DEC_CHAR 1
58#define DEC_INT 2
59#define DEC_DOUBLE 3
60#define DEC_REAL 4
61#define DEC_LOGICAL 5
62#define DEC_DATA 6
63#define DEC_UL 7 /* unsigned long */
64#define DEC_INIT 8 /* initialisation x=0; etc... */
65#define DEC_SMAT 9
66#define DEC_SPARSE 10
67/* pointer declaration */
68#define DEC_IPTR 11
69#define DEC_DPTR 12
70#define DEC_RPTR 13
71#define DEC_CPTR 14
72#define DEC_SPARSEPTR 15
73
74
75/* SCILAB and extensions variable types */
76
77#define DIMFOREXT 0 /* dimension (for example of an external variable )*/
78#define COLUMN 1
79#define LIST 2
80#define TLIST 3
81#define MATRIX 4
82#define POLYNOM 5
83#define ROW 6
84#define SCALAR 7
85#define SEQUENCE 8
86#define STRING 9
87#define WORK 10
88#define EMPTY 11
89#define ANY 12
90#define VECTOR 13
91#define STRINGMAT 14
92#define SCIMPOINTER 15
93#define IMATRIX 16
94#define SCISMPOINTER 17
95#define SCILPOINTER 18
96#define BMATRIX 19
97#define SCIBPOINTER 20
98#define SCIOPOINTER 21
99#define SPARSE 22
100#define MLIST 23
101
102/* SCILAB optional variable types */
103
104#define NAME 1 /* {var default-name} */
105#define VALUE 2 /* {var default-value} */
106
107typedef int IVAR; /* variable number */
108
109/* VAR struct: informations for FORTRAN and/or SCILAB variable */
110
111
112typedef struct var {
113 char *name; /* variable name */
114 int vpos; /* variable is stored in variables[vpos-1] */
115 int type; /* SCILAB type */
116 int length; /* number of el in the variable */
117 IVAR el[MAXEL]; /* list of el IVAR (variable associated with,
118 typically dimensions) */
119 int for_type; /* FORTRAN type */
120 char fexternal[MAXNAM]; /* name of external function when type is
121 external */
122 IVAR equal; /* alias for variable */
123 int nfor_name; /* number of for_name */
124 int kp_state; /* for pass dealing **/
125 char *for_name[MAXARG]; /* list of for_name names (FORTRAN name
126 in generated FORTRAN code) */
127 char *C_name[MAXARG]; /* list of C_name : i.e when a for_name is m1*n1
128 * it cannot be used at C level then C_name is set to
129 * m1n1 and one will have to properly set m1n1=m1*n1
130 */
131
132 int for_name_orig[MAXARG]; /* list of stack_position of for_name occurences */
133 char *list_name; /* name of the list of which the variable is an element */
134 int list_el; /* element number in the previous list
135 0 : means that variable is not in a list */
136 int opt_type; /* type of optional variable */
137 char *opt_name; /* name or value default for optional variable */
138 int present; /* 1 if the variable is really present in the
139 description file
140 0 otherwise used for list elements which might
141 be not really present */
142 int stack_position; /* position of the variable in the stack
143 1 is the first position :
144 the position is : the position in the scilab
145 calling list or the position in the stack for
146 internal variables created inside the interface
147 for a variable in a list : it is the position
148 of the list in the stack
149 */
150 int out_position ; /*
151 The position of the variable in the
152 returned arguments
153 0 if the variable is not returned
154 */
155 int is_sciarg ; /* set to one if variable is a scilab
156 argument of the interfaced function */
157
158} VAR, *VARPTR;
159
160/* BASFUN struct: informations for SCILAB function */
161
162typedef struct basfun {
163 char *name; /* function name */
164 int nin; /* number of arguments */
165 int maxOpt ; /* number of potential optional arguments in function */
166 int NewMaxOpt; /* number of new style optional arguments in function */
167 IVAR in[MAXARG]; /* list of argument IVAR */
168 IVAR out; /* output IVAR : i.e type of output */
169} BASFUN, *BASFUNPTR;
170
171/* FORSUB struct: informations for FORTRAN subroutine */
172
173typedef struct forsub {
174 char *name; /* subroutine name */
175 int narg; /* number of arguments */
176 IVAR arg[MAXARG]; /* list of argument IVAR */
177} FORSUB, *FORSUBPTR;
178
179/* memory allocators */
180
181/** functions **/
182
183
184extern VARPTR VarAlloc (void);
185extern BASFUNPTR BasfunAlloc (void);
186extern FORSUBPTR ForsubAlloc (void);
187
188void WriteInfoCode (FILE *f);
189int GetNumberInScilabCall (int ivar);
190int GetNumberInFortranCall (int ivar);
191char *SGetSciType (int type);
192char* SGetCDec (int type);
193char *SGetForType (int type);
194char *SGetForTypeAbrev (VARPTR var);
195char *SGetForTypeStack (VARPTR var);
196char *SGetForTypeBConvert (VARPTR var);
197void AddForName (IVAR ivar, char *name,char *cname,IVAR ivar1);
198void ChangeForName1 (VARPTR var, char *name);
199void Copyright (void);
200char *Forname2Int (VARPTR,int);
201void GenFundef (char *file, int interf);
202int GetBasType (char *sname);
203int GetForType (char *type);
204IVAR GetExistOutVar (void);
205IVAR CheckOutVar (void);
206IVAR GetExistVar (char *name);
207IVAR GetOutVar (char *name);
208IVAR GetVar (char *name, int p);
209void OptVar ();
210int ParseLine (char *s, char **words);
211int ParseScilabLine (char *s, char **words);
212int ReadListElement (FILE *f, char *varlistname, IVAR iivar, int nel,int);
213void ReadListFile (char *listname, char *varlistname, IVAR ivar,int);
214int ReadFunction (FILE *f);
215int TypeToBas ();
216void WriteArgCheck (FILE *f, int i);
217void WriteCall ();
218void WriteCallRest (FILE *f, IVAR ivar, int farg, char *call);
219void WriteCallConvertion (FILE *f, IVAR ivar, char *farg, char *barg, char *call);
220void WriteCrossCheck (FILE *f);
221void WriteEqualCheck (FILE *f);
222void WriteExternalVariableOutput (FILE *f, VARPTR var, int insidelist, int nel);
223void WriteFortranCall (FILE *f);
224void WriteFunctionCode (FILE *f);
225void WriteHeader (FILE *f, char *fname0, char *fname);
226void WriteMainHeader (FILE *f, char *fname);
227void WriteListAnalysis (FILE *f, int i,char *);
228void WriteOutput (FILE *f);
229void WriteVariable (FILE *f, VARPTR var, IVAR ivar, int insidelist, int nel);
230void WriteVariableOutput (FILE *f, VARPTR var, int convert, int insidelist, int nel);
231void AddForName1 (IVAR ivar, char *name,char *cname, IVAR ivar1);
232void ForNameClean (void);
233void InitDeclare (void);
234void ResetDeclare (void);
235void WriteMain (FILE *f,char *file);
236void FCprintf(FILE*,char *fmt,...);
237void Fprintf(FILE*,int,char *fmt,...);
238void white (FILE *f, int ind);
239void AddDeclare (int type, char *declaration);
240void InitDeclare (void);
241void ResetDeclare (void);
242void WriteDeclaration (FILE*f);
243void WriteCallRestCheck (FILE *f, VARPTR var,char *name, int iel, int flag);
244int CreatePredefVar (char *name);
245void Check (FILE *f, VARPTR var, int nel);
246void CheckSquare (FILE *f, VARPTR var, char *str,char *str1);
247void CheckOptSquare (FILE *f, VARPTR var, char *str);
248void CheckOptDim (FILE *f, VARPTR var, int nel);
249void OptvarGetSize (char *optvar, char *size, char *data);
250void WriteAddInter (char *file);
251
252
253/*** Global variables **/
254
255extern VARPTR variables[MAXVAR]; /* array of VAR structures */
256extern int nVariable; /* number of variables */
257extern BASFUNPTR basfun; /* SCILAB function structure */
258extern int icre; /* incremental counter for variable creation */
259extern int indent; /* incremental counter for code indentation */
260extern int pass ; /* flag for couting pass on code generation */
261extern FORSUBPTR forsub; /* FORTRAN subroutine structure */
262extern int nFun; /* total number of functions in "desc" file */
263extern char *funNames[MAXFUN]; /* array of function names */
264extern char target; /* langage for generation F or C */
265
266
267
268/* protos */
269
270extern void Generate ( char *file);
271extern int ShowVariables (void);
272extern int FixStackPositions (void);
273extern IVAR GetVar (char *name, int p);
274extern IVAR GetExistVar (char *name);
275extern int CreatePredefVar (char *name);
276extern IVAR GetOutVar (char *name);
277extern IVAR GetExistOutVar (void);
278extern void AddForName (IVAR ivar, char *name, char *cname, IVAR ivar1);
279extern void AddForName1 (IVAR ivar, char *name, char *cname, IVAR ivar1);
280extern void ForNameClean (void);
281extern void ChangeForName2 (VARPTR var, char *format,...);
282extern void ChangeForName1 (VARPTR var, char *name);
283extern int GetBasType (char *sname);
284extern char *SGetSciType (int type);
285extern int GetForType (char *type);
286extern char *SGetForType (int type);
287extern char *SGetForTypeAbrev (VARPTR var);
288extern int SGetForDec (int type);
289extern char *SGetCDec (int type);
290extern char *SGetForTypeStack (VARPTR var);
291extern char *SGetForTypeBConvert (VARPTR var);
292extern char *SGetExtForTypeAbrev (VARPTR var);
293extern char *SGetExtForTypeStack (VARPTR var);
294extern void StrGen (char *strl, VARPTR var);
295extern void ForMATRIX (VARPTR var);
296extern void ForSTRING (VARPTR var);
297extern void ForIMATRIX (VARPTR var);
298extern void ForSPARSE (VARPTR var);
299extern void ForROW (VARPTR var);
300extern void ForCOLUMN (VARPTR var);
301extern void ForVECTOR (VARPTR var);
302extern void ForPOLYNOM (VARPTR var);
303extern void ForSCALAR (VARPTR var);
304extern void ForPOINTER (VARPTR var);
305extern void ForANY (VARPTR var);
306extern void ForLIST (VARPTR var);
307extern void ForTLIST (VARPTR var);
308extern void ForSEQUENCE (VARPTR var);
309extern void ForEMPTY (VARPTR var);
310extern void ForWORK (VARPTR var);
311extern void ForDIMFOREXT (VARPTR var);
312extern int main (int argc, char **argv);
313extern void Generate (char *file);
314extern int FixStackPositions (void);
315extern void FixForNames ();
316extern void WriteMain (FILE *f, char *file);
317extern void WriteAddInter (char *file);
318extern void Copyright (void);
319extern void WriteHeader (FILE *f, char *fname0, char *fname);
320extern void WriteFunctionCode (FILE *f);
321extern void WriteOptArgPhase0 (FILE *f, int i);
322extern void WriteOptArgPhase1 (FILE *f, int i);
323extern void WriteOptArgPhase2 (FILE *f, int i);
324
325extern void WriteInfoCode (FILE *f);
326extern void WriteArgCheck (FILE *f, int i);
327extern void WriteOptArg (FILE *f , VARPTR var);
328extern void WriteCrossCheck (FILE *f);
329extern void WriteCrossCheckExternal (FILE *f);
330extern void WriteEqualCheck (FILE *f);
331extern void WriteListAnalysis (FILE *f, int i, char *list_type);
332extern void AddDeclare1 (int type,char *format,...);
333
334extern void WriteFortranCall (FILE *f);
335extern void WriteOutput (FILE *f);
336extern void WriteVariable (FILE *f, VARPTR var, IVAR ivar, int insidelist, int nel);
337extern int GetNumberInScilabCall (int ivar);
338extern int GetNumberInFortranCall (int ivar);
339extern char *Forname2Int (VARPTR var, int i);
340extern void GenFundef (char *file, int interf);
341extern void white (FILE *f, int ind);
342extern VARPTR VarAlloc (void);
343extern BASFUNPTR BasfunAlloc (void);
344extern FORSUBPTR ForsubAlloc (void);
345extern int ReadFunction (FILE *f);
346extern int ParseScilabLine (char *s, char **words);
347extern int ParseLine (char *s, char **words);
348extern void ReadListFile (char *listname, char *varlistname, IVAR ivar, int stack_position);
349extern int ReadListElement (FILE *f, char *varlistname, IVAR iivar, int nel, int stack_position);
350
351extern int ShowVariables (void);
352extern int FixStackPositions (void);
353extern IVAR GetVar (char *name, int p);
354extern IVAR GetExistVar (char *name);
355extern int CreatePredefVar (char *name);
356extern IVAR GetOutVar (char *name);
357extern IVAR GetExistOutVar (void);
358extern void AddForName (IVAR ivar, char *name, char *cname, IVAR ivar1);
359extern void AddForName1 (IVAR ivar, char *name, char *cname, IVAR ivar1);
360extern void ForNameClean (void);
361extern void ChangeForName1 (VARPTR var, char *name);
362extern int GetBasType (char *sname);
363extern char *SGetSciType (int type);
364extern int GetForType (char *type);
365extern char *SGetForType (int type);
366extern char *SGetForTypeAbrev (VARPTR var);
367extern int SGetForDec (int type);
368extern char *SGetCDec (int type);
369extern char *SGetForTypeStack (VARPTR var);
370extern char *SGetForTypeBConvert (VARPTR var);
371extern char *SGetExtForTypeAbrev (VARPTR var);
372extern char *SGetExtForTypeStack (VARPTR var);
373extern void OutCOLUMN (FILE *f, VARPTR var, int insidelist, int nel);
374extern void OutROW (FILE *f, VARPTR var, int insidelist, int nel);
375extern void OutVECTOR (FILE *f, VARPTR var, int insidelist, int nel);
376extern void OutMATRIX (FILE *f, VARPTR var, int insidelist, int nel);
377extern void OutSCALAR (FILE *f, VARPTR var, int insidelist, int nel);
378extern void OutCommon (FILE *f, VARPTR var, int insidelist, int nel);
379extern void OutBMATRIX (FILE *f, VARPTR var, int insidelist, int nel);
380extern void OutSTRING (FILE *f, VARPTR var, int insidelist, int nel);
381extern void OutLIST (FILE *f, VARPTR var, int insidelist, int nel);
382extern void OutLISTarg (FILE *f, VARPTR var, VARPTR var1, int insidelist, int nel);
383extern void OutSPARSE (FILE *f, VARPTR var, int insidelist, int nel);
384extern void OutIMATRIX (FILE *f, VARPTR var, int insidelist, int nel);
385extern void OutPOLYNOM (FILE *f, VARPTR var, int insidelist, int nel);
386extern void OutPOINTER (FILE *f, VARPTR var, int insidelist, int nel);
387extern void OutSTRINGMAT (FILE *f, VARPTR var, int insidelist, int nel);
388extern void OutANY (FILE *f, VARPTR var, int insidelist, int nel);
389extern void WriteVariableOutput (FILE *f, VARPTR var, int convert, int insidelist, int nel);
390void OptMATRIX ( FILE *f, VARPTR var);
391void OptOpointer ( FILE *f, VARPTR var);
392void GetDim (char *str,IVAR ivar) ;
393
394
395
396
397
398
399
diff --git a/scilab/modules/intersci/src/exe/intersci.c b/scilab/modules/intersci/src/exe/intersci.c
deleted file mode 100644
index d674c6c..0000000
--- a/scilab/modules/intersci/src/exe/intersci.c
+++ /dev/null
@@ -1,3573 +0,0 @@
1/*
2* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3* Copyright (C) ????-2008 - INRIA
4* Copyright (C) 2010 - DIGITEO - Allan CORNET
5*
6* This file must be used under the terms of the CeCILL.
7* This source file is licensed as described in the file COPYING, which
8* you should have received as part of this distribution. The terms
9* are also available at
10* http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
11*
12*/
13
14#ifdef _MSC_VER
15#include <windows.h>
16#endif
17#include <stdio.h>
18#include <stdlib.h>
19
20#include "intersci.h"
21#include "PATH_MAX.h"
22#include "stack-def.h"
23
24static char buf[1024];
25
26static int icre = 1; /* incremental counter for variable creation */
27static int indent = 0; /* incremental counter for code indentation */
28static int pass = 0; /* flag for couting pass on code generation */
29
30#ifdef _MSC_VER
31static void SciEnv();
32
33#define putenv _putenv
34#pragma comment(lib,"../../../../../bin/libintl.lib")
35#endif
36
37int main(argc, argv)
38unsigned int argc;
39char **argv;
40{
41 int InterFace = 0;
42
43 fprintf(stderr, "WARNING: This program is deprecated and will be removed with Scilab 6.0.0. Please use SWIG ( http://www.swig.org/ ) instead.\n\n");
44
45#ifdef _MSC_VER
46 SciEnv();
47#endif
48 switch (argc)
49 {
50 case 2:
51 InterFace = 0;
52 break;
53 case 3:
54 InterFace = atoi(argv[2]);
55 break;
56 default:
57 printf("usage: intersci <interface file> <interface number>\n");
58 exit(1);
59 break;
60 }
61 basfun = BasfunAlloc();
62 if (basfun == 0)
63 {
64 printf("Running out of memory\n");
65 exit(1);
66 }
67 forsub = ForsubAlloc();
68 if (forsub == 0)
69 {
70 printf("Running out of memory\n");
71 exit(1);
72 }
73 ISCIReadFile(argv[1]);
74 GenFundef(argv[1], InterFace);
75 return 0;
76}
77
78void ISCIReadFile(file)
79char *file;
80{
81 FILE *fin, *fout, *foutv;
82 char filout[MAXNAM];
83 char filin[MAXNAM];
84
85 sprintf(filin, "%s.desc", file);
86 fin = fopen(filin, "r");
87 if (fin == 0)
88 {
89 printf("Interface file \"%s\" does not exist\n", filin);
90 exit(1);
91 }
92 Copyright();
93 strcpy(filout, file);
94 strcat(filout, ".f");
95 fout = fopen(filout, "w");
96 strcpy(filout, file);
97 strcat(filout, ".tmp");
98 foutv = fopen(filout, "w");
99 InitDeclare();
100 nFun = 0;
101 while (ReadFunction(fin))
102 {
103 nFun++;
104 if (nFun > MAXFUN)
105 {
106 printf("Too many SCILAB functions. The maximum is %d\n", MAXFUN);
107 exit(1);
108 }
109 ResetDeclare();
110 /* first pass to collect declarations */
111 pass = 0;
112 WriteFunctionCode(foutv);
113 /* cleaning added Fornames before pass 2 */
114 ForNameClean();
115 /* scond pass to produce code */
116 pass = 1;
117 WriteFunctionCode(fout);
118 /** WriteInfoCode(fout); **/
119 }
120 WriteMain(fout, file);
121 printf("FORTRAN file \"%s.f\" has been created\n", file);
122 WriteAddInter(file);
123 printf("Scilab file \"%s.sce\" has been created\n", file);
124 fclose(fout);
125 fclose(fin);
126}
127
128void WriteMain(f, file)
129FILE *f;
130char *file;
131{
132 int i;
133
134 FCprintf(f, "\nc interface function\n");
135 FCprintf(f, "c ********************\n");
136 WriteMainHeader(f, file);
137 Fprintf(f, indent, "goto (");
138 for (i = 1; i < nFun; i++)
139 {
140 Fprintf(f, indent, "%d,", i);
141 }
142 Fprintf(f, indent, "%d) fin\nreturn\n", nFun);
143 for (i = 0; i < nFun; i++)
144 {
145 FCprintf(f, "%d call ints%s('%s')\n", i + 1, funNames[i], funNames[i]);
146 Fprintf(f, indent, "return\n");
147 }
148 Fprintf(f, indent, "end\n");
149}
150
151void WriteAddInter(file)
152char *file;
153{
154 FILE *fout;
155 int i;
156 char filout[MAXNAM];
157
158 strcpy(filout, file);
159 strcat(filout, ".sce");
160 fout = fopen(filout, "w");
161 if (fout != (FILE *) 0)
162 {
163 fprintf(fout, "// Addinter for file %s\n", file);
164 fprintf(fout, "// for hppa/sun-solaris/linux/dec\n");
165 fprintf(fout, "//--------------------------------\n");
166 fprintf(fout, "//Scilab functions\n");
167 fprintf(fout, "%s_funs=[...\n", file);
168 for (i = 0; i < nFun - 1; i++)
169 fprintf(fout, " '%s';\n", funNames[i]);
170 fprintf(fout, " '%s']\n", funNames[nFun - 1]);
171 fprintf(fout, "// interface file to link: ifile='%s.o'\n", file);
172 fprintf(fout, "// user's files to link: ufiles=['file1.o','file2.o',....]\n");
173 fprintf(fout, "// files = [ifile,ufiles]\n");
174 fprintf(fout, "addinter(files,'%s',%s_funs);\n", file, file);
175 fclose(fout);
176 }
177 else
178 fprintf(stderr, "Can't open file %s\n", file);
179}
180
181void Copyright()
182{
183 printf("\nINTERSCI Version %s (%s)\n", VERSION, DATE);
184 printf(" Copyright (C) INRIA All rights reserved\n\n");
185}
186
187/**********************************************************
188*Reading the intersci description file
189**********************************************************/
190
191int ReadFunction(f)
192FILE *f;
193{
194 int i, j, l, type, ftype;
195 char s[MAXLINE];
196 char str[MAXNAM];
197 char *words[MAXLINE];
198 char *optwords[MAXLINE];
199 IVAR ivar;
200 int nwords, line1, inbas, fline1, infor, nopt, out1;
201
202 nVariable = 0;
203 maxOpt = 0;
204 line1 = 1;
205 inbas = 0;
206 fline1 = 0;
207 infor = 0;
208 out1 = 0;
209 while (fgets(s, MAXLINE, f))
210