cosmetic, rename functions
[scilab.git] / scilab / modules / mexlib / src / cpp / mexlib.cpp
1 /*
2  *  Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3  *  Copyright (C) 2011-2011 - Gsoc 2011 - Iuri SILVIO
4  *  Copyright (C) 2011-2011 - DIGITEO - Bruno JOFRET
5  *  Copyright (C) 2011 - DIGITEO - Antoine ELIAS
6  *
7  *  This file must be used under the terms of the CeCILL.
8  *  This source file is licensed as described in the file COPYING, which
9  *  you should have received as part of this distribution.  The terms
10  *  are also available at
11  *  http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
12  *
13  */
14
15 /*------------------------------------------------------------------------
16  *    mexlib  library
17  *
18  *    This library emulates Matlab' API functions. It is not fully tested...
19  *    -Assumes that Scilab string matrices have one column, e.g.
20  *    Str=["qwerty";"123456"]; here this is a 2 x 6 matrix but Scilab
21  *    considers Str as a 2 x 1 matrix. ["123";"1234"] is a valid string
22  *    matrix which cannot be used here.
23  *    -Assumes that sparse matrices have been converted into the Matlab
24  *    format. Scilab sparse matrices are stored in the transposed Matlab
25  *    format. If A is a sparse Scilab matrix, it should be converted
26  *    by the command A=mtlb_sparse(A) in the calling sequence of the
27  *    mex function.
28  *    -Structs and Cells are Scilab mlists:
29  *    Struct=mlist(["st","dims","field1",...,"fieldk"],
30  *                 int32([d1,d2,...,dn]),
31  *                 list(obj1,      objN),
32  *                 .....
33  *                 list(obj1,      objN))     k such lists
34  *           N = d1 x d2    x dn
35  *           obj = Scilab variable or pointer to Scilab variable.
36  *     Cell = Struct with one field called "entries" and "st" <- "ce"
37  *    One dimensional structs or cells are as follows:
38  *    Struct=mlist(["st","dims","field1",...,"fieldk"],
39  *                 int32([1,1]),
40  *                 obj1,...,objk)
41  *
42  *    -Nd dimensional arrays are Scilab mlists (for Nd > 2):
43  *     X = mlist(["hm","dims","entries"],
44  *                 int32([d1,d2,...,dn]),
45  *                 values)
46  *     values = vector of doubles or int8-16-32 or char
47  --------------------------------------------------------------------------*/
48 #include <stdarg.h>
49
50 #include <limits>
51
52 #include "scilabWrite.hxx"
53 #include "context.hxx"
54 #include "symbol.hxx"
55 #include "parser.hxx"
56 #include "configvariable.hxx"
57 #include "overload.hxx"
58 #include "execvisitor.hxx"
59
60 #include "types.hxx"
61 #include "int8.hxx"
62 #include "uint8.hxx"
63 #include "int16.hxx"
64 #include "uint16.hxx"
65 #include "int32.hxx"
66 #include "uint32.hxx"
67 #include "int64.hxx"
68 #include "uint64.hxx"
69 #include "double.hxx"
70 #include "bool.hxx"
71 #include "string.hxx"
72 #include "struct.hxx"
73 #include "container.hxx"
74 #include "cell.hxx"
75
76 extern "C"
77 {
78 #include "machine.h"
79 #include "mex.h"
80 #include "freeArrayOfString.h"
81 }
82
83 #ifdef getType
84 #undef getType
85 #endif
86
87 #ifdef isComplex
88 #undef isComplex
89 #endif
90
91 static char *the_current_mex_name;
92 static void (*exitFcn)(void);
93
94 mxClassID mxGetClassID(const mxArray *ptr)
95 {
96     types::InternalType *pIT = (types::InternalType *) ptr;
97     if (pIT == NULL)
98     {
99         return mxUNKNOWN_CLASS;
100     }
101     types::InternalType::RealType type = pIT->getType();
102
103     switch (type)
104     {
105         case types::InternalType::RealInt8:
106             return mxINT8_CLASS;
107         case types::InternalType::RealUInt8:
108             return mxUINT8_CLASS;
109         case types::InternalType::RealInt16:
110             return mxINT16_CLASS;
111         case types::InternalType::RealUInt16:
112             return mxUINT16_CLASS;
113         case types::InternalType::RealInt32:
114             return mxINT32_CLASS;
115         case types::InternalType::RealUInt32:
116             return mxUINT32_CLASS;
117         case types::InternalType::RealInt64:
118             return mxINT64_CLASS;
119         case types::InternalType::RealUInt64:
120             return mxUINT64_CLASS;
121         case types::InternalType::RealString:
122             return mxCHAR_CLASS;
123         case types::InternalType::RealDouble:
124             return mxDOUBLE_CLASS;
125         case types::InternalType::RealBool:
126             return mxLOGICAL_CLASS;
127         case types::InternalType::RealFloat:
128             return mxSINGLE_CLASS;
129         case types::InternalType::RealStruct:
130             return mxSTRUCT_CLASS;
131         case types::InternalType::RealCell:
132             return mxCELL_CLASS;
133         case types::InternalType::RealFunction:
134             return mxFUNCTION_CLASS;
135         default:
136             return mxUNKNOWN_CLASS;
137     }
138 }
139
140 bool mxIsInt8(const mxArray *ptr)
141 {
142     return mxGetClassID(ptr) == mxINT8_CLASS;
143 }
144
145 bool mxIsInt16(const mxArray *ptr)
146 {
147     return mxGetClassID(ptr) == mxINT16_CLASS;
148 }
149
150 bool mxIsInt32(const mxArray *ptr)
151 {
152     return mxGetClassID(ptr) == mxINT32_CLASS;
153 }
154
155 bool mxIsInt64(const mxArray *ptr)
156 {
157     return mxGetClassID(ptr) == mxINT64_CLASS;
158 }
159
160 bool mxIsUint8(const mxArray *ptr)
161 {
162     return mxGetClassID(ptr) == mxUINT8_CLASS;
163 }
164
165 bool mxIsUint16(const mxArray *ptr)
166 {
167     return mxGetClassID(ptr) == mxUINT16_CLASS;
168 }
169
170 bool mxIsUint32(const mxArray *ptr)
171 {
172     return mxGetClassID(ptr) == mxUINT32_CLASS;
173 }
174
175 bool mxIsUint64(const mxArray *ptr)
176 {
177     return mxGetClassID(ptr) == mxUINT64_CLASS;
178 }
179
180 bool mxIsFunction(const mxArray *ptr)
181 {
182     return mxGetClassID(ptr) == mxFUNCTION_CLASS;
183 }
184
185 double mxGetEps(void)
186 {
187     types::InternalType *pITEps = symbol::Context::getInstance()->get(symbol::Symbol(L"%eps"));
188     if (pITEps && pITEps->isDouble())
189     {
190         return pITEps->getAs<types::Double>()->get(0);
191     }
192
193     return -1;
194 }
195
196 double mxGetInf(void)
197 {
198     types::InternalType *pITInf = symbol::Context::getInstance()->get(symbol::Symbol(L"%inf"));
199     if (pITInf && pITInf->isDouble())
200     {
201         return pITInf->getAs<types::Double>()->get(0);
202     }
203
204     return -1;
205 }
206
207 double mxGetNaN(void)
208 {
209     types::InternalType *pITInf = symbol::Context::getInstance()->get(symbol::Symbol(L"%nan"));
210     if (pITInf)
211     {
212         return pITInf->getAs<types::Double>()->get(0);
213     }
214
215     return -1;
216 }
217
218 bool mxIsInf(double x)
219 {
220     if (x == x + 1)
221     {
222         return 1;
223     }
224     else
225     {
226         return 0;
227     }
228 }
229
230 bool mxIsFinite(double x)
231 {
232     if (x < x + 1)
233     {
234         return 1;
235     }
236     else
237     {
238         return 0;
239     }
240 }
241
242 bool mxIsNaN(double x)
243 {
244     if (x != x)
245     {
246         return 1;
247     }
248     else
249     {
250         return 0;
251     }
252 }
253
254 int mxGetNumberOfElements(const mxArray *ptr)
255 {
256     types::InternalType *pIT = (types::InternalType *) ptr;
257     if (pIT == NULL)
258     {
259         return 0;
260     }
261
262     types::GenericType *pGT = dynamic_cast<types::GenericType *>(pIT);
263     if (pGT == NULL)
264     {
265         return 0;
266     }
267
268     return pGT->getSize();
269 }
270
271 double *mxGetPr(const mxArray *ptr)
272 {
273     types::InternalType *pIT = (types::InternalType *) ptr;
274     if (pIT == NULL)
275     {
276         return NULL;
277     }
278
279     types::Double *pD = dynamic_cast<types::Double *>(pIT);
280     if (pD == NULL)
281     {
282         return NULL;
283     }
284
285     return pD->get();
286 }
287
288 double *mxGetPi(const mxArray *ptr)
289 {
290     return ((types::Double *) ptr)->getImg();
291 }
292
293 int mxGetNumberOfDimensions(const mxArray *ptr)
294 {
295     types::InternalType *pIT = (types::InternalType *) ptr;
296     if (pIT == NULL)
297     {
298         return 0;
299     }
300
301     types::GenericType *pGT = pIT->getAs<types::GenericType>();
302     if (pGT == NULL)
303     {
304         //InternalType but not GenericType, so mono dimension type.
305         return 1;
306     }
307
308     return pGT->getDims();
309 }
310
311 int *mxGetDimensions(const mxArray *ptr)
312 {
313     types::InternalType *pIT = (types::InternalType *) ptr;
314     if (pIT == NULL)
315     {
316         return NULL;
317     }
318
319     switch (pIT->getType())
320     {
321         case types::InternalType::RealList:
322         case types::InternalType::RealMList:
323         case types::InternalType::RealTList:
324         {
325             int *piDims = (int *) MALLOC(sizeof(int));
326
327             piDims[0] = pIT->getAs<types::Container>()->getSize();
328             return piDims;
329         }
330         default:
331         {
332             types::GenericType *pGT = pIT->getAs<types::GenericType>();
333             if (pGT == NULL)
334             {
335                 return NULL;
336             }
337             return pGT->getDimsArray();
338         }
339     }
340     return NULL;
341 }
342
343 int mxGetM(const mxArray *ptr)
344 {
345     types::InternalType *pIT = (types::InternalType *) ptr;
346     if (pIT == NULL)
347     {
348         return NULL;
349     }
350
351     types::GenericType *pGT = pIT->getAs<types::GenericType>();
352     if (pGT == NULL)
353     {
354         return NULL;
355     }
356     return pGT->getRows();
357 }
358
359 void mxSetM(mxArray *ptr, int M)
360 {
361     types::InternalType *pIT = (types::InternalType *) ptr;
362     if (pIT == NULL)
363     {
364         return;
365     }
366
367     types::GenericType *pGT = pIT->getAs<types::GenericType>();
368     if (pGT == NULL)
369     {
370         return;
371     }
372
373     pGT->resize(M, pGT->getCols());
374 }
375
376 int *mxGetJc(const mxArray *ptr)
377 {
378     // TODO: sparse
379     return NULL;
380 }
381
382 int *mxGetIr(const mxArray *ptr)
383 {
384     // TODO: sparse
385     return NULL;
386 }
387
388 void mxSetJc(mxArray *array_ptr, int *jc_data)
389 {
390     // TODO: sparse
391 }
392
393 void mxSetIr(mxArray *array_ptr, int *ir_data)
394 {
395     // TODO: sparse
396 }
397
398 void mxSetNzmax(mxArray *array_ptr, int nzmax)
399 {
400     // TODO: sparse
401 }
402
403 int mxGetN(const mxArray *ptr)
404 {
405     types::InternalType * pIT = (types::InternalType *) ptr;
406     if (pIT == NULL)
407     {
408         return NULL;
409     }
410
411     types::GenericType * pGT = pIT->getAs<types::GenericType>();
412     if (pGT == NULL)
413     {
414         return NULL;
415     }
416     return pGT->getCols();
417 }
418
419 void mxSetN(mxArray *ptr, int N)
420 {
421     types::InternalType * pIT = (types::InternalType *) ptr;
422     if (pIT == NULL)
423     {
424         return;
425     }
426
427     types::GenericType * pGT = pIT->getAs<types::GenericType>();
428     if (pGT == NULL)
429     {
430         return;
431     }
432
433     pGT->resize(pGT->getRows(), N);
434 }
435
436 bool mxIsString(const mxArray *ptr)
437 {
438     /* mxIsString is obsolete. */
439     return mxIsChar(ptr);
440 }
441
442 bool mxIsChar(const mxArray *ptr)
443 {
444     return mxGetClassID(ptr) == mxCHAR_CLASS;
445 }
446
447 bool mxIsNumeric(const mxArray *ptr)
448 {
449     return mxIsDouble(ptr) || mxIsSingle(ptr) ||
450            mxIsInt8(ptr) || mxIsUint8(ptr) ||
451            mxIsInt16(ptr) || mxIsUint16(ptr) || mxIsInt32(ptr) || mxIsUint32(ptr) || mxIsInt64(ptr) || mxIsUint64(ptr);
452 }
453
454 bool mxIsDouble(const mxArray *ptr)
455 {
456     return mxGetClassID(ptr) == mxDOUBLE_CLASS;
457 }
458
459 bool mxIsSingle(const mxArray *ptr)
460 {
461     return mxGetClassID(ptr) == mxSINGLE_CLASS;
462 }
463
464 bool mxIsEmpty(const mxArray *ptr)
465 {
466     types::InternalType * pIT = (types::InternalType *) ptr;
467     if (pIT == NULL)
468     {
469         //true or false, whatever ;)
470         return true;
471     }
472
473     switch (pIT->getType())
474     {
475         case types::InternalType::RealDouble:
476         {
477             types::Double *pD = pIT->getAs<types::Double>();
478             return pD->getSize() == 0;
479         }
480         case types::InternalType::RealCell:
481         {
482             types::Cell *pC = pIT->getAs<types::Cell>();
483             return pC->getSize() == 0;
484         }
485         case types::InternalType::RealContainer:
486         case types::InternalType::RealList:
487         case types::InternalType::RealMList:
488         case types::InternalType::RealTList:
489         {
490             types::Container *pC = pIT->getAs<types::Container>();
491             return pC->getSize() == 0;
492         }
493         default:
494         {
495             //other type can not be empty
496             return false;
497         }
498     }
499 }
500
501 bool mxIsFull(const mxArray *ptr)
502 {
503     /* mxIsFull is obsolete. */
504     return !mxIsSparse(ptr);
505 }
506
507 bool mxIsSparse(const mxArray *ptr)
508 {
509     // TODO: sparse
510     return false;
511 }
512
513 bool mxIsLogical(const mxArray *ptr)
514 {
515     return mxGetClassID(ptr) == mxLOGICAL_CLASS;
516 }
517
518 void mxSetLogical(mxArray *ptr)
519 {
520     /* obsolete */
521     if (!mxIsNumeric(ptr))
522     {
523         return;
524     }
525     int *data = (int *) mxGetData(ptr);
526     mxArray *newPtr = (mxArray *) new types::Bool(mxGetNumberOfDimensions(ptr), mxGetDimensions(ptr));
527     mxSetData(newPtr, data);
528     *ptr = *newPtr;
529 }
530
531 void mxClearLogical(mxArray *ptr)
532 {
533     /* obsolete */
534     if (!mxIsLogical(ptr))
535     {
536         return;
537     }
538     int *data = (int *) mxGetData(ptr);
539     mxArray *newPtr = (mxArray *) new types::Int32(mxGetNumberOfDimensions(ptr), mxGetDimensions(ptr));
540     mxSetData(newPtr, data);
541     *ptr = *newPtr;
542 }
543
544 bool mxIsComplex(const mxArray *ptr)
545 {
546     types::InternalType *pIT = (types::InternalType *) ptr;
547     if (pIT == NULL)
548     {
549         return false;
550     }
551
552     types::GenericType *pGT = pIT->getAs<types::GenericType>();
553     if (pGT == NULL)
554     {
555         return false;
556     }
557
558     return pGT->isComplex();
559 }
560
561 double mxGetScalar(const mxArray *ptr)
562 {
563     // TODO: review spec
564     types::InternalType *pIT = (types::InternalType *) ptr;
565     if (pIT == NULL)
566     {
567         return 0;
568     }
569
570     switch (pIT->getType())
571     {
572         case types::InternalType::RealDouble:
573         {
574             types::Double *pD = pIT->getAs<types::Double>();
575             return pD->get(0);
576         }
577         case types::InternalType::RealBool:
578         {
579             types::Bool *pB = pIT->getAs<types::Bool>();
580             return (double) pB->get(0);
581         }
582         case types::InternalType::RealInt8:
583         {
584             types::Int8 *pI = pIT->getAs<types::Int8>();
585             return (double) pI->get(0);
586         }
587         case types::InternalType::RealUInt8:
588         {
589             types::UInt8 *pI = pIT->getAs<types::UInt8>();
590             return (double) pI->get(0);
591         }
592         case types::InternalType::RealInt16:
593         {
594             types::Int16 *pI = pIT->getAs<types::Int16>();
595             return (double) pI->get(0);
596         }
597         case types::InternalType::RealUInt16:
598         {
599             types::UInt16 *pI = pIT->getAs<types::UInt16>();
600             return (double) pI->get(0);
601         }
602         case types::InternalType::RealInt32:
603         {
604             types::Int32 *pI = pIT->getAs<types::Int32>();
605             return (double) pI->get(0);
606         }
607         case types::InternalType::RealUInt32:
608         {
609             types::UInt32 *pI = pIT->getAs<types::UInt32>();
610             return (double) pI->get(0);
611         }
612         case types::InternalType::RealInt64:
613         {
614             types::Int64 *pI = pIT->getAs<types::Int64>();
615             return (double) pI->get(0);
616         }
617         case types::InternalType::RealUInt64:
618         {
619             types::UInt64 *pI = pIT->getAs<types::UInt64>();
620             return (double) pI->get(0);
621         }
622         default:
623             return 0;
624     }
625 }
626
627 void *mxGetData(const mxArray *ptr)
628 {
629     types::InternalType *pIT = (types::InternalType *) ptr;
630     if (pIT == NULL)
631     {
632         return NULL;
633     }
634
635     switch (pIT->getType())
636     {
637         case types::InternalType::RealDouble:
638         {
639             types::Double *pD = pIT->getAs<types::Double>();
640             return pD->get();
641         }
642         case types::InternalType::RealBool:
643         {
644             types::Bool *pB = pIT->getAs<types::Bool>();
645             return pB->get();
646         }
647         case types::InternalType::RealInt8:
648         {
649             types::Int8 *pI = pIT->getAs<types::Int8>();
650             return pI->get();
651         }
652         case types::InternalType::RealUInt8:
653         {
654             types::UInt8 *pI = pIT->getAs<types::UInt8>();
655             return pI->get();
656         }
657         case types::InternalType::RealInt16:
658         {
659             types::Int16 *pI = pIT->getAs<types::Int16>();
660             return pI->get();
661         }
662         case types::InternalType::RealUInt16:
663         {
664             types::UInt16 *pI = pIT->getAs<types::UInt16>();
665             return pI->get();
666         }
667         case types::InternalType::RealInt32:
668         {
669             types::Int32 *pI = pIT->getAs<types::Int32>();
670             return pI->get();
671         }
672         case types::InternalType::RealUInt32:
673         {
674             types::UInt32 *pI = pIT->getAs<types::UInt32>();
675             return pI->get();
676         }
677         case types::InternalType::RealInt64:
678         {
679             types::Int64 *pI = pIT->getAs<types::Int64>();
680             return pI->get();
681         }
682         case types::InternalType::RealUInt64:
683         {
684             types::UInt64 *pI = pIT->getAs<types::UInt64>();
685             return pI->get();
686         }
687         default:
688             return NULL;
689     }
690 }
691
692 void *mxGetImagData(const mxArray *ptr)
693 {
694     types::InternalType *pIT = (types::InternalType *) ptr;
695     if (pIT == NULL)
696     {
697         return NULL;
698     }
699
700     switch (pIT->getType())
701     {
702         case types::InternalType::RealDouble:
703         {
704             types::Double *pD = pIT->getAs<types::Double>();
705             return pD->getImg();
706         }
707         case types::InternalType::RealBool:
708         {
709             types::Bool *pB = pIT->getAs<types::Bool>();
710             return pB->getImg();
711         }
712         case types::InternalType::RealInt8:
713         {
714             types::Int8 *pI = pIT->getAs<types::Int8>();
715             return pI->getImg();
716         }
717         case types::InternalType::RealUInt8:
718         {
719             types::UInt8 *pI = pIT->getAs<types::UInt8>();
720             return pI->getImg();
721         }
722         case types::InternalType::RealInt16:
723         {
724             types::Int16 *pI = pIT->getAs<types::Int16>();
725             return pI->getImg();
726         }
727         case types::InternalType::RealUInt16:
728         {
729             types::UInt16 *pI = pIT->getAs<types::UInt16>();
730             return pI->getImg();
731         }
732         case types::InternalType::RealInt32:
733         {
734             types::Int32 *pI = pIT->getAs<types::Int32>();
735             return pI->getImg();
736         }
737         case types::InternalType::RealUInt32:
738         {
739             types::UInt32 *pI = pIT->getAs<types::UInt32>();
740             return pI->getImg();
741         }
742         case types::InternalType::RealInt64:
743         {
744             types::Int64 *pI = pIT->getAs<types::Int64>();
745             return pI->getImg();
746         }
747         case types::InternalType::RealUInt64:
748         {
749             types::UInt64 *pI = pIT->getAs<types::UInt64>();
750             return pI->getImg();
751         }
752         default:
753             return NULL;
754     }
755 }
756
757 void mexErrMsgTxt(const char *error_msg)
758 {
759     throw new ast::ScilabException(error_msg);
760 }
761
762 mxArray *mxCreateDoubleMatrix(int m, int n, mxComplexity complexFlag)
763 {
764     types::Double *ptr = new types::Double(m, n, complexFlag == mxCOMPLEX);
765     return (mxArray *) ptr;
766 }
767
768 mxArray *mxCreateDoubleScalar(double value)
769 {
770     mxArray *ptr = mxCreateDoubleMatrix(1, 1, mxREAL);
771
772     ((types::Double *) ptr)->set(0, value);
773     return ptr;
774 }
775
776 bool mxIsClass(const mxArray *ptr, const char *name)
777 {
778     if (strcmp(name, "cell") == 0)
779     {
780         return mxIsCell(ptr);
781     }
782     if (strcmp(name, "char") == 0)
783     {
784         return mxIsChar(ptr);
785     }
786     if (strcmp(name, "double") == 0)
787     {
788         return mxIsDouble(ptr);
789     }
790     if (strcmp(name, "function_handle") == 0)
791     {
792         return mxIsFunction(ptr);
793     }
794     if (strcmp(name, "int8") == 0)
795     {
796         return mxIsInt8(ptr);
797     }
798     if (strcmp(name, "int16") == 0)
799     {
800         return mxIsInt16(ptr);
801     }
802     if (strcmp(name, "int32") == 0)
803     {
804         return mxIsInt32(ptr);
805     }
806     if (strcmp(name, "int64") == 0)
807     {
808         return mxIsInt64(ptr);
809     }
810     if (strcmp(name, "logical") == 0)
811     {
812         return mxIsLogical(ptr);
813     }
814     if (strcmp(name, "single") == 0)
815     {
816         return mxIsSingle(ptr);
817     }
818     if (strcmp(name, "struct") == 0)
819     {
820         return mxIsStruct(ptr);
821     }
822     if (strcmp(name, "uint8") == 0)
823     {
824         return mxIsUint8(ptr);
825     }
826     if (strcmp(name, "uint16") == 0)
827     {
828         return mxIsUint16(ptr);
829     }
830     if (strcmp(name, "uint32") == 0)
831     {
832         return mxIsUint32(ptr);
833     }
834     if (strcmp(name, "uint64") == 0)
835     {
836         return mxIsUint64(ptr);
837     }
838     // TODO: how to handle <class_name> and <class_id>?
839     return false;
840 }
841
842 mxArray *mxCreateStructArray(int ndim, const int *dims, int nfields, const char **field_names)
843 {
844     types::Struct *ptr = new types::Struct(ndim, (int *) dims);
845     for (int i = 0; i < nfields; i++)
846     {
847         wchar_t *name = to_wide_string(field_names[i]);
848         ptr->addField(name);
849         FREE(name);
850     }
851     return (mxArray *) ptr;
852 }
853
854 mxArray *mxCreateStructMatrix(int m, int n, int nfields, const char **field_names)
855 {
856     int dims[2] = {m, n};
857     return mxCreateStructArray(2, dims, nfields, field_names);
858 }
859
860 void mxSetFieldByNumber(mxArray *array_ptr, int lindex, int field_number, mxArray *value)
861 {
862     if (mxIsStruct(array_ptr) && lindex < mxGetNumberOfElements(array_ptr))
863     {
864         types::SingleStruct *ptr = ((types::Struct *) array_ptr)->get(lindex);
865         types::String *names = ptr->getFieldNames();
866         ptr->set(names->get(field_number), (types::InternalType *) value);
867     }
868 }
869
870 void mxSetField(mxArray *array_ptr, int lindex, const char *field_name, mxArray *value)
871 {
872     int field_num = mxGetFieldNumber(array_ptr, field_name);
873     if (field_num >= 0)
874     {
875         mxSetFieldByNumber(array_ptr, lindex, field_num, value);
876     }
877 }
878
879 const char *mxGetFieldNameByNumber(const mxArray *array_ptr, int field_number)
880 {
881     if (!mxIsStruct(array_ptr))
882     {
883         return NULL;
884     }
885     if (field_number < 0 || field_number >= mxGetNumberOfFields(array_ptr))
886     {
887         return NULL;
888     }
889     types::String *names = ((types::Struct *) array_ptr)->getFieldNames();
890     wchar_t *name = names->get(field_number);
891     return (const char *) wide_string_to_UTF8(name);
892 }
893
894 int mxAddField(mxArray *ptr, const char *fieldname)
895 {
896     if (!mxIsStruct(ptr))
897     {
898         return -1;
899     }
900     types::Struct *pa = (types::Struct *) ptr;
901     wchar_t *wfieldname = to_wide_string(fieldname);
902     pa->addField(wfieldname);
903     return mxGetFieldNumber(ptr, fieldname);
904 }
905
906 mxChar *mxGetChars(mxArray *array_ptr)
907 {
908     if (!mxIsChar(array_ptr))
909     {
910         return NULL;
911     }
912     wchar_t *chars = ((types::String *) array_ptr)->get(0);
913     return (mxChar *) wide_string_to_UTF8(chars);
914 }
915
916 mxArray *mxCreateNumericArray(int ndim, const int *dims, mxClassID CLASS, mxComplexity complexFlag)
917 {
918     types::GenericType *ptr;
919
920     switch (CLASS)
921     {
922         case mxDOUBLE_CLASS:
923             ptr = new types::Double(ndim, (int *) dims, complexFlag == mxCOMPLEX);
924             break;
925         case mxINT8_CLASS:
926             ptr = new types::Int8(ndim, (int *) dims);
927             break;
928         case mxUINT8_CLASS:
929             ptr = new types::UInt8(ndim, (int *) dims);
930             break;
931         case mxINT16_CLASS:
932             ptr = new types::Int16(ndim, (int *) dims);
933             break;
934         case mxUINT16_CLASS:
935             ptr = new types::UInt16(ndim, (int *) dims);
936             break;
937         case mxINT32_CLASS:
938             ptr = new types::Int32(ndim, (int *) dims);
939             break;
940         case mxUINT32_CLASS:
941             ptr = new types::UInt32(ndim, (int *) dims);
942             break;
943         case mxINT64_CLASS:
944             ptr = new types::Int64(ndim, (int *) dims);
945             break;
946         case mxUINT64_CLASS:
947             ptr = new types::UInt64(ndim, (int *) dims);
948             break;
949         default:
950             ptr = NULL;
951     }
952     return (mxArray *) ptr;
953 }
954
955 mxArray *mxCreateNumericMatrix(int m, int n, mxClassID CLASS, mxComplexity complexFlag)
956 {
957     int dims[2] = {m, n};
958     return mxCreateNumericArray(2, dims, CLASS, complexFlag);
959 }
960
961 mxArray *mxCreateCharArray(int ndim, const int *dims)
962 {
963     if (ndim == 0 || ndim == 1)
964     {
965         ndim = 2;
966     }
967     types::String *ptr = new types::String(ndim, (int *) dims);
968     return (mxArray *) ptr;
969 }
970
971 mxArray *mxCreateCellArray(int ndim, const int *dims)
972 {
973     types::Cell *ptr = new types::Cell(ndim, (int *) dims);
974     return (mxArray *) ptr;
975 }
976
977 mxArray *mxCreateCellMatrix(int m, int n)
978 {
979     int dims[2] = {m, n};
980     return mxCreateCellArray(2, dims);
981 }
982
983 mxArray *mxGetCell(const mxArray *ptr, int lindex)
984 {
985     types::Cell * pa = (types::Cell *) ptr;
986     return (mxArray *) pa->get(lindex);
987 }
988
989 int mxGetFieldNumber(const mxArray *ptr, const char *string)
990 {
991     if (!mxIsStruct(ptr))
992     {
993         return -1;
994     }
995     types::Struct *pa = (types::Struct *) ptr;
996     types::String *names = pa->getFieldNames();
997     wchar_t *field_name = to_wide_string(string);
998
999     for (int i = 0; i < names->getSize(); i++)
1000     {
1001         if (wcscmp(names->get(i), field_name) == 0)
1002         {
1003             FREE(field_name);
1004             return i;
1005         }
1006     }
1007     FREE(field_name);
1008     return -1;
1009 }
1010
1011 mxArray *mxGetField(const mxArray *ptr, int lindex, const char *string)
1012 {
1013     int field_num = mxGetFieldNumber(ptr, string);
1014     if (field_num < 0)
1015     {
1016         return NULL;
1017     }
1018     return mxGetFieldByNumber(ptr, lindex, field_num);
1019 }
1020
1021 mxArray *mxGetFieldByNumber(const mxArray *ptr, int lindex, int field_number)
1022 {
1023     if (!mxIsStruct(ptr))
1024     {
1025         return NULL;
1026     }
1027     if (lindex >= mxGetNumberOfElements(ptr) || lindex < 0)
1028     {
1029         return NULL;
1030     }
1031     if (field_number >= mxGetNumberOfFields(ptr) || field_number < 0)
1032     {
1033         return NULL;
1034     }
1035     types::Struct *pa = (types::Struct *) ptr;
1036     types::String *names = pa->getFieldNames();
1037     types::SingleStruct *s = pa->get(lindex);
1038     return (mxArray *) s->get(names->get(field_number));
1039 }
1040
1041 int mxGetNumberOfFields(const mxArray *ptr)
1042 {
1043     if (!mxIsStruct(ptr))
1044     {
1045         return 0;
1046     }
1047     types::Struct * pa = (types::Struct *) ptr;
1048     return pa->getFieldNames()->getSize();
1049 }
1050
1051 /*----------------------------------------------------
1052 * mxCalloc is supposed to initialize data to 0
1053 * but what does it means since size can be anythink
1054 * we initialize to zero for double and int data types
1055 *----------------------------------------------------*/
1056
1057 void *mxRealloc(void *ptr, size_t nsize)
1058 {
1059     // TODO: manage this memory
1060     return REALLOC(ptr, nsize);
1061 }
1062
1063 void *mxCalloc(size_t n, size_t size)
1064 {
1065     // TODO: manage this memory
1066     return CALLOC(n, size);
1067 }
1068
1069 void *mxMalloc(size_t nsize)
1070 {
1071     // TODO: manage this memory
1072     return MALLOC(nsize);
1073 }
1074
1075 void mexMakeMemoryPersistent(void *ptr)
1076 {
1077     // FIXME
1078 }
1079
1080
1081 void *mxCalloc_m(unsigned int n, unsigned int size)
1082 {
1083     // FIXME
1084     return NULL;
1085 }
1086
1087 void *mxMalloc_m(unsigned int n)
1088 {
1089     // FIXME
1090     return NULL;
1091 }
1092
1093 /* free : explicit free of a mxCalloc_m allocated space
1094 *        except if space is protected
1095 */
1096
1097 void mxFree_m(void *ptr)
1098 {
1099     // FIXME
1100 }
1101
1102 /* free : explicit free of all mxCalloc_m allocated space
1103 *        except if space is protected
1104 */
1105
1106 static void mxFree_m_all()
1107 {
1108     // FIXME
1109 }
1110
1111 bool mxIsCell(const mxArray *ptr)
1112 {
1113     return mxGetClassID(ptr) == mxCELL_CLASS;
1114 }
1115
1116 bool mxIsStruct(const mxArray *ptr)
1117 {
1118     return mxGetClassID(ptr) == mxSTRUCT_CLASS;
1119 }
1120
1121 int mxGetString(const mxArray *ptr, char *str, int strl)
1122 {
1123     if (!mxIsChar(ptr))
1124     {
1125         return 1;
1126     }
1127     types::String *pa = (types::String *) ptr;
1128     int items = mxGetM(ptr);
1129     int index = 0;
1130     int free_space = strl - 1;
1131     for (int k = 0; k < items; k++)
1132     {
1133         wchar_t *to_copy = pa->get(k);
1134         char *dest = wide_string_to_UTF8(to_copy);
1135         int length = (int)strlen(dest);
1136         memcpy(str + index, dest, free_space);
1137         index += Min(length, free_space);
1138         free_space -= length;
1139         FREE(dest);
1140         if (free_space <= 0)
1141         {
1142             break;
1143         }
1144     }
1145     str[index] = '\0';
1146     return free_space >= 0 ? 0 : 1;
1147 }
1148
1149 char *mxArrayToString(const mxArray *ptr)
1150 {
1151     if (!mxIsChar(ptr))
1152     {
1153         return (char *) 0;
1154     }
1155     types::String *pa = (types::String *) ptr;
1156     int items = mxGetM(ptr);
1157     int index = 0;
1158     int length = 1; // one extra char to \0
1159     wchar_t **wstrings = pa->get();
1160     for (int k = 0; k < items; k++)
1161     {
1162         length += (int)wcslen(wstrings[k]);
1163     }
1164     char *str = (char *) malloc(sizeof(char *) * length);
1165     for (int k = 0; k < items; k++)
1166     {
1167         char *dest = wide_string_to_UTF8(wstrings[k]);
1168         int dest_length = strlen(dest);
1169         memcpy(str + index, dest, dest_length);
1170         index += dest_length;
1171     }
1172     str[index] = '\0';
1173     return str;
1174 }
1175
1176 void mxFreeMatrix(mxArray *ptr)
1177 {
1178     mxDestroyArray(ptr);
1179 }
1180
1181 bool mexIsGlobal(const mxArray *ptr)
1182 {
1183     symbol::Context *context = symbol::Context::getInstance();
1184     int size = symbol::Symbol::map_size();
1185     wchar_t **keys = symbol::Symbol::get_all();
1186
1187     for (int i = 0; i < size; i++)
1188     {
1189         symbol::Symbol *s = new symbol::Symbol(keys[i]);
1190         const mxArray *value = (const mxArray *) context->get(*s);
1191         if (value == ptr)
1192         {
1193             return context->isGlobalVisible(*s);
1194         }
1195     }
1196     return false;
1197 }
1198
1199 mxArray *mxDuplicateArray(const mxArray *ptr)
1200 {
1201     types::InternalType *pIT = (types::InternalType *) ptr;
1202     if (pIT == NULL)
1203     {
1204         return 0;
1205     }
1206
1207     return (mxArray *) pIT->clone();
1208 }
1209
1210 void mxDestroyArray(mxArray *ptr)
1211 {
1212     if (mxIsDouble(ptr))
1213     {
1214         delete (types::Double *) ptr;
1215     }
1216     else if (mxIsChar(ptr))
1217     {
1218         delete (types::String *) ptr;
1219     }
1220     else if (mxIsLogical(ptr))
1221     {
1222         delete (types::Bool *) ptr;
1223     }
1224     else if (mxIsSparse(ptr))
1225     {
1226         // TODO: sparse
1227     }
1228     else if (mxIsInt8(ptr))
1229     {
1230         delete (types::Int8 *) ptr;
1231     }
1232     else if (mxIsInt16(ptr))
1233     {
1234         delete (types::Int16 *) ptr;
1235     }
1236     else if (mxIsInt32(ptr))
1237     {
1238         delete(types::Int32 *) ptr;
1239     }
1240     else if (mxIsInt64(ptr))
1241     {
1242         delete((types::Int64 *) ptr);
1243     }
1244     else if (mxIsUint8(ptr))
1245     {
1246         delete((types::UInt8 *) ptr);
1247     }
1248     else if (mxIsUint16(ptr))
1249     {
1250         delete((types::UInt16 *) ptr);
1251     }
1252     else if (mxIsUint32(ptr))
1253     {
1254         delete((types::UInt32 *) ptr);
1255     }
1256     else if (mxIsUint64(ptr))
1257     {
1258         delete((types::UInt64 *) ptr);
1259     }
1260     else if (mxIsCell(ptr))
1261     {
1262         delete((types::Cell *) ptr);
1263     }
1264     else if (mxIsStruct(ptr))
1265     {
1266         delete((types::Struct *) ptr);
1267     }
1268 }
1269
1270 void mxFree(void *ptr)
1271 {
1272     // TODO: manage this memory
1273     FREE(ptr);
1274 }
1275
1276 int mexAtExit(void (*func)(void))
1277 {
1278     exitFcn = func;
1279     return 0;
1280 }
1281
1282 mxArray *mxCreateSparse(int m, int n, int nzmax, mxComplexity cmplx)
1283 {
1284     // TODO: sparse
1285     return NULL;
1286 }
1287
1288 mxArray *mxCreateString(const char *string)
1289 {
1290     types::String *ptr = new types::String(string);
1291     return (mxArray *) ptr;
1292 }
1293
1294
1295 mxArray *mxCreateLogicalArray(int ndim, const int *dims)
1296 {
1297     types::Bool *ptr = new types::Bool(ndim, (int *) dims);
1298     return (mxArray *) ptr;
1299 }
1300
1301 mxArray *mxCreateLogicalMatrix(int m, int n)
1302 {
1303     types::Bool *ptr = new types::Bool(m, n);
1304     return (mxArray *) ptr;
1305 }
1306
1307 mxArray *mxCreateLogicalScalar(mxLogical value)
1308 {
1309     mxArray *ptr = mxCreateLogicalMatrix(1, 1);
1310
1311     ((types::Bool *) ptr)->set(0, value);
1312     return ptr;
1313 }
1314
1315 bool mxIsLogicalScalarTrue(const mxArray *ptr)
1316 {
1317     if (mxIsLogicalScalar(ptr) == false)
1318     {
1319         return false;
1320     }
1321
1322     if (*mxGetLogicals(ptr) == 0)
1323     {
1324         return false;
1325     }
1326
1327     return true;
1328 }
1329
1330 bool mxIsLogicalScalar(const mxArray *ptr)
1331 {
1332     return mxIsLogical(ptr) && mxGetNumberOfElements(ptr) == 1;
1333 }
1334
1335 int mexPrintf(const char *format, ...)
1336 {
1337     // TODO: define this size limit
1338     char string[1024];
1339     va_list arg_ptr;
1340     va_start(arg_ptr, format);
1341     vsnprintf(string, 1024, format, arg_ptr);
1342     va_end(arg_ptr);
1343     scilabWrite(string);
1344     return 0;
1345 }
1346
1347 void mexWarnMsgTxt(const char *error_msg)
1348 {
1349     scilabError(_("Warning: "));
1350     scilabError(error_msg);
1351     scilabError("\n\n");
1352 }
1353
1354 int mexCallSCILAB(int nlhs, mxArray **plhs, int nrhs, mxArray **prhs, const char *name)
1355 {
1356     wchar_t* pwst = to_wide_string(name);
1357     symbol::Context *context = symbol::Context::getInstance();
1358     symbol::Symbol *symbol = new symbol::Symbol(pwst);
1359     FREE(pwst);
1360
1361     types::InternalType *value = context->get(*symbol);
1362     types::Function *func = value->getAs<types::Function>();
1363     if (func == NULL)
1364     {
1365         return 1;
1366     }
1367
1368     types::typed_list in;
1369     types::typed_list out;
1370     types::optional_list opt;
1371     for (int i = 0; i < nrhs; i++)
1372     {
1373         in.push_back((types::InternalType*)prhs[i]);
1374     }
1375
1376     func->call(in, opt, nlhs, out, NULL);
1377
1378     for (int i = 0; i < nlhs; i++)
1379     {
1380         plhs[i] = (mxArray *) (out[i]);
1381     }
1382
1383     return 0;
1384 }
1385
1386 int mexCallMATLAB(int nlhs, mxArray **plhs, int nrhs, mxArray **prhs, const char *name)
1387 {
1388     return mexCallSCILAB(nlhs, plhs, nrhs, prhs, name);
1389 }
1390
1391 int mxCalcSingleSubscript(const mxArray *ptr, int nsubs, const int *subs)
1392 {
1393     int index = 0;
1394     int iMult = 1;
1395     int *dims = mxGetDimensions(ptr);
1396     for (int i = 0; i < nsubs; i++)
1397     {
1398         index += subs[i] * iMult;
1399         iMult *= dims[i];
1400     }
1401     return index;
1402 }
1403
1404 int C2F(mexcallscilab) (int *nlhs, mxArray **plhs, int *nrhs, mxArray **prhs, char *name, int namelen)
1405 {
1406     return mexCallSCILAB(*nlhs, plhs, *nrhs, prhs, name);
1407 }
1408
1409 /** generic mex interface **/
1410 const char *mexFunctionName(void)
1411 {
1412     return the_current_mex_name;
1413 }
1414
1415 int mxGetElementSize(const mxArray *ptr)
1416 {
1417     if (mxIsChar(ptr))
1418     {
1419         return sizeof(wchar_t *);
1420     }
1421     else if (mxIsLogical(ptr))
1422     {
1423         return sizeof(int);
1424     }
1425     else if (mxIsDouble(ptr))
1426     {
1427         return sizeof(double);
1428     }
1429     else if (mxIsSparse(ptr))
1430     {
1431         // TODO: sparse
1432     }
1433     else if (mxIsInt8(ptr))
1434     {
1435         return sizeof(char);
1436     }
1437     else if (mxIsInt16(ptr))
1438     {
1439         return sizeof(short);
1440     }
1441     else if (mxIsInt32(ptr))
1442     {
1443         return sizeof(int);
1444     }
1445     else if (mxIsInt64(ptr))
1446     {
1447         return sizeof(long long);
1448     }
1449     else if (mxIsUint8(ptr))
1450     {
1451         return sizeof(unsigned char);
1452     }
1453     else if (mxIsUint16(ptr))
1454     {
1455         return sizeof(unsigned short);
1456     }
1457     else if (mxIsUint32(ptr))
1458     {
1459         return sizeof(unsigned int);
1460     }
1461     else if (mxIsUint64(ptr))
1462     {
1463         return sizeof(unsigned long long);
1464     }
1465     else if (mxIsCell(ptr))
1466     {
1467         return sizeof(types::InternalType *);
1468     }
1469     else if (mxIsStruct(ptr))
1470     {
1471         return sizeof(types::SingleStruct *);
1472     }
1473     return 0;
1474 }
1475
1476 mxArray *mxCreateCharMatrixFromStrings(int m, const char **str)
1477 {
1478     int n = 1;
1479     wchar_t** strings = NULL;
1480     strings = (wchar_t**)MALLOC(sizeof(wchar_t*) * m);
1481     for (int k = 0; k < m; k++)
1482     {
1483         strings[k] = to_wide_string(str[k]);
1484     }
1485     types::String *ptr = new types::String(m, n, strings);
1486     freeArrayOfWideString(strings, m);
1487     return (mxArray *) ptr;
1488 }
1489
1490 int mexEvalString(const char *name)
1491 {
1492     // TODO: It is almost copied from sci_execstr.cpp. Refactor needed!
1493     int iErr = 0;
1494     bool bErrCatch = false;
1495     bool bMute = true;
1496     Parser parser;
1497     parser.parse(to_wide_string(name));
1498     if (parser.getExitStatus() !=  Parser::Succeded)
1499     {
1500         //mexPrintf(wide_string_to_UTF8(parser.getErrorMessage()));
1501         return 1;
1502     }
1503
1504     Exp *pExp = parser.getTree();
1505
1506     if (pExp == NULL)
1507     {
1508         //mexPrintf("pExp is NULL");
1509         return 1;
1510     }
1511
1512     //save current prompt mode
1513     int oldVal = ConfigVariable::getPromptMode();
1514     if (bMute)
1515     {
1516         ConfigVariable::setPromptMode(-1);
1517     }
1518     std::list<Exp *>::iterator j;
1519     std::list<Exp *>LExp = ((SeqExp*)pExp)->exps_get();
1520
1521     for (j = LExp.begin() ; j != LExp.end() ; j++)
1522     {
1523         try
1524         {
1525             //excecute script
1526             ExecVisitor execMe;
1527             (*j)->accept(execMe);
1528
1529             //to manage call without ()
1530             if (execMe.result_get() != NULL && execMe.result_get()->getAs<Callable>())
1531             {
1532                 Callable *pCall = execMe.result_get()->getAs<Callable>();
1533                 types::typed_list out;
1534                 types::typed_list in;
1535                 types::optional_list opt;
1536                 try
1537                 {
1538                     ExecVisitor execCall;
1539                     Function::ReturnValue Ret = pCall->call(in, opt, 1, out, &execCall);
1540                     if (Ret == Callable::OK)
1541                     {
1542                         if (out.size() == 0)
1543                         {
1544                             execMe.result_set(NULL);
1545                         }
1546                         else if (out.size() == 1)
1547                         {
1548                             out[0]->DecreaseRef();
1549                             execMe.result_set(out[0]);
1550                         }
1551                         else
1552                         {
1553                             for (int i = 0 ; i < static_cast<int>(out.size()) ; i++)
1554                             {
1555                                 out[i]->DecreaseRef();
1556                                 execMe.result_set(i, out[i]);
1557                             }
1558                         }
1559                     }
1560                     else if (Ret == Callable::Error)
1561                     {
1562                         if (ConfigVariable::getLastErrorFunction() == L"")
1563                         {
1564                             ConfigVariable::setLastErrorFunction(pCall->getName());
1565                         }
1566
1567                         if (pCall->isMacro() || pCall->isMacroFile())
1568                         {
1569                             wchar_t szError[bsiz];
1570                             os_swprintf(szError, bsiz, _W("at line % 5d of function %ls called by :\n"), (*j)->location_get().first_line, pCall->getName().c_str());
1571                             throw ScilabMessage(szError);
1572                         }
1573                         else
1574                         {
1575                             throw ScilabMessage();
1576                         }
1577                     }
1578                 }
1579                 catch (ScilabMessage sm)
1580                 {
1581                     wostringstream os;
1582                     PrintVisitor printMe(os);
1583                     (*j)->accept(printMe);
1584                     os << std::endl << std::endl;
1585                     if (ConfigVariable::getLastErrorFunction() == L"")
1586                     {
1587                         ConfigVariable::setLastErrorFunction(pCall->getName());
1588                     }
1589
1590                     if (pCall->isMacro() || pCall->isMacroFile())
1591                     {
1592                         wstring szAllError;
1593                         wchar_t szError[bsiz];
1594                         os_swprintf(szError, bsiz, _W("at line % 5d of function %ls called by :\n"), sm.GetErrorLocation().first_line, pCall->getName().c_str());
1595                         szAllError = szError + os.str();
1596                         os_swprintf(szError, bsiz, _W("in  execstr instruction    called by :\n"));
1597                         szAllError += szError;
1598                         throw ScilabMessage(szAllError);
1599                     }
1600                     else
1601                     {
1602                         sm.SetErrorMessage(sm.GetErrorMessage() + os.str());
1603                         throw sm;
1604                     }
1605                 }
1606             }
1607
1608             //update ans variable.
1609             if (execMe.result_get() != NULL && execMe.result_get()->isDeletable())
1610             {
1611                 symbol::Context::getInstance()->put(symbol::Symbol(L"ans"), *execMe.result_get());
1612                 if ((*j)->is_verbose() && bErrCatch == false)
1613                 {
1614                     std::wostringstream ostr;
1615                     ostr << L"ans = " << std::endl;
1616                     ostr << std::endl;
1617                     execMe.result_get()->toString(ostr);
1618                     ostr << std::endl;
1619                     scilabWriteW(ostr.str().c_str());
1620                 }
1621             }
1622         }
1623         catch (ScilabMessage sm)
1624         {
1625             if (bErrCatch  == false && bMute == false)
1626             {
1627                 scilabErrorW(sm.GetErrorMessage().c_str());
1628
1629                 CallExp* pCall = dynamic_cast<CallExp*>(*j);
1630                 if (pCall != NULL)
1631                 {
1632                     //to print call expression only of it is a macro
1633                     ExecVisitor execFunc;
1634                     pCall->name_get().accept(execFunc);
1635
1636                     if (execFunc.result_get() != NULL &&
1637                             (execFunc.result_get()->isMacro() || execFunc.result_get()->isMacroFile()))
1638                     {
1639                         wostringstream os;
1640
1641                         //add function failed
1642                         PrintVisitor printMe(os);
1643                         pCall->accept(printMe);
1644                         os << std::endl;
1645
1646                         //add info on file failed
1647                         wchar_t szError[bsiz];
1648                         os_swprintf(szError, bsiz, _W("at line % 5d of exec file called by :\n"), (*j)->location_get().first_line);
1649                         os << szError;
1650
1651                         if (ConfigVariable::getLastErrorFunction() == L"")
1652                         {
1653                             ConfigVariable::setLastErrorFunction(execFunc.result_get()->getAs<Callable>()->getName());
1654                         }
1655
1656                         //restore previous prompt mode
1657                         ConfigVariable::setPromptMode(oldVal);
1658                         throw ScilabMessage(os.str(), 0, (*j)->location_get());
1659                     }
1660                 }
1661                 throw ScilabMessage((*j)->location_get());
1662             }
1663             else
1664             {
1665                 iErr = ConfigVariable::getLastErrorNumber();
1666                 break;
1667             }
1668         }
1669         catch (ScilabError se)
1670         {
1671             if (ConfigVariable::getLastErrorMessage() == L"")
1672             {
1673                 ConfigVariable::setLastErrorMessage(se.GetErrorMessage());
1674                 ConfigVariable::setLastErrorNumber(se.GetErrorNumber());
1675                 ConfigVariable::setLastErrorLine(se.GetErrorLocation().first_line);
1676                 ConfigVariable::setLastErrorFunction(wstring(L""));
1677             }
1678
1679             //store message
1680             iErr = ConfigVariable::getLastErrorNumber();
1681             if (bErrCatch == false)
1682             {
1683                 //in case of error, change mode to 2 ( prompt )
1684                 ConfigVariable::setPromptMode(2);
1685                 //write error
1686                 scilabErrorW(ConfigVariable::getLastErrorMessage().c_str());
1687                 scilabErrorW(L"\n");
1688
1689                 //write positino
1690                 wchar_t szError[bsiz];
1691                 os_swprintf(szError, bsiz, _W("at line % 5d of exec file called by :\n"), (*j)->location_get().first_line);
1692                 //restore previous prompt mode
1693                 ConfigVariable::setPromptMode(oldVal);
1694                 throw ScilabMessage(szError, 1, (*j)->location_get());
1695             }
1696             break;
1697         }
1698     }
1699
1700     //restore previous prompt mode
1701     ConfigVariable::setPromptMode(oldVal);
1702
1703     delete parser.getTree();
1704     return 0;
1705 }
1706
1707 mxArray *mexGetArray(char *name, char *workspace)
1708 {
1709     return mexGetVariable(workspace, name);
1710 }
1711
1712 const mxArray *mexGetVariablePtr(const char *workspace, const char *var_name)
1713 {
1714     const mxArray *value = mexGetVariable(workspace, var_name);
1715     return value;
1716 }
1717
1718 mxArray *mexGetVariable(const char *workspace, const char *name)
1719 {
1720     symbol::Context *context = symbol::Context::getInstance();
1721     wchar_t *key = to_wide_string(name);
1722     types::InternalType *value = NULL;
1723     if (strcmp(workspace, "base") == 0)
1724     {
1725         value = context->get(*(new symbol::Symbol(key)));
1726     }
1727     else if (strcmp(workspace, "caller") == 0)
1728     {
1729         value = context->getCurrentLevel(*(new symbol::Symbol(key)));
1730     }
1731     else if (strcmp(workspace, "global") == 0)
1732     {
1733         value = context->getGlobalValue(*(new symbol::Symbol(key)));
1734     }
1735     FREE(key);
1736     return (mxArray *) value;
1737 }
1738
1739 int mexPutVariable(const char *workspace, const char *varname, const mxArray *pm)
1740 {
1741     symbol::Context *context = symbol::Context::getInstance();
1742     wchar_t *dest = to_wide_string(varname);
1743     if (strcmp(workspace, "base") == 0)
1744     {
1745         context->putInPreviousScope(*(new symbol::Symbol(dest)), *(types::InternalType *) pm);
1746     }
1747     else if (strcmp(workspace, "caller") == 0)
1748     {
1749         context->put(*(new symbol::Symbol(dest)), *(types::InternalType *) pm);
1750     }
1751     else if (strcmp(workspace, "global") == 0)
1752     {
1753         context->setGlobalValue(*(new symbol::Symbol(dest)), *(types::InternalType *) pm);
1754     }
1755     else
1756     {
1757         return 1;
1758     }
1759     return 0;
1760 }
1761
1762 int mexPutFull(char *name, int m, int n, double *pr, double *pi)
1763 {
1764     /* obsolete */
1765     mxArray *array_ptr = mxCreateDoubleMatrix(m, n, pi == NULL ? mxREAL : mxCOMPLEX);
1766     mxSetPr(array_ptr, pr);
1767     mxSetPi(array_ptr, pi);
1768     mexPutVariable("caller", name, array_ptr);
1769     return 0;
1770 }
1771
1772 void mxSetName(mxArray *array_ptr, const char *name)
1773 {
1774     /* obsolete */
1775     mexErrMsgTxt(_("Routine mxSetName not implemented !\n"));
1776     exit(1);
1777 }
1778
1779 void mxSetData(mxArray *array_ptr, void *data_ptr)
1780 {
1781     if (mxIsChar(array_ptr))
1782     {
1783         ((types::String *) array_ptr)->set((wchar_t **) data_ptr);
1784     }
1785     else if (mxIsDouble(array_ptr))
1786     {
1787         ((types::Double *) array_ptr)->set((double *) data_ptr);
1788     }
1789     else if (mxIsInt8(array_ptr))
1790     {
1791         ((types::Int8 *) array_ptr)->set((char *) data_ptr);
1792     }
1793     else if (mxIsInt16(array_ptr))
1794     {
1795         ((types::Int16 *) array_ptr)->set((short *) data_ptr);
1796     }
1797     else if (mxIsInt32(array_ptr))
1798     {
1799         ((types::Int32 *) array_ptr)->set((int *) data_ptr);
1800     }
1801     else if (mxIsInt64(array_ptr))
1802     {
1803         ((types::Int64 *) array_ptr)->set((long long *) data_ptr);
1804     }
1805     else if (mxIsLogical(array_ptr))
1806     {
1807         ((types::Bool *) array_ptr)->set((int *) data_ptr);
1808     }
1809     // else if (mxIsSingle(array_ptr)) {
1810     //   ((types::Float *) array_ptr)->set((float *) data_ptr);
1811     // }
1812     else if (mxIsUint8(array_ptr))
1813     {
1814         ((types::UInt8 *) array_ptr)->set((unsigned char *) data_ptr);
1815     }
1816     else if (mxIsUint16(array_ptr))
1817     {
1818         ((types::UInt16 *) array_ptr)->set((unsigned short *) data_ptr);
1819     }
1820     else if (mxIsUint32(array_ptr))
1821     {
1822         ((types::UInt32 *) array_ptr)->set((unsigned int *) data_ptr);
1823     }
1824     else if (mxIsUint64(array_ptr))
1825     {
1826         ((types::UInt64 *) array_ptr)->set((unsigned long long *) data_ptr);
1827     }
1828 }
1829
1830 void mxSetImagData(mxArray *array_ptr, void *data_ptr)
1831 {
1832     if (mxIsChar(array_ptr))
1833     {
1834         ((types::String *) array_ptr)->setImg((wchar_t **) data_ptr);
1835     }
1836     else if (mxIsDouble(array_ptr))
1837     {
1838         ((types::Double *) array_ptr)->setImg((double *) data_ptr);
1839     }
1840     else if (mxIsInt8(array_ptr))
1841     {
1842         ((types::Int8 *) array_ptr)->setImg((char *) data_ptr);
1843     }
1844     else if (mxIsInt16(array_ptr))
1845     {
1846         ((types::Int16 *) array_ptr)->setImg((short *) data_ptr);
1847     }
1848     else if (mxIsInt32(array_ptr))
1849     {
1850         ((types::Int32 *) array_ptr)->setImg((int *) data_ptr);
1851     }
1852     else if (mxIsInt64(array_ptr))
1853     {
1854         ((types::Int64 *) array_ptr)->setImg((long long *) data_ptr);
1855     }
1856     else if (mxIsLogical(array_ptr))
1857     {
1858         ((types::Bool *) array_ptr)->setImg((int *) data_ptr);
1859     }
1860     // else if (mxIsSingle(array_ptr)) {
1861     //   ((types::Float *) array_ptr)->setImg((float *) data_ptr);
1862     // }
1863     else if (mxIsUint8(array_ptr))
1864     {
1865         ((types::UInt8 *) array_ptr)->setImg((unsigned char *) data_ptr);
1866     }
1867     else if (mxIsUint16(array_ptr))
1868     {
1869         ((types::UInt16 *) array_ptr)->setImg((unsigned short *) data_ptr);
1870     }
1871     else if (mxIsUint32(array_ptr))
1872     {
1873         ((types::UInt32 *) array_ptr)->setImg((unsigned int *) data_ptr);
1874     }
1875     else if (mxIsUint64(array_ptr))
1876     {
1877         ((types::UInt64 *) array_ptr)->setImg((unsigned long long *) data_ptr);
1878     }
1879 }
1880
1881 void mxSetPr(mxArray *ptr, double *pr)
1882 {
1883     ((types::Double *) ptr)->set(pr);
1884 }
1885
1886 void mxSetPi(mxArray *ptr, double *pi)
1887 {
1888     ((types::Double *) ptr)->setImg(pi);
1889 }
1890
1891 const char *mxGetName(const mxArray *array_ptr)
1892 {
1893     /* obsolete */
1894     mexPrintf(_("Routine mxGetName not implemented.\n"));
1895     exit(1);
1896     return 0;
1897 }
1898
1899 int mxSetDimensions(mxArray *array_ptr, const int *dims, int ndim)
1900 {
1901     if (mxIsCell(array_ptr))
1902     {
1903         ((types::Cell *) array_ptr)->resize((int *) dims, ndim);
1904     }
1905     else if (mxIsChar(array_ptr))
1906     {
1907         ((types::String *) array_ptr)->resize((int *) dims, ndim);
1908     }
1909     else if (mxIsDouble(array_ptr))
1910     {
1911         ((types::Double *) array_ptr)->resize((int *) dims, ndim);
1912     }
1913     else if (mxIsFunction(array_ptr))
1914     {
1915         //((types::Function *) array_ptr)->resize((int *) dims, ndim);
1916     }
1917     // else if (mxIsSparse(array_ptr)) {
1918     //     TODO: we don't have Sparse classes yet
1919     // }
1920     else if (mxIsInt8(array_ptr))
1921     {
1922         ((types::Int8 *) array_ptr)->resize((int *) dims, ndim);
1923     }
1924     else if (mxIsInt16(array_ptr))
1925     {
1926         ((types::Int16 *) array_ptr)->resize((int *) dims, ndim);
1927     }
1928     else if (mxIsInt32(array_ptr))
1929     {
1930         ((types::Int32 *) array_ptr)->resize((int *) dims, ndim);
1931     }
1932     else if (mxIsInt64(array_ptr))
1933     {
1934         ((types::Int64 *) array_ptr)->resize((int *) dims, ndim);
1935     }
1936     else if (mxIsLogical(array_ptr))
1937     {
1938         ((types::Bool *) array_ptr)->resize((int *) dims, ndim);
1939     }
1940     // else if (mxIsSingle(array_ptr)) {
1941     //     ((types::Float *) array_ptr)->resize((int *) dims, ndim);
1942     // }
1943     else if (mxIsStruct(array_ptr))
1944     {
1945         ((types::Struct *) array_ptr)->resize((int *) dims, ndim);
1946     }
1947     else if (mxIsUint8(array_ptr))
1948     {
1949         ((types::UInt8 *) array_ptr)->resize((int *) dims, ndim);
1950     }
1951     else if (mxIsUint16(array_ptr))
1952     {
1953         ((types::UInt16 *) array_ptr)->resize((int *) dims, ndim);
1954     }
1955     else if (mxIsUint32(array_ptr))
1956     {
1957         ((types::UInt32 *) array_ptr)->resize((int *) dims, ndim);
1958     }
1959     else if (mxIsUint64(array_ptr))
1960     {
1961         ((types::UInt64 *) array_ptr)->resize((int *) dims, ndim);
1962     }
1963
1964     return 0;
1965 }
1966
1967 const char *mxGetClassName(const mxArray *ptr)
1968 {
1969     if (mxIsDouble(ptr))
1970     {
1971         return "double";
1972     }
1973     if (mxIsChar(ptr))
1974     {
1975         return "char";
1976     }
1977     if (mxIsSparse(ptr))
1978     {
1979         return "sparse";
1980     }
1981     if (mxIsInt8(ptr))
1982     {
1983         return "int8";
1984     }
1985     if (mxIsInt16(ptr))
1986     {
1987         return "int16";
1988     }
1989     if (mxIsInt32(ptr))
1990     {
1991         return "int32";
1992     }
1993     if (mxIsInt64(ptr))
1994     {
1995         return "int64";
1996     }
1997     if (mxIsUint8(ptr))
1998     {
1999         return "uint8";
2000     }
2001     if (mxIsUint16(ptr))
2002     {
2003         return "uint16";
2004     }
2005     if (mxIsUint32(ptr))
2006     {
2007         return "uint32";
2008     }
2009     if (mxIsUint64(ptr))
2010     {
2011         return "uint64";
2012     }
2013     if (mxIsCell(ptr))
2014     {
2015         return "cell";
2016     }
2017     if (mxIsStruct(ptr))
2018     {
2019         return "struct";
2020     }
2021     if (mxIsFunction(ptr))
2022     {
2023         return "function_handle";
2024     }
2025     return "unknown";
2026 }
2027
2028 void mxSetCell(mxArray *array_ptr, int lindex, mxArray *value)
2029 {
2030     ((types::Cell *) array_ptr)->set(lindex, (types::InternalType *) value);
2031 }
2032
2033 int mxGetNzmax(const mxArray *ptr)
2034 {
2035     // TODO: sparse
2036     return 0;
2037 }
2038
2039 mxLogical *mxGetLogicals(const mxArray *ptr)
2040 {
2041     types::InternalType *pIT = (types::InternalType *) ptr;
2042     if (pIT == NULL)
2043     {
2044         return NULL;
2045     }
2046
2047     types::Bool *pB = pIT->getAs<types::Bool>();
2048     if (pB == NULL)
2049     {
2050         return NULL;
2051     }
2052
2053     return (mxLogical *) pB->get();
2054 }
2055
2056 void mexInfo(char *str)
2057 {
2058     mexPrintf("mexInfo: %s", str);
2059     // FIXME : Use scilabWrite
2060 }
2061
2062 int mexCheck(char *str, int nbvars)
2063 {
2064     // FIXME : Where does Nbvars come from ??
2065     // if ( nbvars != -1 && Nbvars != nbvars)
2066     //     fprintf(stderr,"%s %d %d\n",str,Nbvars,nbvars);
2067     // return Nbvars ;
2068     return 0;
2069 }
2070
2071 /****************************************************
2072 * C functions for Fortran  mexfunctions
2073 ****************************************************/
2074
2075 double *C2F(mxgetpr) (mxArray *ptr)
2076 {
2077     return mxGetPr(ptr);
2078 }
2079
2080 double *C2F(mxgetpi) (mxArray *ptr)
2081 {
2082     return mxGetPi(ptr);
2083 }
2084
2085 int C2F(mxgetm) (mxArray *ptr)
2086 {
2087     return mxGetM(ptr);
2088 }
2089
2090 int C2F(mxgetn) (mxArray *ptr)
2091 {
2092     return mxGetN(ptr);
2093 }
2094
2095 int C2F(mxisstring) (mxArray *ptr)
2096 {
2097     return mxIsString(ptr);
2098 }
2099
2100 int C2F(mxisnumeric) (mxArray *ptr)
2101 {
2102     return mxIsNumeric(ptr);
2103 }
2104
2105 int C2F(mxisfull) (mxArray *ptr)
2106 {
2107     return mxIsFull(ptr);
2108 }
2109
2110 int C2F(mxissparse) (mxArray *ptr)
2111 {
2112     return mxIsSparse(ptr);
2113 }
2114
2115 int C2F(mxiscomplex) (mxArray *ptr)
2116 {
2117     return mxIsComplex(ptr);
2118 }
2119
2120 double C2F(mxgetscalar) (mxArray *ptr)
2121 {
2122     return mxGetScalar(ptr);
2123 }
2124
2125 void C2F(mexprintf) (char *error_msg, int len)
2126 {
2127     error_msg[len] = '\0';
2128     mexPrintf(error_msg);
2129 }
2130
2131 void C2F(mexerrmsgtxt) (char *error_msg, int len)
2132 {
2133     error_msg[len] = '\0';
2134     mexErrMsgTxt(error_msg);
2135 }
2136
2137 mxArray *C2F(mxcreatefull) (int *m, int *n, int *it)
2138 {
2139     /* mxCreateFull is obsolete. Call mxCreateDoubleMatrix instead. */
2140     return (mxArray *) mxCreateDoubleMatrix(*m, *n, (mxComplexity) * it);
2141 }
2142
2143 mxArray *C2F(mxcreatedoublematrix) (int *m, int *n, int *it)
2144 {
2145     return (mxArray *) mxCreateDoubleMatrix(*m, *n, (mxComplexity) * it);
2146 }
2147
2148 unsigned long int C2F(mxcalloc) (unsigned int *n, unsigned int *size)
2149 {
2150     mxCalloc(*n, *size);
2151     return 0;
2152 }
2153
2154 int C2F(mxgetstring) (mxArray *ptr, char *str, int *strl)
2155 {
2156     return mxGetString(ptr, str, *strl);
2157 }
2158
2159 void C2F(mxfreematrix) (mxArray *ptr)
2160 {
2161     mxFreeMatrix(ptr);
2162 }
2163
2164 mxArray *C2F(mxcreatestring) (char *string, long int l)
2165 {
2166     string[l] = '\0';
2167     return mxCreateString(string);
2168 }
2169
2170 int C2F(mxcopyreal8toptr) (double *y, mxArray *ptr, int *n)
2171 {
2172     double *pr = mxGetPr(ptr);
2173     memcpy(y, pr, (*n) * sizeof(double));
2174     return 0;
2175 }
2176
2177 int C2F(mxcopycomplex16toptr) (double *y, mxArray *ptr, mxArray *pti, int *n)
2178 {
2179     // FIXME : Wrap this one to the C one
2180     return 0;
2181 }
2182
2183 int C2F(mxcopyptrtoreal8) (mxArray *ptr, double *y, int *n)
2184 {
2185     double *pr = mxGetPr(ptr);
2186     memcpy(pr, y, (*n) * sizeof(double));
2187     return 0;
2188 }
2189
2190 int C2F(mxcopyptrtocomplex16) (mxArray *ptr, mxArray *pti, double *y, int *n)
2191 {
2192     // FIXME : Wrap this one to the C one
2193     return 0;
2194 }
2195
2196 /* *mxRealloc(void *ptr, size_t size);
2197    mxArray *mxCreateStringFromNChars(const char *str, int n);
2198    int mxSetClassName(mxArray *pa, const char *classname);
2199    void mxRemoveField(mxArray *pa, int field);
2200    void mxSetCopyInCell(mxArray *pa, int i, mxArray *value);  */