a73325c1b0e3bf48c04d8fda4fda949be2d57a02
[scilab.git] / scilab / modules / scicos / src / c / var2sci.c
1 /*  Scicos
2 *
3 *  Copyright (C) DIGITEO - 2009 - Allan CORNET
4 *
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.
9 *
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.
14 *
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.
18 *
19 * See the file ./license.txt
20 */
21 /*--------------------------------------------------------------------------*/
22 #include "var2sci.h"
23 #include "import.h"
24 #include "stack-c.h"
25 #include "MALLOC.h"
26 /*--------------------------------------------------------------------------*/
27 int var2sci(void *x, int n, int m, int typ_var)
28 {
29     /************************************
30     * variables and constants d?inition
31     ************************************/
32     /*counter and address variable declaration*/
33     int nm = 0, il = 0, l = 0, lw = 0, j = 0, i = 0, err = 0;
34
35     /*define all type of accepted ptr */
36     SCSREAL_COP *x_d = NULL, *ptr_d = NULL;
37     SCSINT8_COP *x_c = NULL, *ptr_c = NULL;
38     SCSUINT8_COP *x_uc = NULL, *ptr_uc = NULL;
39     SCSINT16_COP *x_s = NULL, *ptr_s = NULL;
40     SCSUINT16_COP *x_us = NULL, *ptr_us = NULL;
41     SCSINT_COP *x_i = NULL, *ptr_i = NULL;
42     SCSUINT_COP *x_ui = NULL, *ptr_ui = NULL;
43     SCSINT32_COP *x_l = NULL, *ptr_l = NULL;
44     SCSUINT32_COP *x_ul = NULL, *ptr_ul = NULL;
45
46     /* Check if the stack is not full */
47     if (Top >= Bot)
48     {
49         err = 1;
50         return err;
51     }
52     else
53     {
54         Top = Top + 1;
55         il = iadr(*Lstk(Top));
56         l = sadr(il + 4);
57     }
58
59     /* set number of double needed to store data */
60     if (typ_var == SCSREAL_N)
61     {
62         nm = n * m;    /*double real matrix*/
63     }
64     else if (typ_var == SCSCOMPLEX_N)
65     {
66         nm = n * m * 2;    /*double real matrix*/
67     }
68     else if (typ_var == SCSINT_N)
69     {
70         nm = (int)(ceil((n * m) / 2) + 1);    /*int*/
71     }
72     else if (typ_var == SCSINT8_N)
73     {
74         nm = (int)(ceil((n * m) / 8) + 1);    /*int8*/
75     }
76     else if (typ_var == SCSINT16_N)
77     {
78         nm = (int)(ceil((n * m) / 4) + 1);    /*int16*/
79     }
80     else if (typ_var == SCSINT32_N)
81     {
82         nm = (int)(ceil((n * m) / 2) + 1);    /*int32*/
83     }
84     else if (typ_var == SCSUINT_N)
85     {
86         nm = (int)(ceil((n * m) / 2) + 1);    /*uint*/
87     }
88     else if (typ_var == SCSUINT8_N)
89     {
90         nm = (int)(ceil((n * m) / 8) + 1);    /*uint8*/
91     }
92     else if (typ_var == SCSUINT16_N)
93     {
94         nm = (int)(ceil((n * m) / 4) + 1);    /*uint16*/
95     }
96     else if (typ_var == SCSUINT32_N)
97     {
98         nm = (int)(ceil((n * m) / 2) + 1);    /*uint32*/
99     }
100     else if (typ_var == SCSUNKNOW_N)
101     {
102         nm = n * m;    /*arbitrary scilab object*/
103     }
104     else
105     {
106         nm = n * m;    /*double real matrix*/
107     }
108
109     /*check if there is free space for new data*/
110     err = l + nm - *Lstk(Bot);
111     if (err > 0)
112     {
113         err = 2;
114         return err;
115     }
116
117     /**************************
118     * store data on the stack
119     *************************/
120     switch (typ_var) /*for each type of data*/
121     {
122         case SCSREAL_N    : /* set header */
123             *istk(il) = sci_matrix; /*double real matrix*/
124             *istk(il + 1) = n;
125             *istk(il + 2) = m;
126             *istk(il + 3) = 0;
127             x_d = (SCSREAL_COP *) x;
128             ptr_d = (SCSREAL_COP *) stk(l);
129             for (j = 0; j < m * n; j++)
130             {
131                 ptr_d[j] = x_d[j];
132             }
133             break;
134
135         case SCSCOMPLEX_N : /* set header */
136             *istk(il) = 1; /*double complex matrix*/
137             *istk(il + 1) = n;
138             *istk(il + 2) = m;
139             *istk(il + 3) = 1;
140             x_d = (SCSCOMPLEX_COP *) x;
141             ptr_d = (SCSCOMPLEX_COP *) stk(l);
142             for (j = 0; j < 2 * m * n; j++)
143             {
144                 ptr_d[j] = x_d[j];
145             }
146             break;
147
148         case SCSINT_N     : /* set header */
149             *istk(il) = sci_ints; /*int*/
150             *istk(il + 1) = n;
151             *istk(il + 2) = m;
152             *istk(il + 3) = 4;
153             x_i = (SCSINT_COP *) x;
154             for (j = 0; j < m * n; j++)
155             {
156                 ptr_i = (SCSINT_COP *) istk(il + 4);
157                 ptr_i[j] = x_i[j];
158             }
159             break;
160
161         case SCSINT8_N    : /* set header */
162             *istk(il) = sci_ints; /*int8*/
163             *istk(il + 1) = n;
164             *istk(il + 2) = m;
165             *istk(il + 3) = 1;
166             x_c = (SCSINT8_COP *) x;
167             for (j = 0; j < m * n; j++)
168             {
169                 ptr_c = (SCSINT8_COP *) istk(il + 4);
170                 ptr_c[j] = x_c[j];
171             }
172             break;
173
174         case SCSINT16_N   : /* set header */
175             *istk(il) = sci_ints; /*int16*/
176             *istk(il + 1) = n;
177             *istk(il + 2) = m;
178             *istk(il + 3) = 2;
179             x_s = (SCSINT16_COP *) x;
180             for (j = 0; j < m * n; j++)
181             {
182                 ptr_s = (SCSINT16_COP *) istk(il + 4);
183                 ptr_s[j] = x_s[j];
184             }
185             break;
186
187         case SCSINT32_N   : /* set header */
188             *istk(il) = sci_ints; /*int32*/
189             *istk(il + 1) = n;
190             *istk(il + 2) = m;
191             *istk(il + 3) = 4;
192             x_l = (SCSINT32_COP *) x;
193             for (j = 0; j < m * n; j++)
194             {
195                 ptr_l = (SCSINT32_COP *) istk(il + 4);
196                 ptr_l[j] = x_l[j];
197             }
198             break;
199
200         case SCSUINT_N   : /* set header */
201             *istk(il) = sci_ints; /*uint*/
202             *istk(il + 1) = n;
203             *istk(il + 2) = m;
204             *istk(il + 3) = 14;
205             x_ui = (SCSUINT_COP *) x;
206             for (j = 0; j < m * n; j++)
207             {
208                 ptr_ui = (SCSUINT_COP *) istk(il + 4);
209                 ptr_ui[j] = x_ui[j];
210             }
211             break;
212
213         case SCSUINT8_N   : /* set header */
214             *istk(il) = sci_ints; /*uint8*/
215             *istk(il + 1) = n;
216             *istk(il + 2) = m;
217             *istk(il + 3) = 11;
218             x_uc = (SCSUINT8_COP *) x;
219             for (j = 0; j < m * n; j++)
220             {
221                 ptr_uc = (SCSUINT8_COP *) istk(il + 4);
222                 ptr_uc[j] = x_uc[j];
223             }
224             break;
225
226         case SCSUINT16_N  : /* set header */
227             *istk(il) = sci_ints; /*uint16*/
228             *istk(il + 1) = n;
229             *istk(il + 2) = m;
230             *istk(il + 3) = 12;
231             x_us = (SCSUINT16_COP *) x;
232             for (j = 0; j < m * n; j++)
233             {
234                 ptr_us = (SCSUINT16_COP *) istk(il + 4);
235                 ptr_us[j] = x_us[j];
236             }
237             break;
238
239         case SCSUINT32_N  : /* set header */
240             *istk(il) = sci_ints; /*uint32*/
241             *istk(il + 1) = n;
242             *istk(il + 2) = m;
243             *istk(il + 3) = 14;
244             x_ul = (SCSUINT32_COP *) x;
245             for (j = 0; j < m * n; j++)
246             {
247                 ptr_ul = (SCSUINT32_COP *) istk(il + 4);
248                 ptr_ul[j] = x_ul[j];
249             }
250             break;
251
252         case SCSUNKNOW_N  :
253             lw = Top;
254             x_d = (double *) x;
255             C2F(unsfdcopy)(&nm, x_d, (j = 1, &j), stk(*Lstk(Top)), (i = 1, &i));
256             break;
257
258         default         : /* set header */
259             *istk(il) = sci_matrix; /* double by default */
260             *istk(il + 1) = n;
261             *istk(il + 2) = m;
262             *istk(il + 3) = 0;
263             x_d = (double *) x;
264             for (j = 0; j < m * n; j++)
265             {
266                 ptr_d = (double *) stk(il + 4);
267                 ptr_d[j] = x_d[j];
268             }
269             break;
270     }
271
272     /* set value in lstk */
273     *Lstk(Top + 1) = l + nm;
274
275     /*return error flag = 0 */
276     err = 0;
277     return 0;
278 }
279 /*--------------------------------------------------------------------------*/