06ffa8436e378263892a34de8b09394acd812b65
[scilab.git] / scilab / modules / core / src / c / run.c
1 /*
2  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3  * Copyright (C) INRIA - Serge STEER
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 /*--------------------------------------------------------------------------
13  * Execution of a compiled macro (byte code)
14  * byte code is a sequence of tags each of them containing the data relative
15  * to a particular basic operation
16  *
17  * Code automatically translated from Fortran to C
18  *------------------------------------------------------------------ */
19
20 #include <string.h>
21 #include <stdio.h>
22 #ifdef _MSC_VER
23 #include <stdlib.h>
24 #endif
25
26 #include <time.h>
27 #include "sciquit.h"
28 #include "stack-c.h"
29 #include "run.h"
30 #include "basout.h"
31 #include "parse.h"
32 #include "localization.h"
33 #include "core_math.h"
34 #include "scilabmode.h"
35 #include "stack-def.h" /* C2F(basbrk) */
36 #include "storeCommand.h"
37 #include "do_error_number.h"
38 #include "Scierror.h"
39 #include "msgs.h"
40 #include "parserConstant.h"
41 #undef Lstk
42 #undef Infstk
43
44
45 /* Table of constant values */
46
47 static int c__1 = 1;
48 static int c__0 = 0;
49
50 #define Pt (C2F(recu).pt)
51 extern int C2F(stackp)(int *,int *);
52 extern int C2F(eqid)(int *,int *);
53 extern int C2F(bexec)(char *,int *,int *);
54 extern int C2F(print)(int *,int *,int *);
55 extern int C2F(createref1)(int *);
56 extern int C2F(command)(int *,int *);
57 extern int C2F(mkindx)(int *,int *);
58 extern int C2F(whatln)(int *,int *, int *,int *,int *,int *);
59 extern int C2F(prompt)(int *,int *);
60 extern int C2F(seteol)(void);
61 extern int C2F(name2var)(int *);
62 extern int C2F(getendian)(void);
63 extern int C2F(nextj)(int *, int *);
64 extern int C2F(isafunptr)(int *, int *,int *,int *);
65 extern int C2F(varfunptr)(int *, int *,int *);
66 extern int C2F(defmat)(void);
67 extern int C2F(clunit)(int *, char *, int *);
68 extern int C2F(istrue)(int *);
69
70 int Istrue(int n)
71 {
72
73   return C2F(istrue)(&n);
74 }
75
76
77
78 int C2F(run)(void)
79 {
80   /* Initialized data */
81   /* Fortran common data equivalence */
82   static int    *Ids  = C2F(recu).ids-nsiz-1;
83   static int    *Rstk = C2F(recu).rstk-1;
84   static int    *Pstk = C2F(recu).pstk-1;
85   static int    *Lstk = C2F(vstk).lstk-1;
86   static int    *Lin  = C2F(iop).lin-1;
87   static int    *Lpt  = C2F(iop).lpt-1;
88   static int  *Infstk = C2F(vstk).infstk-1;
89   static int    *Lct = C2F(iop).lct - 1;
90
91   static double equiv_4[1];
92 #define x (equiv_4)
93 #define ix ((int *)equiv_4)
94
95   /* Local variables */
96   static int ifin, iesc, ibpt, tref, ifun;
97   static int ierr, ndel;
98   static int j, k, m, n, p, r, t;
99   static int lname, imode;
100   static int l0;
101   static int id[6], lc, kc, nc, lb, li, il, io, ip;
102   static int ok;
103   static int ir, lr, op;
104   static int mm1;
105   static int nn1;
106   static int nentry, lastindpos;
107   static int lcc, kid, nlr;
108   int i2;
109   static char tmp[80]; /*string for sending debug messages*/
110   tref = 0;
111
112   /* set debug trace mode on  */
113   if (C2F(iop).ddt == 4) {
114     sprintf(tmp," run pt:%d rstk(pt):%d",Pt,Rstk[Pt]);
115     C2F(basout)(&io, &C2F(iop).wte,tmp, (long)strlen(tmp));
116   }
117
118   l0 = 0;
119   nc = 0;
120
121   if (Ptover(0)) {
122     return 0;
123   }
124
125   r = Rstk[Pt];
126   ir = r / 100;
127   if (ir != 6) {
128     goto L1;
129   }
130   switch ((int)(r - 600)) {
131   case 1:  goto L33;
132   case 2:  goto L66;
133   case 3:  goto L82;
134   case 4:  goto L92;
135   case 5:  goto L58;
136   case 6:  goto L116;
137   case 7:  goto L250;
138   case 8:  /*Rstk[Pt]=1101;*/ goto L254;
139   case 9:  /*Rstk[Pt]=1101;*/ goto L240;
140
141   }
142
143
144  L1: /*  Start execution of a "compiled" function  */
145   tref = clock();
146   C2F(errgst).toperr = Top;
147   k = Lpt[1] - (13+nsiz);
148   lc = Lin[k + 7];
149
150  L10: /* Current opcode finished handle error, interruptions,...*/
151   if (Err > 0)  return 0;
152
153   if (C2F(basbrk).iflag) {
154     C2F(basbrk).iflag = FALSE;
155     goto L91;
156   }
157   if (C2F(errgst).err1 != 0 ) {
158     if ((C2F(errgst).errpt >0) && (Pt >= C2F(errgst).errpt) && (Rstk[C2F(errgst).errpt]==618)) {
159       /* error under try catch */
160       for (p=Pt;p>=C2F(errgst).errpt;p--) {
161         if (Rstk[p]<=502 && Rstk[p]>=501){
162           k = Lpt[1] - (13+nsiz);
163           Lpt[1] = Lin[k+1];
164           Lpt[2] = Lin[k+2];
165           Lpt[3] = Lin[k+3];
166           Lpt[4] = Lin[k+4];
167           Lpt[6] = k;
168           C2F(recu).macr--;
169           if (Rstk[p-1]==909) Top--; /* execed function*/
170         }
171         /* may it will be necessary to take care of for loop variables */
172       }
173       Pt = C2F(errgst).errpt;
174       goto L271;
175     }
176    /* errcatch in exec(function,'errcatch')
177      * or catched error in an external
178      * or errcatch in execstr('foo()','errcatch') */
179     if (C2F(errgst).errcatch == 0) goto L999;
180     /* error under errcatch(....,'continue') */
181
182         /* @TODO : replace 903 909 1001 1002 by a #define ... */
183     if (Rstk[Pt - 1] == 903 || Rstk[Pt - 1] == 909 || Rstk[Pt] == 1001 || Rstk[Pt] == 1002)  return 0;
184   }
185   if (lc - l0 == nc) { /* is current opcodes block (if, for, .. structure) finished ?*/
186     /* yes */
187     r = Rstk[Pt] - 610;
188     switch (r) {
189     case 1:  goto L46;
190     case 2:  goto L47;
191     case 3:  goto L52;
192     case 4:  goto L56;
193     case 5:  goto L57;
194     case 6:  goto L61;
195     case 8:  goto L271;
196     case 9:  goto L272;
197     }
198   }
199
200
201  L11:   /*  next opcode */
202   op = *istk(lc);
203   /*  label 49 retains to be able issue a compatibility error message */
204   switch ((int)op) { /* step to corresponding part*/
205   case 1:  goto L20;
206   case 2:  goto L25;
207   case 3:  goto L40;
208   case 4:  goto L42;
209   case 5:  goto L30;
210   case 6:  goto L41;
211   case 7:  goto L45;
212   case 8:  goto L49;
213   case 9:  goto L49;
214   case 10:  goto L55;
215   case 11:  goto L270;/* try */
216   case 12:  goto L90;
217   case 13:  goto L95;
218   case 14:  goto L100;
219   case 15:  goto L105;
220   case 16:  goto L110;
221   case 17:  goto L120;
222   case 18:  goto L130;
223   case 19:  goto L140;
224   case 20:  goto L150;
225   case 21:  goto L160;
226   case 22:  goto L170;
227   case 23:  goto L180;
228   case 24:  goto L190;
229   case 25:  goto L200;
230   case 26:  goto L210;
231   case 27:  goto L220;
232   case 28:  goto L97;
233   case 29:  goto L230;
234   case 30:  goto L260;
235   case 31:  goto L261;
236
237   }
238   if (op >= 100) {
239     /* ------------- primitive call (matfn's) -------------- */
240     goto L80;
241   }
242
243   if (op == 99) {
244     /* ------------- return -------------------------------- */
245     /* check if "return" occured in a for loop */
246     p = Pt + 1;
247   L12:
248     --p;
249     if (Rstk[p] == 612) {
250       /* yes, remove the for loop variable */
251       --Top;
252       goto L12;
253     } else if (Rstk[p] != 501) {
254       goto L12;
255     }
256     Fin = 2;
257     goto L998;
258   }
259
260   if (op <= 0) {
261     /* ------------- nop ---------------------------------- */
262     lc += *istk(1 + lc);
263     goto L11;
264   }
265
266   SciError(60);
267   return 0;
268
269  L20: /* stackp, retplaced by assign */
270   /*     retained for 2.7 and earlier versions compatibility */
271   C2F(stackp)(istk(1 + lc), &c__0);
272   /*     store info if printing is required see code 22 */
273   C2F(putid)(id, istk(1 + lc));
274   kid = Fin;
275   lc += 7;
276   goto L10;
277
278  L25: /* stackg */
279   Fin = *istk(7 + lc);
280   ifin = Fin;
281   Rhs = *istk(8 + lc);
282   lname = lc + 1;
283  L26:
284   C2F(stackg)(istk(lname));
285   if (Err > 0||C2F(errgst).err1 > 0) {
286     lc += 9;
287     goto L10;
288   }
289   if (Fin != 0) {/* variable exists */
290     goto L28;
291   }
292   C2F(funs)(istk(1 + lc)); /* check if it is a function */
293   if (Err > 0||C2F(errgst).err1 > 0) {
294     lc += 9;
295     goto L10;
296   }
297   if (C2F(com).fun != -2) {
298     C2F(putid)(&Ids[1 +(Pt + 1) * nsiz ], istk(1 + lc));
299     if (C2F(com).fun == 0) {
300       /* the search variable is neither a regular variable nor a function in a librar */
301       /* it may be a simple variable in a lib */
302
303       C2F(stackg)(istk(lname));
304       if (Err > 0||C2F(errgst).err1 > 0) {
305         lc += 9;
306         goto L10;
307       }
308       if (Fin==0) {
309         SciError(4);
310         if (Err > 0||C2F(errgst).err1 > 0) {
311           lc += 9;
312           goto L10;
313         }
314       }
315
316     } else {
317       /* referenced name was function at compile time it is now a
318        * primitive. Modify the code for further use */
319       if (ifin != -4 && ifin != 0) {
320         /* function call */
321         /* change current  opcode to nop */
322         *istk(lc) = 0;
323         *istk(1 + lc) = 9;
324         lc += 9;
325         /* change the following opcode to matfn opcode */
326         op = C2F(com).fun * 100;
327         *istk(lc) = op;
328         *istk(1 + lc) = *istk(2 + lc) - 1;
329         *istk(2 + lc) = *istk(3 + lc);
330         *istk(3 + lc) = Fin;
331         goto L80;
332       } else {
333         /* only reference to a function */
334         /* stackg opcode replaced by varfun opcode */
335         *istk(lc) = 27;
336         *istk(1 + lc) = C2F(com).fun;
337         *istk(2 + lc) = Fin;
338         C2F(putid)(istk(3 + lc), &Ids[1 + (Pt + 1) * nsiz]);
339         goto L10;
340       }
341     }
342     lc += 9;
343     goto L10;
344   }
345   Fin = *istk(7 + lc);
346   goto L26;
347  L28:
348   if (Rhs == 0 && ((*istk(7 + lc) == -2)||(*istk(7 + lc) == -1)) && Fin == -1) {
349     lc += 9;
350
351     if (*istk(7 + lc-9) == -2) {
352
353       /* instruction reduced to <name> with name not a function, replace */
354       /* next two op code by a single store */
355       /* skip extract op-code <5 3 1 1> */
356       if (*istk(lc) != 5 || *istk(1 + lc) != 3) {
357         strcpy(C2F(cha1).buf,_("Unexpected opcode, please report into the Scilab bug tracker."));
358         SciError(9999);
359         return 0;
360       }
361       lc += 4;
362     }
363     /* skip assignment op_code <29 43 ans 0> */
364     if (*istk(lc) != 29) {
365       strcpy(C2F(cha1).buf,_("Unexpected opcode, please report into the Scilab bug tracker."));
366       SciError(9999);
367       return 0;
368     }
369     lc += 10;
370     /* store */
371     Rhs = 1;
372     C2F(ref2val)();
373     C2F(stackp)(istk(lname), &c__0);
374     if (Err > 0 ||C2F(errgst).err1 > 0) {
375       goto L10;
376     }
377     goto L10;
378   }
379   lc += 9;
380   if (Fin > 0) {
381     goto L65;
382   }
383   goto L10;
384
385   /*     allops */
386  L30:
387   Fin = *istk(1 + lc);
388   Rhs = *istk(2 + lc);
389   Lhs = *istk(3 + lc);
390   lc += 4;
391   if (Fin == extrac) {
392     C2F(isafunptr)(&Top, id, &ifun, &ifin);
393     if (ifun != 0) {
394       --Top;
395       --Rhs;
396       C2F(com).fun = ifun;
397       Fin = ifin;
398       C2F(adjustrhs)();
399       goto L81;
400     }
401   }
402   if (Fin == extrac || Fin == insert) {
403     C2F(adjustrhs)();
404   }
405   ++Pt;
406   Rstk[Pt] = 601;
407   Ids[1 + Pt * nsiz] = tref;
408   Ids[3 + Pt * nsiz] = l0;
409   Ids[4 + Pt * nsiz] = nc;
410   C2F(recu).icall = 4;
411   /*     pstk(pt) is used by allops to get the name of output variable (insertion) */
412   Pstk[Pt] = lc;
413   /*     *call* allops */
414   return 0;
415  L33:
416   tref = Ids[1 + Pt * nsiz];
417   l0 = Ids[3 + Pt *  nsiz];
418   nc = Ids[4 + Pt *  nsiz];
419   lc = Pstk[Pt];
420   --Pt;
421   goto L70;
422
423   /*     string */
424  L40:
425   n = *istk(1 + lc);
426   if (C2F(errgst).err1 <= 0) {
427     ++Top;
428     if (C2F(cresmat)("run", &Top, &c__1, &c__1, &n, 3L)) {
429       C2F(getsimat)("run", &Top, &Top, &mm1, &nn1, &c__1, &
430                     c__1, &lr, &nlr, 3L);
431       C2F(icopy)(&n, istk(2 + lc), &c__1, istk(lr), &c__1);
432     }
433   }
434   lc = lc + n + 2;
435   goto L10;
436
437   /*     num */
438  L41:
439   if (C2F(errgst).err1 <= 0) {
440     if (C2F(getendian)() == 1) {
441       ix[0] = *istk(1 + lc);
442       ix[1] = *istk(2 + lc);
443     } else {
444       ix[1] = *istk(1 + lc);
445       ix[0] = *istk(2 + lc);
446     }
447     ++Top;
448     if (C2F(cremat)("run", &Top, &c__0, &c__1, &c__1, &lr, &lcc, 3L)) {
449       *stk(lr) = *x;
450     }
451   }
452   lc += 3;
453   goto L10;
454
455  L42:
456   C2F(defmat)();
457   ++lc;
458   goto L10;
459
460   /*     for */
461  L45:
462   nc = *istk(1 + lc);
463   lc += 2;
464   l0 = lc;
465   if (Ptover(1)) {
466     lc += nc;
467     lc = lc + nsiz + *istk(lc);
468     goto L10;
469   }
470   Rstk[Pt] = 611;
471   Ids[1 + Pt * nsiz] = l0;
472   Ids[2 + Pt * nsiz] = nc;
473   goto L10;
474
475  L46:
476   nc = *istk(lc);
477   l0 = lc + 7;
478   if  (C2F(errgst).errcatch>=1 &&C2F(errgst).err1 > 0) {
479     /*an error occured in the loop variable expression evaluation, in 'continue' mode
480       skip all the for codes*/
481     lc = l0;
482     goto L48;
483   }
484   Rstk[Pt] = 612;
485   Pstk[Pt] = 0;
486   Ids[1 + Pt * nsiz] = l0;
487   Ids[2 + Pt * nsiz] = Lct[8];
488   Ids[3 + Pt * nsiz] = Top;
489   Ids[4 + Pt * nsiz] = C2F(errgst).toperr;
490   C2F(errgst).toperr = Top;
491  L47:
492   lc = l0;
493   if (Top != Ids[3 + Pt * nsiz]) {
494     SciError(115);
495     goto L48;
496   }
497   C2F(nextj)(istk(1 + l0 - 7), &Pstk[Pt]);
498   if (Pstk[Pt] != 0) {
499     Lct[8] = Ids[2 + Pt * nsiz];
500     if (ismenu() == 1 && C2F(basbrk).interruptible) goto L115;
501     goto L10;
502   }
503   /*     fin for */
504  L48:
505   lc += nc;
506   C2F(errgst).toperr = Ids[4 + Pt * nsiz];
507   --Pt;
508   goto L70;
509
510   /*     Very old if - while (removed) */
511  L49:
512   if (*istk(1 + lc) < 0) {
513     goto L55;
514   }
515  L52:
516   strcpy(C2F(cha1).buf, _("Functions compiled with very old versions are no more handled."));
517   SciError(997);
518   return 0;
519
520   /*     "select- case"  or  "if elseif else end" */
521  L55:
522   if (Ptover(1)) {
523     lc += (i2 = *istk(1 + lc), abs(i2));
524     goto L10;
525   }
526   Pstk[Pt] = lc;
527   Ids[3 + Pt * nsiz] = C2F(errgst).toperr;
528
529  L551:
530   if (*istk(1 + lc) > 0) {
531     /*    first expression */
532     nc = *istk(3 + lc);
533     Rstk[Pt] = 614;
534     lc += 4;
535     l0 = lc;
536     Ids[1 + Pt * nsiz] = l0;
537     Ids[2 + Pt * nsiz] = nc;
538     goto L10;
539   } else {
540     lc += 4;
541   }
542
543   /*     expri */
544  L56:
545   if  (C2F(errgst).errcatch>=1 && C2F(errgst).err1 > 0 ) {
546     /*an error occured in the first expression evaluation, in 'continue' mode
547       skip all the control structure codes*/
548     goto L62;
549   }
550
551   if (*istk(Pstk[Pt]) == 10) {
552     /*     copy first expression */
553     i2 = Top + 1;
554     if (! C2F(vcopyobj)("run", &Top, &i2,3L)) {
555       return 0;
556     }
557     ++Top;
558   }
559
560   nc = *istk(lc);
561   Rstk[Pt] = 615;
562   ++lc;
563   l0 = lc;
564   Ids[1 + Pt * nsiz] = l0;
565   Ids[2 + Pt * nsiz] = nc;
566   goto L10;
567
568   /*     instructions i */
569  L57:
570   if  (C2F(errgst).errcatch>=1 && C2F(errgst).err1 > 0 ) {
571     /*an error occured in the first expression evaluation, in 'continue' mode
572       skip all the control structure codes*/
573     goto L62;
574   }
575   if (nc == 0) {
576     /* if nc=0 the instruction correspond to the else */
577     ok = TRUE;
578     if (*istk(Pstk[Pt]) == 10) {
579       --Top;
580     }
581     goto L59;
582   } else if (*istk(Pstk[Pt]) != 10) {
583     ok = Istrue(1);
584     if (Err > 0 || C2F(errgst).err1 > 0) {
585       goto L10;
586     }
587     goto L59;
588   }
589   ++Pt;
590   Fin = equal;
591   Rhs = 2;
592   Lhs = 1;
593   Rstk[Pt] = 605;
594   C2F(recu).icall = 4;
595   Pstk[Pt] = lc;
596   Ids[1 + Pt * nsiz] = tref;
597   /*     *call* allops(equal) */
598   return 0;
599
600  L58:
601   if  (C2F(errgst).errcatch>=1 && C2F(errgst).err1 > 0 ) {
602     /*an error occured in the first expression evaluation, in 'continue' mode
603       skip all the control structure codes*/
604     goto L62;
605   }
606
607   lc = Pstk[Pt];
608   tref = Ids[1 + Pt * nsiz];
609   --Pt;
610   ok = Istrue(1);
611   if (Err > 0 || C2F(errgst).err1 > 0) {
612     goto L10;
613   }
614  L59:
615   nc = *istk(lc);
616   C2F(errgst).toperr = Top;
617   if (ok) {
618     ++lc;
619     if (*istk(Pstk[Pt]) == 10) {
620       --Top;
621     }
622     l0 = lc;
623     Ids[1 + Pt * nsiz] = l0;
624     Ids[2 + Pt * nsiz] = nc;
625     Rstk[Pt] = 616;
626     if (ismenu() == 1 && C2F(basbrk).interruptible) goto L115;
627     goto L10;
628   } else {
629     if (*istk(Pstk[Pt]) == 9) {
630       goto L62;
631     }
632     lc = lc + nc + 1;
633     goto L56;
634   }
635
636  L61:
637   /*     fin if while select/case */
638   l0 = Pstk[Pt];
639   if (*istk(Pstk[Pt]) == 9) {
640     lc = l0 + 4;
641     goto L56;
642   }
643  L62:
644   l0 = Pstk[Pt];
645   lc = l0 + (i2 = *istk(1 + l0), abs(i2));
646   C2F(errgst).toperr = Ids[3 + Pt * nsiz];
647   --Pt;
648   goto L70;
649
650   /*     macro */
651  L65:
652   i2 = *istk(2 + lc) - 1;
653   Rhs = Max(i2,0);
654   C2F(adjustrhs)();
655   Lhs = *istk(3 + lc);
656
657   lc += 4;
658
659   if (Ptover(1)) {
660     goto L10;
661   }
662   Rstk[Pt] = 602;
663   Pstk[Pt] = lc;
664   /*  Ids[1 + Pt * nsiz] = C2F(dbg).wmac; *//*moved into macro.f*/
665   Ids[2 + Pt * nsiz] = tref;
666   Ids[3 + Pt * nsiz] = l0;
667   Ids[4 + Pt * nsiz] = nc;
668   C2F(recu).icall = 5;
669   C2F(com).fun = 0;
670   /*     *call* macro */
671   return 0;
672  L66:
673   lc = Pstk[Pt];
674   /*C2F(dbg).wmac = Ids[1 + Pt * nsiz];*//*moved into macro.f*/
675   tref = Ids[2 + Pt * nsiz];
676   l0 = Ids[3 + Pt * nsiz];
677   nc = Ids[4 + Pt * nsiz];
678   --Pt;
679   goto L70;
680
681  L70:
682   /* re entering run to continue macro evaluation */
683   if (ismenu() == 1 && C2F(basbrk).interruptible) goto L115;
684
685  L71:
686   /* reset proper values for l0 and nc if a control structure had been escaped*/
687   r = Rstk[Pt] - 610;
688   switch ((int)r) {
689   case 1:
690     l0 = Ids[1 + Pt * nsiz];
691     nc = Ids[2 + Pt * nsiz];
692     goto L10;
693   case 2: /* back to a for */
694     j = Pstk[Pt];
695     l0 = Ids[1 + Pt * nsiz];
696     nc = *istk(l0 - 7);
697     goto L10;
698   case 3: /* back to an if or a while */
699     li = Ids[1 + Pt * nsiz];
700     kc = Ids[2 + Pt * nsiz];
701     nc = *istk(2 + li);
702     l0 = li + 5;
703     if (kc == 0) {
704       goto L10;
705     }
706     l0 += nc;
707     nc = *istk(3 + li);
708     if (kc == 1) {
709       goto L10;
710     }
711     l0 += nc;
712     nc = *istk(4 + li);
713     goto L10;
714   case 4:
715   case 5:
716   case 6:
717   /*    back to a select case   */
718     l0 = Ids[1 + Pt * nsiz];
719     nc = Ids[2 + Pt * nsiz];
720     goto L10;
721   case 8: /*back to a try*/
722     l0 = Ids[1 + Pt * nsiz];
723     nc = *istk(l0 - 2);
724     goto L10;
725   case 9:  /*back to a catch*/
726     l0 = Ids[1 + Pt * nsiz];
727     nc = *istk(l0 - 1);
728     l0 = l0 + *istk(l0 - 2);
729     goto L10;
730   default :
731     goto L10;
732   }
733
734  L80:
735   C2F(com).fun = op / 100;
736   Rhs = *istk(1 + lc);
737   C2F(adjustrhs)();
738   Lhs = *istk(2 + lc);
739   Fin = *istk(3 + lc);
740   lc += 4;
741
742  L81:
743   ++Pt;
744   Rstk[Pt] = 603;
745   Pstk[Pt] = lc;
746   C2F(recu).icall = 9;
747   Ids[2 + Pt * nsiz] = 0;
748   Ids[3 + Pt * nsiz] = tref;
749   Ids[4 + Pt * nsiz] = l0;
750   Ids[5 + Pt * nsiz] = nc;
751   /*     *call* matfns */
752   return 0;
753  L82:
754   /*     warning if builtin is "resume" control is passed to macro and not here */
755   lc = Pstk[Pt];
756   tref = Ids[3 + Pt * nsiz];
757   l0 =   Ids[4 + Pt * nsiz];
758   nc =   Ids[5 + Pt * nsiz];
759   --Pt;
760   goto L70;
761
762   /*     pause */
763  L90:
764   ++lc;
765  L91:
766   if (Ptover(1)) {
767     goto L10;
768   }
769   Pstk[Pt] = C2F(iop).rio;
770   C2F(iop).rio = C2F(iop).rte;
771   Fin = 2;
772   if (Lct[4] <= -10) {
773     Fin = -1;
774         Lct[4] = -Lct[4] - 11;
775   }
776   Ids[1 + Pt * nsiz] = lc;
777   Ids[2 + Pt * nsiz] = Top;
778   Ids[3 + Pt * nsiz] = tref;
779   Ids[4 + Pt * nsiz] = l0;
780   Ids[5 + Pt * nsiz] = nc;
781   Rstk[Pt] = 604;
782   C2F(recu).icall = 5;
783   /*     *call* macro */
784   return 0;
785  L92:
786   lc =   Ids[1 + Pt * nsiz];
787   Top =  Ids[2 + Pt * nsiz];
788   tref = Ids[3 + Pt * nsiz];
789   l0 =   Ids[4 + Pt * nsiz];
790   nc =   Ids[5 + Pt * nsiz];
791   C2F(iop).rio = Pstk[Pt];
792   --Pt;
793   goto L70;
794
795   /*     break */
796  L95:
797   p = Pt + 1;
798  L96:
799   --p;
800   if (p == 0) {
801     ++lc;
802     goto L10;
803   }
804   if (Rstk[p] == 612) {
805     /*     break in a for */
806     l0 = Ids[1 + p * nsiz];
807     lc = l0 + *istk(1 + l0 - 8);
808     Pt = p - 1;
809     --Top;
810     goto L70;
811   } else if (Rstk[p] == 616 && *istk(1 + Pstk[p] - 1) == 9)
812     {
813       /*     break in a while */
814       l0 = Pstk[p];
815       lc = l0 + (i2 = *istk(1 + l0), abs(i2));
816       Pt = p - 1;
817       goto L70;
818     } else if (Rstk[p] == 501 || Rstk[p] == 502 ||
819                Rstk[p] == 503) {
820       /*     going outside a function an exec (break ignored) */
821       ++lc;
822       goto L10;
823     } else {
824       goto L96;
825     }
826   /*     continue */
827  L97:
828   p = Pt + 1;
829  L98:
830   --p;
831   if (p == 0) {
832     ++lc;
833     goto L10;
834   }
835   if (Rstk[p] == 612) {
836     /*     continue in a  for */
837     l0 = Ids[1 + p * nsiz];
838     /* nc is required for the end of loop */
839     lc = l0 - 7;
840     nc = *istk(lc);
841     Pt = p;
842     goto L47;
843   } else if (Rstk[p] == 616 && *istk(1 + Pstk[p] - 1) == 9)
844     {
845       /*     continue in a while */
846       l0 = Pstk[p];
847       lc = l0;
848       nc = *istk(lc);
849       Pt = p;
850       goto L551;
851     } else {
852       goto L98;
853     }
854   /*     abort */
855  L100:
856   ++Pt;
857  L101:
858   --Pt;
859   if (Pt == 0) {
860     goto L102;
861   }
862   if (Rstk[Pt] / 100 == 5) {
863     k = Lpt[1] - (13 + nsiz);
864     Lpt[1] = Lin[1 + k];
865     Lpt[2] = Lin[2 + k];
866     Lpt[3] = Lin[3 + k];
867     Lpt[4] = Lin[4 + k];
868         Lct[4] = Lin[6 + k ];
869     Lpt[6] = k;
870     if (Rstk[Pt] <= 502) {
871       if (Pt>1) {
872         if (Rstk[Pt-1] != 903 && Rstk[Pt-1] != 909 && Rstk[Pt-1] != 706)
873           Bot = Lin[5 + k];}
874       else
875         Bot = Lin[5 + k];
876     }
877     else if (Rstk[Pt] == 503) {
878       if (C2F(iop).rio == C2F(iop).rte) {
879             /* abort in a pause mode */
880         C2F(iop).rio = Pstk[Pt-1];
881         C2F(recu).paus--;
882         Bot = Lin[5 + k];}
883       else {
884         int mode[3];
885         int lunit = -C2F(iop).rio;
886         /*  abort in an exec*/
887         mode[0]=0;
888         C2F(clunit)(&lunit,C2F(cha1).buf,mode);
889         C2F(iop).rio = Pstk[Pt-1];
890       }
891     }
892   }
893   goto L101;
894  L102:
895   C2F(recu).icall = 10;
896   Top = 0;
897   C2F(com).comp[0] = 0;
898   if (C2F(recu).niv > 1) {
899     Err = 9999999;
900   }
901   return 0;
902
903  L105:
904   /*     eol */
905   /*     la gestion de la recuperation des erreurs devrait plutot se trouver */
906   /*     a la fin de l'instruction (mais il n'y a pas actuellement d'indicateur */
907   /*     de fin d'instruction dans les macros */
908   if (C2F(errgst).err1 != 0) { 
909     if (C2F(errgst).err2 == 0) {
910       C2F(errgst).err2 = C2F(errgst).err1;
911     }
912     if (C2F(errgst).errcatch > 0) {
913       /* running under errcatch(num,....) */
914       if (Rstk[Pt] != 614 && Rstk[Pt] != 615 && Rstk[Pt] != 605) C2F(errgst).err1 = 0;
915       if (Pt<C2F(errgst).errpt) {
916         C2F(errgst).errcatch = 0;
917       }
918     }
919     imode = (i2 = C2F(errgst).errct / 100000, abs(i2));
920     if (imode - (imode / 8 << 3) == 2) {
921       C2F(basbrk).iflag = TRUE;
922     }
923   }
924
925   /*     gestion des points d'arrets dynamiques */
926   if (C2F(dbg).nmacs != 0) { /* there are breakpoints set */
927     int kfin=C2F(dbg).wmac-1; /*the stack index of the current function*/
928     /*  first test if the function has breakpoints   */
929     int kmac;
930     for (kmac=0;kmac<C2F(dbg).nmacs;kmac++) { /* loop on table of functions containing breakpoints */
931       /* does the name of the current funtion fit the registered name*/
932       if (C2F(eqid)(&(C2F(vstk).idstk[kfin * nsiz]), &(C2F(dbg).macnms[kmac * nsiz]))) {/* yes */
933         /* test if there is a registered breakpoint at the current line*/
934         i2 = C2F(dbg).lgptrs[kmac+1] - 1;
935         for (ibpt = C2F(dbg).lgptrs[kmac]; ibpt <= i2; ++ibpt) {
936           if (Lct[8] == C2F(dbg).bptlg[ibpt - 1]) { /* yes */
937             /* display a message */
938             C2F(cvname)(&C2F(dbg).macnms[kmac * nsiz], tmp, &c__1, 24L);
939             sprintf(C2F(cha1).buf,"%s %5d",tmp, Lct[8]);
940             Msgs(32, 0);
941             /* raise the interruption flag */
942             C2F(basbrk).iflag = TRUE;
943             goto L107;
944           }
945         }
946         break;
947       }
948     }
949   }
950  L107:
951
952   if (Lct[4] / 2 % 2 == 1) {
953     i2 = Lct[4] / 4;
954     C2F(prompt)(&i2, &iesc);
955   }
956   ++Lct[8];
957   ++lc;
958   if (ismenu() == 1 && C2F(basbrk).interruptible) goto L115;
959
960   goto L10;
961
962   /* set line number.
963    *
964    *   Au debut de chaque expression liee a un then et a la fin de
965    *   chaque clause, le compilateur (compcl) inscrit la valeur de la
966    *   ligne. ceci permet de mettre rapidement a jour le compteur de
967    *   ligne sans avoir a analyser la suite des codes operatoires */
968
969  L110:
970   Lct[8] = *istk(1 + lc);
971   lc += 2;
972   goto L10;
973
974   /* gestion des evements asynchrones "interpretes" */
975  L115:
976   C2F(basbrk).interruptible = C2F(getmen)(C2F(cha1).buf, &lb, &nentry) == 0;
977   C2F(bexec)(C2F(cha1).buf, &lb, &ierr);
978   if (ierr != 0) {
979     goto L10;
980   }
981   ++Pt;
982   Ids[1 + Pt * nsiz] = lc;
983   Ids[2 + Pt * nsiz] = l0;
984   Ids[3 + Pt * nsiz] = nc;
985   Ids[4 + Pt * nsiz] = tref;
986   Rstk[Pt] = 606;
987   C2F(recu).icall = 5;
988   /*     *call* macro */
989   return 0;
990  L116:
991   C2F(basbrk).interruptible = TRUE;
992   lc = Ids[1 + Pt * nsiz];
993   l0 = Ids[2 + Pt * nsiz];
994   nc = Ids[3 + Pt * nsiz];
995   tref = Ids[4 + Pt * nsiz];
996   --Top;
997   --Pt;
998   goto L71;
999     /*  r = Rstk[Pt] - 610;
1000   switch ((int)r) {
1001   case 1:  goto L74;
1002   case 2:  goto L71;
1003   case 3:  goto L72;
1004   case 4:  goto L73;
1005   case 5:  goto L73;
1006   case 6:  goto L73;
1007   }
1008   goto L10;*/
1009
1010   /*     quit */
1011
1012  L120:
1013   if (C2F(recu).paus!=0) {
1014     /*   quit in a pause: decrease recursion level up to the pause one (Rstk[Pt] == 503) */
1015     Pt = Pt + 1;
1016   L121:  
1017     Pt = Pt - 1;
1018     /*  suppress loop variables if any */
1019     if (Rstk[Pt]==802 || Rstk[Pt]==612 || 
1020         (Rstk[Pt]==805 && Ids[1 + Pt * nsiz]==iselect) ||  
1021         (Rstk[Pt]==616 && Pstk[Pt] ==10)) Top--;
1022     if (Rstk[Pt] != 503) goto L121;
1023     /* recall macro to terminate the pause level */
1024     C2F(com).fun=0;
1025     return 0;
1026   }
1027   else
1028     C2F(com).fun = 99;
1029   return 0;
1030
1031   /*     named variable */
1032
1033  L130:
1034   Infstk[Top] = 1;
1035   C2F(putid)(&C2F(vstk).idstk[Top * nsiz - nsiz], istk(1 + lc));
1036   lc += 7;
1037   goto L10;
1038
1039   /*     form recursive extraction list */
1040
1041  L140:
1042   m = *istk(2 + lc);
1043   if (Rstk[Pt] == 617) {
1044     /* runtime arg count (list extraction) */
1045     m += Pstk[Pt];
1046     Pstk[Pt] = 0;
1047   }
1048   C2F(mkindx)(istk(1 + lc), &m);
1049   lc += 3;
1050   goto L10;
1051
1052   /*     exit */
1053
1054  L150:
1055   ++lc;
1056   if (C2F(recu).niv > 0) {
1057     sciquit();
1058     exit(0); /* stop */
1059   }
1060   C2F(com).fun = 99;
1061   goto L10;
1062
1063   /*     begrhs - for run time rhs value computation */
1064   /*              syntax like: l=list(...); a(l(:)) */
1065
1066  L160:
1067   ++lc;
1068   ++Pt;
1069   Rstk[Pt] = 617;
1070   Pstk[Pt] = 0;
1071   goto L10;
1072
1073   /*     printmode */
1074
1075  L170:
1076   /*     print stored variable */
1077   if (Lct[4] >= 0 && *istk(1 + lc) != semi && kid != 0) {
1078     C2F(print)(id, &kid, &C2F(iop).wte);
1079   }
1080   lc += 2;
1081   goto L10;
1082  L180:
1083   /*     name2var */
1084   C2F(name2var)(istk(1 + lc));
1085   lc += 7;
1086   goto L10;
1087
1088  L190:
1089   /*     deffnull */
1090   ++lc;
1091   ++Top;
1092   C2F(objvide)(" ", &Top, 1L);
1093   goto L10;
1094
1095  L200:
1096   /*     profile */
1097   ++*istk(1 + lc);
1098   t = clock();
1099   *istk(2 + lc) = *istk(2 + lc) + t - tref;
1100   tref = t;
1101   lc += 3;
1102   goto L10;
1103
1104  L210:
1105   /*     character string vector */
1106   if (C2F(errgst).err1 <= 0) {
1107     n = *istk(1 + lc) * *istk(2 + lc);
1108     nc = *istk(lc + 4 + n) - 1;
1109     ++Top;
1110     il = Lstk[Top] + Lstk[Top] - 1;
1111     i2 = il + 5 + n + nc;
1112     Err = i2 / 2 + 1 - Lstk[Bot];
1113     if (Err > 0 || C2F(errgst).err1 > 0) {
1114       SciError(17);
1115       lc = lc + 5 + n + nc;
1116       goto L10;
1117     }
1118     i2 = n + 5 + nc;
1119     C2F(icopy)(&i2, istk(lc), &c__1, istk(il), &c__1);
1120     *istk(il) = 10;
1121     i2 = il + 5 + n + nc;
1122     Lstk[1 + Top] = i2 / 2 + 1;
1123   }
1124   lc = lc + 5 + n + nc;
1125   goto L10;
1126  L220:
1127   /*     varfun */
1128   C2F(varfunptr)(istk(3 + lc), istk(1 + lc), istk(2 + lc));
1129   lc += 9;
1130   goto L10;
1131  L230:
1132   /*     affectation */
1133   Lhs = *istk(1 + lc);
1134   ip = *istk(2 + lc);
1135   li = lc + 3;
1136   lc = li + Lhs * 7;
1137   /*     following code is an adaptation of corresponding code in parse.f */
1138   ndel = 0;
1139  L231:
1140   Rhs = *istk(6 + li);
1141   lastindpos = Top - Lhs - ndel;
1142   if (C2F(errgst).err1 != 0) {
1143     goto L253;
1144   }
1145   if (Rhs == 0) {
1146     /* goto simple affectation */
1147     C2F(stackp)(istk(li), &c__0);
1148     if (Err > 0 || C2F(errgst).err1 > 0) {
1149       goto L10;
1150     }
1151     if (C2F(errgst).err1 > 0) {
1152       goto L253;
1153     }
1154     /* fin points on the newly saved variable */
1155     if (!(Lct[4] >= 0 && ip != semi && Fin != 0)) goto L253;
1156     ifin=Fin;
1157   L232:
1158     C2F(print)(istk(li), &ifin, &C2F(iop).wte);
1159     if (Rstk[Pt]!=1101) goto L253;
1160     ++Pt;
1161     Pstk[Pt] = li;
1162     Ids[1 + Pt * nsiz] = ndel;
1163     Ids[2 + Pt * nsiz] = lastindpos;
1164     Ids[3 + Pt * nsiz] = tref;
1165     Ids[4 + Pt * nsiz] = l0;
1166     Ids[5 + Pt * nsiz] = Lhs;
1167     Ids[6 + Pt * nsiz] = nc;
1168     Rstk[Pt]=609;
1169     return 0;
1170   L240:
1171     li = Pstk[Pt];
1172     ip = *istk(li-1);
1173     ndel =       Ids[1 + Pt * nsiz];
1174     lastindpos = Ids[2 + Pt * nsiz];
1175     tref =       Ids[3 + Pt * nsiz];
1176     l0 =         Ids[4 + Pt * nsiz];
1177     Lhs =        Ids[5 + Pt * nsiz];
1178     nc =         Ids[6 + Pt * nsiz];
1179     --Pt;
1180     /*goto L253;*/
1181     goto L232;
1182
1183   }
1184
1185   /*     take rhs (number of indices) computed at runtime into account */
1186   C2F(adjustrhs)();
1187   /*     partial variable affectation (insertion) */
1188   if (lastindpos + 1 != Top) {
1189     /* create reference variables to get index1,...,indexn, value at */
1190     /* the top of the stack in this order */
1191     /* create reference variables pointing to the  indices */
1192     for (ir = 1; ir <= Rhs; ++ir) {
1193       i2 = lastindpos - Rhs + ir;
1194       C2F(createref1)(&i2);
1195     }
1196     /* create reference variable pointing to the value */
1197     i2 = Top - Rhs;
1198     C2F(createref1)(&i2);
1199     /* remind to remove the original indices */
1200     ndel += Rhs;
1201   }
1202   lastindpos -= Rhs;
1203   /*     put a reference to the lhs variable */
1204   Fin = -3;
1205   C2F(stackg)(istk(li));
1206   if (Err > 0 || C2F(errgst).err1 > 0) {
1207     goto L10;
1208   }
1209   /*     perform insertion operation */
1210   /*     index1,...,indexn, value ==> updated lhs value (or pointer to) */
1211   if (Eptover(1)) {
1212     return 0;
1213   }
1214   /*     pstk(pt) is used by allops to get the name of output variable */
1215   Pstk[Pt] = li;
1216   Ids[1 + Pt * nsiz] = ndel;
1217   Ids[2 + Pt * nsiz] = lastindpos;
1218   Ids[3 + Pt * nsiz] = tref;
1219   Ids[4 + Pt * nsiz] = l0;
1220   Ids[5 + Pt * nsiz] = Lhs;
1221   Ids[6 + Pt * nsiz] = nc;
1222   Rstk[Pt] = 607;
1223   Rhs += 2;
1224   Lhs = 1;
1225   C2F(recu).icall = 4;
1226   Fin = insert;
1227   /*     *call* allops(insert) */
1228   return 0;
1229  L250:
1230   li = Pstk[Pt];
1231   ip = *istk(li-1);
1232   ndel =       Ids[1 + Pt * nsiz];
1233   lastindpos = Ids[2 + Pt * nsiz];
1234   tref =       Ids[3 + Pt * nsiz];
1235   l0 =         Ids[4 + Pt * nsiz];
1236   Lhs =        Ids[5 + Pt * nsiz];
1237   nc =         Ids[6 + Pt * nsiz];
1238   --Pt;
1239   /*     store the updated value */
1240   C2F(stackp)(istk(li), &c__0);
1241
1242   if (Err > 0 || C2F(errgst).err1 > 0) {
1243     goto L10;
1244   }
1245   if (C2F(errgst).err1 > 0) {
1246     goto L253;
1247   }
1248   /*     fin points on the newly saved variable */
1249   if (!(Lct[4] >= 0 && ip != semi && Fin != 0))  goto L252;
1250   ifin=Fin;
1251  L251:
1252   C2F(print)(istk(li), &ifin, &C2F(iop).wte);
1253   if (Rstk[Pt]!=1101) goto L252;
1254   ++Pt;
1255   Pstk[Pt] = li;
1256   Ids[1 + Pt * nsiz] = ndel;
1257   Ids[2 + Pt * nsiz] = lastindpos;
1258   Ids[3 + Pt * nsiz] = tref;
1259   Ids[4 + Pt * nsiz] = l0;
1260   Ids[5 + Pt * nsiz] = Lhs;
1261   Ids[6 + Pt * nsiz] = nc;
1262   Rstk[Pt]=608;
1263   return 0;
1264  L254:
1265   li = Pstk[Pt];
1266   ip = *istk(li-1);
1267   ndel =       Ids[1 + Pt * nsiz];
1268   lastindpos = Ids[2 + Pt * nsiz];
1269   tref =       Ids[3 + Pt * nsiz];
1270   l0 =         Ids[4 + Pt * nsiz];
1271   Lhs =        Ids[5 + Pt * nsiz];
1272   nc =         Ids[6 + Pt * nsiz];
1273   --Pt;
1274   goto L251;
1275
1276  L252:
1277   /*     remove variable containing the value if required */
1278   if (lastindpos != Top)   --Top;
1279
1280  L253:
1281   li += 7;
1282   --Lhs;
1283   if (Lhs > 0) {
1284     goto L231;
1285   }
1286   Top -= ndel;
1287   lc = li;
1288   goto L10;
1289
1290   /*     logical expression shortcircuit */
1291  L260:
1292   if (*istk(1 + lc) == 1) {
1293     /* | case */
1294     if (C2F(gettype)(&Top) != sci_ints && Istrue(0)) {
1295       lc += *istk(2 + lc);
1296     }
1297   } else {
1298     /* & case */
1299     if (C2F(gettype)(&Top) != sci_ints && ! Istrue(0)) {
1300       lc += *istk(2 + lc);
1301     }
1302   }
1303   lc += 3;
1304   goto L10;
1305  /*     comment */
1306  L261:
1307
1308   lc += 2+*istk(1 + lc);
1309   goto L10;
1310
1311  /*     try catch */
1312  L270:
1313   nc = *istk(1 + lc);
1314   lc += 3;
1315   l0 = lc;
1316   if (Ptover(1)) {
1317     lc += nc;
1318     lc += nsiz + *istk(lc);
1319     goto L10;
1320   }
1321   Rstk[Pt] = 618;
1322   Ids[1 + Pt * nsiz] = l0;
1323   /* preserve current error modes */
1324   Ids[2 + Pt * nsiz] = C2F(errgst).errct;
1325   Ids[3 + Pt * nsiz] = C2F(errgst).err2;
1326   Ids[4 + Pt * nsiz] = C2F(errgst).err1;
1327   Ids[5 + Pt * nsiz] = C2F(errgst).errpt;
1328   Ids[6 + Pt * nsiz] = (Lct[4]+100)+10000*C2F(com).sym;
1329   /* set error recovery mode without message*/
1330   C2F(errgst).errct = -(900000+1);
1331   C2F(errgst).errpt = Pt;
1332   Pstk[Pt] = Top;
1333   goto L10;
1334  L271:
1335   /* try op-codes finished*/
1336   l0 = Ids[1 + Pt * nsiz];
1337   /*check if an error occured*/
1338   ok = Max(C2F(errgst).err2,C2F(errgst).err1)<=0;
1339   /* restore preserved error modes */
1340   C2F(errgst).errct = Ids[2 + Pt * nsiz];
1341   C2F(errgst).err2  = Ids[3 + Pt * nsiz];
1342   C2F(errgst).err1  = Ids[4 + Pt * nsiz];
1343   C2F(errgst).errpt = Ids[5 + Pt * nsiz];
1344   C2F(com).sym      = Ids[6 + Pt * nsiz]/10000;
1345   Lct[4]            = Ids[6 + Pt * nsiz]-10000*C2F(com).sym - 100;
1346   if (ok) {
1347     /* no error occured in the try part*/
1348     nc = *istk(l0-1);
1349     lc += nc; /*skip catch  instructions*/
1350     /* finish try catch context and continue*/
1351     --Pt;
1352     goto L70;
1353   }
1354   /*an error occured in the try part*/
1355   lc = l0+*istk(l0-2);/*skip remaining try instruction*/
1356   nc = *istk(l0-1);
1357   /*execute catch instructions (next op-codes)*/
1358   l0 = lc;
1359   Rstk[Pt] = 619;
1360   goto L10;
1361  L272:
1362   /* catch op-codes finished*/
1363   /* close "try catch" context and continue*/
1364   --Pt;
1365   goto L70;
1366
1367
1368  L998:
1369   Lhs = 0;
1370  L999:
1371   /*remove context down to current running macro */
1372   if (Rstk[Pt] != 501) {
1373     --Pt;
1374     goto L999;
1375   }
1376   C2F(com).fun = 0;
1377   return 0;
1378 #undef ix
1379 #undef x
1380 }
1381
1382
1383
1384 int C2F(adjustrhs)(void)
1385 {
1386   /* to adjust rhs in the case it is only fixed at run time example
1387   *  l=list(....); foo(a,l(2:3)).  the parser supposes that the rhs
1388   *  for foo is 2. at run time it is really 3. See begrhs.
1389   * Copyright INRIA
1390   * Author S. Steer
1391   */
1392   static int    *Ids  = C2F(recu).ids-nsiz-1;
1393   static int    *Rstk = C2F(recu).rstk-1;
1394   static int    *Pstk = C2F(recu).pstk-1;
1395
1396   if (Rstk[Pt] == 617) {
1397     Rhs += Pstk[Pt];
1398     --Pt;
1399   } else if (Rstk[Pt] == 501) {
1400     /* retained for 2.4.1 compatiblity */
1401     Rhs += Ids[5 + Pt * nsiz];
1402     Ids[5 + Pt * nsiz] = 0;
1403   }
1404   return 0;
1405 }