3 * Copyright (C) INRIA - Allan CORNET
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 * See the file ./license.txt
21 /*--------------------------------------------------------------------------*/
22 #include "gw_scicos.h"
25 #include "localization.h"
27 /*--------------------------------------------------------------------------*/
28 /* intbuildouttb build an initialized outtb list
30 * [outtb]=buildouttb(lnksz,lnktyp)
32 * rhs 1 : lnksz, give the size of scilab object in outtb
33 * can be all int type or double matrix
34 * can have n,2 or 2,n size
36 * rhs 2 : lnktyp, gives the type of scilab object in outtb
46 * can be all int type or double matrix
47 * can have n,1 or 1,n size
49 * lhs 1 : a list of size n
51 * 02/07/06, Alan : Initial version.
52 * 21/11/06, Alan : Allow void rhs input param.
55 /*--------------------------------------------------------------------------*/
56 int sci_buildouttb(char *fname, unsigned long fname_len)
58 static int l1 = 0, m1 = 0, n1 = 0;
59 static int l2 = 0, m2 = 0, n2 = 0;
60 static int l3 = 0, n3 = 1;
63 int n_lnksz = 0, n_lnktyp = 0;
64 int *lnksz = NULL, *lnktyp = NULL;
67 double *ptr_dc = NULL;
75 int nm = 0, i = 0, j = 0, ierr = 0;
77 static int minlhs = 1, maxlhs = 1;
78 static int minrhs = 2, maxrhs = 2;
80 /*check number of lhs/rhs*/
81 CheckLhs(minlhs, maxlhs);
82 CheckRhs(minrhs, maxrhs);
84 /*check type of Rhs 1*/
87 GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
89 else if (VarType(1) == sci_ints)
91 GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1);
95 Scierror(888, _("%s : lnksz argument must be double or integer.\n"), fname);
99 /*check type of Rhs 2*/
102 GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
104 else if (VarType(2) == sci_ints)
106 GetRhsVar(2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &M2);
110 Scierror(888, _("%s : lnktyp argument must be double or integer.\n"), fname);
114 /*check size of Rhs 1*/
123 /*void double input give void list output*/
124 else if ((n1 == 0) || (m1 == 0))
126 if ((n2 == 0) || (m2 == 0))
128 /*manually code a void list on rhs(1)*/
129 ptr_i = (int*)GetData(1);
139 Scierror(888, _("%s : inconsistent dimension between lnksz and lnktyp.\n"), fname);
145 Scierror(888, _("%s : bad dimension for lnksz argument.\n"), fname);
149 /*check size of Rhs 2*/
158 else if ((n2 == 0) || (m2 == 0))
160 if ( (n1 != 0) && (m1 != 0) )
162 Scierror(888, _("%s : inconsistent dimension between lnksz and lnktyp.\n"), fname);
168 Scierror(888, _("%s : bad dimension for lnktyp argument.\n"), fname);
172 /*cross size checking*/
173 if (n_lnksz != n_lnktyp)
175 Scierror(888, _("%s : lnksz and lnktyp argument must have the same length.\n"), fname);
180 if ((lnksz = MALLOC(2 * n_lnksz * sizeof(int))) == NULL)
182 Scierror(999, _("%s : No more free memory.\n"), fname);
187 if ((lnktyp = MALLOC(n_lnktyp * sizeof(int))) == NULL)
189 Scierror(999, _("%s : No more free memory.\n"), fname);
194 /*store rhs 1 in lnksz */
195 if ((m1 == n1) && (m2 == m1))
197 m1 = -1; /* this is done for matrix 2,2 */
206 for (j = 0; j < n_lnksz; j++)
208 lnksz[j] = (int) IC_CHAR(M1.D)[j * 2];
209 lnksz[n_lnksz + j] = (int) IC_CHAR(M1.D)[2 * j + 1];
214 for (j = 0; j < 2 * n_lnksz; j++)
216 lnksz[j] = (int) IC_CHAR(M1.D)[j];
224 for (j = 0; j < n_lnksz; j++)
226 lnksz[j] = (int) IC_INT16(M1.D)[j * 2];
227 lnksz[n_lnksz + j] = (int) IC_INT16(M1.D)[2 * j + 1];
232 for (j = 0; j < 2 * n_lnksz; j++)
234 lnksz[j] = (int) IC_INT16(M1.D)[j];
242 for (j = 0; j < n_lnksz; j++)
244 lnksz[j] = (int) IC_INT32(M1.D)[j * 2];
245 lnksz[n_lnksz + j] = (int) IC_INT32(M1.D)[2 * j + 1];
250 for (j = 0; j < 2 * n_lnksz; j++)
252 lnksz[j] = (int) IC_INT32(M1.D)[j];
260 for (j = 0; j < n_lnksz; j++)
262 lnksz[j] = (int) IC_UCHAR(M1.D)[j * 2];
263 lnksz[n_lnksz + j] = (int) IC_UCHAR(M1.D)[2 * j + 1];
268 for (j = 0; j < 2 * n_lnksz; j++)
270 lnksz[j] = (int) IC_UCHAR(M1.D)[j];
278 for (j = 0; j < n_lnksz; j++)
280 lnksz[j] = (int) IC_UINT16(M1.D)[j * 2];
281 lnksz[n_lnksz + j] = (int) IC_UINT16(M1.D)[2 * j + 1];
286 for (j = 0; j < 2 * n_lnksz; j++)
288 lnksz[j] = (int) IC_UINT16(M1.D)[j];
296 for (j = 0; j < n_lnksz; j++)
298 lnksz[j] = (int) IC_UINT32(M1.D)[j * 2];
299 lnksz[n_lnksz + j] = (int) IC_UINT32(M1.D)[2 * j + 1];
304 for (j = 0; j < 2 * n_lnksz; j++)
306 lnksz[j] = (int) IC_UINT32(M1.D)[j];
316 for (j = 0; j < n_lnksz; j++)
318 lnksz[j] = (int) ((double *) stk(l1))[j * 2];
319 lnksz[n_lnksz + j] = (int) ((double *) stk(l1))[2 * j + 1];
324 for (j = 0; j < 2 * n_lnksz; j++)
326 lnksz[j] = (int) ((double *) stk(l1))[j];
331 /*store rhs 2 in lnktyp */
332 if (VarType(2) == sci_ints)
337 for (j = 0; j < n_lnktyp; j++)
339 lnktyp[j] = (int) IC_CHAR(M2.D)[j];
344 for (j = 0; j < n_lnktyp; j++)
346 lnktyp[j] = (int) IC_INT16(M2.D)[j];
351 for (j = 0; j < n_lnktyp; j++)
353 lnktyp[j] = (int) IC_INT32(M2.D)[j];
358 for (j = 0; j < n_lnktyp; j++)
360 lnktyp[j] = (int) IC_UCHAR(M2.D)[j];
365 for (j = 0; j < n_lnktyp; j++)
367 lnktyp[j] = (int) IC_UINT16(M2.D)[j];
372 for (j = 0; j < n_lnktyp; j++)
374 lnktyp[j] = (int) IC_UINT32(M2.D)[j];
379 /* Invalid integer type */
380 Scierror(999, _("%s: Wrong value for input argument #%d: An integer expected.\n"), fname, 2);
388 for (j = 0; j < n_lnktyp; j++)
390 lnktyp[j] = (int) ((double *) stk(l2))[j];
394 /* build output list */
395 CreateVar(3, LIST_DATATYPE, &n_lnktyp, &n3, &l3);
397 for (i = 0; i < n_lnktyp; i++)
399 nm = lnksz[i] * lnksz[i + n_lnktyp];
403 if ((ptr_d = MALLOC(nm * sizeof(double))) == NULL)
408 for (j = 0; j < nm; j++)
412 CreateListVarFromPtr(3, i + 1, MATRIX_OF_DOUBLE_DATATYPE, &lnksz[i], &lnksz[i + n_lnktyp], &ptr_d);
417 if ((ptr_d = MALLOC(2 * nm * sizeof(double))) == NULL)
422 for (j = 0; j < 2 * nm; j++)
427 CreateListCVarFromPtr(3, i + 1, MATRIX_OF_DOUBLE_DATATYPE, (j = 1, &j), &lnksz[i], &lnksz[i + n_lnktyp], &ptr_d, &ptr_dc);
432 if ((ptr_i = MALLOC(nm * sizeof(int))) == NULL)
437 for (j = 0; j < nm; j++)
442 M3.n = lnksz[i + n_lnktyp];
446 CreateListVarFromPtr(3, i + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &M3.m, &M3.n, &M3);
451 if ((ptr_s = MALLOC(nm * sizeof(short))) == NULL)
456 for (j = 0; j < nm; j++)
461 M3.n = lnksz[i + n_lnktyp];
465 CreateListVarFromPtr(3, i + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &M3.m, &M3.n, &M3);
470 if ((ptr_c = MALLOC(nm * sizeof(char))) == NULL)
475 for (j = 0; j < nm; j++)
480 M3.n = lnksz[i + n_lnktyp];
484 CreateListVarFromPtr(3, i + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &M3.m, &M3.n, &M3);
489 if ((ptr_ui = MALLOC(nm * sizeof(unsigned int))) == NULL)
494 for (j = 0; j < nm; j++)
499 M3.n = lnksz[i + n_lnktyp];
503 CreateListVarFromPtr(3, i + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &M3.m, &M3.n, &M3);
508 if ((ptr_us = MALLOC(nm * sizeof(unsigned short))) == NULL)
513 for (j = 0; j < nm; j++)
518 M3.n = lnksz[i + n_lnktyp];
522 CreateListVarFromPtr(3, i + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &M3.m, &M3.n, &M3);
527 if ((ptr_uc = MALLOC(nm * sizeof(unsigned char))) == NULL)
532 for (j = 0; j < nm; j++)
537 M3.n = lnksz[i + n_lnktyp];
541 CreateListVarFromPtr(3, i + 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &M3.m, &M3.n, &M3);
546 if ((ptr_d = MALLOC(nm * sizeof(double))) == NULL)
551 for (j = 0; j < nm; j++)
555 CreateListVarFromPtr(3, i + 1, MATRIX_OF_DOUBLE_DATATYPE, &lnksz[i], &lnksz[i + n_lnktyp], &ptr_d);
562 Scierror(999, _("%s : No more free memory.\n"), fname);
575 /*--------------------------------------------------------------------------*/