Fixe endianness issue with namstr.
[scilab.git] / scilab / modules / core / src / cpp / search_functions.cpp
1 /*
2  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3  * Copyright (C) 2010 - DIGITEO - Bernard HUGUENEY
4  *
5  * This file must be used under the terms of the CeCILL.
6  * This source file is licensed as described in the file COPYING, which
7  * you should have received as part of this distribution.  The terms
8  * are also available at
9  * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10  *
11  */
12 #ifdef _MSC_VER
13 #include <Windows.h>
14 #endif
15
16 #include <cstdlib>
17 #include <algorithm>
18 #include "unrolled_algorithms.hxx"
19 extern "C" {
20 #include "stack-c.h"
21 #include "stack-def.h" /* C2F(basbrk) */
22 #include "intmacr2tree.h" /*#define idstk(x,y) (C2F(vstk).idstk+(x-1)+(y-1)*nsiz) */
23
24     void C2F(siflibs)(int* id, int* k_ptr, int* istr, int* lbibn, int* nbibn,
25         int* ilp, int* nn, int* should_return);
26     void C2F(sivars)(int* id, int* should_return);
27     void C2F(namstr)(int* id, int* str, int* n, int const* job);
28 }
29
30
31 /*
32  * These are C++ reimplementations of some (as few as possible) code from funs.f
33  * The goal was to improve speed with :
34  * 1°) avoiding a call to namstr_ when only the first (two) caracters where needed
35  * 2°) allowing the compiler to replace eqid() calls with inlined faster C++ implementation of eq_n<nsiz>
36  */
37
38 namespace
39 {
40     char const f_true = 1;
41     char const f_false = 0;
42     int const percent = 56;
43     int const nclas = 29;
44     int const from_id = 1;
45
46     /* directly convert from id to upper char */
47     int upper_char(int id)
48     {
49         /* scilab character encoding is using signed bytes packed into an int.
50          * testing for the 7th bit with & 0x80 gives us the sign
51          * & 0xff extracts the byte if positive,
52          * |0xffffff00 extracts the byte if negative (assuming two's complement negative numbers representations)
53          * abs() takes the upper value in scilab character encoding.
54          */
55         return std::abs((int)((id & 0x80) ? (id |0xffffff00) :  (id & 0xff)));
56     }
57
58     /* gives the discriminating char (either first of second if first=percent) */
59     int id_char(int const* id)
60     {
61         int ch(upper_char(*id));
62         if (ch == percent)
63         {
64             return upper_char((*id)>>8);
65         }
66         return ch;
67     }
68 }
69 /* search for an id in the libraries
70  * as we reimplement part of Fortran function, we now use a 'bool' (for Fortran) should_return to tell calling
71  * function that it should return at once.
72  * other variables are lifted straight from Fortran code.
73  */
74 void C2F(siflibs)(int* id, int* k_ptr, int* istr, int* lbibn_ptr, int* nbibn_ptr,
75                   int* ilp_ptr, int* nn_ptr, int* should_return)
76 {
77
78     int const* const lstk_ptr = (int*)C2F(vstk).lstk-1;
79     int const* const istk_ptr = ((int*)C2F(stack).Stk)-1;
80     int k, ilp, nbibn, lbibn;
81
82     *should_return= f_false;
83
84     for (k= Bot; k < C2F(vstk).isiz; ++k)
85     {
86         int il = iadr(lstk_ptr[k]);
87         int ip;
88
89         if (istk_ptr[il] == sci_lib)
90         {
91             nbibn = istk_ptr[il+1];
92             lbibn = il+2;
93             il += nbibn+2;
94             ilp = il+1;
95 #ifdef _MSC_VER
96             ip = min(nclas,max(1, id_char(id)-9));
97 #else
98             ip =  std::min(nclas,std::max(1, id_char(id)-9));
99 #endif
100             if (ip <= nclas)
101             {
102
103                 int n = istk_ptr[ilp+ip] -istk_ptr[ilp+ip-1];
104                 if (n != 0)
105                 {
106                     int iln= ilp+nclas+1+(istk_ptr[ilp+ip-1]-1)*nsiz;
107
108                     for (int i = 1; i<=n; ++i, iln+= nsiz)
109                     {
110                         if (eq_n<nsiz>(id, istk_ptr+iln))
111                         { /* 39 */
112                             if ((Fin == -1) || (Fin == -3))
113                             {
114                                 C2F(com).fun= k;
115                                 Fin= i;
116                                 *should_return= f_true;
117                                 return;
118                             }
119
120                             Fin= i;
121                             if (C2F(errgst).err1 != 0)
122                             {
123                                 C2F(com).fun= Fin= 0;
124                                 *should_return= f_true;
125                                 return;
126                             }
127
128                             C2F(namstr)(id,istr, nn_ptr, &from_id);
129                             *k_ptr= k;
130                             *lbibn_ptr= lbibn;
131                             *nbibn_ptr= nbibn;
132                             *ilp_ptr= ilp;
133                             *should_return= f_false;
134                             return;
135                         }
136                     }
137                 }
138
139             }
140
141         }
142
143     }
144     C2F(com).fun= Fin= 0;
145     *should_return= f_true;
146     return;
147 }
148
149 /* search for an id in vars, also lifted from Fortran code in funs.f 
150  30   k=bot-1
151  31   k=k+1
152       if(k.gt.isiz) goto 35
153       if(.not.eqid(idstk(1,k),id)) goto 31
154       il=iadr(lstk(k))
155 c     modif 1.3 SS
156       if(istk(il).ne.11.and.istk(il).ne.13) then
157          fin=0
158          fun=0
159          return
160       endif
161       fin=k
162       fun=-1
163       return
164 */
165 void C2F(sivars)(int* id, int* should_return)
166 {
167     int* const lstk_ptr = (int*)C2F(vstk).lstk-1;
168
169     int k;
170     /*  idstk(x,y) (C2F(vstk).idstk+(x-1)+(y-1)*nsiz) */
171     int* id_addr=C2F(vstk).idstk;
172     for (*should_return= f_false, k= Bot, id_addr+=(k-1)*nsiz;
173          k <=  C2F(vstk).isiz && !eq_n<nsiz>(id_addr, id);
174          ++k, id_addr+=nsiz)
175     {
176     }
177
178     if (k <=  C2F(vstk).isiz)
179     {/* eq_id */
180         int il=lstk_ptr[k];
181         il=il+il-1;/* iadr() */
182         if ((*istk(il) != sci_u_function) && (*istk(il) != sci_c_function))
183         {
184             C2F(com).fun= Fin= 0;
185         }
186         else
187         {
188           C2F(com).fun= -1;
189           Fin= k;
190         }
191         *should_return= f_true;
192     }
193     return; 
194 }