summaryrefslogtreecommitdiffstats
path: root/scilab/modules/intersci
diff options
context:
space:
mode:
authorAllan CORNET <allan.cornet@scilab.org>2010-05-06 15:00:08 +0200
committerSylvestre Ledru <sylvestre.ledru@scilab.org>2010-05-10 11:03:32 +0200
commit3b7ff3b39b4e34c2f9d998b21e146270656a38f3 (patch)
tree8148248df5ed880bbe5977ca3ef1526bd08bef84 /scilab/modules/intersci
parent6d8b3a373351596a2cee6fa28e2d2e6ce4efad41 (diff)
downloadscilab-3b7ff3b39b4e34c2f9d998b21e146270656a38f3.zip
scilab-3b7ff3b39b4e34c2f9d998b21e146270656a38f3.tar.gz
bug 4625 intersci was broken on Windows
Change-Id: Ie9503b54d9f53695e10f8b35bf1a03eee09fb64c
Diffstat (limited to 'scilab/modules/intersci')
-rw-r--r--scilab/modules/intersci/src/exe/intersci-n.c1529
-rw-r--r--scilab/modules/intersci/src/exe/read.c1327
-rw-r--r--scilab/modules/intersci/tests/nonreg_tests/bug_4625.c25
-rw-r--r--scilab/modules/intersci/tests/nonreg_tests/bug_4625.desc13
-rw-r--r--scilab/modules/intersci/tests/nonreg_tests/bug_4625.dia.ref23
-rw-r--r--scilab/modules/intersci/tests/nonreg_tests/bug_4625.tst25
6 files changed, 1513 insertions, 1429 deletions
diff --git a/scilab/modules/intersci/src/exe/intersci-n.c b/scilab/modules/intersci/src/exe/intersci-n.c
index 24da6e4..8aa3960 100644
--- a/scilab/modules/intersci/src/exe/intersci-n.c
+++ b/scilab/modules/intersci/src/exe/intersci-n.c
@@ -1,6 +1,7 @@
1/* 1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab 2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA 3 * Copyright (C) ????-2008 - INRIA
4 * Copyright (C) 2010 - DIGITEO - Allan CORNET
4 * 5 *
5 * This file must be used under the terms of the CeCILL. 6 * 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 * This source file is licensed as described in the file COPYING, which
@@ -8,7 +9,7 @@
8 * are also available at 9 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt 10 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 * 11 *
11 */ 12*/
12 13
13#include <stdlib.h> 14#include <stdlib.h>
14#ifdef _MSC_VER 15#ifdef _MSC_VER
@@ -40,441 +41,441 @@ void CheckCreateOrder(void);
40 41
41int main( int argc,char ** argv) 42int main( int argc,char ** argv)
42{ 43{
43 char *files,*libs; 44 char *files,*libs;
44 char *file; 45 char *file;
45 int SciLabinterface = 0 ; 46 int SciLabinterface = 0 ;
46 switch (argc) 47 switch (argc)
47 { 48 {
48 case 2: 49 case 2:
49 file = argv[1]; 50 file = argv[1];
50 target = 'C'; 51 target = 'C';
51 SciLabinterface = 0; 52 SciLabinterface = 0;
52 files = NULL; 53 files = NULL;
53 libs = NULL; 54 libs = NULL;
54 break; 55 break;
55 case 3: 56 case 3:
56 file = argv[1]; 57 file = argv[1];
57 target = 'C'; 58 target = 'C';
58 SciLabinterface = 0; 59 SciLabinterface = 0;
59 files = argv[2]; 60 files = argv[2];
60 libs = NULL; 61 libs = NULL;
61 break; 62 break;
62 case 4: 63 case 4:
63 file = argv[1]; 64 file = argv[1];
64 target = 'C'; 65 target = 'C';
65 SciLabinterface = 0; 66 SciLabinterface = 0;
66 files = argv[2]; 67 files = argv[2];
67 libs = argv[3]; 68 libs = argv[3];
68 break; 69 break;
69 default: 70 default:
70 printf("Usage: intersci <interface file> 'files' 'libs'\n"); 71 printf("Usage: intersci <interface file> 'files' 'libs'\n");
71 printf("intersci is a program for building an interface file between Scilab\n"); 72 printf("intersci is a program for building an interface file between Scilab\n");
72 printf("and C/Fortran functions/subroutines.\n"); 73 printf("and C/Fortran functions/subroutines.\n");
73 printf("See : http://www.scilab.org/doc/intersci.pdf\n"); 74 printf("See : http://www.scilab.org/doc/intersci.pdf\n");
74 exit(1); 75 exit(1);
75 break; 76 break;
77 }
78 basfun = BasfunAlloc();
79 if (basfun == 0) {
80 printf("Running out of memory\n");
81 exit(1);
82 }
83 forsub = ForsubAlloc();
84 if (forsub == 0) {
85 printf("Running out of memory\n");
86 exit(1);
76 } 87 }
77 basfun = BasfunAlloc(); 88 Generate(file);
78 if (basfun == 0) { 89 GenFundef(file,SciLabinterface);
79 printf("Running out of memory\n"); 90 GenBuilder(file,files,libs);
80 exit(1); 91 exit(0);
81 }
82 forsub = ForsubAlloc();
83 if (forsub == 0) {
84 printf("Running out of memory\n");
85 exit(1);
86 }
87 Generate(file);
88 GenFundef(file,SciLabinterface);
89 GenBuilder(file,files,libs);
90 exit(0);
91} 92}
92 93
93/** 94/**
94 * Produce the interface 95* Produce the interface
95 * @param file 96* @param file
96 */ 97*/
97 98
98void Generate(char *file) 99void Generate(char *file)
99{ 100{
100 int icrekp; 101 int icrekp;
101 FILE *fin, *fout, *foutv; 102 FILE *fin, *fout, *foutv;
102 char filout[MAXNAM]; 103 char filout[MAXNAM];
103 char filin[MAXNAM]; 104 char filin[MAXNAM];
104 sprintf(filin,"%s.desc",file); 105 sprintf(filin,"%s.desc",file);
105 fin = fopen(filin,"r"); 106 fin = fopen(filin,"rt");
106 if (fin == 0) { 107 if (fin == 0) {
107 printf("Interface file \"%s\" does not exist\n",filin); 108 printf("Interface file \"%s\" does not exist\n",filin);
108 exit(1); 109 exit(1);
109 }
110 Copyright();
111 strcpy(filout,file);
112 strcat(filout,(target == 'F' ) ? ".f" : ".c" );
113 fout = fopen(filout,"w");
114 strcpy(filout,file);
115 strcat(filout,".tmp");
116 foutv = fopen(filout,"w");
117 InitDeclare();
118 nFun = 0;
119 Fprintf(fout,indent,"#include \"stack-c.h\"\n");
120 while(ReadFunction(fin)) {
121 nFun++;
122 if (nFun > MAXFUN) {
123 printf("Too many SCILAB functions. The maximum is %d\n",MAXFUN);
124 exit(1);
125 } 110 }
126 pass=0; 111 Copyright();
127 /** changing stack_positions (external variables are not in the stack)**/ 112 strcpy(filout,file);
128 FixStackPositions(); 113 strcat(filout,(target == 'F' ) ? ".f" : ".c" );
129 icrekp=icre; 114 fout = fopen(filout,"wt");
130 FixForNames(); 115 strcpy(filout,file);
131 ResetDeclare(); 116 strcat(filout,".tmp");
132 /** ShowVariables();**/ 117 foutv = fopen(filout,"wt");
133 /* first pass to collect declarations */ 118 InitDeclare();
134 WriteFunctionCode(foutv); 119 nFun = 0;
135 /* cleaning added Fornames before pass 2 */ 120 Fprintf(fout,indent,"#include \"stack-c.h\"\n");
136 ForNameClean(); 121 while(ReadFunction(fin)) {
137 FixForNames(); 122 nFun++;
138 /* scond pass to produce code */ 123 if (nFun > MAXFUN) {
139 pass=1; 124 printf("Too many SCILAB functions. The maximum is %d\n",MAXFUN);
140 icre=icrekp; 125 exit(1);
141 WriteFunctionCode(fout); 126 }
142 /** WriteInfoCode(fout); **/ 127 pass=0;
143 } 128 /** changing stack_positions (external variables are not in the stack)**/
144 /* WriteMain(fout,file); */ 129 FixStackPositions();
145 printf("C file \"%s.c\" has been created\n",file); 130 icrekp=icre;
146 /* WriteAddInter(file) ; 131 FixForNames();
147 printf("Scilab file \"%s.sce\" has been created\n",file);*/ 132 ResetDeclare();
148 fclose(fout); 133 /** ShowVariables();**/
149 fclose(fin); 134 /* first pass to collect declarations */
135 WriteFunctionCode(foutv);
136 /* cleaning added Fornames before pass 2 */
137 ForNameClean();
138 FixForNames();
139 /* scond pass to produce code */
140 pass=1;
141 icre=icrekp;
142 WriteFunctionCode(fout);
143 /** WriteInfoCode(fout); **/
144 }
145 /* WriteMain(fout,file); */
146 printf("C file \"%s.c\" has been created\n",file);
147 /* WriteAddInter(file) ;
148 printf("Scilab file \"%s.sce\" has been created\n",file);*/
149 fclose(fout);
150 fclose(fin);
150} 151}
151 152
152/*************************************************************** 153/***************************************************************
153 * Interface function 154* Interface function
154 ***************************************************************/ 155***************************************************************/
155 156
156void WriteMain(FILE *f,char *file) 157void WriteMain(FILE *f,char *file)
157{ 158{
158 int i; 159 int i;
159 FCprintf(f,"\n/**********************\n"); 160 FCprintf(f,"\n/**********************\n");
160 FCprintf(f," * interface function\n"); 161 FCprintf(f," * interface function\n");
161 FCprintf(f," ********************/\n"); 162 FCprintf(f," ********************/\n");
162 Fprintf(f,indent++,"static TabF Tab[]={\n"); 163 Fprintf(f,indent++,"static TabF Tab[]={\n");
163 for (i = 0; i < nFun; i++) { 164 for (i = 0; i < nFun; i++) {
164 Fprintf(f,indent,"{ ints%s, \"%s\"},\n",funNames[i],funNames[i]); 165 Fprintf(f,indent,"{ ints%s, \"%s\"},\n",funNames[i],funNames[i]);
165 } 166 }
166 Fprintf(f,--indent,"};\n\n"); 167 Fprintf(f,--indent,"};\n\n");
167 Fprintf(f,indent,"int C2F(%s)()\n",file); 168 Fprintf(f,indent,"int C2F(%s)()\n",file);
168 Fprintf(f,indent++,"{\n"); 169 Fprintf(f,indent++,"{\n");
169 Fprintf(f,indent,"Rhs=Max(0,Rhs);\n"); 170 Fprintf(f,indent,"Rhs=Max(0,Rhs);\n");
170 Fprintf(f,indent,"(*(Tab[Fin-1].f))(Tab[Fin-1].name);\n"); 171 Fprintf(f,indent,"(*(Tab[Fin-1].f))(Tab[Fin-1].name);\n");
171 Fprintf(f,indent,"return 0;\n"); 172 Fprintf(f,indent,"return 0;\n");
172 Fprintf(f,--indent,"};\n"); 173 Fprintf(f,--indent,"};\n");
173 174
174} 175}
175 176
176/*************************************************************** 177/***************************************************************
177 * Code for addinter 178* Code for addinter
178 ***************************************************************/ 179***************************************************************/
179 180
180void WriteAddInter(char *file) 181void WriteAddInter(char *file)
181{ 182{
182 FILE *fout; 183 FILE *fout;
183 int i; 184 int i;
184 char filout[MAXNAM]; 185 char filout[MAXNAM];
185 strcpy(filout,file); 186 strcpy(filout,file);
186 strcat(filout,".sce"); 187 strcat(filout,".sce");
187 fout = fopen(filout,"w"); 188 fout = fopen(filout,"w");
188 if ( fout != (FILE*) 0) 189 if ( fout != (FILE*) 0)
189 { 190 {
190 fprintf(fout,"// Addinter for file %s\n",file); 191 fprintf(fout,"// Addinter for file %s\n",file);
191 fprintf(fout,"// for hppa/sun-solaris/linux/dec\n"); 192 fprintf(fout,"// for hppa/sun-solaris/linux/dec\n");
192 fprintf(fout,"//--------------------------------\n"); 193 fprintf(fout,"//--------------------------------\n");
193 fprintf(fout,"//Scilab functions\n"); 194 fprintf(fout,"//Scilab functions\n");
194 fprintf(fout,"%s_funs=[...\n",file); 195 fprintf(fout,"%s_funs=[...\n",file);
195 for (i = 0; i < nFun -1; i++) 196 for (i = 0; i < nFun -1; i++)
196 fprintf(fout," '%s';\n",funNames[i]); 197 fprintf(fout," '%s';\n",funNames[i]);
197 fprintf(fout," '%s']\n",funNames[nFun-1]); 198 fprintf(fout," '%s']\n",funNames[nFun-1]);
198 fprintf(fout,"// interface file to link: ifile='%s.o'\n",file); 199 fprintf(fout,"// interface file to link: ifile='%s.o'\n",file);
199 fprintf(fout,"// user's files to link: ufiles=['file1.o','file2.o',....]\n"); 200 fprintf(fout,"// user's files to link: ufiles=['file1.o','file2.o',....]\n");
200 fprintf(fout,"addinter([files],'%s',%s_funs);\n",file,file); 201 fprintf(fout,"addinter([files],'%s',%s_funs);\n",file,file);
201 fclose(fout); 202 fclose(fout);
202 } 203 }
203 else 204 else
204 fprintf(stderr,"Can't open file %s\n",file); 205 fprintf(stderr,"Can't open file %s\n",file);
205} 206}
206 207
207 208
208void Copyright() 209void Copyright()
209{ 210{
210 printf("\nINTERSCI Version %s (%s)\n",VERSION,DATE); 211 printf("\nINTERSCI Version %s (%s)\n",VERSION,DATE);
211 printf(" Copyright (C) INRIA/ENPC All rights reserved\n\n"); 212 printf(" Copyright (C) INRIA/ENPC All rights reserved\n\n");
212} 213}
213 214
214/*************************************************************** 215/***************************************************************
215 Code generation 216Code generation
216***************************************************************/ 217***************************************************************/
217 218
218void WriteHeader(FILE *f, char *fname0,char *fname) 219void WriteHeader(FILE *f, char *fname0,char *fname)
219{ 220{
220 Fprintf(f,indent,"\nint %s%s(char *fname)\n",fname0,fname); 221 Fprintf(f,indent,"\nint %s%s(char *fname)\n",fname0,fname);
221 Fprintf(f,indent,"{\n");indent++; 222 Fprintf(f,indent,"{\n");indent++;
222 WriteDeclaration(f); 223 WriteDeclaration(f);
223} 224}
224 225
225void WriteFunctionCode(FILE *f) 226void WriteFunctionCode(FILE *f)
226{ 227{
227 int i; 228 int i;
228 IVAR ivar; 229 IVAR ivar;
229 if ( pass == 1) 230 if ( pass == 1)
230 { 231 {
231 printf(" generating C interface for function (%s) Scilab function\"%s\"\n", 232 printf(" generating C interface for function (%s) Scilab function\"%s\"\n",
232 forsub->name, 233 forsub->name,
233 basfun->name); 234 basfun->name);
234 } 235 }
235 FCprintf(f,"/******************************************\n"); 236 FCprintf(f,"/******************************************\n");
236 FCprintf(f," * SCILAB function : %s, fin = %d\n",basfun->name,nFun); 237 FCprintf(f," * SCILAB function : %s, fin = %d\n",basfun->name,nFun);
237 FCprintf(f," ******************************************/\n"); 238 FCprintf(f," ******************************************/\n");
238 239
239 WriteHeader(f,"ints",basfun->name); 240 WriteHeader(f,"ints",basfun->name);
240 241
241 /* optional arguments : new style */ 242 /* optional arguments : new style */
242 /** XXXXXX basfun->NewMaxOpt= basfun->maxOpt; */ 243 /** XXXXXX basfun->NewMaxOpt= basfun->maxOpt; */
243 basfun->NewMaxOpt= basfun->maxOpt; 244 basfun->NewMaxOpt= basfun->maxOpt;
244 if ( basfun->NewMaxOpt > 0 ) 245 if ( basfun->NewMaxOpt > 0 )
245 { 246 {
246 /** optional arguments **/ 247 /** optional arguments **/
247 AddDeclare(DEC_INT,"nopt"); 248 AddDeclare(DEC_INT,"nopt");
248 AddDeclare(DEC_INT,"iopos"); 249 AddDeclare(DEC_INT,"iopos");
249 Fprintf(f,indent,"nopt=NumOpt();\n"); 250 Fprintf(f,indent,"nopt=NumOpt();\n");
250 } 251 }
251 252
252 /* rhs argument number checking */ 253 /* rhs argument number checking */
253 254
254 if ( basfun->NewMaxOpt > 0 ) 255 if ( basfun->NewMaxOpt > 0 )
255 Fprintf(f,indent,"CheckRhs(%d,%d+nopt);\n",basfun->nin - basfun->maxOpt, 256 Fprintf(f,indent,"CheckRhs(%d,%d+nopt);\n",basfun->nin - basfun->maxOpt,
256 basfun->nin-basfun->maxOpt); 257 basfun->nin-basfun->maxOpt);
257 else 258 else
258 Fprintf(f,indent,"CheckRhs(%d,%d);\n",basfun->nin - basfun->maxOpt,basfun->nin); 259 Fprintf(f,indent,"CheckRhs(%d,%d);\n",basfun->nin - basfun->maxOpt,basfun->nin);
259 260
260 261
261 /* lhs argument number checking */ 262 /* lhs argument number checking */
262 ivar = basfun->out; 263 ivar = basfun->out;
263 if ( ivar == 0) 264 if ( ivar == 0)
264 { 265 {
265 Fprintf(f,indent,"CheckLhs(0,1);\n"); 266 Fprintf(f,indent,"CheckLhs(0,1);\n");
266 } 267 }
267 else 268 else
268 { 269 {
269 if ((variables[ivar-1]->length == 0) 270 if ((variables[ivar-1]->length == 0)
270 || (variables[ivar-1]->type == LIST) 271 || (variables[ivar-1]->type == LIST)
271 || (variables[ivar-1]->type == TLIST)) 272 || (variables[ivar-1]->type == TLIST))
272 { 273 {
273 Fprintf(f,indent,"CheckLhs(1,1);\n"); 274 Fprintf(f,indent,"CheckLhs(1,1);\n");
274 } 275 }
275 else 276 else
276 { 277 {
277 Fprintf(f,indent,"CheckLhs(1,%d);\n",variables[ivar-1]->length); 278 Fprintf(f,indent,"CheckLhs(1,%d);\n",variables[ivar-1]->length);
278 } 279 }
279 } 280 }
280 /* SCILAB argument checking */ 281 /* SCILAB argument checking */
281 for (i = 0; i < basfun->nin - basfun->NewMaxOpt ; i++) 282 for (i = 0; i < basfun->nin - basfun->NewMaxOpt ; i++)
282 { 283 {
283 switch ( variables[i]->type ) 284 switch ( variables[i]->type )
284 { 285 {
285 case LIST : 286 case LIST :
286 WriteListAnalysis(f,i,"l"); 287 WriteListAnalysis(f,i,"l");
287 break; 288 break;
288 case TLIST: 289 case TLIST:
289 WriteListAnalysis(f,i,"t"); 290 WriteListAnalysis(f,i,"t");
290 break; 291 break;
291 case MLIST : 292 case MLIST :
292 WriteListAnalysis(f,i,"m"); 293 WriteListAnalysis(f,i,"m");
293 break; 294 break;
294 default: 295 default:
295 WriteArgCheck(f,i); 296 WriteArgCheck(f,i);
296 break; 297 break;
297 } 298 }
298 } 299 }
299 300
300 if ( basfun->NewMaxOpt != 0) 301 if ( basfun->NewMaxOpt != 0)
301 { 302 {
302 sprintf(str1,"rhs_opts opts[]={\n"); 303 sprintf(str1,"rhs_opts opts[]={\n");
303 for (i = basfun->nin -basfun->NewMaxOpt ; i < basfun->nin ; i++) 304 for (i = basfun->nin -basfun->NewMaxOpt ; i < basfun->nin ; i++)
304 { 305 {
305 sprintf(str2,"\t{-1,\"%s\",\"%s\",0,0,0},\n",variables[i]->name, 306 sprintf(str2,"\t{-1,\"%s\",\"%s\",0,0,0},\n",variables[i]->name,
306 SGetForTypeAbrev(variables[i])); 307 SGetForTypeAbrev(variables[i]));
307 strcat(str1,str2); 308 strcat(str1,str2);
308 } 309 }
309 strcat(str1,"\t{-1,NULL,NULL,NULL,0,0}}"); 310 strcat(str1,"\t{-1,NULL,NULL,NULL,0,0}}");
310 AddDeclare(DEC_DATA,str1); 311 AddDeclare(DEC_DATA,str1);
311 Fprintf(f,indent,"iopos=Rhs;\n"); 312 Fprintf(f,indent,"iopos=Rhs;\n");
312 Fprintf(f,indent,"if ( get_optionals(fname,opts) == 0) return 0;\n"); 313 Fprintf(f,indent,"if ( get_optionals(fname,opts) == 0) return 0;\n");
313 for (i = basfun->nin -basfun->NewMaxOpt ; i < basfun->nin ; i++) 314 for (i = basfun->nin -basfun->NewMaxOpt ; i < basfun->nin ; i++)
314 { 315 {
315 WriteOptArgPhase2(f,i); 316 WriteOptArgPhase2(f,i);
316 } 317 }
317 } 318 }
318 319
319 /* SCILAB cross checking */ 320 /* SCILAB cross checking */
320 WriteCrossCheck(f); 321 WriteCrossCheck(f);
321 322
322 /* SCILAB equal output variable checking */ 323 /* SCILAB equal output variable checking */
323 WriteEqualCheck(f); 324 WriteEqualCheck(f);
324 325
325 /* FORTRAN call */ 326 /* FORTRAN call */
326 WriteFortranCall(f); 327 WriteFortranCall(f);
327 328
328 /* FORTRAN output to SCILAB */ 329 /* FORTRAN output to SCILAB */
329 WriteOutput(f); 330 WriteOutput(f);
330} 331}
331 332
332 333
333void WriteInfoCode(FILE *f) 334void WriteInfoCode(FILE *f)
334{ 335{
335 int i,iout; 336 int i,iout;
336 IVAR ivar; 337 IVAR ivar;
337 VARPTR var,vout; 338 VARPTR var,vout;
338 339
339 iout = GetExistOutVar(); 340 iout = GetExistOutVar();
340 vout = variables[iout -1]; 341 vout = variables[iout -1];
341 342
342 switch (vout->type) { 343 switch (vout->type) {
343 case LIST: 344 case LIST:
344 case TLIST: 345 case TLIST:
345 /* loop on output variables */ 346 /* loop on output variables */
346 printf("list("); 347 printf("list(");
347 for (i = 0; i < vout->length; i++) 348 for (i = 0; i < vout->length; i++)
348 { 349 {
349 ivar = vout->el[i]; 350 ivar = vout->el[i];
350 var = variables[ivar-1]; 351 var = variables[ivar-1];
351 printf("%s",var->name); 352 printf("%s",var->name);
352 if ( i != vout->length -1 ) 353 if ( i != vout->length -1 )
353 printf(","); 354 printf(",");
354 else 355 else
355 printf(")"); 356 printf(")");
356 } 357 }
357 break ; 358 break ;
358 case SEQUENCE: 359 case SEQUENCE:
359 /* loop on output variables */ 360 /* loop on output variables */
360 printf("["); 361 printf("[");
361 for (i = 0; i < vout->length; i++) 362 for (i = 0; i < vout->length; i++)
362 { 363 {
363 ivar = vout->el[i]; 364 ivar = vout->el[i];
364 var = variables[ivar-1]; 365 var = variables[ivar-1];
365 printf("%s",var->name); 366 printf("%s",var->name);
366 if ( i != vout->length -1 ) 367 if ( i != vout->length -1 )
367 printf(","); 368 printf(",");
368 else 369 else
369 printf("]"); 370 printf("]");
370 } 371 }
371 break; 372 break;
372 case EMPTY: 373 case EMPTY:
373 printf("[]\n"); 374 printf("[]\n");
374 break; 375 break;
375 } 376 }
376 377
377 printf("=%s(",basfun->name); 378 printf("=%s(",basfun->name);
378 for (i = 0; i < basfun->nin; i++) 379 for (i = 0; i < basfun->nin; i++)
379 { 380 {
380 printf("%s(%s)",variables[i]->name,SGetSciType(variables[i]->type)); 381 printf("%s(%s)",variables[i]->name,SGetSciType(variables[i]->type));
381 if ( i != basfun->nin -1 ) 382 if ( i != basfun->nin -1 )
382 printf(","); 383 printf(",");
383 } 384 }
384 printf(")\n"); 385 printf(")\n");
385 386
386} 387}
387 388
388/************************************************************* 389/*************************************************************
389 * Ckecking and getting infos for datas coming from scilab calling 390* Ckecking and getting infos for datas coming from scilab calling
390 * sequence ( datas on the stack ) 391* sequence ( datas on the stack )
391 ***********************************************************/ 392***********************************************************/
392 393
393void WriteArgCheck(FILE *f,int i) 394void WriteArgCheck(FILE *f,int i)
394{ 395{
395 int i1; 396 int i1;
396 VARPTR var = variables[basfun->in[i]-1]; 397 VARPTR var = variables[basfun->in[i]-1];
397 398
398 i1 = i + 1; 399 i1 = i + 1;
399 400
400 Fprintf(f,indent,"/* checking variable %s */\n",var->name); 401 Fprintf(f,indent,"/* checking variable %s */\n",var->name);
401 402
402 if (var->opt_type != 0) 403 if (var->opt_type != 0)
403 { 404 {
404 /* Optional Arguments */ 405 /* Optional Arguments */
405 WriteOptArg(f,var); 406 WriteOptArg(f,var);
406 } 407 }
407 else 408 else
408 { 409 {
409 /** 410 /**
410 * generate the code for getting a Scilab argument 411 * generate the code for getting a Scilab argument
411 * and check some dimensions property if necessary 412 * and check some dimensions property if necessary
412 **/ 413 **/
413 if (RHSTAB[var->type].type != var->type ) 414 if (RHSTAB[var->type].type != var->type )
414 { 415 {
415 fprintf(stderr,"Bug in intersci : Something wrong in RHSTAB\n"); 416 fprintf(stderr,"Bug in intersci : Something wrong in RHSTAB\n");
416 } 417 }
417 (*(RHSTAB[var->type].fonc))(f,var,0); 418 (*(RHSTAB[var->type].fonc))(f,var,0);
418 } 419 }
419} 420}
420 421
421 422
422 423
423/************************************************************* 424/*************************************************************
424 * cross checking dimensions 425* cross checking dimensions
425 ***********************************************************/ 426***********************************************************/
426 427
427void WriteCrossCheck(FILE *f) 428void WriteCrossCheck(FILE *f)
428{ 429{
429 int i, j; 430 int i, j;
430 VARPTR var; 431 VARPTR var;
431 Fprintf(f,indent,"/* cross variable size checking */\n"); 432 Fprintf(f,indent,"/* cross variable size checking */\n");
432 for (i = 0; i < nVariable; i++) 433 for (i = 0; i < nVariable; i++)
433 { 434 {
434 var = variables[i]; 435 var = variables[i];
435 if ( var->type == DIMFOREXT ) 436 if ( var->type == DIMFOREXT )
436 { 437 {
437 if ( var->nfor_name > 1) 438 if ( var->nfor_name > 1)
438 { 439 {
439 for ( j = 1 ; j < var->nfor_name ; j++) 440 for ( j = 1 ; j < var->nfor_name ; j++)
440 { 441 {
441 /** we do not check square variables : this is done elsewhere */ 442 /** we do not check square variables : this is done elsewhere */
442 /* we do not check external values since they are not known here */ 443 /* we do not check external values since they are not known here */
443 if ( (var->for_name_orig[j] != var->for_name_orig[j-1]) 444 if ( (var->for_name_orig[j] != var->for_name_orig[j-1])
444 && ( var->for_name[j-1][1] != 'e' && var->for_name[j][1] != 'e' )) 445 && ( var->for_name[j-1][1] != 'e' && var->for_name[j][1] != 'e' ))
445 { 446 {
446 Fprintf(f,indent,"CheckDimProp(%d,%d,%s != %s);\n", 447 Fprintf(f,indent,"CheckDimProp(%d,%d,%s != %s);\n",
447 var->for_name_orig[j-1], var->for_name_orig[j], 448 var->for_name_orig[j-1], var->for_name_orig[j],
448 var->for_name[j-1], var->for_name[j]); 449 var->for_name[j-1], var->for_name[j]);
449 } 450 }
450 } 451 }
451 } 452 }
452 } 453 }
453 else if (var->type == SCALAR) 454 else if (var->type == SCALAR)
454 { 455 {
455 /** some dimensions are given by a scalar input argument **/ 456 /** some dimensions are given by a scalar input argument **/
456 if ( var->nfor_name > 1) 457 if ( var->nfor_name > 1)
457 { 458 {
458 for ( j = 1 ; j < var->nfor_name ; j++) 459 for ( j = 1 ; j < var->nfor_name ; j++)
459 { 460 {
460 int dim=2; 461 int dim=2;
461 if ( var->for_name[j][0]=='m') dim=1; 462 if ( var->for_name[j][0]=='m') dim=1;
462 if ( var->for_name[j][1] != 'e' ) /* do not check external variables */ 463 if ( var->for_name[j][1] != 'e' ) /* do not check external variables */
463 { 464 {
464 if ( strncmp(var->for_name[0],"istk",4)==0) 465 if ( strncmp(var->for_name[0],"istk",4)==0)
465 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,*%s);\n", 466 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,*%s);\n",
466 var->for_name_orig[j], dim , var->for_name[j],var->for_name[0]); 467 var->for_name_orig[j], dim , var->for_name[j],var->for_name[0]);
467 else 468 else
468 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,%s);\n", 469 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,%s);\n",
469 var->for_name_orig[j], dim , var->for_name[j],var->for_name[0]); 470 var->for_name_orig[j], dim , var->for_name[j],var->for_name[0]);
470 } 471 }
471 } 472 }
472 } 473 }
473 } 474 }
474 } 475 }
475 /* 476 /*
476 FCprintf(f,"/ * cross formal parameter checking\n"); 477 FCprintf(f,"/ * cross formal parameter checking\n");
477 FCprintf(f," * not implemented yet * /\n"); */ 478 FCprintf(f," * not implemented yet * /\n"); */
478} 479}
479 480
480 481
@@ -482,535 +483,503 @@ void WriteCrossCheck(FILE *f)
482 483
483void WriteEqualCheck(FILE *f) 484void WriteEqualCheck(FILE *f)
484{ 485{
485 /*Fprintf(f,indent,"/ * cross equal output variable checking\n"); 486 /*Fprintf(f,indent,"/ * cross equal output variable checking\n");
486 Fprintf(f,indent," not implemented yet* /\n"); */ 487 Fprintf(f,indent," not implemented yet* /\n"); */
487} 488}
488 489
489/*************************************************************** 490/***************************************************************
490 * Scilab argument of type list 491* Scilab argument of type list
491 ***************************************************************/ 492***************************************************************/
492 493
493void WriteListAnalysis(FILE *f,int i,char *list_type) 494void WriteListAnalysis(FILE *f,int i,char *list_type)
494{ 495{
495 int k,i1; 496 int k,i1;
496 VARPTR var; 497 VARPTR var;
497 i1=i+1; 498 i1=i+1;
498 499
499 AddDeclare1(DEC_INT,"m%d",i1); 500 AddDeclare1(DEC_INT,"m%d",i1);
500 AddDeclare1(DEC_INT,"n%d",i1); 501 AddDeclare1(DEC_INT,"n%d",i1);
501 AddDeclare1(DEC_INT,"l%d",i1); 502 AddDeclare1(DEC_INT,"l%d",i1);
502 Fprintf(f,indent,"GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n", 503 Fprintf(f,indent,"GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n",
503 i1,list_type,i1,i1,i1); 504 i1,list_type,i1,i1,i1);
504 for (k = 0; k < nVariable ; k++) 505 for (k = 0; k < nVariable ; k++)
505 { 506 {
506 var = variables[k]; 507 var = variables[k];
507 if ((var->list_el != 0) && 508 if ((var->list_el != 0) &&
508 (strcmp(var->list_name,variables[i]->name) == 0) && 509 (strcmp(var->list_name,variables[i]->name) == 0) &&
509 var->present) 510 var->present)
510 { 511 {
511 Fprintf(f,indent,"/* list element %d %s */\n",var->list_el,var->name); 512 Fprintf(f,indent,"/* list element %d %s */\n",var->list_el,var->name);
512 if (RHSTAB[var->type].type != var->type ) 513 if (RHSTAB[var->type].type != var->type )
513 { 514 {
514 fprintf(stderr,"Bug in intersci : Something wrong in RHSTAB\n"); 515 fprintf(stderr,"Bug in intersci : Something wrong in RHSTAB\n");
515 } 516 }
516 (*(RHSTAB[var->type].fonc))(f,var,0); 517 (*(RHSTAB[var->type].fonc))(f,var,0);
517 } 518 }
518 } 519 }
519} 520}
520 521
521/*************************************************************** 522/***************************************************************
522 * Create the code for stack creation of 523* Create the code for stack creation of
523 * variables which are not Scilab argument 524* variables which are not Scilab argument
524 * and gather the code for C or Fortran call 525* and gather the code for C or Fortran call
525 ***************************************************************/ 526***************************************************************/
526 527
527void CheckCreateOrder() 528void CheckCreateOrder()
528{ 529{
529 int ivar,min= 10000; 530 int ivar,min= 10000;
530 int i,count=0; 531 int i,count=0;
531 if ( forsub->narg == 0) return ; 532 if ( forsub->narg == 0) return ;
532 for (i = 0; i < forsub->narg; i++) 533 for (i = 0; i < forsub->narg; i++)
533 { 534 {
534 ivar = forsub->arg[i]; 535 ivar = forsub->arg[i];
535 if (variables[ivar-1]->list_el == 0 536 if (variables[ivar-1]->list_el == 0
536 && variables[ivar-1]->is_sciarg == 0 537 && variables[ivar-1]->is_sciarg == 0
537 && variables[ivar-1]->for_type != EXTERNAL 538 && variables[ivar-1]->for_type != EXTERNAL
538 && variables[ivar-1]->for_type != CSTRINGV ) 539 && variables[ivar-1]->for_type != CSTRINGV )
539 { 540 {
540 count++; 541 count++;
541 if ( min != 10000 && variables[ivar-1]->stack_position !=0 542 if ( min != 10000 && variables[ivar-1]->stack_position !=0
542 && variables[ivar-1]->stack_position < min) 543 && variables[ivar-1]->stack_position < min)
543 { 544 {
544 fprintf(stderr,"Error: declaration for local variables\n"); 545 fprintf(stderr,"Error: declaration for local variables\n");
545 fprintf(stderr,"\t must respect the order given in the calling sequence\n"); 546 fprintf(stderr,"\t must respect the order given in the calling sequence\n");
546 fprintf(stderr,"\t declaration for %s must be moved downward\n", 547 fprintf(stderr,"\t declaration for %s must be moved downward\n",
547 variables[ivar-1]->name); 548 variables[ivar-1]->name);
548 exit(1); 549 exit(1);
549 } 550 }
550 if ( variables[ivar-1]->stack_position !=0 ) 551 if ( variables[ivar-1]->stack_position !=0 )
551 min = variables[ivar-1]->stack_position; 552 min = variables[ivar-1]->stack_position;
552 } 553 }
553 } 554 }
554} 555}
555 556
556 557
557void WriteFortranCall(FILE *f) 558void WriteFortranCall(FILE *f)
558{ 559{
559 int i, ind; 560 int i, ind;
560 IVAR ivar, iivar; 561 IVAR ivar, iivar;
561 char call[MAXCALL]; 562 char call[MAXCALL];
562 563
563 sprintf(call,"C2F(%s)(",forsub->name); 564 sprintf(call,"C2F(%s)(",forsub->name);
564 565
565 CheckCreateOrder(); 566 CheckCreateOrder();
566 567
567 /* loop on FORTRAN arguments */ 568 /* loop on FORTRAN arguments */
568 569
569 for (i = 0; i < forsub->narg; i++) 570 for (i = 0; i < forsub->narg; i++)
570 { 571 {
571 ivar = forsub->arg[i]; 572 ivar = forsub->arg[i];
572 ind = 0; 573 ind = 0;
573 if (variables[ivar-1]->list_el != 0) 574 if (variables[ivar-1]->list_el != 0)
574 { 575 {
575 /* FORTRAN argument is a list element */ 576 /* FORTRAN argument is a list element */
576 iivar = GetExistVar(variables[ivar-1]->list_name); 577 iivar = GetExistVar(variables[ivar-1]->list_name);
577 if ( variables[iivar-1]->is_sciarg == 0) 578 if ( variables[iivar-1]->is_sciarg == 0)
578 { 579 {
579 printf("list or tlist \"%s\" must be an argument of SCILAB function\n", 580 printf("list or tlist \"%s\" must be an argument of SCILAB function\n",
580 variables[ivar-1]->list_name); 581 variables[ivar-1]->list_name);
581 exit(1); 582 exit(1);
582 } 583 }
583 strcat(call,variables[ivar-1]->for_name[0]); 584 strcat(call,variables[ivar-1]->for_name[0]);
584 strcat(call,","); 585 strcat(call,",");
585 } 586 }
586 else 587 else
587 { 588 {
588 589 int bCheck = 0;
589 if ( variables[ivar-1]->is_sciarg == 1) 590 if ( variables[ivar-1]->is_sciarg != 1)
590 { 591 {
591 #ifdef _MSC_VER 592 /* FORTRAN argument is not a SCILAB argument */
592 _try 593 /* a new variable is created on the stack for each
593 { 594 Fortran argument */
594 if (target == 'C' && variables[ivar-1]->C_name[0] != NULL) 595 (*(CRERHSTAB[variables[ivar-1]->type].fonc))(f,variables[ivar-1]);
595 { 596 }
596 strcat(call,"&"); 597#ifdef _MSC_VER
597 strcat(call,variables[ivar-1]->C_name[0]); 598 _try
598 } 599 {
599 else strcat(call,variables[ivar-1]->for_name[0]); 600 bCheck = (variables[ivar-1]->C_name[0] != NULL);
600 strcat(call,","); 601 if (bCheck)
601 } 602 {
602 603 char *buffertmp = _strdup(variables[ivar-1]->C_name[0]);
603 _except (EXCEPTION_EXECUTE_HANDLER) 604 if (buffertmp)
604 { 605 {
605 printf("Error EXCEPTION_EXECUTE_HANDLER %s %d\n",__FILE__,__LINE__); 606 free(buffertmp);
606 exit(1); 607 buffertmp = NULL;
607 } 608 }
608 #else 609 }
609 if (target == 'C' && variables[ivar-1]->C_name[0] != NULL) 610 }
610 { 611 _except (EXCEPTION_EXECUTE_HANDLER)
611 strcat(call,"&"); 612 {
612 strcat(call,variables[ivar-1]->C_name[0]); 613 bCheck = 0;
613 } 614 }
614 else strcat(call,variables[ivar-1]->for_name[0]); 615#else
615 strcat(call,","); 616 bCheck = (variables[ivar-1]->C_name[0] != NULL);
616 #endif 617#endif
617 618 if (target == 'C' && bCheck)
618 } 619 {
619 620 strcat(call,"&");
620 621 strcat(call,variables[ivar-1]->C_name[0]);
621 622 }
622 else 623 else strcat(call,variables[ivar-1]->for_name[0]);
623 { 624 strcat(call,",");
624 /* FORTRAN argument is not a SCILAB argument */ 625 }
625 /* a new variable is created on the stack for each
626 Fortran argument */
627 (*(CRERHSTAB[variables[ivar-1]->type].fonc))(f,variables[ivar-1]);
628 #ifdef _MSC_VER
629 _try
630 {
631 if (target == 'C' && variables[ivar-1]->C_name[0] != NULL && ((int)strlen(variables[ivar-1]->C_name[0])>0) )
632 {
633 strcat(call,"&");
634 strcat(call,variables[ivar-1]->C_name[0]);
635 }
636 else strcat(call,variables[ivar-1]->for_name[0]);
637 strcat(call,",");
638 }
639 _except (EXCEPTION_EXECUTE_HANDLER)
640 {
641 printf("Error EXCEPTION_EXECUTE_HANDLER %s %d\n",__FILE__,__LINE__);
642 /* bug 1957 */
643 /* replaces last character ',' by ')' */
644 if (call[strlen(call)-1] == ',') call[strlen(call)-1]=')';
645 }
646 #else
647 if (target == 'C' && variables[ivar-1]->C_name[0] != NULL)
648 {
649 strcat(call,"&");
650 strcat(call,variables[ivar-1]->C_name[0]);
651 }
652 else strcat(call,variables[ivar-1]->for_name[0]);
653 strcat(call,",");
654 #endif
655 }
656 }
657 } 626 }
658 if (forsub->narg == 0) 627 if (forsub->narg == 0)
659 strcat(call,")"); 628 strcat(call,")");
660 else 629 else
661 call[strlen(call)-1] = ')'; 630 call[strlen(call)-1] = ')';
662 631
663 if (target == 'C' ) strcat(call,";\n"); 632 if (target == 'C' ) strcat(call,";\n");
664 Fprintf(f,indent,call); 633 Fprintf(f,indent,call);
665 634
666 for ( i=0 ; i < nVariable ; i++) 635 for ( i=0 ; i < nVariable ; i++)
667 { 636 {
668 if ( strcmp(variables[i]->name,"err")==0) 637 if ( strcmp(variables[i]->name,"err")==0)
669 { 638 {
670 AddDeclare(DEC_INT,"err=0"); 639 AddDeclare(DEC_INT,"err=0");
671 Fprintf(f,indent++,"if (err > 0) {\n"); 640 Fprintf(f,indent++,"if (err > 0) {\n");
672 Fprintf(f,indent,"Scierror(999,\"%%s: Internal Error \\n\",fname);\n"); 641 Fprintf(f,indent,"Scierror(999,\"%%s: Internal Error \\n\",fname);\n");
673 Fprintf(f,indent,"return 0;\n"); 642 Fprintf(f,indent,"return 0;\n");
674 Fprintf(f,--indent,"};\n"); 643 Fprintf(f,--indent,"};\n");
675 break; 644 break;
676 } 645 }
677 } 646 }
678} 647}
679 648
680/*************************************************** 649/***************************************************
681 * Write the interface code 650* Write the interface code
682 * for lhs variables creation 651* for lhs variables creation
683 *****************************************************/ 652*****************************************************/
684 653
685void WriteOutput(FILE *f) 654void WriteOutput(FILE *f)
686{ 655{
687 IVAR iout,ivar; 656 IVAR iout,ivar;
688 VARPTR var,vout; 657 VARPTR var,vout;
689 int i; 658 int i;
690 659
691 iout = CheckOutVar(); 660 iout = CheckOutVar();
692 661
693 if ( iout == 0) 662 if ( iout == 0)
694 { 663 {
695 Fprintf(f,indent,"LhsVar(1)=0;\n;return 0;\n"); 664 Fprintf(f,indent,"LhsVar(1)=0;\n;return 0;\n");
696 } 665 }
697 else 666 else
698 { 667 {
699 vout = variables[iout-1]; 668 vout = variables[iout-1];
700 switch (vout->type) 669 switch (vout->type)
701 { 670 {
702 case LIST: 671 case LIST:
703 case TLIST: 672 case TLIST:
704 case MLIST: 673 case MLIST:
705 Fprintf(f,indent,"/* Creation of output %s of length %d*/\n", 674 Fprintf(f,indent,"/* Creation of output %s of length %d*/\n",
706 SGetSciType(vout->type),vout->length); 675 SGetSciType(vout->type),vout->length);
707 vout->stack_position = icre; 676 vout->stack_position = icre;
708 icre++; 677 icre++;
709 Fprintf(f,indent,"Create%s(%d,%d);\n", 678 Fprintf(f,indent,"Create%s(%d,%d);\n",
710 SGetSciType(vout->type), 679 SGetSciType(vout->type),
711 vout->stack_position, 680 vout->stack_position,
712 vout->length); 681 vout->length);
713 /* loop on output variables */ 682 /* loop on output variables */
714 for (i = 0; i < vout->length; i++) 683 for (i = 0; i < vout->length; i++)
715 { 684 {
716 ivar = vout->el[i]; 685 ivar = vout->el[i];
717 var = variables[ivar-1]; 686 var = variables[ivar-1];
718 Fprintf(f,indent,"/* Element %d: %s*/\n",i+1,var->name); 687 Fprintf(f,indent,"/* Element %d: %s*/\n",i+1,var->name);
719 WriteVariable(f,var,ivar,1,i+1); 688 WriteVariable(f,var,ivar,1,i+1);
720 } 689 }
721 Fprintf(f,indent,"LhsVar(1)= %d;\nreturn 0;",vout->stack_position); 690 Fprintf(f,indent,"LhsVar(1)= %d;\nreturn 0;",vout->stack_position);
722 break; 691 break;
723 case SEQUENCE: 692 case SEQUENCE:
724 /* loop on output variables */ 693 /* loop on output variables */
725 for (i = 0; i < vout->length; i++) 694 for (i = 0; i < vout->length; i++)
726 { 695 {
727 ivar = vout->el[i]; 696 ivar = vout->el[i];
728 var = variables[ivar-1]; 697 var = variables[ivar-1];
729 WriteVariable(f,var,ivar,0,0); 698 WriteVariable(f,var,ivar,0,0);
730 } 699 }
731 Fprintf(f,indent,"return 0;\n"); 700 Fprintf(f,indent,"return 0;\n");
732 break; 701 break;
733 case EMPTY: 702 case EMPTY:
734 Fprintf(f,indent,"LhsVar(1)=0;\n;return 0;\n"); 703 Fprintf(f,indent,"LhsVar(1)=0;\n;return 0;\n");
735 break; 704 break;
736 } 705 }
737 } 706 }
738 Fprintf(f,--indent,"}\n"); 707 Fprintf(f,--indent,"}\n");
739} 708}
740 709
741/*********************************************** 710/***********************************************
742 * Output of variable var 711* Output of variable var
743 * if variable is outputed inside a list 712* if variable is outputed inside a list
744 * insidelist is set to true (1) and nel is the number 713* insidelist is set to true (1) and nel is the number
745 * of the variable in the list 714* of the variable in the list
746 ***********************************************/ 715***********************************************/
747 716
748void WriteVariable(FILE *f, VARPTR var,IVAR ivar,int insidelist,int nel) 717void WriteVariable(FILE *f, VARPTR var,IVAR ivar,int insidelist,int nel)
749{ 718{
750 IVAR ivar2, barg, farg; 719 IVAR ivar2, barg, farg;
751 VARPTR var2; 720 VARPTR var2;
752 int j; 721 int j;
753 722
754 /* get number of variable in SCILAB calling list */ 723 /* get number of variable in SCILAB calling list */
755 724
756 barg = GetNumberInScilabCall(ivar); 725 barg = GetNumberInScilabCall(ivar);
757 726
758 /* get number of variable in FORTRAN calling list */ 727 /* get number of variable in FORTRAN calling list */
759 728
760 farg = GetNumberInFortranCall(ivar); 729 farg = GetNumberInFortranCall(ivar);
761 730
762 if (var->for_type == EXTERNAL) 731 if (var->for_type == EXTERNAL)
763 { 732 {
764 /* external type */ 733 /* external type */
765 if (barg != 0) 734 if (barg != 0)
766 { 735 {
767 printf("output variable with external type \"%s\"\n",var->name); 736 printf("output variable with external type \"%s\"\n",var->name);
768 printf(" cannot be an input argument of SCILAB function\n"); 737 printf(" cannot be an input argument of SCILAB function\n");
769 exit(1); 738 exit(1);
770 } 739 }
771 if (var->equal != 0) 740 if (var->equal != 0)
772 { 741 {
773 printf("output variable with external type \"%s\"\n", var->name); 742 printf("output variable with external type \"%s\"\n", var->name);
774 printf(" cannot have a convertion\n"); 743 printf(" cannot have a convertion\n");
775 exit(1); 744 exit(1);
776 } 745 }
777 if (farg == 0) 746 if (farg == 0)
778 { 747 {
779 printf("output variable with external type \"%s\" must be\n", var->name); 748 printf("output variable with external type \"%s\" must be\n", var->name);
780 printf(" an argument of FORTRAN subroutine"); 749 printf(" an argument of FORTRAN subroutine");
781 exit(1); 750 exit(1);
782 } 751 }
783 WriteExternalVariableOutput(f,var,insidelist,nel); 752 WriteExternalVariableOutput(f,var,insidelist,nel);
784 } 753 }
785 else 754 else
786 { 755 {
787 if ( insidelist == 0 && var->list_el == 0 ) 756 if ( insidelist == 0 && var->list_el == 0 )
788 { 757 {
789 if ( var->opt_type != 0) 758 if ( var->opt_type != 0)
790 { 759 {
791 Fprintf(f,indent,"LhsVar(%d)= opts[%d].position /* %s */;\n", 760 Fprintf(f,indent,"LhsVar(%d)= opts[%d].position /* %s */;\n",
792 var->out_position, 761 var->out_position,
793 var->stack_position - basfun->NewMaxOpt+1, 762 var->stack_position - basfun->NewMaxOpt+1,
794 var->name); 763 var->name);
795 } 764 }
796 else 765 else
797 { 766 {
798 767
799 if ( var->for_type == CSTRINGV) 768 if ( var->for_type == CSTRINGV)
800 /* variable is recreated fro output */ 769 /* variable is recreated fro output */
801 Fprintf(f,indent,"LhsVar(%d)= %d;\n", 770 Fprintf(f,indent,"LhsVar(%d)= %d;\n",
802 var->out_position,icre); 771 var->out_position,icre);
803 else 772 else
804 Fprintf(f,indent,"LhsVar(%d)= %d;\n", 773 Fprintf(f,indent,"LhsVar(%d)= %d;\n",
805 var->out_position,var->stack_position); 774 var->out_position,var->stack_position);
806 } 775 }
807 } 776 }
808 if (var->equal != 0) 777 if (var->equal != 0)
809 { 778 {
810 /* SCILAB type convertion */ 779 /* SCILAB type convertion */
811 if (barg !=0 || farg!= 0) 780 if (barg !=0 || farg!= 0)
812 { 781 {
813 printf("output variable with convertion \"%s\" must not be\n",var->name); 782 printf("output variable with convertion \"%s\" must not be\n",var->name);
814 printf(" an input variable of SCILAB function or an argument\n"); 783 printf(" an input variable of SCILAB function or an argument\n");
815 printf(" of FORTRAN subroutine\n"); 784 printf(" of FORTRAN subroutine\n");
816 exit(1); 785 exit(1);
817 } 786 }
818 ivar2 = var->equal; 787 ivar2 = var->equal;
819 var2 = variables[ivar2-1]; 788 var2 = variables[ivar2-1];
820 /* get number of equal variable in SCILAB calling list */ 789 /* get number of equal variable in SCILAB calling list */
821 barg = 0; 790 barg = 0;
822 for (j = 0; j < basfun->nin; j++) 791 for (j = 0; j < basfun->nin; j++)
823 { 792 {
824 if (ivar2 == basfun->in[j]) 793 if (ivar2 == basfun->in[j])
825 { 794 {
826 barg = j + 1; 795 barg = j + 1;
827 break; 796 break;
828 } 797 }
829 } 798 }
830 if (barg == 0) 799 if (barg == 0)
831 { 800 {
832 printf("output variable with convertion \"%s\" must be\n", 801 printf("output variable with convertion \"%s\" must be\n",
833 var->name); 802 var->name);
834 printf(" an input variable of SCILAB function\n"); 803 printf(" an input variable of SCILAB function\n");
835 exit(1); 804 exit(1);
836 } 805 }
837 /* get number of equal variable in FORTRAN calling list */ 806 /* get number of equal variable in FORTRAN calling list */
838 farg = 0; 807 farg = 0;
839 for (j = 0; j < forsub->narg; j++) { 808 for (j = 0; j < forsub->narg; j++) {
840 if (ivar2 == forsub->arg[j]) { 809 if (ivar2 == forsub->arg[j]) {
841 farg = j + 1; 810 farg = j + 1;
842 break; 811 break;
843 } 812 }
844 } 813 }
845 if (farg == 0) 814 if (farg == 0)
846 { 815 {
847 printf("output variable with convertion \"%s\" must be\n", 816 printf("output variable with convertion \"%s\" must be\n",
848 var->name); 817 var->name);
849 printf(" an argument FORTRAN subroutine"); 818 printf(" an argument FORTRAN subroutine");
850 exit(1); 819 exit(1);
851 } 820 }
852 var->for_type = var2->for_type; 821 var->for_type = var2->for_type;
853 WriteVariableOutput(f,var,1,insidelist,nel); 822 WriteVariableOutput(f,var,1,insidelist,nel);
854 } 823 }
855 else 824 else
856 { 825 {
857 /* no SCILAB type convertion */ 826 /* no SCILAB type convertion */
858 if ( var->type == LIST || var->type == TLIST ) 827 if ( var->type == LIST || var->type == TLIST )
859 { 828 {
860 /** il faut alors verifier la condition pour 829 /** il faut alors verifier la condition pour
861 tous les arguments de la liste **/ 830 tous les arguments de la liste **/
862 WriteVariableOutput(f,var,0,insidelist,nel); 831 WriteVariableOutput(f,var,0,insidelist,nel);
863 return; 832 return;
864 } 833 }
865 if (farg == 0 ) { 834 if (farg == 0 ) {
866 printf("variable without convertion \"%s\" must be an argument\n", 835 printf("variable without convertion \"%s\" must be an argument\n",
867 var->name); 836 var->name);
868 printf(" of FORTRAN subroutine\n"); 837 printf(" of FORTRAN subroutine\n");
869 exit(1); 838 exit(1);
870 } 839 }
871 840
872 WriteVariableOutput(f,var,0,insidelist,nel); 841 WriteVariableOutput(f,var,0,insidelist,nel);
873 } 842 }
874 } 843 }
875} 844}
876 845
877 846
878int GetNumberInScilabCall(int ivar) 847int GetNumberInScilabCall(int ivar)
879{ 848{
880 int j; 849 int j;
881 for (j = 0; j < basfun->nin; j++) 850 for (j = 0; j < basfun->nin; j++)
882 { 851 {
883 if (ivar == basfun->in[j]) { 852 if (ivar == basfun->in[j]) {
884 return(j+1); 853 return(j+1);
885 break; 854 break;
886 } 855 }
887 } 856 }
888 return(0); 857 return(0);
889} 858}
890 859
891int GetNumberInFortranCall(int ivar) 860int GetNumberInFortranCall(int ivar)
892{ 861{
893 int j; 862 int j;
894 for (j = 0; j < forsub->narg; j++) 863 for (j = 0; j < forsub->narg; j++)
895 { 864 {
896 if (ivar == forsub->arg[j]) 865 if (ivar == forsub->arg[j])
897 { 866 {
898 return( j + 1); 867 return( j + 1);
899 break; 868 break;
900 } 869 }
901 } 870 }
902 return(0); 871 return(0);
903} 872}
904 873
905/******************************************** 874/********************************************
906 * changes string "str" to "int(str)" 875* changes string "str" to "int(str)"
907 * if str begins with stk or return str unchanged 876* if str begins with stk or return str unchanged
908 ********************************************/ 877********************************************/
909 878
910char unknown[]="ukn"; 879char unknown[]="ukn";
911 880
912char *Forname2Int(VARPTR var,int i) 881char *Forname2Int(VARPTR var,int i)
913{ 882{
914 int l; 883 int l;
915 char *p; 884 char *p;
916 if ( var->for_name[i] == (char *) 0) 885 if ( var->for_name[i] == (char *) 0)
917 { 886 {
918 printf("Error in Forname2Int for variable %s\n",var->name); 887 printf("Error in Forname2Int for variable %s\n",var->name);
919 printf("Maybe an internal variable has a dimension\n"); 888 printf("Maybe an internal variable has a dimension\n");
920 printf("which can't be evaluated\n"); 889 printf("which can't be evaluated\n");
921 abort(); 890 abort();
922 return(unknown); 891 return(unknown);
892 }
893 if ( var->C_name[i] != (char *) 0)
894 return var->C_name[i];
895 if (strncmp(var->for_name[i],"stk",3) == 0) {
896 l = (int)strlen(var->for_name[i]);
897 p = (char *)malloc((unsigned)(l + 6));
898 sprintf(p,"int(%s)",var->for_name[i]);
899 return p;
923 } 900 }
924 if ( var->C_name[i] != (char *) 0) 901 else return var->for_name[i];
925 return var->C_name[i];
926 if (strncmp(var->for_name[i],"stk",3) == 0) {
927 l = (int)strlen(var->for_name[i]);
928 p = (char *)malloc((unsigned)(l + 6));
929 sprintf(p,"int(%s)",var->for_name[i]);
930 return p;
931 }
932 else return var->for_name[i];
933} 902}
934 903
935void GenFundef(char *file,int interf) 904void GenFundef(char *file,int interf)
936{ 905{
937 FILE *fout; 906 FILE *fout;
938 char filout[MAXNAM]; 907 char filout[MAXNAM];
939 int i,j; 908 int i,j;
940 if (interf != 0 ) 909 if (interf != 0 )
941 { 910 {
942 strcpy(filout,file); 911 strcpy(filout,file);
943 strcat(filout,".fundef"); 912 strcat(filout,".fundef");
944 fout = fopen(filout,"w"); 913 fout = fopen(filout,"wt");
945 fprintf(fout,"#define IN_%s %.2d\n",file,interf); 914 fprintf(fout,"#define IN_%s %.2d\n",file,interf);
946 for (i = 0; i < nFun; i++) { 915 for (i = 0; i < nFun; i++) {
947 fprintf(fout,"{\"%s\",",funNames[i]); 916 fprintf(fout,"{\"%s\",",funNames[i]);
948 for (j = 0; j < 25 - (int)strlen(funNames[i]); j++) fprintf(fout," "); 917 for (j = 0; j < 25 - (int)strlen(funNames[i]); j++) fprintf(fout," ");
949 fprintf(fout,"\t\tIN_%s,\t%d,\t3},\n",file,i+1); 918 fprintf(fout,"\t\tIN_%s,\t%d,\t3},\n",file,i+1);
950 } 919 }
951 printf("\nfile \"%s\" has been created\n",filout); 920 printf("\nfile \"%s\" has been created\n",filout);
952 fclose(fout); 921 fclose(fout);
953 } 922 }
954} 923}
955 924
956static void GenBuilder(char *file,char *files,char *libs) 925static void GenBuilder(char *file,char *files,char *libs)
957{ 926{
958 FILE *fout; 927 FILE *fout;
959 char filout[MAXNAM]; 928 char filout[MAXNAM];
960 int i; 929 int i;
961 strcpy(filout,file); 930 strcpy(filout, file);
962 strcat(filout,"_builder.sce"); 931 strcat(filout, "_builder.sce");
963 fout = fopen(filout,"w"); 932 fout = fopen(filout, "wt");
964 fprintf(fout,"// generated with intersci\n"); 933 fprintf(fout,"// generated with intersci\n");
965 fprintf(fout,"ilib_name = 'lib%s'\t\t// interface library name\n",file); 934 fprintf(fout,"ilib_name = 'lib%s'\t\t// interface library name\n",file);
966 935
967 /* files = 'file1.o file2.o ....' delimiter = ' ' */ 936 /* files = 'file1.o file2.o ....' delimiter = ' ' */
968 while ( files != NULL) 937 while ( files != NULL)
969 { 938 {
970 static int first =1; 939 static int first =1;
971 if ( first ==1 ) { fprintf(fout,"files =['%s.o';\n\t'",file);first ++;} 940 if ( first ==1 ) { fprintf(fout,"files =['%s.o';\n\t'",file);first ++;}
972 else { fprintf(fout,"\t'");} 941 else { fprintf(fout,"\t'");}
973 while ( *files != 0 && *files != ' ' ) { fprintf(fout,"%c",*files); files++;} 942 while ( *files != 0 && *files != ' ' ) { fprintf(fout,"%c",*files); files++;}
974 while ( *files == ' ') files++; 943 while ( *files == ' ') files++;
975 if ( *files == 0 ) { fprintf(fout,"'];\n"); break;} 944 if ( *files == 0 ) { fprintf(fout,"'];\n"); break;}
976 else { fprintf(fout,"'\n");} ; 945 else { fprintf(fout,"'\n");} ;
977 } 946 }
978 947
979 while ( libs != NULL) 948 while ( libs != NULL)
980 { 949 {
981 static int first =1; 950 static int first =1;
982 if ( first ==1 ) { fprintf(fout,"libs =['");first ++;} 951 if ( first ==1 ) { fprintf(fout,"libs =['");first ++;}
983 else { fprintf(fout,"\t'");} 952 else { fprintf(fout,"\t'");}
984 while ( *libs != 0 && *libs != ' ' ) { fprintf(fout,"%c",*libs); libs++;} 953 while ( *libs != 0 && *libs != ' ' ) { fprintf(fout,"%c",*libs); libs++;}
985 while ( *libs == ' ') libs++; 954 while ( *libs == ' ') libs++;
986 if ( *libs == 0 ) { fprintf(fout,"'];\n"); break;} 955 if ( *libs == 0 ) { fprintf(fout,"'];\n"); break;}
987 else { fprintf(fout,"'\n");} ; 956 else { fprintf(fout,"'\n");} ;
988 } 957 }
989 958
990 fprintf(fout,"\ntable =["); 959 fprintf(fout,"\ntable =[");
991 i=0; 960 i=0;
992 if ( nFun == 1) 961 if ( nFun == 1)
993 fprintf(fout,"\"%s\",\"ints%s\"];\n",funNames[i],funNames[i]); 962 fprintf(fout,"\"%s\",\"ints%s\"];\n",funNames[i],funNames[i]);
994 else 963 else
995 { 964 {
996 fprintf(fout,"\"%s\",\"ints%s\";\n",funNames[i],funNames[i]); 965 fprintf(fout,"\"%s\",\"ints%s\";\n",funNames[i],funNames[i]);
997 for (i = 1; i < nFun-1; i++) { 966 for (i = 1; i < nFun-1; i++) {
998 fprintf(fout,"\t\"%s\",\"ints%s\";\n",funNames[i],funNames[i]); 967 fprintf(fout,"\t\"%s\",\"ints%s\";\n",funNames[i],funNames[i]);
999 } 968 }
1000 i=nFun-1; 969 i=nFun-1;
1001 fprintf(fout,"\t\"%s\",\"ints%s\"];\n",funNames[i],funNames[i]); 970 fprintf(fout,"\t\"%s\",\"ints%s\"];\n",funNames[i],funNames[i]);
1002 } 971 }
1003 fprintf(fout,"ilib_build(ilib_name,table,files,libs);\n"); 972 fprintf(fout,"ilib_build(ilib_name,table,files,libs);\n");
1004 printf("\nfile \"%s\" has been created\n",filout); 973 printf("\nfile \"%s\" has been created\n",filout);
1005 fclose(fout); 974 fclose(fout);
1006} 975}
1007 976
1008 977
1009 978
1010 979
1011/********************************************************** 980/**********************************************************
1012 Dealing With Fortran OutPut 981Dealing With Fortran OutPut
1013 taking into account indentation and line breaks after column 72 982taking into account indentation and line breaks after column 72
1014***********************************************************/ 983***********************************************************/
1015 984
1016 985
@@ -1021,63 +990,63 @@ char sbuf[MAXBUF];
1021 990
1022void Fprintf(FILE *f,int indent2,char *format,...) 991void Fprintf(FILE *f,int indent2,char *format,...)
1023{ 992{
1024 int i; 993 int i;
1025 static int count=0; 994 static int count=0;
1026 va_list ap; 995 va_list ap;
1027 va_start(ap,format); 996 va_start(ap,format);
1028 997
1029 vsprintf(sbuf,format,ap); 998 vsprintf(sbuf,format,ap);
1030 999
1031 for ( i = 0 ; i < (int) strlen(sbuf); i++) 1000 for ( i = 0 ; i < (int) strlen(sbuf); i++)
1032 { 1001 {
1033 if ( count == 0) 1002 if ( count == 0)
1034 { 1003 {
1035 white(f,indent2); 1004 white(f,indent2);
1036 count = indent2; 1005 count = indent2;
1037 } 1006 }
1038 if ( count >= 100 && sbuf[i] != '\n' && (sbuf[i] == ' ' || sbuf[i]== ',' || sbuf[i] == ';' || sbuf[i] == '(' ) ) 1007 if ( count >= 100 && sbuf[i] != '\n' && (sbuf[i] == ' ' || sbuf[i]== ',' || sbuf[i] == ';' || sbuf[i] == '(' ) )
1039 { 1008 {
1040 fprintf(f,"\n"); 1009 fprintf(f,"\n");
1041 white(f,indent2);count=indent2; 1010 white(f,indent2);count=indent2;
1042 } 1011 }
1043 if ( sbuf[i] == '\n') count = -1 ; 1012 if ( sbuf[i] == '\n') count = -1 ;
1044 fprintf(f,"%c",sbuf[i]); 1013 fprintf(f,"%c",sbuf[i]);
1045 count++; 1014 count++;
1046 } 1015 }
1047 va_end(ap); 1016 va_end(ap);
1048} 1017}
1049 1018
1050void white(FILE *f,int ind) 1019void white(FILE *f,int ind)
1051{ 1020{
1052 int i ; 1021 int i ;
1053 for (i =0 ; i < ind ; i++) fprintf(f," "); 1022 for (i =0 ; i < ind ; i++) fprintf(f," ");
1054} 1023}
1055 1024
1056 1025
1057void FCprintf(FILE *f,char *format,...) 1026void FCprintf(FILE *f,char *format,...)
1058{ 1027{
1059 va_list ap; 1028 va_list ap;
1060 va_start(ap,format); 1029 va_start(ap,format);
1061 1030
1062 vfprintf(f,format,ap); 1031 vfprintf(f,format,ap);
1063 va_end(ap); 1032 va_end(ap);
1064} 1033}
1065 1034
1066/****************************************** 1035/******************************************
1067 * memory allocators 1036* memory allocators
1068 ******************************************/ 1037******************************************/
1069 1038
1070VARPTR VarAlloc() 1039VARPTR VarAlloc()
1071{ 1040{
1072 return((VARPTR) malloc(sizeof(VAR))); 1041 return((VARPTR) malloc(sizeof(VAR)));
1073} 1042}
1074 1043
1075BASFUNPTR BasfunAlloc() 1044BASFUNPTR BasfunAlloc()
1076{ 1045{
1077 return((BASFUNPTR) malloc(sizeof(BASFUN))); 1046 return((BASFUNPTR) malloc(sizeof(BASFUN)));
1078} 1047}
1079 1048
1080FORSUBPTR ForsubAlloc() 1049FORSUBPTR ForsubAlloc()
1081{ 1050{
1082 return((FORSUBPTR) malloc(sizeof(FORSUB))); 1051 return((FORSUBPTR) malloc(sizeof(FORSUB)));
1083} 1052}
diff --git a/scilab/modules/intersci/src/exe/read.c b/scilab/modules/intersci/src/exe/read.c
index 0f5d059..4ca0079 100644
--- a/scilab/modules/intersci/src/exe/read.c
+++ b/scilab/modules/intersci/src/exe/read.c
@@ -1,700 +1,729 @@
1/* 1/*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab 2* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA 3* Copyright (C) ????-2008 - INRIA
4 * 4*
5 * This file must be used under the terms of the CeCILL. 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 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 7* you should have received as part of this distribution. The terms
8 * are also available at 8* are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt 9* http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 * 10*
11 */ 11*/
12 12
13#include <stdlib.h> 13#include <stdlib.h>
14 14
15#include "intersci-n.h" 15#include "intersci-n.h"
16 16
17#ifndef nlgh 17#ifndef nlgh
18 #define nlgh 24 18#define nlgh 24
19#endif 19#endif
20
21#define CR '\r'
22
23static int removeEOL(char *_str)
24{
25 if (_str)
26 {
27 int len = (int)strlen(_str);
28 if (len > 0)
29 {
30 if (_str[len - 1] == CR)
31 {
32 _str[len - 1] = 0;
33 return 1;
34 }
35 }
36 }
37 return 0;
38}
20/********************************************************** 39/**********************************************************
21 *Reading the intersci description file 40*Reading the intersci description file
22 **********************************************************/ 41**********************************************************/
23 42
24int ReadFunction(FILE *f) 43int ReadFunction(FILE *f)
25{ 44{
26 int i, j, l, type, ftype; 45 int i = 0, j = 0, l = 0, type = 0, ftype = 0;
27 char s[MAXLINE]; 46 char s[MAXLINE];
28 char *words[MAXLINE]; 47 char *words[MAXLINE];
29 char *optwords[MAXLINE]; 48 char *optwords[MAXLINE];
30 IVAR ivar; 49 IVAR ivar = 0;
31 int nwords, line1, inbas, fline1, infor, nopt, out1; 50 int nwords = 0, line1 = 0, inbas = 0, fline1 = 0, infor = 0, nopt = 0, out1 = 0;
32 nVariable = 0; 51
33 icre=1; 52 nVariable = 0;
34 basfun->maxOpt = 0; 53 icre = 1;
35 basfun->NewMaxOpt = 0; 54 basfun->maxOpt = 0;
36 line1 = 1; 55 basfun->NewMaxOpt = 0;
37 inbas = 0; 56 line1 = 1;
38 fline1 = 0; 57 inbas = 0;
39 infor = 0; 58 fline1 = 0;
40 out1 = 0; 59 infor = 0;
41 while (fgets(s,MAXLINE,f)) 60 out1 = 0;
61
62 strcpy(s, "");
63
64 while (fgets(s, MAXLINE, f) != NULL)
42 { 65 {
43 /* ignoring comments */ 66 removeEOL(s);
44 if (s[0] == '/' && s[1] == '/' ) continue; 67 /* ignoring comments */
68 if (s[0] == '/' && s[1] == '/' ) continue;
45 69
46 /* analysis of one line */ 70 /* analysis of one line */
47 if (line1 != 1) 71 if (line1 != 1)
48 nwords = ParseLine(s,words); 72 nwords = ParseLine(s,words);
49 else 73 else
50 nwords = ParseScilabLine(s,words); 74 nwords = ParseScilabLine(s,words);
51 /* empty definition at end of file */ 75 /* empty definition at end of file */
52 if (line1 == 1 && nwords == 0) 76 if (line1 == 1 && nwords == 0)
53 { 77 {
54 return 0; 78 return 0;
55 } 79 }
56 /* end of description */ 80 /* end of description */
57 if (words[0][0] == '*') return(1); 81 if (words[0][0] == '*') return(1);
58 if (line1 == 1) 82 if (line1 == 1)
59 { 83 {
60 /* SCILAB function description */ 84 /* SCILAB function description */
61 if ((int)strlen(words[0]) > nlgh) 85 if ((int)strlen(words[0]) > nlgh)
62 { 86 {
63 printf("SCILAB function name too long: \"%s\"\n",words[0]); 87 printf("SCILAB function name too long: \"%s\"\n",words[0]);
64 exit(1); 88 exit(1);
65 } 89 }
66 basfun->name = (char *)malloc((unsigned)(strlen(words[0])+1)); 90 basfun->name = (char *)malloc((unsigned)(strlen(words[0])+1));
67 strcpy(basfun->name,words[0]); 91 strcpy(basfun->name,words[0]);
68 printf("**************************\n"); 92 printf("**************************\n");
69 printf("processing SCILAB function \"%s\"\n",words[0]); 93 printf("processing SCILAB function \"%s\"\n",words[0]);
70 funNames[nFun] = basfun->name; 94 funNames[nFun] = basfun->name;
71 i = nwords - 1; 95 i = nwords - 1;
72 if (i > MAXARG) 96 if (i > MAXARG)
73 { 97 {
74 printf("too may input arguments for SCILAB function\"%s\"\n", 98 printf("too may input arguments for SCILAB function\"%s\"\n",
75 words[0]); 99 words[0]);
76 printf(" augment constant \"MAXARG\" and recompile intersci\n"); 100 printf(" augment constant \"MAXARG\" and recompile intersci\n");
77 exit(1); 101 exit(1);
78 } 102 }
79 basfun->nin = i; 103 basfun->nin = i;
80 for (i = 0; i < basfun->nin ; i++) 104 for (i = 0; i < basfun->nin ; i++)
81 { 105 {
82 if (words[i+1][0] == '{') 106 if (words[i+1][0] == '{')
83 { 107 {
84 basfun->maxOpt++; 108 basfun->maxOpt++;
85 nopt = ParseLine(words[i+1]+1,optwords); 109 nopt = ParseLine(words[i+1]+1,optwords);
86 if (nopt != 2) { 110 if (nopt != 2) {
87 printf("Bad syntax for optional argument. Two variables needed\n"); 111 printf("Bad syntax for optional argument. Two variables needed\n");
88 exit(1); 112 exit(1);
89 } 113 }
90 ivar = GetVar(optwords[0],1); 114 ivar = GetVar(optwords[0],1);
91 basfun->in[i] = ivar; 115 basfun->in[i] = ivar;
92 variables[ivar-1]->opt_type = NAME; 116 variables[ivar-1]->opt_type = NAME;
93 variables[ivar-1]->opt_name = 117 variables[ivar-1]->opt_name =
94 (char *)malloc((unsigned)(strlen(optwords[1])+1)); 118 (char *)malloc((unsigned)(strlen(optwords[1])+1));
95 variables[ivar-1]->stack_position = icre++; 119 variables[ivar-1]->stack_position = icre++;
96 strcpy(variables[ivar-1]->opt_name,optwords[1]); 120 strcpy(variables[ivar-1]->opt_name,optwords[1]);
97 variables[ivar-1]->is_sciarg = 1; 121 variables[ivar-1]->is_sciarg = 1;
98 } 122 }
99 else if (words[i+1][0] == '[') 123 else if (words[i+1][0] == '[')
100 { 124 {
101 basfun->maxOpt++; 125 basfun->maxOpt++;
102 nopt = ParseLine(words[i+1]+1,optwords); 126 nopt = ParseLine(words[i+1]+1,optwords);
103 if (nopt != 2) 127 if (nopt != 2)
104 { 128 {
105 printf("Bad syntax for optional argument. Two variables needed\n"); 129 printf("Bad syntax for optional argument. Two variables needed\n");
106 exit(1); 130 exit(1);
107 } 131 }
108 ivar = GetVar(optwords[0],1); 132 ivar = GetVar(optwords[0],1);
109 basfun->in[i] = ivar; 133 basfun->in[i] = ivar;
110 variables[ivar-1]->opt_type = VALUE; 134 variables[ivar-1]->opt_type = VALUE;
111 variables[ivar-1]->opt_name = 135 variables[ivar-1]->opt_name =
112 (char *)malloc((unsigned)(strlen(optwords[1])+1)); 136 (char *)malloc((unsigned)(strlen(optwords[1])+1));
113 strcpy(variables[ivar-1]->opt_name,optwords[1]); 137 strcpy(variables[ivar-1]->opt_name,optwords[1]);
114 variables[ivar-1]->stack_position = icre++; 138 variables[ivar-1]->stack_position = icre++;
115 variables[ivar-1]->is_sciarg = 1; 139 variables[ivar-1]->is_sciarg = 1;
116 } 140 }
117 else 141 else
118 { 142 {
119 basfun->in[i] = GetVar(words[i+1],1); 143 basfun->in[i] = GetVar(words[i+1],1);
120 variables[basfun->in[i]-1]->stack_position = icre++; 144 variables[basfun->in[i]-1]->stack_position = icre++;
121 variables[basfun->in[i]-1]->is_sciarg = 1; 145 variables[basfun->in[i]-1]->is_sciarg = 1;
122 } 146 }
123 } 147 }
124 line1 = 0; 148 line1 = 0;
125 inbas = 1; 149 inbas = 1;
126 } 150 }
127 else if (inbas == 1) 151 else if (inbas == 1)
128 { 152 {
129 if (nwords == 0) 153 if (nwords == 0)
130 { 154 {
131 /* end of SCILAB variable description */ 155 /* end of SCILAB variable description */
132 inbas = 0; 156 inbas = 0;
133 fline1 = 1; 157 fline1 = 1;
134 } 158 }
135 else 159 else
136 { 160 {
137 /* SCILAB variable description */ 161 /* SCILAB variable description */
138 ivar = GetVar(words[0],1); 162 ivar = GetVar(words[0],1);
139 i = ivar - 1; 163 i = ivar - 1;
140 if ( variables[i]->is_sciarg == 0) 164 if ( variables[i]->is_sciarg == 0)
141 { 165 {
142 /** we only fix stack_position for remaining arguments**/ 166 /** we only fix stack_position for remaining arguments**/
143 variables[i]->stack_position = icre++; 167 variables[i]->stack_position = icre++;
144 } 168 }
145 if (nwords == 1) 169 if (nwords == 1)
146 { 170 {
147 printf("type missing for variable \"%s\"\n",words[0]); 171 printf("type missing for variable \"%s\"\n",words[0]);
148 exit(1); 172 exit(1);
149 } 173 }
150 type = GetBasType(words[1]); 174 type = GetBasType(words[1]);
151 variables[i]->type = type; 175 variables[i]->type = type;
152 switch (type) 176 switch (type)
153 { 177 {
154 case SCALAR: 178 case SCALAR:
155 case ANY: 179 case ANY:
156 case SCIMPOINTER: 180 case SCIMPOINTER:
157 case SCISMPOINTER: 181 case SCISMPOINTER:
158 case SCILPOINTER: 182 case SCILPOINTER:
159 case SCIBPOINTER: 183 case SCIBPOINTER:
160 case SCIOPOINTER: 184 case SCIOPOINTER:
161 break; 185 break;
162 case COLUMN: 186 case COLUMN:
163 case ROW: 187 case ROW:
164 case STRING: 188 case STRING:
165 case WORK: 189 case WORK:
166 case VECTOR: 190 case VECTOR:
167 if (nwords != 3) 191 if (nwords != 3)
168 { 192 {
169 printf("bad type specification for variable \"%s\"\n", words[0]); 193 printf("bad type specification for variable \"%s\"\n", words[0]);
170 printf("only %d argument given and %d are expected\n", nwords,3); 194 printf("only %d argument given and %d are expected\n", nwords,3);
171 exit(1); 195 exit(1);
172 } 196 }
173 variables[i]->el[0] = GetVar(words[2],1); 197 variables[i]->el[0] = GetVar(words[2],1);
174 variables[i]->length++; 198 variables[i]->length++;
175 break; 199 break;
176 case LIST: 200 case LIST:
177 case TLIST: 201 case TLIST:
178 if (nwords != 3) 202 if (nwords != 3)
179 { 203 {
180 printf("bad type specification for variable \"%s\"\n", words[0]); 204 printf("bad type specification for variable \"%s\"\n", words[0]);
181 printf("only %d argument given and %d are expected\n", nwords,3); 205 printf("only %d argument given and %d are expected\n", nwords,3);
182 exit(1); 206 exit(1);
183 } 207 }
184 ReadListFile(words[2],words[0],i, 208 ReadListFile(words[2],words[0],i,
185 variables[i]->stack_position); 209 variables[i]->stack_position);
186 break; 210 break;
187 case POLYNOM: 211 case POLYNOM:
188 case MATRIX: 212 case MATRIX:
189 case BMATRIX: 213 case BMATRIX:
190 case STRINGMAT: 214 case STRINGMAT:
191 if (nwords != 4) 215 if (nwords != 4)
192 { 216 {
193 printf("bad type specification for variable \"%s\"\n",words[0]); 217 printf("bad type specification for variable \"%s\"\n",words[0]);
194 printf("%d argument given and %d are expected\n", nwords,4); 218 printf("%d argument given and %d are expected\n", nwords,4);
195 exit(1); 219 exit(1);
196 } 220 }
197 variables[i]->el[0] = GetVar(words[2],1); 221 variables[i]->el[0] = GetVar(words[2],1);
198 variables[i]->el[1] = GetVar(words[3],1); 222 variables[i]->el[1] = GetVar(words[3],1);
199 variables[i]->length = 2; 223 variables[i]->length = 2;
200 break; 224 break;
201 case IMATRIX: 225 case IMATRIX:
202 if (nwords != 5) 226 if (nwords != 5)
203 { 227 {
204 printf("bad type specification for variable \"%s\"\n",words[0]); 228 printf("bad type specification for variable \"%s\"\n",words[0]);
205 printf("%d argument given and %d are expected\n", nwords,4); 229 printf("%d argument given and %d are expected\n", nwords,4);
206 exit(1); 230 exit(1);
207 } 231 }
208 variables[i]->el[0] = GetVar(words[2],1); 232 variables[i]->el[0] = GetVar(words[2],1);
209 variables[i]->el[1] = GetVar(words[3],1); 233 variables[i]->el[1] = GetVar(words[3],1);
210 variables[i]->el[2] = GetVar(words[4],1); 234 variables[i]->el[2] = GetVar(words[4],1);
211 variables[i]->length = 3; 235 variables[i]->length = 3;
212 break; 236 break;
213 case SPARSE: 237 case SPARSE:
214 if (nwords != 6) 238 if (nwords != 6)
215 { 239 {
216 printf("bad type specification for variable \"%s\"\n",words[0]); 240 printf("bad type specification for variable \"%s\"\n",words[0]);
217 printf("%d argument given and %d are expected\n", nwords,6); 241 printf("%d argument given and %d are expected\n", nwords,6);
218 printf("name sparse m n nel it\n"); 242 printf("name sparse m n nel it\n");
219 exit(1); 243 exit(1);
220 } 244 }
221 variables[i]->el[0] = GetVar(words[2],1); 245 variables[i]->el[0] = GetVar(words[2],1);
222 variables[i]->el[1] = GetVar(words[3],1); 246 variables[i]->el[1] = GetVar(words[3],1);
223 variables[i]->el[2] = GetVar(words[4],1); 247 variables[i]->el[2] = GetVar(words[4],1);
224 variables[i]->el[3] = GetVar(words[5],1); 248 variables[i]->el[3] = GetVar(words[5],1);
225 variables[i]->length = 4; 249 variables[i]->length = 4;
226 break; 250 break;
227 case SEQUENCE: 251 case SEQUENCE:
228 printf("variable \"%s\" cannot have type \"SEQUENCE\"\n", 252 printf("variable \"%s\" cannot have type \"SEQUENCE\"\n",
229 words[0]); 253 words[0]);
230 exit(1); 254 exit(1);
231 break; 255 break;
232 case EMPTY: 256 case EMPTY:
233 printf("variable \"%s\" cannot have type \"EMPTY\"\n", 257 printf("variable \"%s\" cannot have type \"EMPTY\"\n",
234 words[0]); 258 words[0]);
235 exit(1); 259 exit(1);
236 break; 260 break;
237 } 261 }
238 } 262 }
239 } 263 }
240 else if (fline1 == 1) 264 else if (fline1 == 1)
241 { 265 {
242 /* FORTRAN subroutine description */ 266 /* FORTRAN subroutine description */
243 forsub->name = (char *)malloc((unsigned)(strlen(words[0])+1)); 267 forsub->name = (char *)malloc((unsigned)(strlen(words[0])+1));
244 strcpy(forsub->name,words[0]); 268 strcpy(forsub->name,words[0]);
245 i = nwords - 1; 269 i = nwords - 1;
246 if (i > MAXARG) 270 if (i > MAXARG)
247 { 271 {
248 printf("too many argument for FORTRAN subroutine \"%s\"\n", 272 printf("too many argument for FORTRAN subroutine \"%s\"\n",
249 words[0]); 273 words[0]);
250 printf(" augment constant \"MAXARG\" and recompile intersci\n"); 274 printf(" augment constant \"MAXARG\" and recompile intersci\n");
251 exit(1); 275 exit(1);
252 } 276 }
253 forsub->narg = i; 277 forsub->narg = i;
254 for (i = 0; i < nwords - 1; i++) 278 for (i = 0; i < nwords - 1; i++)
255 { 279 {
256 forsub->arg[i] = GetExistVar(words[i+1]); 280 forsub->arg[i] = GetExistVar(words[i+1]);
257 } 281 }
258 fline1 = 0; 282 fline1 = 0;
259 infor = 1; 283 infor = 1;
260 } 284 }
261 else if (infor == 1) 285 else if (infor == 1)
262 { 286 {
263 if (nwords == 0) 287 if (nwords == 0)
264 { 288 {
265 /* end of FORTRAN subroutine description */ 289 /* end of FORTRAN subroutine description */
266 infor = 0; 290 infor = 0;
267 out1 = 1; 291 out1 = 1;
268 } 292 }
269 else 293 else
270 { 294 {
271 /* FORTRAN variable description */ 295 /* FORTRAN variable description */
272 if (nwords == 1) 296 if (nwords == 1)
273 { 297 {
274 printf("type missing for FORTRAN argument \"%s\"\n", 298 printf("type missing for FORTRAN argument \"%s\"\n",
275 words[0]); 299 words[0]);
276 exit(1); 300 exit(1);
277 } 301 }
278 ivar = GetExistVar(words[0]); 302 ivar = GetExistVar(words[0]);
279 ftype = GetForType(words[1]); 303 ftype = GetForType(words[1]);
280 variables[ivar-1]->for_type = ftype; 304 variables[ivar-1]->for_type = ftype;
281 if (ftype == EXTERNAL) 305 if (ftype == EXTERNAL)
282 { 306 {
283 strcpy((char *)(variables[ivar-1]->fexternal),words[1]); 307 strcpy((char *)(variables[ivar-1]->fexternal),words[1]);
284 switch (variables[ivar-1]->type) 308 switch (variables[ivar-1]->type)
285 { 309 {
286 case LIST : 310 case LIST :
287 case TLIST : 311 case TLIST :
288 case SCALAR : 312 case SCALAR :
289 case SEQUENCE : 313 case SEQUENCE :
290 case WORK: 314 case WORK:
291 case EMPTY : 315 case EMPTY :
292 case ANY: 316 case ANY:
293 case SCIMPOINTER : 317 case SCIMPOINTER :
294 case SCISMPOINTER : 318 case SCISMPOINTER :
295 case SCILPOINTER : 319 case SCILPOINTER :
296 case SCIBPOINTER : 320 case SCIBPOINTER :
297 case SCIOPOINTER : 321 case SCIOPOINTER :
298 printf("FORTRAN argument \"%s\" with external type \"%s\"\n", 322 printf("FORTRAN argument \"%s\" with external type \"%s\"\n",
299 variables[ivar-1]->name,words[1]); 323 variables[ivar-1]->name,words[1]);
300 printf(" cannot have a variable type of \"%s\"\n",SGetSciType(variables[ivar-1]->type)); 324 printf(" cannot have a variable type of \"%s\"\n",SGetSciType(variables[ivar-1]->type));
301 exit(1); 325 exit(1);
302 break; 326 break;
303 } 327 }
304 } 328 }
305 } 329 }
306 } 330 }
307 else if (out1 == 1) 331 else if (out1 == 1)
308 { 332 {
309 /* output variable description */ 333 /* output variable description */
310 i = ivar - 1; 334 i = ivar - 1;
311 if (nwords == 1) 335 if (nwords == 1)
312 { 336 {
313 printf("type missing for output variable \"out\"\n"); 337 printf("type missing for output variable \"out\"\n");
314 exit(1); 338 exit(1);
315 } 339 }
316 ivar = GetOutVar(words[0]); 340 ivar = GetOutVar(words[0]);
317 basfun->out = ivar; 341 basfun->out = ivar;
318 i = ivar - 1; 342 i = ivar - 1;
319 type = GetBasType(words[1]); 343 type = GetBasType(words[1]);
320 variables[i]->type = type; 344 variables[i]->type = type;
321 switch (type) 345 switch (type)
322 { 346 {
323 case LIST: 347 case LIST:
324 case TLIST: 348 case TLIST:
325 case SEQUENCE: 349 case SEQUENCE:
326 l = nwords - 2; 350 l = nwords - 2;
327 if (l > MAXEL) 351 if (l > MAXEL)
328 { 352 {
329 printf("list or sequence too long for output variable \"out\"\n"); 353 printf("list or sequence too long for output variable \"out\"\n");
330 printf(" augment constant \"MAXEL\" and recompile intersci\n"); 354 printf(" augment constant \"MAXEL\" and recompile intersci\n");
331 exit(1); 355 exit(1);
332 } 356 }
333 for (j = 0; j < l; j++) 357 for (j = 0; j < l; j++)
334 { 358 {
335 int k = GetExistVar(words[j+2]); 359 int k = GetExistVar(words[j+2]);
336 variables[i]->el[j] = k; 360 variables[i]->el[j] = k;
337 variables[k-1]->out_position = j+1; 361 variables[k-1]->out_position = j+1;
338 } 362 }
339 variables[i]->length = l; 363 variables[i]->length = l;
340 break; 364 break;
341 case EMPTY: 365 case EMPTY:
342 break; 366 break;
343 default: 367 default:
344 printf("output variable \"out\" of SCILAB function\n"); 368 printf("output variable \"out\" of SCILAB function\n");
345 printf(" must have type \"LIST\", \"TLIST\", \"SEQUENCE\" or\n"); 369 printf(" must have type \"LIST\", \"TLIST\", \"SEQUENCE\" or\n");
346 printf(" \"EMPTY\"\n"); 370 printf(" \"EMPTY\"\n");
347 exit(1); 371 exit(1);
348 break; 372 break;
349 } 373 }
350 out1 = 0; 374 out1 = 0;
351 } 375 }
352 else 376 else
353 { 377 {
354 /* possibly equal variables */ 378 /* possibly equal variables */
355 ivar = GetExistVar(words[0]); 379 ivar = GetExistVar(words[0]);
356 i = ivar -1 ; 380 i = ivar -1 ;
357 variables[i]->equal = GetExistVar(words[1]); 381 variables[i]->equal = GetExistVar(words[1]);
358 } 382 }
383 strcpy(s, "");
359 } 384 }
360 /* end of description file */ 385 /* end of description file */
361 return(0); 386 return(0);
362} 387}
363 388
364/*********************************************************************** 389/***********************************************************************
365 * put the words of SCILAB function description line "s" in "words" and 390* put the words of SCILAB function description line "s" in "words" and
366 * return the number of words with checking syntax of optional variables: 391* return the number of words with checking syntax of optional variables:
367 * "{g the_g }" => 1 word "{g the_g\n" 392* "{g the_g }" => 1 word "{g the_g\n"
368 * "[f v]" => 1 word "[f v\n" 393* "[f v]" => 1 word "[f v\n"
369 **************************************************************************/ 394**************************************************************************/
370 395
371int ParseScilabLine(char *s,char *words[]) 396int ParseScilabLine(char *s,char *words[])
372{ 397{
373 char w[MAXNAM]; 398 char w[MAXNAM];
374 int nwords = 0; 399 int nwords = 0;
375 int inword = 1; 400 int inword = 1;
376 int inopt1 = 0; /* { } */ 401 int inopt1 = 0; /* { } */
377 int inopt2 = 0; /* [ ] */ 402 int inopt2 = 0; /* [ ] */
378 int i = 0; 403 int i = 0;
379 if (*s == ' ' || *s == '\t') inword = 0; 404 if (*s == ' ' || *s == '\t') inword = 0;
380 if (*s == '{') inopt1 = 1; 405 if (*s == '{') inopt1 = 1;
381 if (*s == '[') inopt2 = 1; 406 if (*s == '[') inopt2 = 1;
382 while (*s) { 407 while (*s) {
383 if (inopt1) { 408 if (inopt1) {
384 w[i++] = *s++; 409 w[i++] = *s++;
385 if (*s == '{' || *s == '[' || *s == ']' || *s == '\n') { 410 if (*s == '{' || *s == '[' || *s == ']' || *s == '\n') {
386 printf("Bad syntax for optional argument. No matching \"}\"\n"); 411 printf("Bad syntax for optional argument. No matching \"}\"\n");
387 exit(1); 412 exit(1);
388 } 413 }
389 else if (*s == '}') { 414 else if (*s == '}') {
390 w[i++] = '\n'; 415 w[i++] = '\n';
391 w[i] = '\0'; 416 w[i] = '\0';
392 words[nwords] = (char *)malloc((unsigned)(i+1)); 417 words[nwords] = (char *)malloc((unsigned)(i+1));
393 strcpy(words[nwords],w); 418 strcpy(words[nwords],w);
394 nwords++; 419 nwords++;
395 inopt1 = 0; 420 inopt1 = 0;
396 inword = 0; 421 inword = 0;
397 } 422 }
398 } 423 }
399 else if (inopt2) { 424 else if (inopt2) {
400 w[i++] = *s++; 425 w[i++] = *s++;
401 if (*s == '[' || *s == '{' || *s == '}' || *s == '\n') { 426 if (*s == '[' || *s == '{' || *s == '}' || *s == '\n') {
402 printf("Bad syntax for optional argument. No matching \"]\"\n"); 427 printf("Bad syntax for optional argument. No matching \"]\"\n");
403 exit(1); 428 exit(1);
404 } 429 }
405 else if (*s == ']') { 430 else if (*s == ']') {
406 w[i++] = '\n'; 431 w[i++] = '\n';
407 w[i] = '\0'; 432 w[i] = '\0';
408 words[nwords] = (char *)malloc((unsigned)(i+1)); 433 words[nwords] = (char *)malloc((unsigned)(i+1));
409 strcpy(words[nwords],w); 434 strcpy(words[nwords],w);
410 nwords++; 435 nwords++;
411 inopt2 = 0; 436 inopt2 = 0;
412 inword = 0; 437 inword = 0;
413 } 438 }
414 } 439 }
415 else if (inword) { 440 else if (inword) {
416 w[i++] = *s++; 441 w[i++] = *s++;
417 if (*s == ' ' || *s == '\t' || *s == '\n') { 442 if (*s == ' ' || *s == '\t' || *s == '\n') {
418 w[i] = '\0'; 443 w[i] = '\0';
419 words[nwords] = (char *)malloc((unsigned)(i+1)); 444 words[nwords] = (char *)malloc((unsigned)(i+1));
420 strcpy(words[nwords],w); 445 strcpy(words[nwords],w);
421 nwords++; 446 nwords++;
422 inword = 0; 447 inword = 0;
423 } 448 }
449 }
450 else {
451 s++; /* *s++; */
452 if (*s != ' ' && *s != '\t') {
453 /* beginning of a word */
454 i = 0;
455 inword = 1;
456 if (*s == '{') inopt1 = 1;
457 if (*s == '[') inopt2 = 1;
458 }
459 }
424 } 460 }
425 else { 461 return(nwords);
426 s++; /* *s++; */
427 if (*s != ' ' && *s != '\t') {
428 /* beginning of a word */
429 i = 0;
430 inword = 1;
431 if (*s == '{') inopt1 = 1;
432 if (*s == '[') inopt2 = 1;
433 }
434 }
435 }
436 return(nwords);
437} 462}
438 463
439/* put the words of line "s" in "words" and return the number of words */ 464/* put the words of line "s" in "words" and return the number of words */
440 465
441int ParseLine(char *s,char *words[]) 466int ParseLine(char *s,char *words[])
442{ 467{
443 char w[MAXNAM]; 468 char w[MAXNAM];
444 int nwords = 0; 469 int nwords = 0;
445 int inword = 1; 470 int inword = 1;
446 int i = 0; 471 int i = 0;
447 if(*s == ' ' || *s == '\t') inword = 0; 472 if(*s == ' ' || *s == '\t') inword = 0;
448 while (*s) { 473 while (*s) {
449 if (inword) { 474 if (inword) {
450 w[i++] = *s++; 475 w[i++] = *s++;
451 if (*s == ' ' || *s == '\t' || *s == '\n') { 476 if (*s == ' ' || *s == '\t' || *s == '\n') {
452 w[i] = '\0'; 477 w[i] = '\0';
453 words[nwords] = (char *)malloc((unsigned)(i+1)); 478 words[nwords] = (char *)malloc((unsigned)(i+1));
454 strcpy(words[nwords],w); 479 strcpy(words[nwords],w);
455 nwords++; 480 nwords++;
456 inword = 0; 481 inword = 0;
457 } 482 }
458 } 483 }
459 else { 484 else {
460 s++; /* *s++; */ 485 s++; /* *s++; */
461 if (*s != ' ' && *s != '\t') { 486 if (*s != ' ' && *s != '\t') {
462 i = 0; 487 i = 0;
463 inword = 1; 488 inword = 1;
464 } 489 }
490 }
465 } 491 }
466 } 492 return(nwords);
467 return(nwords);
468} 493}
469 494
470/*********************************************************************** 495/***********************************************************************
471 * Read a List description file 496* Read a List description file
472 **************************************************************************/ 497**************************************************************************/
473 498
474 499
475void ReadListFile(char *listname,char *varlistname,IVAR ivar,int stack_position) 500void ReadListFile(char *listname,char *varlistname,IVAR ivar,int stack_position)
476{ 501{
477 FILE *fin; 502 FILE *fin;
478 char filin[MAXNAM]; 503 char filin[MAXNAM];
479 int nel; 504 int nel;
480 505
481 sprintf(filin,"%s.list",listname); 506 sprintf(filin,"%s.list",listname);
482 fin = fopen(filin,"r"); 507 fin = fopen(filin,"rt");
483 if (fin == 0) 508 if (fin == 0)
484 { 509 {
485 printf("description file for list or tlist \"%s\" does not exist\n", 510 printf("description file for list or tlist \"%s\" does not exist\n",
486 filin); 511 filin);
487 exit(1); 512 exit(1);
488 } 513 }
489 printf("reading description file for list or tlist \"%s\"\n", listname); 514 printf("reading description file for list or tlist \"%s\"\n", listname);
490 515
491 nel = 0; 516 nel = 0;
492 while(ReadListElement(fin,varlistname,ivar,nel,stack_position)) 517 while(ReadListElement(fin,varlistname,ivar,nel,stack_position))
493 { 518 {
494 nel++; 519 nel++;
495 } 520 }
496 521
497 fclose(fin); 522 fclose(fin);
498} 523}
499 524
500int ReadListElement(FILE *f,char *varlistname,IVAR iivar,int nel,int stack_position) 525int ReadListElement(FILE *f,char *varlistname,IVAR iivar,int nel,int stack_position)
501{ 526{
502 char s[MAXLINE]; 527 char s[MAXLINE];
503 char *words[MAXLINE]; 528 char *words[MAXLINE];
504 int i, nline, nwords, type; 529 int i = 0, nline = 0, nwords = 0, type = 0;
505 IVAR ivar; 530 IVAR ivar = 0;
506 char str[MAXNAM]; 531 char str[MAXNAM];
507 nline = 0; 532
508 while (fgets(s,MAXLINE,f) != NULL) 533 strcpy(s, "");
534 nline = 0;
535 while (fgets(s, MAXLINE, f) != NULL)
509 { 536 {
510 /* analyse of one line */ 537 removeEOL(s);
511 nline++; 538 /* analyse of one line */
512 switch (nline) 539 nline++;
513 { 540 switch (nline)
514 case 1: 541 {
515 break; 542 case 1:
516 case 2: 543 break;
517 /* SCILAB variable description */ 544 case 2:
518 nwords = ParseLine(s,words); 545 /* SCILAB variable description */
519 sprintf(str,"%s(%s)",words[0],varlistname); 546 nwords = ParseLine(s,words);
520 ivar = GetVar(str,0); 547 sprintf(str,"%s(%s)",words[0],varlistname);
521 i = ivar - 1; 548 ivar = GetVar(str,0);
522 variables[ivar-1]->stack_position =stack_position; 549 i = ivar - 1;
523 if (nwords == 1) 550 variables[ivar-1]->stack_position =stack_position;
524 { 551 if (nwords == 1)
525 printf("type missing for variable \"%s\"\n",words[0]); 552 {
526 exit(1); 553 printf("type missing for variable \"%s\"\n",words[0]);
527 } 554 exit(1);
528 type = GetBasType(words[1]); 555 }
529 variables[i]->type = type; 556 type = GetBasType(words[1]);
530 variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname)+1)); 557 variables[i]->type = type;
531 strcpy(variables[i]->list_name,varlistname); 558 variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname)+1));
532 variables[i]->list_el = nel+1; 559 strcpy(variables[i]->list_name,varlistname);
533 switch (type) 560 variables[i]->list_el = nel+1;
534 { 561 switch (type)
535 case SCALAR: 562 {
536 case ANY: 563 case SCALAR:
537 break; 564 case ANY:
538 case COLUMN: 565 break;
539 case ROW: 566 case COLUMN:
540 case STRING: 567 case ROW:
541 case VECTOR: 568 case STRING:
542 if (nwords != 3) 569 case VECTOR:
543 { 570 if (nwords != 3)
544 printf("bad type for variable \"%s\"\n", 571 {
545 words[0]); 572 printf("bad type for variable \"%s\"\n",
546 exit(1); 573 words[0]);
547 } 574 exit(1);
548 if (isdigit(words[2][0])) 575 }
549 { 576 if (isdigit(words[2][0]))
550 variables[i]->el[0] = GetVar(words[2],0); 577 {
551 variables[i]->length = 1; 578 variables[i]->el[0] = GetVar(words[2],0);
552 } 579 variables[i]->length = 1;
553 else 580 }
554 { 581 else
555 sprintf(str,"%s(%s)",words[2],varlistname); 582 {
556 variables[i]->el[0] = GetVar(str,0); 583 sprintf(str,"%s(%s)",words[2],varlistname);
557 variables[i]->length = 1; 584 variables[i]->el[0] = GetVar(str,0);
558 } 585 variables[i]->length = 1;
559 break; 586 }
560 case POLYNOM: 587 break;
561 case MATRIX: 588 case POLYNOM:
562 case BMATRIX: 589 case MATRIX:
563 case STRINGMAT: 590 case BMATRIX:
564 if (nwords != 4) 591 case STRINGMAT:
565 { 592 if (nwords != 4)
566 printf("bad type for variable \"%s\"\n", 593 {
567 words[0]); 594 printf("bad type for variable \"%s\"\n",
568 exit(1); 595 words[0]);
569 } 596 exit(1);
570 if (isdigit(words[2][0])) 597 }
571 { 598 if (isdigit(words[2][0]))
572 variables[i]->el[0] = GetVar(words[2],0); 599 {
573 variables[i]->length = 1; 600 variables[i]->el[0] = GetVar(words[2],0);
574 } 601 variables[i]->length = 1;
575 else 602 }
576 { 603 else
577 sprintf(str,"%s(%s)",words[2],varlistname); 604 {
578 variables[i]->el[0] = GetVar(str,0); 605 sprintf(str,"%s(%s)",words[2],varlistname);
579 variables[i]->length = 1; 606 variables[i]->el[0] = GetVar(str,0);
580 } 607 variables[i]->length = 1;
581 if (isdigit(words[3][0])) 608 }
582 { 609 if (isdigit(words[3][0]))
583 variables[i]->el[1] = GetVar(words[3],0); 610 {
584 variables[i]->length = 2; 611 variables[i]->el[1] = GetVar(words[3],0);
585 } 612 variables[i]->length = 2;
586 else 613 }
587 { 614 else
588 sprintf(str,"%s(%s)",words[3],varlistname); 615 {
589 variables[i]->el[1] = GetVar(str,0); 616 sprintf(str,"%s(%s)",words[3],varlistname);
590 variables[i]->length = 2; 617 variables[i]->el[1] = GetVar(str,0);
591 } 618 variables[i]->length = 2;
592 break; 619 }
593 case IMATRIX: 620 break;
594 if (nwords != 5) 621 case IMATRIX:
595 { 622 if (nwords != 5)
596 printf("bad type for variable \"%s\"\n", 623 {
597 words[0]); 624 printf("bad type for variable \"%s\"\n",
598 exit(1); 625 words[0]);
599 } 626 exit(1);
600 if (isdigit(words[2][0])) 627 }
601 { 628 if (isdigit(words[2][0]))
602 variables[i]->el[0] = GetVar(words[2],0); 629 {
603 variables[i]->length = 1; 630 variables[i]->el[0] = GetVar(words[2],0);
604 } 631 variables[i]->length = 1;
605 else 632 }
606 { 633 else
607 sprintf(str,"%s(%s)",words[2],varlistname); 634 {
608 variables[i]->el[0] = GetVar(str,0); 635 sprintf(str,"%s(%s)",words[2],varlistname);
609 variables[i]->length = 1; 636 variables[i]->el[0] = GetVar(str,0);
610 } 637 variables[i]->length = 1;
611 if (isdigit(words[3][0])) 638 }
612 { 639 if (isdigit(words[3][0]))
613 variables[i]->el[1] = GetVar(words[3],0); 640 {
614 variables[i]->length = 2; 641 variables[i]->el[1] = GetVar(words[3],0);
615 } 642 variables[i]->length = 2;
616 else 643 }
617 { 644 else
618 sprintf(str,"%s(%s)",words[3],varlistname); 645 {
619 variables[i]->el[1] = GetVar(str,0); 646 sprintf(str,"%s(%s)",words[3],varlistname);
620 variables[i]->length = 2; 647 variables[i]->el[1] = GetVar(str,0);
621 } 648 variables[i]->length = 2;
622 sprintf(str,"%s(%s)",words[4],varlistname); 649 }
623 variables[i]->el[2] = GetVar(str,0); 650 sprintf(str,"%s(%s)",words[4],varlistname);
624 variables[i]->length = 3; 651 variables[i]->el[2] = GetVar(str,0);
625 break; 652 variables[i]->length = 3;
626 case SPARSE: 653 break;
627 if (nwords != 6) 654 case SPARSE:
628 { 655 if (nwords != 6)
629 printf("bad type for variable \"%s\"\n", 656 {
630 words[0]); 657 printf("bad type for variable \"%s\"\n",
631 exit(1); 658 words[0]);
632 } 659 exit(1);
633 if (isdigit(words[2][0])) 660 }
634 { 661 if (isdigit(words[2][0]))
635 variables[i]->el[0] = GetVar(words[2],0); 662 {
636 variables[i]->length = 1; 663 variables[i]->el[0] = GetVar(words[2],0);
637 } 664 variables[i]->length = 1;
638 else 665 }
639 { 666 else
640 sprintf(str,"%s(%s)",words[2],varlistname); 667 {
641 variables[i]->el[0] = GetVar(str,0); 668 sprintf(str,"%s(%s)",words[2],varlistname);
642 variables[i]->length = 1; 669 variables[i]->el[0] = GetVar(str,0);
643 } 670 variables[i]->length = 1;
644 if (isdigit(words[3][0])) 671 }
645 { 672 if (isdigit(words[3][0]))
646 variables[i]->el[1] = GetVar(words[3],0); 673 {
647 variables[i]->length = 2; 674 variables[i]->el[1] = GetVar(words[3],0);
648 } 675 variables[i]->length = 2;
649 else 676 }
650 { 677 else
651 sprintf(str,"%s(%s)",words[3],varlistname); 678 {
652 variables[i]->el[1] = GetVar(str,0); 679 sprintf(str,"%s(%s)",words[3],varlistname);
653 variables[i]->length = 2; 680 variables[i]->el[1] = GetVar(str,0);
654 } 681 variables[i]->length = 2;
655 if (isdigit(words[4][0])) 682 }
656 { 683 if (isdigit(words[4][0]))
657 variables[i]->el[2] = GetVar(words[4],0); 684 {
658 variables[i]->length = 3; 685 variables[i]->el[2] = GetVar(words[4],0);
659 } 686 variables[i]->length = 3;
660 else 687 }
661 { 688 else
662 sprintf(str,"%s(%s)",words[4],varlistname); 689 {
663 variables[i]->el[2] = GetVar(str,0); 690 sprintf(str,"%s(%s)",words[4],varlistname);
664 variables[i]->length = 3; 691 variables[i]->el[2] = GetVar(str,0);
665 } 692 variables[i]->length = 3;
666 sprintf(str,"%s(%s)",words[5],varlistname); 693 }
667 variables[i]->el[3] = GetVar(str,0); 694 sprintf(str,"%s(%s)",words[5],varlistname);
668 variables[i]->length = 4; 695 variables[i]->el[3] = GetVar(str,0);
669 break; 696 variables[i]->length = 4;
670 case WORK: 697 break;
671 case SEQUENCE: 698 case WORK:
672 case EMPTY: 699 case SEQUENCE:
673 case LIST: 700 case EMPTY:
674 case TLIST: 701 case LIST:
675 printf("variable \"%s\" cannot have type \"%s\"\n", 702 case TLIST:
676 words[0],SGetSciType(type)); 703 printf("variable \"%s\" cannot have type \"%s\"\n",
677 exit(1); 704 words[0],SGetSciType(type));
678 default: 705 exit(1);
679 printf("variable \"%s\" has unknown type \"%s\"\n", 706 default:
680 words[0],SGetSciType(type)); 707 printf("variable \"%s\" has unknown type \"%s\"\n",
681 } 708 words[0],SGetSciType(type));
682 break; 709 }
683 default: 710 break;
684 /* end of description */ 711 default:
685 if (s[0] == '*') 712 /* end of description */
686 { 713 if (s[0] == '*')
687 return(1); 714 {
688 } 715 return(1);
689 else 716 }
690 { 717 else
691 printf("bad description file for list or tlist \"%s\"\n", 718 {
692 varlistname); 719 printf("bad description file for list or tlist \"%s\"\n",
693 exit(1); 720 varlistname);
694 } 721 exit(1);
695 break; 722 }
696 } 723 break;
724 }
725 strcpy(s, "");
697 } 726 }
698 return(0); 727 return(0);
699} 728}
700 729
diff --git a/scilab/modules/intersci/tests/nonreg_tests/bug_4625.c b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.c
new file mode 100644
index 0000000..d598761
--- /dev/null
+++ b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.c
@@ -0,0 +1,25 @@
1#include "stack-c.h"
2/******************************************
3 * SCILAB function : ext1c, fin = 1
4 ******************************************/
5
6int intsext1c(char *fname)
7{
8 int m1,n1,l1,mn1,m2,n2,l2,mn2,un=1,mn3,l3;
9 CheckRhs(2,2);
10 CheckLhs(1,1);
11 /* checking variable a */
12 GetRhsVar(1,"d",&m1,&n1,&l1);
13 CheckVector(1,m1,n1);
14 mn1=m1*n1;
15 /* checking variable b */
16 GetRhsVar(2,"d",&m2,&n2,&l2);
17 CheckVector(2,m2,n2);
18 mn2=m2*n2;
19 /* cross variable size checking */
20 CheckDimProp(1,2,m1*n1 != m2*n2);
21 CreateVar(3,"d",(un=1,&un),(mn3=mn1,&mn3),&l3);/* named: c */
22 C2F(ext1c)(&mn1,stk(l1),stk(l2),stk(l3));
23 LhsVar(1)= 3;
24 return 0;
25}
diff --git a/scilab/modules/intersci/tests/nonreg_tests/bug_4625.desc b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.desc
new file mode 100644
index 0000000..5768a55
--- /dev/null
+++ b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.desc
@@ -0,0 +1,13 @@
1ext1c a b
2a vector m
3b vector m
4c vector m
5
6ext1c m a b c
7m integer
8a double
9b double
10c double
11
12out sequence c
13***********************
diff --git a/scilab/modules/intersci/tests/nonreg_tests/bug_4625.dia.ref b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.dia.ref
new file mode 100644
index 0000000..14ad7e9
--- /dev/null
+++ b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.dia.ref
@@ -0,0 +1,23 @@
1// =============================================================================
2// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3// Copyright (C) 2010 - DIGITEO - Allan CORNET
4//
5// This file is distributed under the same license as the Scilab package.
6// =============================================================================
7// <-- Non-regression test for bug 4625 -->
8//
9// <-- Bugzilla URL -->
10// http://bugzilla.scilab.org/show_bug.cgi?id=4625
11//
12// <-- Short Description -->
13// intersci-n was broken on Windows.
14//
15if getos() == 'Windows' then
16 copyfile(SCI+"/modules/intersci/tests/nonreg_tests/bug_4625.desc", TMPDIR+"/bug_4625.desc");
17 cd(TMPDIR);
18 s = dos(SCI+'/modules/intersci/bin/intersci-n.exe bug_4625');
19 if s <> %t then bugmes();quit;end
20 r = mgetl(TMPDIR + '/bug_4625.c');
21 ref = mgetl(SCI+"/modules/intersci/tests/nonreg_tests/bug_4625.c");
22 if ~and(r == ref) then bugmes();quit;end
23end
diff --git a/scilab/modules/intersci/tests/nonreg_tests/bug_4625.tst b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.tst
new file mode 100644
index 0000000..07b3208
--- /dev/null
+++ b/scilab/modules/intersci/tests/nonreg_tests/bug_4625.tst
@@ -0,0 +1,25 @@
1// =============================================================================
2// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3// Copyright (C) 2010 - DIGITEO - Allan CORNET
4//
5// This file is distributed under the same license as the Scilab package.
6// =============================================================================
7
8// <-- Non-regression test for bug 4625 -->
9//
10// <-- Bugzilla URL -->
11// http://bugzilla.scilab.org/show_bug.cgi?id=4625
12//
13// <-- Short Description -->
14// intersci-n was broken on Windows.
15//
16
17if getos() == 'Windows' then
18 copyfile(SCI+"/modules/intersci/tests/nonreg_tests/bug_4625.desc", TMPDIR+"/bug_4625.desc");
19 cd(TMPDIR);
20 s = dos(SCI+'/modules/intersci/bin/intersci-n.exe bug_4625');
21 if s <> %t then pause, end
22 r = mgetl(TMPDIR + '/bug_4625.c');
23 ref = mgetl(SCI+"/modules/intersci/tests/nonreg_tests/bug_4625.c");
24 if ~and(r == ref) then pause, end
25end