fix Windows compilation after scicos commits
[scilab.git] / scilab / modules / scicos / src / c / import.c
1 /*  Scicos
2 *
3 *  Copyright (C) INRIA -
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 <string.h>
23 #include <stdio.h>
24 #include "machine.h"
25 #include "import.h"
26 #include "scicos.h"
27 #include "scicos_internal.h"
28 #include "cvstr.h"
29 /*--------------------------------------------------------------------------*/
30 ScicosImport scicos_imp =
31 {
32     (double *)  NULL,      /* x      **  */
33     (int *) NULL,      /* nx         */
34     (int *) NULL,      /* xptr   **  */
35     (int *) NULL,      /* zcptr  **  */
36     (double *)  NULL,      /* z      **  */
37     (int *) NULL,      /* nz         */
38     (int *) NULL,      /* zptr   **  */
39     (int *) NULL,      /* noz        */
40     (void **)   NULL,      /* oz         */
41     (int *) NULL,      /* ozsz       */
42     (int *) NULL,      /* oztyp      */
43     (int *) NULL,      /* ozptr      */
44     (double *)  NULL,      /* g          */
45     (int *) NULL,      /* ng         */
46     (int *) NULL,      /* mod        */
47     (int *) NULL,      /* nmod       */
48     (int *) NULL,      /* modptr **  */
49     (char **) NULL,      /* iz         */
50     (int *) NULL,      /* izptr      */
51     (char **) NULL,      /* uid        */
52     (int *) NULL,      /* uidptr     */
53     (int *) NULL,      /* inpptr **  */
54     (int *) NULL,      /* inplnk **  */
55     (int *) NULL,      /* outptr **  */
56     (int *) NULL,      /* outlnk **  */
57     (double *)  NULL,      /* rpar   **  */
58     (int *) NULL,      /* rpptr  **  */
59     (int *) NULL,      /* ipar   **  */
60     (int *) NULL,      /* ipptr  **  */
61     (void **)   NULL,      /* opar       */
62     (int *) NULL,      /* oparsz     */
63     (int *) NULL,      /* opartyp    */
64     (int *) NULL,      /* opptr      */
65     (int *) NULL,      /* nblk       */
66     (void **)   NULL,      /* outtbptr   */
67     (int *) NULL,      /* outtbsz    */
68     (int *) NULL,      /* outtbtyp   */
69     (int *) NULL,      /* nlnk       */
70     (int *) NULL,      /* subs   **  */
71     (int *) NULL,      /* nsubs      */
72     (double *)  NULL,      /* tevts  **  */
73     (int *) NULL,      /* evtspt **  */
74     (int *) NULL,      /* nevts      */
75     (int *) NULL,      /* pointi **  */
76     (int *) NULL,      /* iord   **  */
77     (int *) NULL,      /* niord      */
78     (int *) NULL,      /* oord   **  */
79     (int *) NULL,      /* noord      */
80     (int *) NULL,      /* zord   **  */
81     (int *) NULL,      /* nzord      */
82     (int *) NULL,      /* funptr     */
83     (int *) NULL,      /* funtyp **  */
84     (int *) NULL,      /* ztyp   **  */
85     (int *) NULL,      /* cord   **  */
86     (int *) NULL,      /* ncord      */
87     (int *) NULL,      /* ordclk **  */
88     (int *) NULL,      /* nordclk ** */
89     (int *) NULL,      /* clkptr **  */
90     (int *) NULL,      /* ordptr **  */
91     (int *) NULL,      /* nordptr    */
92     (int *) NULL,      /* critev **  */
93     (int *) NULL,      /* iwa        */
94     (int *) NULL,      /* mask       */
95     (scicos_block *) NULL, /* blocks     */
96     (double *)  NULL,      /* t0         */
97     (double *)  NULL,      /* tf         */
98     (double *)  NULL,      /* Atol       */
99     (double *)  NULL,      /* rtol       */
100     (double *)  NULL,      /* ttol       */
101     (double *)  NULL,      /* deltat     */
102     (double *)  NULL,      /* hmax       */
103     (outtb_el *) NULL,     /* outtb_elem */
104     (int *) NULL,      /* nelem      */
105     (int *) NULL,      /* xprop      */
106     (double *)  NULL,      /* xd         */
107 };
108
109 /*--------------------------------------------------------------------------*/
110 /* getscicosimportptr returns a pointer
111  * to the imported structure
112  */
113 ScicosImport* getscicosimportptr(void)
114 {
115     return &scicos_imp;
116 }
117 /*--------------------------------------------------------------------------*/
118 void makescicosimport(double *x, int *nx,
119                       int *xptr, int *zcptr,
120                       double *z, int *nz, int *zptr,
121                       int *noz, void **oz, int *ozsz, int *oztyp, int *ozptr,
122                       double *g, int *ng,
123                       int *mod, int *nmod, int *modptr,
124                       char **iz, int *izptr, char **uid, int *uidptr, int *inpptr, int *inplnk,
125                       int *outptr, int *outlnk, void **outtbptr, int *outtbsz, int *outtbtyp,
126                       outtb_el *outtb_elem, int *nelem,
127                       int *nlnk, double *rpar, int *rpptr, int *ipar, int *ipptr,
128                       void **opar, int *oparsz, int *opartyp, int *opptr,
129                       int *nblk, int *subs, int *nsubs,
130                       double *tevts, int *evtspt, int *nevts, int *pointi,
131                       int *iord, int *niord, int *oord, int *noord, int *zord, int *nzord,
132                       int *funptr, int *funtyp, int *ztyp,
133                       int *cord, int *ncord, int *ordclk, int *nordclk, int *clkptr,
134                       int *ordptr, int *nordptr, int *critev,  int *iwa, scicos_block *blocks,
135                       double *t0, double *tf, double *Atol, double *rtol, double *ttol, double *deltat, double *hmax,
136                       int *xprop, double *xd)
137 {
138     scicos_imp.x = x;
139     scicos_imp.nx = nx;
140     scicos_imp.xptr = xptr;
141     scicos_imp.zcptr = zcptr;
142     scicos_imp.z = z;
143     scicos_imp.nz = nz;
144     scicos_imp.zptr = zptr;
145
146     scicos_imp.noz = noz;
147     scicos_imp.oz = oz;
148     scicos_imp.ozsz = ozsz;
149     scicos_imp.oztyp = oztyp;
150     scicos_imp.ozptr = ozptr;
151
152     scicos_imp.g = g;
153     scicos_imp.ng = ng;
154     scicos_imp.mod = mod;
155     scicos_imp.nmod = nmod;
156     scicos_imp.modptr = modptr;
157     scicos_imp.iz = iz;
158     scicos_imp.izptr = izptr;
159     scicos_imp.uid = uid;
160     scicos_imp.uidptr = uidptr;
161
162     scicos_imp.inpptr = inpptr;
163     scicos_imp.inplnk = inplnk;
164     scicos_imp.outptr = outptr;
165     scicos_imp.outlnk = outlnk;
166
167     scicos_imp.rpar = rpar;
168     scicos_imp.rpptr = rpptr;
169     scicos_imp.ipar = ipar;
170     scicos_imp.ipptr = ipptr;
171
172     scicos_imp.opar = opar;
173     scicos_imp.oparsz = oparsz;
174     scicos_imp.opartyp = opartyp;
175     scicos_imp.opptr = opptr;
176
177     scicos_imp.nblk = nblk;
178     scicos_imp.outtbptr = outtbptr;
179     scicos_imp.outtbsz = outtbsz;
180     scicos_imp.outtbtyp = outtbtyp;
181     scicos_imp.outtb_elem = outtb_elem;
182     scicos_imp.nelem = nelem;
183     scicos_imp.nlnk = nlnk;
184
185     scicos_imp.subs = subs;
186     scicos_imp.nsubs = nsubs;
187
188     scicos_imp.tevts = tevts;
189     scicos_imp.evtspt = evtspt;
190     scicos_imp.nevts = nevts;
191     scicos_imp.pointi = pointi;
192
193     scicos_imp.iord = iord;
194     scicos_imp.niord = niord;
195     scicos_imp.oord = oord;
196     scicos_imp.noord = noord;
197     scicos_imp.zord = zord;
198     scicos_imp.nzord = nzord;
199
200     scicos_imp.funptr = funptr;
201     scicos_imp.funtyp = funtyp;
202
203     scicos_imp.ztyp = ztyp;
204     scicos_imp.cord = cord;
205     scicos_imp.ncord = ncord;
206     scicos_imp.ordclk = ordclk;
207     scicos_imp.nordclk = nordclk;
208     scicos_imp.clkptr = clkptr;
209     scicos_imp.ordptr = ordptr;
210     scicos_imp.nordptr = nordptr;
211     scicos_imp.critev = critev;
212     scicos_imp.iwa = iwa;
213     scicos_imp.blocks = blocks;
214
215     scicos_imp.t0 = t0;
216     scicos_imp.tf = tf;
217     scicos_imp.Atol = Atol;
218     scicos_imp.ttol = ttol;
219     scicos_imp.rtol = rtol;
220     scicos_imp.deltat = deltat;
221     scicos_imp.hmax = hmax;
222
223     scicos_imp.xprop = xprop;
224     scicos_imp.xd = xd;
225 }
226 /*--------------------------------------------------------------------------*/
227 void C2F(clearscicosimport)()
228 {
229     scicos_imp.x = (double *) NULL;
230     scicos_imp.nx = (int *) NULL;
231     scicos_imp.xptr = (int *) NULL;
232     scicos_imp.zcptr = (int *) NULL;
233     scicos_imp.z = (double *) NULL;
234     scicos_imp.nz = (int *) NULL;
235     scicos_imp.zptr = (int *) NULL;
236
237     scicos_imp.noz = (int *) NULL;
238     scicos_imp.oz = (void **) NULL;
239     scicos_imp.ozsz = (int *) NULL;
240     scicos_imp.oztyp = (int *) NULL;
241     scicos_imp.ozptr = (int *) NULL;
242
243     scicos_imp.g = (double *) NULL;
244     scicos_imp.ng = (int *) NULL;
245     scicos_imp.mod = (int *) NULL;
246     scicos_imp.nmod = (int *) NULL;
247     scicos_imp.modptr = (int *) NULL;
248     scicos_imp.iz = (char **) NULL;
249     scicos_imp.izptr = (int *) NULL;
250     scicos_imp.uid = (char **) NULL;
251     scicos_imp.uidptr = (int *) NULL;
252
253     scicos_imp.inpptr = (int *) NULL;
254     scicos_imp.inplnk = (int *) NULL;
255     scicos_imp.outptr = (int *) NULL;
256     scicos_imp.outlnk = (int *) NULL;
257
258     scicos_imp.rpar = (double *) NULL;
259     scicos_imp.rpptr = (int *) NULL;
260     scicos_imp.ipar = (int *) NULL;
261     scicos_imp.ipptr = (int *) NULL;
262
263     scicos_imp.opar = (void **) NULL;
264     scicos_imp.oparsz = (int *) NULL;
265     scicos_imp.opartyp = (int *) NULL;
266     scicos_imp.opptr = (int *) NULL;
267
268     scicos_imp.nblk = (int *) NULL;
269     scicos_imp.outtbptr = (void **) NULL;
270     scicos_imp.outtbsz = (int *) NULL;
271     scicos_imp.outtbtyp = (int *) NULL;
272     scicos_imp.outtb_elem = (outtb_el *) NULL;
273     scicos_imp.nelem = (int *) NULL;
274     scicos_imp.nlnk = (int *) NULL;
275
276     scicos_imp.subs = (int *) NULL;
277     scicos_imp.nsubs = (int *) NULL;
278     scicos_imp.tevts = (double *) NULL;
279     scicos_imp.evtspt = (int *) NULL;
280     scicos_imp.nevts = (int *) NULL;
281     scicos_imp.pointi = (int *) NULL;
282
283     scicos_imp.iord = (int *) NULL;
284     scicos_imp.niord = (int *) NULL;
285     scicos_imp.oord = (int *) NULL;
286     scicos_imp.noord = (int *) NULL;
287     scicos_imp.zord = (int *) NULL;
288     scicos_imp.nzord = (int *) NULL;
289
290     scicos_imp.funptr = (int *) NULL;
291     scicos_imp.funtyp = (int *) NULL;
292
293     scicos_imp.ztyp = (int *) NULL;
294     scicos_imp.cord = (int *) NULL;
295     scicos_imp.ncord = (int *) NULL;
296     scicos_imp.ordclk = (int *) NULL;
297     scicos_imp.nordclk = (int *) NULL;
298     scicos_imp.clkptr = (int *) NULL;
299     scicos_imp.ordptr = (int *) NULL;
300     scicos_imp.nordptr = (int *) NULL;
301     scicos_imp.critev = (int *) NULL;
302
303     scicos_imp.iwa = (int *) NULL;
304     scicos_imp.mask = (int *) NULL;
305     scicos_imp.blocks = (scicos_block *) NULL;
306
307     scicos_imp.t0 = (double *) NULL;
308     scicos_imp.tf = (double *) NULL;
309     scicos_imp.Atol = (double *) NULL;
310     scicos_imp.ttol = (double *) NULL;
311     scicos_imp.rtol = (double *) NULL;
312     scicos_imp.deltat = (double *) NULL;
313     scicos_imp.hmax = (double *) NULL;
314
315     scicos_imp.xprop = (int *) NULL;
316     scicos_imp.xd = (double *) NULL;
317 }
318 /*--------------------------------------------------------------------------*/
319 /* 20/06/06, Alan : review
320  * 08/02/07, Alan : update
321  */
322
323 int getscicosvarsfromimport(char *what, void **v, int *nv, int *mv)
324 /*char *what;   data structure selection -see import.h for definition-*/
325 /*void **v;     Pointer to the beginning of the imported data */
326 /*int *nv;      size 1 of the imported data */
327 /*int *mv; size 1 of the imported data */
328 {
329     /*variable declaration*/
330     int nx, nz, noz, nmod, nblk, nlnk, nsubs, nevts, ng;
331     int niord, noord, ncord, nordptr, nzord, nelem;
332
333     /*test if scicosim is running*/
334     if (scicos_imp.x == (double *)NULL)
335     {
336         v = (void *) NULL;
337         return 0; /* undefined import table scicos is not running */
338     }
339
340     /* retrieve length of x register */
341     nx = (int) scicos_imp.nx[0];
342     /* retrieve length of z register */
343     nz = (int) scicos_imp.nz[0];
344     /* retrieve length of oz register */
345     noz = (int) scicos_imp.noz[0];
346     /* retrieve number of block */
347     nmod = (int) scicos_imp.nmod[0];
348     /* retrieve number of block */
349     nblk = (int) scicos_imp.nblk[0];
350     /* retrieve number of link */
351     nlnk = (int) scicos_imp.nlnk[0];
352     /* retrieve number nsubs */
353     nsubs = (int) scicos_imp.nsubs[0];
354     /* retrieve number nevts */
355     nevts = (int) scicos_imp.nevts[0];
356     /* retrieve number niord */
357     niord = (int) scicos_imp.niord[0];
358     /* retrieve number noord */
359     noord = (int) scicos_imp.noord[0];
360     /* retrieve number ncord */
361     ncord = (int) scicos_imp.ncord[0];
362     /* retrieve number nordptr */
363     nordptr = (int) scicos_imp.nordptr[0];
364     /* retrieve number nzord */
365     nzord = (int) scicos_imp.nzord[0];
366     /* retrieve number ng */
367     ng = (int) scicos_imp.ng[0];
368     /* retrieve number nelem */
369     nelem = (int) scicos_imp.nelem[0];
370
371     /* imported from */
372     if (strcmp(what, "x") == 0)
373     {
374         /* x - continuous state */
375         *nv = (int) (scicos_imp.xptr[nblk] - scicos_imp.xptr[0]);
376         *mv = 1;
377         *v  = (double *)(scicos_imp.x);
378     }
379     else if (strcmp(what, "nx") == 0)
380     {
381         /* length of x register */
382         *nv = 1;
383         *mv = 1;
384         *v  = (int *) (scicos_imp.nx);
385     }
386     else if (strcmp(what, "xptr") == 0)
387     {
388         /* xptr - continuous state splitting array */
389         *nv = nblk + 1;
390         *mv = 1;
391         *v  = (int *) (scicos_imp.xptr);
392     }
393     else if (strcmp(what, "zcptr") == 0)
394     {
395         /* zcptr - zero crossing splitting array */
396         *nv = nblk + 1;
397         *mv = 1;
398         *v  = (int *) (scicos_imp.zcptr);
399     }
400     else if (strcmp(what, "z") == 0)
401     {
402         /* z - discrete state */
403         *nv = (int)(scicos_imp.zptr[nblk] - scicos_imp.zptr[0]);
404         *mv = 1;
405         *v  = (double *) (scicos_imp.z);
406     }
407     else if (strcmp(what, "nz") == 0)
408     {
409         /* length of z register */
410         *nv = 1;
411         *mv = 1;
412         *v  = (int *) (scicos_imp.nz);
413     }
414     else if (strcmp(what, "noz") == 0)
415     {
416         /* length of oz register */
417         *nv = 1;
418         *mv = 1;
419         *v  = (int *) (scicos_imp.noz);
420     }
421     else if (strcmp(what, "oz") == 0)
422     {
423         /* oz - vector of ptr of object discrete states */
424         *nv = (int)(scicos_imp.ozptr[nblk] - scicos_imp.ozptr[0]);
425         *mv = 1;
426         *v  = (int *) (scicos_imp.oz);
427     }
428     else if (strcmp(what, "ozptr") == 0)
429     {
430         /* ozptr - object discrete states splitting array */
431         *nv = nblk + 1;
432         *mv = 1;
433         *v  = (int *) (scicos_imp.ozptr);
434     }
435     else if (strcmp(what, "ozsz") == 0)
436     {
437         /* oparsz - object discrete states size array */
438         *nv = (int)(scicos_imp.ozptr[nblk] - scicos_imp.ozptr[0]);
439         *mv = 2;
440         *v  = (int *) (scicos_imp.ozsz);
441     }
442     else if (strcmp(what, "oztyp") == 0)
443     {
444         /* opartyp - object discrete states type array */
445         *nv = (int)(scicos_imp.ozptr[nblk] - scicos_imp.ozptr[0]);
446         *mv = 1;
447         *v  = (int *) (scicos_imp.oztyp);
448     }
449     else if (strcmp(what, "zptr") == 0)
450     {
451         /* zptr - discrete state splitting array */
452         *nv = nblk + 1;
453         *mv = 1;
454         *v  = (int *) (scicos_imp.zptr);
455     }
456     else if (strcmp(what, "mod") == 0)
457     {
458         /* modes - block discontinuities array */
459         *nv = (int)(scicos_imp.modptr[nblk] - scicos_imp.modptr[0]);
460         *mv = 1;
461         *v  = (int *) (scicos_imp.mod);
462     }
463     else if (strcmp(what, "nmod") == 0)
464     {
465         /* nmodes - number of block discontinuities array */
466         *nv = 1;
467         *mv = 1;
468         *v  = (int *) (scicos_imp.nmod);
469     }
470     else if (strcmp(what, "modptr") == 0)
471     {
472         /* modptr - block discontinuities splitting array */
473         *nv = nblk + 1;
474         *mv = 1;
475         *v  = (int *) (scicos_imp.modptr);
476     }
477     else if (strcmp(what, "iz") == 0)
478     {
479         /* iz - label integer code of blocks array */
480         *nv = (int)(scicos_imp.izptr[nblk] - scicos_imp.izptr[0]);
481         *mv = 1;
482         *v  = (char **) (scicos_imp.iz);
483     }
484     else if (strcmp(what, "izptr") == 0)
485     {
486         /* izptr - label integer code of blocks splitting array */
487         *nv = nblk + 1;
488         *mv = 1;
489         *v  = (int *) (scicos_imp.izptr);
490     }
491     else if (strcmp(what, "uid") == 0)
492     {
493         /* uid */
494         *nv = (int)(scicos_imp.uidptr[nblk] - scicos_imp.uidptr[0]);
495         *mv = 1;
496         *v  = (char **) (scicos_imp.uid);
497     }
498     else if (strcmp(what, "uidptr") == 0)
499     {
500         /* uidptr */
501         *nv = nblk + 1;
502         *mv = 1;
503         *v  = (int *) (scicos_imp.uidptr);
504     }
505     else if (strcmp(what, "inpptr") == 0)
506     {
507         /* inpptr */
508         *nv = nblk + 1;
509         *mv = 1;
510         *v  = (int *) (scicos_imp.inpptr);
511     }
512     else if (strcmp(what, "inplnk") == 0)
513     {
514         /* inplnk */
515         *nv = (int)(scicos_imp.inpptr[nblk] - scicos_imp.inpptr[0]);
516         *mv = 1;
517         *v  = (int *) (scicos_imp.inplnk);
518     }
519     else if (strcmp(what, "outptr") == 0)
520     {
521         /* outptr */
522         *nv = nblk + 1;
523         *mv = 1;
524         *v  = (int *) (scicos_imp.outptr);
525     }
526     else if (strcmp(what, "outlnk") == 0)
527     {
528         /* outlnk */
529         *nv = (int)(scicos_imp.outptr[nblk] - scicos_imp.outptr[0]);
530         *mv = 1;
531         *v  = (int *) (scicos_imp.outlnk);
532     }
533     else if (strcmp(what, "rpar") == 0)
534     {
535         /* rpar - vector of real parameters */
536         *nv = (int)(scicos_imp.rpptr[nblk] - scicos_imp.rpptr[0]);
537         *mv = 1;
538         *v  = (double *) (scicos_imp.rpar);
539     }
540     else if (strcmp(what, "rpptr") == 0)
541     {
542         /* rpptr - real parameters splitting array */
543         *nv = nblk + 1;
544         *mv = 1;
545         *v  = (int *) (scicos_imp.rpptr);
546     }
547     else if (strcmp(what, "ipar") == 0)
548     {
549         /* ipar - vector of integer parameters */
550         *nv = (int)(scicos_imp.ipptr[nblk] - scicos_imp.ipptr[0]);
551         *mv = 1;
552         *v  = (int *) (scicos_imp.ipar);
553     }
554     else if (strcmp(what, "ipptr") == 0)
555     {
556         /* ipptr - integer parameters splitting array */
557         *nv = nblk + 1;
558         *mv = 1;
559         *v  = (int *) (scicos_imp.ipptr);
560     }
561     else if (strcmp(what, "opar") == 0)
562     {
563         /* opar - vector of ptr of objects parameters */
564         *nv = (int)(scicos_imp.opptr[nblk] - scicos_imp.opptr[0]);
565         *mv = 1;
566         *v  = (int *) (scicos_imp.opar);
567     }
568     else if (strcmp(what, "opptr") == 0)
569     {
570         /* opptr - object parameters splitting array */
571         *nv = nblk + 1;
572         *mv = 1;
573         *v  = (int *) (scicos_imp.opptr);
574     }
575     else if (strcmp(what, "oparsz") == 0)
576     {
577         /* oparsz - object parameters size array */
578         *nv = (int)(scicos_imp.opptr[nblk] - scicos_imp.opptr[0]);
579         *mv = 2;
580         *v  = (int *) (scicos_imp.oparsz);
581     }
582     else if (strcmp(what, "opartyp") == 0)
583     {
584         /* opartyp - object parameters type array */
585         *nv = (int)(scicos_imp.opptr[nblk] - scicos_imp.opptr[0]);
586         *mv = 1;
587         *v  = (int *) (scicos_imp.opartyp);
588     }
589     else if (strcmp(what, "nblk") == 0)
590     {
591         /* number of block */
592         *nv = 1;
593         *mv = 1;
594         *v  = (int *) (scicos_imp.nblk);
595     }
596     else if (strcmp(what, "outtbptr") == 0)
597     {
598         /* ptr on output register */
599         *nv = nlnk;
600         *mv = 1;
601         *v  = (int *) (scicos_imp.outtbptr);
602     }
603     else if (strcmp(what, "outtbsz") == 0)
604     {
605         /* size of output register */
606         *nv = nlnk;
607         *mv = 2;
608         *v  = (int *) (scicos_imp.outtbsz);
609     }
610     else if (strcmp(what, "outtbtyp") == 0)
611     {
612         /* type of output register  */
613         *nv = nlnk;
614         *mv = 1;
615         *v  = (int *) (scicos_imp.outtbtyp);
616     }
617     else if (strcmp(what, "nlnk") == 0)
618     {
619         /* number of link  */
620         *nv = 1;
621         *mv = 1;
622         *v  = (int *) (scicos_imp.nlnk);
623     }
624     else if (strcmp(what, "subs") == 0) /* Aquoisertsubs?? */
625     {
626         /*   */
627         *nv = nsubs;
628         *mv = 1;
629         *v  = (int *) (scicos_imp.subs);
630     }
631     else if (strcmp(what, "nsubs") == 0)
632     {
633         /*   */
634         *nv = 1;
635         *mv = 1;
636         *v  = (int *) (scicos_imp.nsubs);
637     }
638     else if (strcmp(what, "tevts") == 0)
639     {
640         /*   */
641         *nv = nevts;
642         *mv = 1;
643         *v  = (double *) (scicos_imp.tevts);
644     }
645     else if (strcmp(what, "evtspt") == 0)
646     {
647         /*   */
648         *nv = nevts;
649         *mv = 1;
650         *v  = (int *) (scicos_imp.evtspt);
651     }
652     else if (strcmp(what, "nevts") == 0)
653     {
654         /*   */
655         *nv = 1;
656         *mv = 1;
657         *v  = (int *) (scicos_imp.nevts);
658     }
659     else if (strcmp(what, "pointi") == 0)
660     {
661         /* */
662         *nv = 1;
663         *mv = 1;
664         *v  = (int *) (scicos_imp.pointi);
665     }
666     else if (strcmp(what, "iord") == 0)
667     {
668         /* */
669         *nv = niord;
670         *mv = 2;
671         *v  = (int *) (scicos_imp.iord);
672     }
673     else if (strcmp(what, "niord") == 0)
674     {
675         /* */
676         *nv = 1;
677         *mv = 1;
678         *v  = (int *) (scicos_imp.niord);
679     }
680     else if (strcmp(what, "oord") == 0)
681     {
682         /* */
683         *nv = noord;
684         *mv = 2;
685         *v  = (int *) (scicos_imp.oord);
686     }
687     else if (strcmp(what, "noord") == 0)
688     {
689         /* */
690         *nv = 1;
691         *mv = 1;
692         *v  = (int *) (scicos_imp.noord);
693     }
694     else if (strcmp(what, "zord") == 0)
695     {
696         /* */
697         *nv = nzord;
698         *mv = 2;
699         *v  = (int *) (scicos_imp.zord);
700     }
701     else if (strcmp(what, "nzord") == 0)
702     {
703         /* */
704         *nv = 1;
705         *mv = 1;
706         *v  = (int *) (scicos_imp.nzord);
707     }
708     else if (strcmp(what, "funptr") == 0)
709     {
710         /* */
711         *nv = nblk;
712         *mv = 1;
713         *v  = (int *) (scicos_imp.funptr);
714     }
715     else if (strcmp(what, "funtyp") == 0)
716     {
717         /* */
718         *nv = nblk;
719         *mv = 1;
720         *v  = (int *) (scicos_imp.funtyp);
721     }
722     else if (strcmp(what, "ztyp") == 0)
723     {
724         /* */
725         *nv = nblk;
726         *mv = 1;
727         *v  = (int *) (scicos_imp.ztyp);
728     }
729     else if (strcmp(what, "cord") == 0)
730     {
731         /* */
732         *nv = ncord;
733         *mv = 2;
734         *v  = (int *) (scicos_imp.cord);
735     }
736     else if (strcmp(what, "ncord") == 0)
737     {
738         /* */
739         *nv = 1;
740         *mv = 1;
741         *v  = (int *) (scicos_imp.ncord);
742     }
743     else if (strcmp(what, "ordclk") == 0)
744     {
745         /* */
746         *nv = (int)(scicos_imp.ordptr[nordptr] - 1);
747         *mv = 2;
748         *v  = (int *) (scicos_imp.ordclk);
749     }
750     else if (strcmp(what, "clkptr") == 0)
751     {
752         /* */
753         *nv = (int)(nblk + 1);
754         *mv = 1;
755         *v  = (int *) (scicos_imp.clkptr);
756     }
757     else if (strcmp(what, "ordptr") == 0)
758     {
759         /* */
760         *nv = nordptr;
761         *mv = 1;
762         *v  = (int *) (scicos_imp.ordptr);
763     }
764     else if (strcmp(what, "nordptr") == 0)
765     {
766         /* */
767         *nv = 1;
768         *mv = 1;
769         *v  = (int *) (scicos_imp.nordptr);
770     }
771     else if (strcmp(what, "critev") == 0)
772     {
773         /* */
774         *nv = (int)(scicos_imp.clkptr[nblk] - 1); /* !! a faire verifier !! */
775         *mv = 1;
776         *v  = (int *) (scicos_imp.critev);
777     }
778     else if (strcmp(what, "iwa") == 0)
779     {
780         /* */
781         *nv = nevts; /* !! a faire verifier !! */
782         *mv = 1;
783         *v  = (int *) (scicos_imp.iwa);
784     }
785     else if (strcmp(what, "blocks") == 0)
786     {
787         /* */
788         *nv = 1;
789         *mv = 1;
790         *v  = (scicos_block *) (scicos_imp.blocks);
791     }
792     else if (strcmp(what, "ng") == 0)
793     {
794         /* */
795         *nv = 1;
796         *mv = 1;
797         *v  = (int *) (scicos_imp.ng);
798     }
799     else if (strcmp(what, "g") == 0)
800     {
801         /* g */
802         *nv = ng;
803         *mv = 1;
804         *v  = (double *) (scicos_imp.g);
805     }
806     else if (strcmp(what, "t0") == 0)
807     {
808         /* g */
809         *nv = 1;
810         *mv = 1;
811         *v  = (double *) (scicos_imp.t0);
812     }
813     else if (strcmp(what, "tf") == 0)
814     {
815         /* g */
816         *nv = 1;
817         *mv = 1;
818         *v  = (double *) (scicos_imp.tf);
819     }
820     else if (strcmp(what, "Atol") == 0)
821     {
822         /* g */
823         *nv = 1;
824         *mv = 1;
825         *v  = (double *) (scicos_imp.Atol);
826     }
827     else if (strcmp(what, "rtol") == 0)
828     {
829         /* g */
830         *nv = 1;
831         *mv = 1;
832         *v  = (double *) (scicos_imp.rtol);
833     }
834     else if (strcmp(what, "ttol") == 0)
835     {
836         /* g */
837         *nv = 1;
838         *mv = 1;
839         *v  = (double *) (scicos_imp.ttol);
840     }
841     else if (strcmp(what, "deltat") == 0)
842     {
843         /* g */
844         *nv = 1;
845         *mv = 1;
846         *v  = (double *) (scicos_imp.deltat);
847     }
848     else if (strcmp(what, "hmax") == 0)
849     {
850         /* g */
851         *nv = 1;
852         *mv = 1;
853         *v  = (double *) (scicos_imp.hmax);
854     }
855     else if (strcmp(what, "nelem") == 0)
856     {
857         /* g */
858         *nv = 1;
859         *mv = 1;
860         *v  = (int*) (scicos_imp.nelem);
861     }
862     else if (strcmp(what, "outtb_elem") == 0)
863     {
864         /* */
865         *nv = nelem;
866         *mv = 2;
867         *v  = (outtb_el *) (scicos_imp.outtb_elem);
868     }
869     else /*return FALSE_*/
870     {
871         return 0;
872     }
873
874     /* return TRUE_ */
875     return 1;
876 }
877 /*--------------------------------------------------------------------------*/
878 /* Used in some scicos block */
879 void C2F(getlabel)(int *kfun, char *label, int *n)
880 /*int *n, *kfun;  length of the label as input n gives the max length expected*/
881 {
882     int k;
883     int job = 1;
884
885     k = *kfun;
886     if (*n > (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]))
887     {
888         *n = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
889     }
890     if (*n > 0 )
891     {
892         strcpy(label, scicos_imp.iz[k]);
893     }
894 }
895
896 /*never used, never interfaced */
897 void C2F(getblockbylabel)(int *kfun, char **label, int *n)
898 {
899     int k, i, i0, nblk, n1;
900     int job = 0;
901
902     nblk = scicos_imp.nblk[0];
903
904     *kfun = 0;
905     for (k = 0; k < nblk; k++)
906     {
907         n1 = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
908         if (n1 == *n)
909         {
910             i0 = scicos_imp.izptr[k - 1] - 1;
911             i = 0;
912             while ((label[i] == scicos_imp.iz[i0 + i]) & (i < n1))
913             {
914                 i++;
915             }
916             if (i == n1)
917             {
918                 *kfun = k + 1;
919                 return;
920             }
921         }
922     }
923 }
924 /*--------------------------------------------------------------------------*/
925 /*never used, never interfaced */
926 int C2F(getsciblockbylabel)(int*kfun, int label[], int *n)
927 {
928     int k, i, i0, nblk, n1;
929     int job = 1;
930     char* lab[100];
931     if (scicos_imp.x == (double *)NULL)
932     {
933         return (2); /* undefined import table scicos is not running */
934     }
935     nblk = scicos_imp.nblk[0];
936
937     F2C(cvstr)(n, lab, *label, &job, *n);
938
939     *kfun = 0;
940     for (k = 0; k < nblk; k++)
941     {
942         n1 = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
943         if (n1 == *n)
944         {
945             i0 = scicos_imp.izptr[k - 1] - 1;
946             i = 0;
947             while ((lab[i] == scicos_imp.iz[i0 + i]) & (i < n1))
948             {
949                 i++;
950             }
951             if (i == n1)
952             {
953                 *kfun = k + 1;
954                 return 0;
955             }
956         }
957     }
958     return 0;
959 }
960 /*--------------------------------------------------------------------------*/
961 int getscilabel(int *kfun, char *label, int *n)
962 {
963     int k, i;
964     int *u, *y;
965
966     if (scicos_imp.x == (double *)NULL)
967     {
968         return 2; /* undefined import table scicos is not running */
969     }
970     k = *kfun;
971
972     *n = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
973     if (*n > 0 )
974     {
975         u = (char **) & (scicos_imp.iz[scicos_imp.izptr[k - 1] - 1]);
976         y = &label;
977         for (i = 0; i < *n; i++)
978         {
979             *(y++) = *(u++);
980         }
981     }
982     return 0;
983 }
984 /*--------------------------------------------------------------------------*/
985 int C2F(getcurblock)()
986 {
987     return (C2F(curblk).kfun);
988 }
989 /*--------------------------------------------------------------------------*/
990 /* used in fscope
991  *
992  * 30/06/06, Alan : Rewritte to preserve compatibility with fscope.f.
993  * Only first element of matrix is delivred and converted to double data.
994  *
995  */
996 void C2F(getouttb)(int *nsize, int *nvec, double *outtc)
997 {
998     /* declaration of ptr for typed port */
999     void **outtbptr;            /*to store outtbptr*/
1000     SCSREAL_COP *outtbdptr;     /*to store double of outtb*/
1001     SCSINT8_COP *outtbcptr;     /*to store int8 of outtb*/
1002     SCSINT16_COP *outtbsptr;    /*to store int16 of outtb*/
1003     SCSINT32_COP *outtblptr;    /*to store int32 of outtb*/
1004     SCSUINT8_COP *outtbucptr;   /*to store unsigned int8 of outtb */
1005     SCSUINT16_COP *outtbusptr;  /*to store unsigned int16 of outtb */
1006     SCSUINT32_COP *outtbulptr;  /*to store unsigned int32 of outtb */
1007     int *outtb_nelem;           /*to store maximum number of element*/
1008     int outtbtyp;               /*to store type of data*/
1009     int *outtbsz;               /*to store size of data*/
1010     outtb_el *outtb_elem;       /*to store ptr of outtb_elem structure */
1011
1012     /*auxiliary variable*/
1013     int j, sz, lnk, pos;
1014
1015     /*get outtbptr from import struct.*/
1016     outtbptr = scicos_imp.outtbptr;
1017     /*get outtb_elem from import struct.*/
1018     outtb_elem = scicos_imp.outtb_elem;
1019     /*get outtbsz from import struct.*/
1020     outtbsz = scicos_imp.outtbsz;
1021     /*get max number of elem in outtb*/
1022     outtb_nelem = scicos_imp.nelem;
1023
1024     /*initialization of position in outtc */
1025     j = 0;
1026
1027     while (j < *nsize)
1028     {
1029         /*test to know if we are outside outtb_elem*/
1030         if (nvec[j] > (*outtb_nelem))
1031         {
1032             set_block_error(-1);
1033             return;
1034         }
1035
1036         lnk = outtb_elem[nvec[j] - 1].lnk;
1037         pos = outtb_elem[nvec[j] - 1].pos;
1038         outtbtyp = scicos_imp.outtbtyp[lnk];
1039
1040         /*double data type*/
1041         if (outtbtyp == SCSREAL_N)
1042         {
1043             outtbdptr = (SCSREAL_COP *)outtbptr[lnk];
1044             outtc[j] = (double)outtbdptr[pos];
1045             j++;
1046         }
1047         /*complex data type*/
1048         else if (outtbtyp == SCSCOMPLEX_N)
1049         {
1050             sz = outtbsz[2 * lnk] + outtbsz[(2 * lnk) + 1];
1051             outtbdptr = (SCSCOMPLEX_COP *)outtbptr[lnk];
1052             outtc[j] =  (double)outtbdptr[pos];
1053             /*outtc[j+1] =  (double)outtbdptr[pos+sz];*/
1054             /*j=j+2;*/
1055             j++;
1056         }
1057         /*int data type*/
1058         else
1059         {
1060             switch (outtbtyp)
1061             {
1062                 case SCSINT8_N   :
1063                     outtbcptr = (SCSINT8_COP *)outtbptr[lnk]; /*int8*/
1064                     outtc[j] = (double)outtbcptr[pos];
1065                     j++;
1066                     break;
1067
1068                 case SCSINT16_N  :
1069                     outtbsptr = (SCSINT16_COP *)outtbptr[lnk]; /*int16*/
1070                     outtc[j] = (double)outtbsptr[pos];
1071                     j++;
1072                     break;
1073
1074                 case SCSINT32_N  :
1075                     outtblptr = (SCSINT32_COP *)outtbptr[lnk]; /*int32*/
1076                     outtc[j] = (double)outtblptr[pos];
1077                     j++;
1078                     break;
1079
1080                 case SCSUINT8_N  :
1081                     outtbucptr = (SCSUINT8_COP *)outtbptr[lnk]; /*uint8*/
1082                     outtc[j] = (double)outtbucptr[pos];
1083                     j++;
1084                     break;
1085
1086                 case SCSUINT16_N :
1087                     outtbusptr = (SCSUINT16_COP *)outtbptr[lnk]; /*uint16*/
1088                     outtc[j] = (double)outtbusptr[pos];
1089                     j++;
1090                     break;
1091
1092                 case SCSUINT32_N :
1093                     outtbulptr = (SCSUINT32_COP *)outtbptr[lnk]; /*uint32*/
1094                     outtc[j] = (double)outtbulptr[pos];
1095                     j++;
1096                     break;
1097
1098                 default        :
1099                     outtc[j] = 0;
1100                     j++;
1101                     break;
1102             }
1103         }
1104     }
1105 }
1106 /*--------------------------------------------------------------------------*/