Patrick
/
Nife_v0
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
Nife version Beta
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2 Commits
1 Branch
631 KiB
 
 
 
 
Tree: cfaac31344
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from 'cfaac31344'
${ noResults }
Nife_v0/src/stackN.c

1898 lines
41 KiB
Raw Blame History 

  1. /* Copyright (C) 2011-2014  Patrick H. E. Foubet - S.E.R.I.A.N.E.

  2. 

  3. This program is free software: you can redistribute it and/or modify

  4. it under the terms of the GNU General Public License as published by

  5. the Free Software Foundation, either version 3 of the License, or any

  6. later version.

  7. 

  8. This program is distributed in the hope that it will be useful,

  9. but WITHOUT ANY WARRANTY; without even the implied warranty of

  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

  11. GNU General Public License for more details.

  12. 

  13. You should have received a copy of the GNU General Public License

  14. along with this program.  If not, see <http://www.gnu.org/licenses/>

  15. *******************************************************************/

  16. /* stackN.c */

  17. #include "conf.h"

  18. 

  19. #include <stdio.h>

  20. #include <stdlib.h>

  21. #include <string.h>

  22. #include <strings.h>

  23. #include <sys/types.h>

  24. #include <math.h>

  25. 

  26. #include "nife.h"

  27. #include "mth.h"

  28. #include "err.h"

  29. #include "lib.h"

  30. #include "stackN.h"

  31. #include "stackL.h"

  32. #include "stackF.h"

  33. #include "stackV.h"

  34. #include "debug.h"

  35. #include "net.h"

  36. #include "scs.h"

  37. 

  38. #define _VERIF_STACK_ if (StackN == VIDE) { messErr(2); return; }

  39. 

  40. 

  41. void IF_vars(void)

  42. {

  43. char * L;

  44.     printf("DEBUG : ");

  45.     if (Debug) printf("ON"); else printf("OFF");

  46.     printf("\nDefault type=");

  47.     if (DOUBLE) printf("REAL"); else printf("INTEGER");

  48.     printf("\nDefault echo=");

  49.     if (ECHOOFF) printf("OFF"); else printf("ON");

  50.     printf("\nNetServer : \"%s\"",NetServer);

  51.     printf("\nSCS Key   : 0x%lx",(long)getScs());

  52.     printf("\nNetKey    : 0x%lx",(long)NetKey);

  53.     printf("\nVARS : ");

  54.     switch(VARS) {

  55.        case 1 :

  56.          printf("DOWN");

  57.          break;

  58.        case 2 :

  59.          printf("UP");

  60.          break;

  61.        default :

  62.          printf("OFF");

  63.          break;

  64.     }

  65.     printf("\nVariable Function : ");

  66.     if ((L=libByAddr(FCT_INST)) != NULL) printf("%s (std lib)",L);

  67.     else {

  68.       if ((L=fctByAddr(FCT_INST)) != NULL) printf("%s (user function)",L);

  69.         else {

  70.           if ((L=varByAddr(FCT_INST)) != NULL) printf("%s (variable)",L);

  71.           else printf("none");

  72.         }

  73.     }

  74.     printf("\nNBTAB=%d\nNBLIG=%d\n",NBTAB,NBLIG);

  75. }

  76. 

  77. void IF_REAL(void) { _MODIF_DOUBLE_(1); }

  78. void IF_INTEGER(void) { _MODIF_DOUBLE_(0); }

  79. 

  80. void IF_ECHOFF(void) { _MODIF_ECHOOFF_(1); }

  81. void IF_ECHOON(void) { _MODIF_ECHOOFF_(0); }

  82. 

  83. /* IMPORTANT **************************

  84.    la taille t est codee sur 30 bits + a droite

  85.    B31 = 1 si Var

  86.    B32 = 1 si REAL 

  87. **********************/

  88. #define MSK_T    (uint32_t)(0x3FFFFFFF)

  89. #define MSK_V    (uint32_t)(0x40000000)

  90. #define MSK_R    (uint32_t)(0x80000000)

  91. 

  92. struct Num {

  93.     uint32_t t; /* taille : cf precisions ci-dessus */

  94.     uint32_t key; /* net key */

  95.     void *n;

  96.     union {

  97.       long long l;

  98.       double d;

  99.     };

  100. };

  101. 

  102. int lAdrNum(void)

  103. {

  104. struct Num N;

  105.    return((char*)&(N.l) - (char*)&(N.n));

  106. }

  107. 

  108. void putLong(long long l)

  109. {

  110. void * M;

  111. struct Num * N;

  112.     if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("putLong","malloc");

  113.     N = (struct Num*)M;

  114.     N->t = 1;

  115.     N->n = StackN;

  116.     N->l = l;

  117.     _MODIF_STACKN_(M);

  118. }

  119. 

  120. void putDouble(double d)

  121. {

  122. void * M;

  123. struct Num * N;

  124.     if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("putDouble","malloc");

  125.     N = (struct Num*)M;

  126.     N->t = 1 | MSK_R;

  127.     N->n = StackN;

  128.     N->d = d;

  129.     _MODIF_STACKN_(M);

  130. }

  131. 

  132. int putVal(char *V)

  133. {

  134. void * M;

  135. char * R;

  136. struct Num * N;

  137. long long l;

  138. double d;

  139. #ifdef DEBUG

  140.     printf("putVal (%s) \n",V);

  141. #endif

  142.     l = strtoll(V,&R,0);

  143.     if (strlen(R)==0) {

  144.        if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("putVal","malloc");

  145.        N = (struct Num*)M;

  146.        N->t = 1;

  147.        N->n = StackN;

  148.        N->l = l;

  149.        if (fctEnCours) makeFct(T_NUM,M);

  150.        else _MODIF_STACKN_(M);

  151.        return 1;

  152.     } else {

  153.        d = strtod(V,&R);

  154.        if (strlen(R)==0) {

  155.          if ((M=malloc(sizeof(struct Num))) == NULL) stopErr("putVal","malloc");

  156.          N = (struct Num*)M;

  157.          N->t = 1 | MSK_R;

  158.          N->n = StackN;

  159.          N->d = d;

  160.          if (fctEnCours) makeFct(T_NUM,M);

  161.          else _MODIF_STACKN_(M);

  162.          return 1;

  163.        }

  164.     }

  165.     return 0;

  166. }

  167. 

  168. static int isScalar(void)

  169. {

  170. struct Num *Elt;

  171. int t;

  172.    if(StackN == VIDE) return 0;

  173.    Elt = (struct Num *)StackN;

  174.    if ((t = Elt->t&MSK_T) == 1) return 1;

  175.    return 0;

  176. }

  177. 

  178. static int dropElt(void)

  179. {

  180. struct Num *Elt;

  181.    if(StackN == VIDE) return 0;

  182.    Elt = (struct Num *)StackN;

  183.    _MODIF_STACKN_(Elt->n);

  184.    if (!(Elt->t&MSK_V)) free((void*)Elt);

  185.    return 1;

  186. }

  187. 

  188. void IF_drop(void)

  189. {

  190.    _VERIF_STACK_

  191.    dropElt();

  192. }

  193. 

  194. 

  195. static long long getVal(void)

  196. {

  197. struct Num *Elt;

  198.    Elt = (struct Num *)StackN;

  199.    if (Elt->t & MSK_R) return((long long)Elt->d);

  200.    else  return(Elt->l);

  201. }

  202. 

  203. void IF_vers(void)

  204. {

  205.     putDouble(atof(VERSION));

  206. }

  207. 

  208. /* fonction pour les autres */

  209. int getParLong(long *V)

  210. {

  211.    if (StackN == VIDE) { 

  212.         messErr(2); return 0 ;

  213.    }

  214.    if (!isScalar()) {

  215.         messErr(36); return 0 ;

  216.    }

  217.    *V = (long)getVal();

  218.    dropElt();

  219.    return 1;

  220. }

  221. 

  222. 

  223. void putVar(void * V)

  224. {

  225. struct Num *Elt;

  226.    if (V==VIDE) return;

  227.    Elt = (struct Num *)V;

  228.    Elt->n = StackN;

  229.    _MODIF_STACKN_(V);

  230. }

  231. 

  232. void * getVar(void)

  233. {

  234. void * N;

  235. struct Num *Elt;

  236.    N = StackN;

  237.    if (N != VIDE) {

  238.       Elt = (struct Num *)N;

  239.       _MODIF_STACKN_(Elt->n); /* drop no free !! */

  240.       Elt->n = VIDE;

  241.       Elt->t = Elt->t|MSK_V; /* VARIABLE ! */

  242.    }

  243.    return N;

  244. }

  245. 

  246. void IF_NBTAB(void)

  247. {

  248. long V;

  249.    if (getParLong(&V)) _MODIF_NBTAB_(V);

  250. }

  251. 

  252. void IF_NBLIG(void)

  253. {

  254. long V;

  255.    if (getParLong(&V)) _MODIF_NBLIG_(V);

  256. }

  257. 

  258. void IF_VAROFF(void) { _MODIF_VARS_(0); }

  259. void IF_VARDOWN(void) { _MODIF_VARS_(1); }

  260. void IF_VARUP(void) { _MODIF_VARS_(2); }

  261. 

  262. void insertVal(void*A)

  263. {

  264. void * M;

  265. struct Num *Elt;

  266.     if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("insertVal","malloc");

  267.     bcopy(A,M,sizeof(struct Num));

  268.     Elt=(struct Num*)M;

  269.     Elt->n = StackN;

  270.     _MODIF_STACKN_(M);

  271. }

  272. 

  273. static void Ramp(int D)

  274. {

  275. long n, i, dep=1;

  276. void * M;

  277. struct Num * N;

  278. long long *T;

  279.    _VERIF_STACK_

  280.    if (!isScalar()) {

  281.        messErr(36); return;

  282.    }

  283.    n = (long)getVal();

  284.    dropElt();

  285.    if (n > 1) {

  286.     if (D) { /* double ramp */

  287.         dep = -n;

  288.         n = (2*n) +1;

  289.     }

  290.     if ((M = malloc(sizeof(struct Num)+((n-1)*(sizeof(double))))) == NULL)

  291.              stopErr("Ramp","malloc");

  292.     N = (struct Num*)M;

  293.     N->t = n;

  294.     N->n = StackN;

  295.     _MODIF_STACKN_(M);

  296.     T = &(N->l);

  297.     for(i=0;i<n;i++) T[i]=i+dep;

  298.    } else messErr(30);

  299. }

  300. 

  301. void IF_ramp(void)

  302. {

  303.     Ramp(0);

  304. }

  305. 

  306. void IF_dramp(void)

  307. {

  308.     Ramp(1);

  309. }

  310. 

  311. void IF_stack_clear(void)

  312. { 

  313.     while (StackN != VIDE) dropElt();

  314. }

  315. 

  316. #define ELT_POINT -9

  317. static void printElt(struct Num * N, long I)

  318. {

  319. long n, i, m, nt, IB;

  320. long long *l;

  321. double *d;

  322.    IB = I;

  323.    n = N->t&MSK_T;

  324.    if (IB < 0) nt = 3;

  325.    else nt = NBTAB;

  326.    if (n > nt) m=nt-1;

  327.    else m=n-1;

  328.    if (I==ELT_POINT) {

  329.       IB=0;

  330.       n=2;

  331.       m=1;

  332.    }

  333.    if (IB) printf(" ");

  334.    if(N->t & MSK_R) {

  335.          if (n==1) printf("%g (REAL)",N->d);

  336.          else  {

  337.             d = &N->d;

  338.             for(i=0;i<m;i++) printf("%g ",*d++);

  339.             if (I==ELT_POINT) return;

  340.             if (n > nt) printf("... ");

  341.             printf("%g (REAL)[%ld]",*(&N->d+(n-1)),n);

  342.          }

  343.    } else {

  344.          if (n==1) printf("%lld (INTEGER)",N->l);

  345.          else  {

  346.             l = &N->l;

  347.             for(i=0;i<m;i++) printf("%lld ",*l++);

  348.             if (I==ELT_POINT) return;

  349.             if (n > nt) printf("... ");

  350.             printf("%lld (INTEGER)[%ld]",*(&N->l+(n-1)),n);

  351.          }

  352.    }

  353.    if ((IB>0) && (N->t&MSK_V)) printf(" Var. %s",varByAddrA((void*)N));

  354.    if (IB==1) printf(" <- top");

  355.    if (IB) printf("\n");

  356. }

  357. 

  358. void printNumber(void * E)

  359. {

  360.    printElt((struct Num*)E, 0);

  361. }

  362. 

  363. void numVarOff(void * A)

  364. {

  365. struct Num * N;

  366.    N = (struct Num*) A;

  367.    N->t = N->t & ~MSK_V;

  368. }

  369. 

  370. void IF_show_stack(void)

  371. {

  372. void * Next;

  373. struct Num * N;

  374. long i=0,Nbl;

  375. char s;

  376.     Nbl=NBLIG;

  377.     Next = StackN;

  378.     while (Next != VIDE) {

  379.        N = (struct Num*) Next;

  380.        i++;

  381.        if (i<=Nbl) printElt(N,i);

  382.        Next = N->n;

  383.     }

  384.     if (i<=Nbl) printf("<end of stack>\n");

  385.     else {

  386.        if (i==Nbl+1) s = ' ';

  387.        else s = 's';

  388.        printf(" ... and %ld other%c element%c !\n",i-Nbl,s,s);

  389.     }

  390. }

  391. 

  392. void IF_point(void)

  393. {

  394. struct Num *Elt;

  395.    _VERIF_STACK_

  396.    Elt = (struct Num *)StackN;

  397.    printElt(Elt,ELT_POINT);

  398.    /* printf("\n"); */

  399.    dropElt();

  400. }

  401. 

  402. void * duplicateNum(void * S, int vSoff)

  403. {

  404. struct Num *Elt, *NElt;

  405. void * M;

  406. uint32_t n;

  407. int s;

  408.     Elt = (struct Num*)S;

  409.     n = Elt->t&MSK_T;

  410.     s = sizeof(struct Num)+((n-1)*(sizeof(double)));

  411.     if ((M = malloc(s)) == NULL) stopErr("dupElt","malloc");

  412.     bcopy((void*)Elt,M,s);

  413.     NElt = (struct Num *)M;

  414.     NElt->n = VIDE;

  415.     NElt->t = Elt->t;

  416.     if (vSoff) Elt->t = Elt->t & ~MSK_V; /* Source no more a Var */

  417.     return(M);

  418. }

  419. 

  420. static void dupElt(struct Num * Elt)

  421. {

  422. struct Num *NElt;

  423. void * M;

  424. uint32_t n;

  425. int s;

  426.       n = Elt->t&MSK_T;

  427.       s = sizeof(struct Num)+((n-1)*(sizeof(double)));

  428.       if ((M = malloc(s)) == NULL) stopErr("dupElt","malloc");

  429.       bcopy((void*)Elt,M,s);

  430.       NElt = (struct Num *)M;

  431.       NElt->n = StackN;

  432.       NElt->t = Elt->t & ~MSK_V; /* au cas ou Var */

  433.       _MODIF_STACKN_(M);

  434.       ;

  435. }

  436. 

  437. void IF_dup(void)

  438. {

  439.    _VERIF_STACK_

  440.    dupElt((struct Num *)StackN);

  441. }

  442. 

  443. void IF_swap(void)

  444. {

  445. struct Num *Elt, *Elt2;

  446.    _VERIF_STACK_

  447.    Elt = (struct Num *)StackN;

  448.    if (Elt->n != VIDE) {

  449.       _MODIF_STACKN_(Elt->n);

  450.       Elt2 = (struct Num *)StackN;

  451.       Elt->n = Elt2->n;

  452.       Elt2->n = (void*)Elt;

  453.    }

  454.    else messErr(4);

  455. }

  456. 

  457. void IF_over (void)

  458. {

  459. struct Num *Elt;

  460.    _VERIF_STACK_

  461.    Elt = (struct Num *)StackN;

  462.    if (Elt->n != VIDE)

  463.          dupElt((struct Num *)Elt->n);

  464.    else messErr(4);

  465. }

  466. 

  467. void IF_pick(void)

  468. {

  469. void * Next;

  470. struct Num * N;

  471. long n, i;

  472.   _VERIF_STACK_

  473.   if (!isScalar()) {

  474.        messErr(36); return;

  475.   }

  476.   n = (long)getVal();

  477.   dropElt();

  478.   if (n>0) {

  479.    Next = StackN;

  480.    i=1;

  481.    while (Next != VIDE) {

  482.        if (i==n) break;

  483.        N = (struct Num*) Next;

  484.        Next = N->n;

  485.        i++;

  486.    }

  487.    if (Next != VIDE) dupElt((struct Num *)Next);

  488.    else messErr(4);

  489.   } else messErr(29);

  490. }

  491. 

  492. static int rotateBid(long n, int d) /* d=0 : rot d=1 : unrot */

  493. {

  494. void **ANext;

  495. struct Num * N, *N1;

  496. long i;

  497.    ANext = _ADDR_STACKN_;

  498.    i=1;

  499.    while (*ANext != VIDE) {

  500.       if (i==n) break;

  501.       N = (struct Num*) *ANext;

  502.       ANext = &N->n;

  503.       i++;

  504.    }

  505.    if (*ANext != VIDE) {

  506.       N = (struct Num*) *ANext;

  507.       if (d) { /* unrot */

  508.          N1 = (struct Num*) StackN;

  509.          _MODIF_STACKN_(N1->n);

  510.          N1->n = N->n;

  511.          N->n = (void*)N1;

  512.       } else { /* rot */

  513.          *ANext = N->n;

  514.          N->n = StackN;

  515.          _MODIF_STACKN_((void*)N);

  516.       }

  517.       return 1;

  518.    } else return 0;

  519. }

  520. 

  521. void IF_rot(void)

  522. {

  523.    if (!rotateBid(3L,0)) messErr(4);

  524. }

  525. 

  526. void IF_unrot(void)

  527. {

  528.    if (!rotateBid(3L,1)) messErr(4);

  529. }

  530. 

  531. void IF_roll(void)

  532. {

  533. long n;

  534.   _VERIF_STACK_

  535.   if (!isScalar()) {

  536.        messErr(36); return;

  537.   }

  538.   n = (long)getVal();

  539.   dropElt();

  540.   if (n>1) {

  541.    if (!rotateBid(n,0)) messErr(4);

  542.   } else messErr(30);

  543. }

  544. 

  545. void IF_unroll(void)

  546. {

  547. long n;

  548.   _VERIF_STACK_

  549.   if (!isScalar()) {

  550.        messErr(36); return;

  551.   }

  552.   n = (long)getVal();

  553.   dropElt();

  554.   if (n>1) {

  555.    if (!rotateBid(n,1)) messErr(4);

  556.   } else messErr(30);

  557. }

  558. 

  559. void IF_depth(void)

  560. {

  561. void * Next;

  562. struct Num * N;

  563. long long i=0;

  564.     Next = StackN;

  565.     while (Next != VIDE) {

  566.        N = (struct Num*) Next;

  567.        i++;

  568.        Next = N->n;

  569.     }

  570.     putLong(i);

  571. }

  572. 

  573. int nbOnStack(void* A)

  574. {

  575. void * Next;

  576. struct Num * N;

  577. int i=0;

  578.     Next = StackN;

  579.     while (Next != VIDE) {

  580.        N = (struct Num*) Next;

  581.        if (Next == A) i++;

  582.        Next = N->n;

  583.     }

  584.     return i;

  585. }

  586. 

  587. static uint32_t nbSizeTypeOnStack(uint32_t n,uint32_t *T)

  588. {

  589. void * Next;

  590. struct Num * N;

  591. uint32_t i=0, D=0, S=0;

  592.     Next = StackN;

  593.     while (Next != VIDE) {

  594.        N = (struct Num*) Next;

  595.        S += N->t&MSK_T;

  596.        if (N->t&MSK_R) D=1;

  597.        Next = N->n;

  598.        i++;

  599.        if (i==n) break;

  600.     }

  601.     if (D) S = S|MSK_R;

  602.     *T = S;

  603.     return i;

  604. }

  605. 

  606. void IF_Ndrop(void)

  607. {

  608. long n, i;

  609.    _VERIF_STACK_

  610.    if (!isScalar()) {

  611.        messErr(36); return;

  612.    }

  613.    n = (long)getVal();

  614.    dropElt();

  615.    for(i=0;i<n;i++) if (!dropElt()) break;

  616.    if (i<n) messErr(4); /* erreur pour la rigueur ! */

  617. }

  618. 

  619. void IF_Ndup(void)

  620. {

  621. void *Next, *M, *NewS, **P;

  622. struct Num * Elt, * NElt;

  623. uint32_t n, i=0, t;

  624. int s;

  625.    _VERIF_STACK_

  626.    if (!isScalar()) {

  627.        messErr(36); return;

  628.    }

  629.    n = (long)getVal();

  630.    dropElt();

  631.    if (n>0) {

  632.     NewS=VIDE;

  633.     P=&NewS;

  634.     Next = StackN;

  635.     while (Next != VIDE) {

  636.        Elt = (struct Num*) Next;

  637.        t = Elt->t&MSK_T;

  638.        s = sizeof(struct Num)+((t-1)*(sizeof(double)));

  639.        if ((M = malloc(s)) == NULL) stopErr("IF_Ndup","malloc");

  640.        bcopy(Next,M,s);

  641.        *P = M;

  642.        NElt = (struct Num *)M;

  643.        NElt->t = NElt->t & ~MSK_V; /* au cas ou Var */

  644.        P=&NElt->n;

  645.        i++;

  646.        if (i==n) break;

  647.        Next = Elt->n;

  648.     }

  649.     NElt->n = StackN;

  650.     _MODIF_STACKN_(NewS);

  651.     if (i<n) messErr(4); /* erreur pour la rigueur ! */

  652.    } else messErr(29);

  653. }

  654. 

  655. static void toDouble(struct Num * N)

  656. {

  657. uint32_t n;

  658. int i;

  659. double *d;

  660. long long  *l;

  661.     if (N->t & MSK_R) return;

  662.     n = N->t&MSK_T;

  663.     d = &N->d;

  664.     l = &N->l;

  665.     for(i=0; i<n; i++) *d++ = (double)*l++;

  666.     N->t = N->t|MSK_R;

  667. }

  668. 

  669. /* NET Functions for STSP */

  670. 

  671. void IF_NetKey (void)

  672. {

  673.   _VERIF_STACK_

  674.   if (!isScalar()) {

  675.        messErr(36); return;

  676.   }

  677.   _MODIF_NetKey_((uint32_t)getVal());

  678.   dropElt();

  679. }

  680. 

  681. void IF_NetErrVal (void)

  682. {

  683.    putLong(-(long long)NetKey);

  684. }

  685. 

  686. void StackToNet(long n)

  687. {

  688. struct Num *Elt;

  689. int i;

  690. uint32_t t, l;

  691.    for (i=0; i<n ; i++) {

  692.       if(StackN == VIDE) break;

  693.       Elt = (struct Num *)StackN;

  694.       t = Elt->t&MSK_T;

  695.       l=(sizeof(struct Num)+((t-1)*(sizeof(double))));

  696.       Elt->key = NetKey;

  697.       sendDataC(StackN, l);

  698.       dropElt();

  699.    }

  700. }

  701. 

  702. int NetDepth(uint32_t k)

  703. {

  704. void * Next;

  705. struct Num * N;

  706. int v=0;

  707.     Next = StackN;

  708.     while (Next != VIDE) {

  709.        N = (struct Num*) Next;

  710.        if (N->key == k) v++;

  711.        Next = N->n;

  712.     }

  713.     return v;

  714. }

  715. 

  716. void NetToStack(int s, uint32_t k)

  717. {

  718. void * Next;

  719. struct Num * N;

  720. uint32_t t, l;

  721.     Next = StackN;

  722.     while (Next != VIDE) {

  723.        N = (struct Num*) Next;

  724.        if (N->key == k) {

  725.           t = N->t&MSK_T;

  726.           l=(sizeof(struct Num)+((t-1)*(sizeof(double))));

  727.           sendData(s, Next, l);

  728.        }

  729.        Next = N->n;

  730.     }

  731. }

  732. 

  733. void IF_show_netStack(uint32_t k)

  734. {

  735. void * Next;

  736. struct Num * N;

  737.     Next = StackN;

  738.     printf("<bottom of net stack>\n");

  739.     while (Next != VIDE) {

  740.        N = (struct Num*) Next;

  741.        if (k == UNI_KEY) {

  742.           printf("<0x%.8lx> ",(long)N->key);

  743.           printElt(N,(long)-1);

  744.        } else {

  745.           if (N->key == k) printElt(N,(long)-1);

  746.        }

  747.        Next = N->n;

  748.     }

  749.     printf("<top of net stack> key=0x%lx\n",(long)k);

  750. }

  751. 

  752. void IF_netDrop(uint32_t k)

  753. {

  754. void * Next, **ANext;

  755. struct Num * N;

  756.     Next = StackN;

  757.     ANext = _ADDR_STACKN_;

  758.     while (Next != VIDE) {

  759.        N = (struct Num*) Next;

  760.        if (k == N->key) {

  761.            *ANext = N->n;

  762.            free(Next);

  763.            Next = *ANext;

  764.            continue;

  765.        }

  766.        Next = N->n;

  767.        ANext = &(N->n);

  768.     }

  769. }

  770. 

  771. /* end of Net functions */

  772. 

  773. static void IF_fct_2(char O)

  774. {

  775. struct Num *Elt, *Elt2;

  776. long long ConstL, *l1, *l2;

  777. double ConstD, *d1, *d2;

  778. int D1=0, D2=0, T1, T2, i;

  779. int M_C, M_D, M_S; /* Mode Const : 1 ou 0 | Double : 1 ou 0 | Swap : 1 ou 0 */

  780. bool B=TRUE;

  781. 

  782.     _VERIF_STACK_

  783.     Elt = (struct Num *)StackN;

  784.     T1 = Elt->t&MSK_T;

  785.     D1 = Elt->t&MSK_R;

  786.     if (Elt->n == VIDE) {

  787.        messErr(4);

  788.        return;

  789.     }

  790.     Elt2 = (struct Num *)Elt->n;

  791.     T2 = Elt2->t&MSK_T;

  792.     D2 = Elt2->t&MSK_R;

  793.     /* si 2 tab de dim diff pas possible !! */

  794.     if ((T1>1) && (T2>1) && (T1!=T2)) {

  795.        messErr(3);

  796.        return;

  797.     }

  798.     M_S = M_C = M_D = 0;

  799.     if ((T1>1) && (T2==1)) {  /* on swap */

  800.        IF_swap();

  801.        D1=D2=0;

  802.        Elt = (struct Num *)StackN;

  803.        T1 = Elt->t&MSK_T;

  804.        D1 = Elt->t&MSK_R;

  805.        Elt2 = (struct Num *)Elt->n;

  806.        T2 = Elt2->t&MSK_T;

  807.        D2 = Elt2->t&MSK_R;

  808.        M_S=1;

  809.     }

  810.     if (D1!=D2) { /* on transforme long en double */

  811.         if (D2) toDouble(Elt); else toDouble(Elt2);

  812.         M_D = 1;

  813.     } else if(D1) M_D = 1;

  814.     l1 = &Elt->l;

  815.     l2 = &Elt2->l;

  816.     d1 = &Elt->d;

  817.     d2 = &Elt2->d;

  818.     if (T1==1) {

  819.         M_C=1;

  820.         if (M_D) ConstD = *d1;

  821.         else ConstL = *l1;

  822.     }

  823. /* pour debug

  824.     printf("T1=%d T2=%d M_C=%d M_D=%d M_S=%d ",T1,T2,M_C,M_D,M_S);

  825.     if (M_C)

  826.        if (M_D) printf("ConstD=%g",ConstD); else printf("ConstL=%lld",ConstL);

  827.     printf("\n");

  828. *****/

  829.     switch(O) {

  830.        case '+' :

  831.            if (M_C) {

  832.               if (M_D) for (i=0;i<T2;i++) *d2++ += ConstD;

  833.               else  for (i=0;i<T2;i++) *l2++ += ConstL;

  834.            } else {

  835.               if (M_D) for (i=0;i<T2;i++) *d2++ += *d1++;

  836.               else  for (i=0;i<T2;i++) *l2++ += *l1++;

  837.            }

  838.            break;

  839.        case '-' :

  840.            if (M_C) {

  841.               if (M_S) {

  842.                  if (M_D) for (i=0;i<T2;i++) *d2++ = ConstD - *d2;

  843.                  else  for (i=0;i<T2;i++) *l2++ = ConstL - *l2;

  844.               } else {

  845.                  if (M_D) for (i=0;i<T2;i++) *d2++ -= ConstD;

  846.                  else  for (i=0;i<T2;i++) *l2++ -= ConstL;

  847.               }

  848.            } else {

  849.               if (M_D) for (i=0;i<T2;i++) *d2++ -= *d1++;

  850.               else  for (i=0;i<T2;i++) *l2++ -= *l1++;

  851.            }

  852.            break;

  853.        case '*' :

  854.            if (M_C) {

  855.               if (M_D) for (i=0;i<T2;i++) *d2++ *= ConstD;

  856.               else  for (i=0;i<T2;i++) *l2++ *= ConstL;

  857.            } else {

  858.               if (M_D) for (i=0;i<T2;i++) *d2++ *= *d1++;

  859.               else  for (i=0;i<T2;i++) *l2++ *= *l1++;

  860.            }

  861.            break;

  862.        case '/' :

  863.            if (M_C) {

  864.               if (M_S) {

  865.                  if (M_D) for (i=0;i<T2;i++) *d2++ = ConstD / *d2;

  866.                  else  for (i=0;i<T2;i++) *l2++ = ConstL / *l2;

  867.               } else {

  868.                  if (M_D) for (i=0;i<T2;i++) *d2++ /= ConstD;

  869.                  else  for (i=0;i<T2;i++) *l2++ /= ConstL;

  870.               }

  871.            } else {

  872.               if (M_D) for (i=0;i<T2;i++) *d2++ /= *d1++;

  873.               else  for (i=0;i<T2;i++) *l2++ /= *l1++;

  874.            }

  875.            break;

  876.        case 'm' : /* min */

  877.          if (M_C) {

  878.            if (M_D) for(i=0;i<T2;i++) { if (*d2>ConstD) *d2=ConstD; d2++; }

  879.            else for(i=0;i<T2;i++) { if (*l2>ConstL) *l2=ConstL; l2++; }

  880.          } else {

  881.            if (M_D) for (i=0;i<T2;i++) { if (*d2>*d1) *d2=*d1; d2++; d1++; }

  882.            else  for (i=0;i<T2;i++) { if (*l2>*l1) *l2=*l1; l2++; l1++; }

  883.          }

  884.          break;

  885.        case 'M' : /* max */

  886.          if (M_C) {

  887.            if (M_D) for(i=0;i<T2;i++) { if (*d2<ConstD) *d2=ConstD; d2++; }

  888.            else for(i=0;i<T2;i++) { if (*l2<ConstL) *l2=ConstL; l2++; }

  889.          } else {

  890.            if (M_D) for (i=0;i<T2;i++) { if (*d2<*d1) *d2=*d1; d2++; d1++; }

  891.            else  for (i=0;i<T2;i++) { if (*l2<*l1) *l2=*l1; l2++; l1++; }

  892.          }

  893.          break;

  894.        case '%' : /* modulo */

  895.          if (M_C) {

  896.           if (M_S) {

  897.             if (M_D) for (i=0;i<T2;i++) *d2++ = fmod(ConstD,*d2);

  898.             else  for (i=0;i<T2;i++) *l2++ = ConstL % *l2;

  899.           } else {

  900.             if (M_D) for (i=0;i<T2;i++) *d2++ = fmod(*d2,ConstD);

  901.             else  for (i=0;i<T2;i++) *l2++ %= ConstL;

  902.           }

  903.          } else {

  904.           if (M_D) for (i=0;i<T2;i++) { *d2++ = fmod(*d2,*d1); d1++; }

  905.           else  for (i=0;i<T2;i++) *l2++ %= *l1++;

  906.          }

  907.          break;

  908.        case '^' : /* puissance */

  909.          if (! M_D) { /* passage en double force car + pratique */

  910.             toDouble(Elt); toDouble(Elt2);

  911.             if (M_C) ConstD=*d1;

  912.          }

  913.          if (M_C) {

  914.           if (M_S) {

  915.             for (i=0;i<T2;i++) *d2++ = pow(ConstD,*d2);

  916.           } else {

  917.             for (i=0;i<T2;i++) *d2++ = pow(*d2,ConstD);

  918.           }

  919.          } else {

  920.            for (i=0;i<T2;i++) { *d2++ = pow(*d2,*d1); d1++; }

  921.          }

  922.          break;

  923.        case '=' :  /* test egal */

  924.          if (M_C) {

  925.             if (M_D) for(i=0;i<T2;i++) {

  926.                  if (*d2 != ConstD) {B=FALSE; break;} d2++; }

  927.             else  for (i=0;i<T2;i++)  {

  928.                  if (*l2 != ConstL) {B=FALSE; break;} l2++; }

  929.          } else {

  930.             if (M_D) for (i=0;i<T2;i++) {

  931.                  if (*d2 != *d1) {B=FALSE; break;} d1++; d2++; }

  932.             else  for (i=0;i<T2;i++) {

  933.                  if (*l2 != *l1) {B=FALSE; break;} l1++; l2++; }

  934.          }

  935.          putBool(B);

  936.          dropElt(); /* suppression des 2 !! */

  937.          break;

  938.        case '#' :  /* test different */

  939.          if (M_C) {

  940.             if (M_D) for(i=0;i<T2;i++) {

  941.                  if (*d2 == ConstD) {B=FALSE; break;} d2++; }

  942.             else  for (i=0;i<T2;i++)  {

  943.                  if (*l2 == ConstL) {B=FALSE; break;} l2++; }

  944.          } else {

  945.             if (M_D) for (i=0;i<T2;i++) {

  946.                  if (*d2 == *d1) {B=FALSE; break;} d1++; d2++; }

  947.             else  for (i=0;i<T2;i++) {

  948.                  if (*l2 == *l1) {B=FALSE; break;} l1++; l2++; }

  949.          }

  950.          putBool(B);

  951.          dropElt(); /* suppression des 2 !! */

  952.          break;

  953.        case '<' :  /* test inf */

  954.          if (M_C) {

  955.            if (M_S) {

  956.             if (M_D) for(i=0;i<T2;i++) {

  957.                  if (*d2 < ConstD) {B=FALSE; break;} d2++; }

  958.             else  for (i=0;i<T2;i++)  {

  959.                  if (*l2 < ConstL) {B=FALSE; break;} l2++; }

  960.            } else {

  961.             if (M_D) for(i=0;i<T2;i++) {

  962.                  if (*d2 >= ConstD) {B=FALSE; break;} d2++; }

  963.             else  for (i=0;i<T2;i++)  {

  964.                  if (*l2 >= ConstL) {B=FALSE; break;} l2++; }

  965.            }

  966.          } else {

  967.             if (M_D) for (i=0;i<T2;i++) {

  968.                  if (*d2 >= *d1) {B=FALSE; break;} d1++; d2++; }

  969.             else  for (i=0;i<T2;i++) {

  970.                  if (*l2 >= *l1) {B=FALSE; break;} l1++; l2++; }

  971.          }

  972.          putBool(B);

  973.          dropElt(); /* suppression des 2 !! */

  974.          break;

  975.        case '>' :  /* test sup */

  976.          if (M_C) {

  977.            if (M_S) {

  978.             if (M_D) for(i=0;i<T2;i++) {

  979.                  if (*d2 > ConstD) {B=FALSE; break;} d2++; }

  980.             else  for (i=0;i<T2;i++)  {

  981.                  if (*l2 > ConstL) {B=FALSE; break;} l2++; }

  982.            } else {

  983.             if (M_D) for(i=0;i<T2;i++) {

  984.                  if (*d2 <= ConstD) {B=FALSE; break;} d2++; }

  985.             else  for (i=0;i<T2;i++)  {

  986.                  if (*l2 <= ConstL) {B=FALSE; break;} l2++; }

  987.            }

  988.          } else {

  989.             if (M_D) for (i=0;i<T2;i++) {

  990.                  if (*d2 <= *d1) {B=FALSE; break;} d1++; d2++; }

  991.             else  for (i=0;i<T2;i++) {

  992.                  if (*l2 <= *l1) {B=FALSE; break;} l1++; l2++; }

  993.          }

  994.          putBool(B);

  995.          dropElt(); /* suppression des 2 !! */

  996.          break;

  997.        case 'i' :  /* test inf ou egal */

  998.          if (M_C) {

  999.            if (M_S) {

  1000.             if (M_D) for(i=0;i<T2;i++) {

  1001.                  if (*d2 <= ConstD) {B=FALSE; break;} d2++; }

  1002.             else  for (i=0;i<T2;i++)  {

  1003.                  if (*l2 <= ConstL) {B=FALSE; break;} l2++; }

  1004.            } else {

  1005.             if (M_D) for(i=0;i<T2;i++) {

  1006.                  if (*d2 > ConstD) {B=FALSE; break;} d2++; }

  1007.             else  for (i=0;i<T2;i++)  {

  1008.                  if (*l2 > ConstL) {B=FALSE; break;} l2++; }

  1009.            }

  1010.          } else {

  1011.             if (M_D) for (i=0;i<T2;i++) {

  1012.                  if (*d2 > *d1) {B=FALSE; break;} d1++; d2++; }

  1013.             else  for (i=0;i<T2;i++) {

  1014.                  if (*l2 > *l1) {B=FALSE; break;} l1++; l2++; }

  1015.          }

  1016.          putBool(B);

  1017.          dropElt(); /* suppression des 2 !! */

  1018.          break;

  1019.        case 's' :  /* test sup ou egal */

  1020.          if (M_C) {

  1021.            if (M_S) {

  1022.             if (M_D) for(i=0;i<T2;i++) {

  1023.                  if (*d2 >= ConstD) {B=FALSE; break;} d2++; }

  1024.             else  for (i=0;i<T2;i++)  {

  1025.                  if (*l2 >= ConstL) {B=FALSE; break;} l2++; }

  1026.            } else {

  1027.             if (M_D) for(i=0;i<T2;i++) {

  1028.                  if (*d2 < ConstD) {B=FALSE; break;} d2++; }

  1029.             else  for (i=0;i<T2;i++)  {

  1030.                  if (*l2 < ConstL) {B=FALSE; break;} l2++; }

  1031.            }

  1032.          } else {

  1033.             if (M_D) for (i=0;i<T2;i++) {

  1034.                  if (*d2 < *d1) {B=FALSE; break;} d1++; d2++; }

  1035.             else  for (i=0;i<T2;i++) {

  1036.                  if (*l2 < *l1) {B=FALSE; break;} l1++; l2++; }

  1037.          }

  1038.          putBool(B);

  1039.          dropElt(); /* suppression des 2 !! */

  1040.          break;

  1041.        default :

  1042.          printf("%c : not yet implemented !\n",O);

  1043.        break;

  1044.     }

  1045.     dropElt(); /* suppression du 1er */

  1046. }

  1047. 

  1048. void IF_plus(void) { IF_fct_2('+'); }

  1049. void IF_moins(void) { IF_fct_2('-'); }

  1050. void IF_mult(void) { IF_fct_2('*'); }

  1051. void IF_div(void) { IF_fct_2('/'); }

  1052. void IF_min(void) { IF_fct_2('m'); }

  1053. void IF_max(void) { IF_fct_2('M'); }

  1054. void IF_modulo(void) { IF_fct_2('%'); }

  1055. void IF_puiss(void) { IF_fct_2('^'); }

  1056. void IF_neg(void)

  1057. {

  1058.     putLong((long long)-1);

  1059.     IF_mult();

  1060. }

  1061. 

  1062. void IF_Legal(void) { IF_fct_2('='); }

  1063. void IF_Ldiff(void) { IF_fct_2('#'); }

  1064. void IF_Lsup(void) { IF_fct_2('>'); }

  1065. void IF_Linf(void) { IF_fct_2('<'); }

  1066. void IF_Lsupeg(void) { IF_fct_2('s'); }

  1067. void IF_Linfeg(void) { IF_fct_2('i'); }

  1068. 

  1069. void IF_fctD_1(double(*f)(double))

  1070. {

  1071. struct Num *Elt;

  1072. uint32_t n;

  1073. long long *L;

  1074. double *D;

  1075. int i;

  1076.    _VERIF_STACK_

  1077.    Elt = (struct Num *)StackN;

  1078.    n = Elt->t&MSK_T;

  1079.    if (Elt->t&MSK_R) { /* double */

  1080.       D = &(Elt->d);

  1081.       for(i=0;i<n;i++) *D++ = f(*D);

  1082.    } else {

  1083.       D = &(Elt->d);

  1084.       L = &(Elt->l);

  1085.       for(i=0;i<n;i++) *D++ = f((double)*L++);

  1086.       Elt->t = Elt->t | MSK_R;

  1087.    }

  1088. }

  1089. 

  1090. void IF_fctB_1(long long (*f1)(long long), double(*f2)(double))

  1091. {

  1092. struct Num *Elt;

  1093. uint32_t n;

  1094. long long *L;

  1095. double *D;

  1096. int i;

  1097.    _VERIF_STACK_

  1098.    Elt = (struct Num *)StackN;

  1099.    n = Elt->t&MSK_T;

  1100.    if (Elt->t&MSK_R) { /* double */

  1101.       D = &(Elt->d);

  1102.       for(i=0;i<n;i++) *D++ = f2(*D);

  1103.    } else {

  1104.       L = &(Elt->l);

  1105.       for(i=0;i<n;i++) *L++ = f1(*L);

  1106.    }

  1107. }

  1108. 

  1109. void IF_fctD_1L(long long(*f)(double))

  1110. {

  1111. struct Num *Elt;

  1112. uint32_t n;

  1113. long long *L;

  1114. double *D;

  1115. int i;

  1116.    _VERIF_STACK_

  1117.    Elt = (struct Num *)StackN;

  1118.    n = Elt->t&MSK_T;

  1119.    if (Elt->t&MSK_R) { /* double */

  1120.       D = &(Elt->d);

  1121.       L = &(Elt->l);

  1122.       for(i=0;i<n;i++) *L++ = f(*D++);

  1123.       Elt->t = Elt->t & ~MSK_R; /* change type */

  1124.    }

  1125.    /* rien si long */

  1126. }

  1127. 

  1128. void IF_fctD_1LB(long long(*f)(double))

  1129. {

  1130. struct Num *Elt;

  1131. uint32_t n;

  1132. long long *L;

  1133. double *D;

  1134. int i;

  1135.    _VERIF_STACK_

  1136.    Elt = (struct Num *)StackN;

  1137.    n = Elt->t&MSK_T;

  1138.    D = &(Elt->d);

  1139.    L = &(Elt->l);

  1140.    if (Elt->t&MSK_R) { /* double */

  1141.       for(i=0;i<n;i++) *L++ = f(*D++);

  1142.       Elt->t = Elt->t & ~MSK_R; /* change type */

  1143.    } else {

  1144.       for(i=0;i<n;i++) *L++ = f(*L);

  1145.    }

  1146. }

  1147. 

  1148. void IF_inFile_1d(FILE * fd, char delim, int virg)

  1149. {

  1150. struct Num *Elt;

  1151. uint32_t n;

  1152. long long *L;

  1153. double *D;

  1154. int i;

  1155. char buf[40], *pt;

  1156.    _VERIF_STACK_

  1157.    Elt = (struct Num *)StackN;

  1158.    n = Elt->t&MSK_T;

  1159.    if (Elt->t&MSK_R) { /* double */

  1160.       D = &(Elt->d);

  1161.       for(i=0;i<n;i++) {

  1162.          sprintf(buf,"%.15f%c",*D++,delim);

  1163.          pt = buf + strlen(buf) - 2;

  1164.          while (*pt == '0') pt--;

  1165.          pt++;

  1166.          *pt++ = delim;

  1167.          *pt='\0';

  1168.          if (virg)

  1169.             if ((pt = strchr(buf, (int)'.')) != NULL) *pt = ',';

  1170.          fprintf(fd,buf);

  1171.       }

  1172.    } else {

  1173.       L = &(Elt->l);

  1174.       for(i=0;i<n;i++) fprintf(fd,"%lld%c",*L++,delim);

  1175.    }

  1176.    fprintf(fd,"\n");

  1177.    dropElt(); /* suppression */

  1178. }

  1179. 

  1180. void IF_inFile_1(FILE * fd)

  1181. {

  1182. struct Num *Elt;

  1183. uint32_t n;

  1184. long long *L;

  1185. double *D;

  1186. int i;

  1187.    _VERIF_STACK_

  1188.    Elt = (struct Num *)StackN;

  1189.    n = Elt->t&MSK_T;

  1190.    if (Elt->t&MSK_R) { /* double */

  1191.       D = &(Elt->d);

  1192.       for(i=0;i<n;i++) fprintf(fd,"%d %g\n",i,*D++);

  1193.    } else {

  1194.       L = &(Elt->l);

  1195.       for(i=0;i<n;i++) fprintf(fd,"%d %lld\n",i,*L++);

  1196.    }

  1197. }

  1198. 

  1199. void IF_inFile_2(FILE * fd)

  1200. {

  1201. struct Num *Elt, *Elt2;

  1202. uint32_t n, n2;

  1203. long long *L, *L2;

  1204. double *D, *D2;

  1205. int i;

  1206.    _VERIF_STACK_

  1207.    Elt = (struct Num *)StackN;

  1208.    n = Elt->t&MSK_T;

  1209.    Elt2 = Elt->n;

  1210.    n2 = Elt2->t&MSK_T;

  1211.    if (n>n2) n=n2;

  1212.    if (Elt->t&MSK_R) { /* double */

  1213.       D = &(Elt->d);

  1214.       if (Elt2->t&MSK_R) { /* double */

  1215.          D2 = &(Elt2->d);

  1216.          for(i=0;i<n;i++) fprintf(fd,"%g %g\n",*D2++,*D++);

  1217.       } else {

  1218.          L2 = &(Elt2->l);

  1219.          for(i=0;i<n;i++) fprintf(fd,"%lld %g\n",*L2++,*D++);

  1220.       }

  1221.    } else {

  1222.       L = &(Elt->l);

  1223.       if (Elt2->t&MSK_R) { /* double */

  1224.          D2 = &(Elt2->d);

  1225.          for(i=0;i<n;i++) fprintf(fd,"%g %lld\n",*D2++,*L++);

  1226.       } else {

  1227.          L2 = &(Elt2->l);

  1228.          for(i=0;i<n;i++) fprintf(fd,"%lld %lld\n",*L2++,*L++);

  1229.       }

  1230.    }

  1231. }

  1232. 

  1233. static int dimTab(void * A)

  1234. {

  1235. struct Num *N;

  1236. uint32_t l;

  1237.     if (A==VIDE) return 0L;

  1238.     N = (struct Num*)A;

  1239.     l = N->t&MSK_T;

  1240.     return (int)l;

  1241. }

  1242. 

  1243. static long transLongTo(long long * C)

  1244. {

  1245. struct Num *Elt;

  1246. int i;

  1247. uint32_t l;

  1248. long long *L;

  1249. double *D;

  1250.    Elt = (struct Num *)StackN;

  1251.    l = Elt->t&MSK_T;

  1252.    L = &(Elt->l)+l-1;

  1253.    D = &(Elt->d)+l-1;

  1254.    if (Elt->t & MSK_R)

  1255.       for (i=0;i<l;i++) *C--=(long long)*D--;

  1256.    else

  1257.       for (i=0;i<l;i++) *C--=*L--;

  1258.    dropElt();

  1259.    return(l);

  1260. }

  1261. 

  1262. static long transDoubTo(double * C)

  1263. {

  1264. struct Num *Elt;

  1265. int i;

  1266. uint32_t l;

  1267. long long *L;

  1268. double *D;

  1269.    Elt = (struct Num *)StackN;

  1270.    l = Elt->t&MSK_T;

  1271.    L = &(Elt->l)+l-1;

  1272.    D = &(Elt->d)+l-1;

  1273.    if (Elt->t & MSK_R)

  1274.       for (i=0;i<l;i++) *C--=*D--;

  1275.    else

  1276.       for (i=0;i<l;i++) *C--=(double)*L--;

  1277.    dropElt();

  1278.    return(l);

  1279. }

  1280. 

  1281. void IF_toArray( void )

  1282. {

  1283. uint32_t n, i, l, T, t;

  1284. long long  *L;

  1285. double *D;

  1286. void * M;

  1287. struct Num *N;

  1288.   _VERIF_STACK_

  1289.   if (!isScalar()) {

  1290.        messErr(36); return;

  1291.   }

  1292.   n = (uint32_t)getVal();

  1293.   dropElt();

  1294.   if (n>1) {

  1295.    i = nbSizeTypeOnStack(n,&t);

  1296.    if (i<n) messErr(4);

  1297.    else {

  1298.       T = t & MSK_T;      

  1299.       if ((M = malloc(sizeof(struct Num)+((T-1)*(sizeof(double))))) == NULL)

  1300.              stopErr("IF_toArray","malloc");

  1301.       N = (struct Num*)M;

  1302.       N->t = t;

  1303.       if (t & MSK_R) {

  1304.          D = &(N->d)+(T-1);

  1305.          for(i=0;i<n;i++) { l=transDoubTo(D); D -= l; }

  1306.       } else {

  1307.          L = &(N->l)+(T-1);

  1308.          for(i=0;i<n;i++) { l=transLongTo(L); L -= l; }

  1309.       }

  1310.       /* on the stack */

  1311.       N->n = StackN;

  1312.       _MODIF_STACKN_(M);

  1313.    }

  1314.   } else messErr(30);

  1315. }

  1316. 

  1317. static void toScalar( int s )

  1318. {

  1319. struct Num *Elt;

  1320. uint32_t l;

  1321. int i;

  1322. double *D;

  1323. long long * L;

  1324.    _VERIF_STACK_

  1325.    Elt = (struct Num *)StackN;

  1326.    l = Elt->t&MSK_T;

  1327.    if (l==1) return;

  1328.    _MODIF_STACKN_(Elt->n); /* depile */

  1329.    if (s) {

  1330.       L = &(Elt->l);

  1331.       D = &(Elt->d);

  1332.       if (Elt->t & MSK_R)

  1333.          for(i=0;i<l;i++) putDouble(*D++);

  1334.       else 

  1335.          for(i=0;i<l;i++) putLong(*L++);

  1336.    } else {

  1337.       L = &(Elt->l)+l-1;

  1338.       D = &(Elt->d)+l-1;

  1339.       if (Elt->t & MSK_R)

  1340.          for(i=0;i<l;i++) putDouble(*D--);

  1341.       else 

  1342.          for(i=0;i<l;i++) putLong(*L--);

  1343.    }

  1344.    if (!(Elt->t&MSK_V)) free((void*)Elt);

  1345. }

  1346. 

  1347. void IF_toScalar( void )

  1348. {

  1349.     toScalar(1);

  1350. }

  1351. 

  1352. void IF_toScalarR( void )

  1353. {

  1354.     toScalar(0);

  1355. }

  1356. 

  1357. static void tabShift(void **A,long s)

  1358. {

  1359. struct Num *Elt, *NElt;

  1360. void * M;

  1361. long j, k;

  1362. uint32_t l;

  1363. long long *L, *NL;

  1364.    _VERIF_STACK_

  1365.    Elt = (struct Num *)*A;

  1366.    l = Elt->t&MSK_T;

  1367.    if (l==1) return;

  1368.    if (s>0)

  1369.       while (s>=l) s-=l;

  1370.    else  while (-s>=l) s+=l;

  1371.    if (s==0) return;

  1372.    if (s>0) j=s;

  1373.    else j=l+s;

  1374.    k = sizeof(struct Num)+((l-1)*(sizeof(double)));

  1375.    if ((M = malloc(k)) == NULL) stopErr("tabShift","malloc");

  1376.    NElt = (struct Num *)M;

  1377.    *A = M;

  1378.    NElt->t = Elt->t;

  1379.    NElt->n = Elt->n;

  1380.    L = &(Elt->l);

  1381.    NL = &(NElt->l);

  1382.    k=l-j;

  1383.    bcopy((void*)&L[0],(void*)&NL[j],k*sizeof(long long));

  1384.    bcopy((void*)&L[k],(void*)&NL[0],j*sizeof(long long));

  1385.    if (!(Elt->t&MSK_V)) free((void*)Elt);

  1386. }

  1387. 

  1388. void IF_TShiftR( void )

  1389. {

  1390.    tabShift(_ADDR_STACKN_,1);

  1391. }

  1392. 

  1393. void IF_TShiftL( void )

  1394. {

  1395.    tabShift(_ADDR_STACKN_,-1);

  1396. }

  1397. 

  1398. static void nTabShift( int v )

  1399. {

  1400. void ** ANext;

  1401. struct Num * N;

  1402. long i=0, n;

  1403.    _VERIF_STACK_

  1404.    if (!isScalar()) {

  1405.        messErr(36); return;

  1406.    }

  1407.    n = (long)getVal();

  1408.    dropElt();

  1409.    if (n>0) {

  1410.     ANext = _ADDR_STACKN_;

  1411.     while (*ANext != VIDE) {

  1412.        tabShift(ANext,v);

  1413.        N = (struct Num*) *ANext;

  1414.        ANext = &(N->n);

  1415.        i++;

  1416.        if (i==n) break;

  1417.     }

  1418.    } else messErr(29);

  1419. }

  1420. 

  1421. void IF_NTShiftR( void )

  1422. {

  1423.    nTabShift(1);

  1424. }

  1425. 

  1426. void IF_NTShiftL( void )

  1427. {

  1428.    nTabShift(-1);

  1429. }

  1430. 

  1431. void IF_TNShiftR( void )

  1432. {

  1433. long n;

  1434.    _VERIF_STACK_

  1435.    if (!isScalar()) {

  1436.        messErr(36); return;

  1437.    }

  1438.    n = (long)getVal();

  1439.    dropElt();

  1440.    tabShift(_ADDR_STACKN_,n);

  1441. }

  1442. 

  1443. void IF_TNShiftL( void )

  1444. {

  1445. long n;

  1446.    _VERIF_STACK_

  1447.    if (!isScalar()) {

  1448.        messErr(36); return;

  1449.    }

  1450.    n = (long)getVal();

  1451.    dropElt();

  1452.    tabShift(_ADDR_STACKN_,-n);

  1453. }

  1454. 

  1455. static void nTNShift( int s )

  1456. {

  1457. long n;

  1458.    _VERIF_STACK_

  1459.    if (!isScalar()) {

  1460.        messErr(36); return;

  1461.    }

  1462.    n = (long)getVal();

  1463.    dropElt();

  1464.    nTabShift(n*s);

  1465. }

  1466. 

  1467. void IF_NTNShiftR( void )

  1468. {

  1469.     nTNShift(1);

  1470. }

  1471. 

  1472. void IF_NTNShiftL( void )

  1473. {

  1474.     nTNShift(-1);

  1475. }

  1476. 

  1477. static void subTab(void **pA , long n, char r) /* r=1 : right else left */

  1478. {

  1479. struct Num *Elt, *Elt2;

  1480. uint32_t l;

  1481. long k;

  1482. long long *L, *Lf;

  1483. void *A, * M;

  1484. double *D, *Df;

  1485. 

  1486.    _VERIF_STACK_

  1487.    A = *pA;

  1488.    Elt = (struct Num *)A;

  1489.    l = Elt->t&MSK_T;

  1490.    if (l==n) return;

  1491.    k = sizeof(struct Num)+((n-1)*(sizeof(long long)));

  1492.    if ((M = malloc(k)) == NULL) stopErr("subTab","malloc");

  1493.    Elt2 = (struct Num *)M;

  1494.    Elt2->n = Elt->n;

  1495.    Elt2->t = (Elt->t&MSK_R) | n;

  1496.    *pA = M;

  1497.    if (n<l) {

  1498.       L = &(Elt->l);

  1499.       if (r) L += (l-n);

  1500.       bcopy((void*)L,(void*)&(Elt2->l),n*sizeof(long long));

  1501.    } else { /* fill with zero */

  1502.       L = &(Elt2->l);

  1503.       if (!r) L += (n-l);

  1504.       bcopy((void*)&(Elt->l),(void*)L,l*sizeof(long long));

  1505.       if (Elt->t&MSK_R) {

  1506.          D = &(Elt2->d);

  1507.          if (r) D += l;

  1508.          Df = D + (n-l);

  1509.          while (D < Df) *D++ = (double)0;

  1510.       } else {

  1511.          L = &(Elt2->l);

  1512.          if (r) L += l;

  1513.          Lf = L + (n-l);

  1514.          while (L < Lf) *L++ = 0L;

  1515.       }

  1516.    }

  1517.    if (!(Elt->t&MSK_V)) free(A);

  1518. }

  1519. 

  1520. void IF_subTab(void)

  1521. {

  1522. long n;

  1523.    _VERIF_STACK_

  1524.    if (!isScalar()) {

  1525.        messErr(36); return;

  1526.    }

  1527.    n = (long)getVal();

  1528.    dropElt();

  1529.    if (n>0) subTab(_ADDR_STACKN_, n, 0);

  1530.    else messErr(29);

  1531. }

  1532. 

  1533. void IF_subTabR(void)

  1534. {

  1535. long n;

  1536.    _VERIF_STACK_

  1537.    if (!isScalar()) {

  1538.        messErr(36); return;

  1539.    }

  1540.    n = (long)getVal();

  1541.    dropElt();

  1542.    if (n>0) subTab(_ADDR_STACKN_, n, (char)1);

  1543.    else messErr(29);

  1544. }

  1545. 

  1546. static void NSubTab( char r )

  1547. {

  1548. void **pNext;

  1549. struct Num * N;

  1550. long i=0, n, l;

  1551.    _VERIF_STACK_

  1552.    if (!isScalar()) {

  1553.        messErr(36); return;

  1554.    }

  1555.    l = (long)getVal();

  1556.    dropElt();

  1557.    if (l>0) {

  1558.     if (!isScalar()) {

  1559.        messErr(36); return;

  1560.     }

  1561.     n = (long)getVal();

  1562.     dropElt();

  1563.     if (n>0) {

  1564.      pNext = _ADDR_STACKN_;

  1565.      while (*pNext != VIDE) {

  1566.        subTab(pNext,l,r);

  1567.        N = (struct Num*) *pNext;

  1568.        pNext = &(N->n);

  1569.        i++;

  1570.        if (i==n) break;

  1571.      }

  1572.     } else messErr(29);

  1573.    } else messErr(29);

  1574. }

  1575. 

  1576. void IF_NsubTab(void)

  1577. {

  1578.     NSubTab((char)0);

  1579. }

  1580. 

  1581. void IF_NsubTabR(void)

  1582. {

  1583.     NSubTab((char)1);

  1584. }

  1585. 

  1586. static void tabRev( void* A )

  1587. {

  1588. struct Num *Elt;

  1589. uint32_t l;

  1590. double *D, *FD, vD;

  1591. long long * L, *FL, vL;

  1592.    _VERIF_STACK_

  1593.    Elt = (struct Num *)A;

  1594.    l = Elt->t&MSK_T;

  1595.    if (l==1) return;

  1596.    if (Elt->t & MSK_R) {

  1597.       D = &(Elt->d);

  1598.       FD = D+l-1;

  1599.       while (D<FD) {

  1600.         vD=*D; *D=*FD; *FD=vD;

  1601.         D++; FD--;

  1602.       }

  1603.    } else  {

  1604.       L = &(Elt->l);

  1605.       FL=L+l-1;

  1606.       while (L<FL) {

  1607.         vL=*L; *L=*FL; *FL=vL;

  1608.         L++; FL--;

  1609.       }

  1610.    }

  1611. }

  1612. 

  1613. void IF_TabRev( void )

  1614. {

  1615.     tabRev(StackN);

  1616. }

  1617. 

  1618. void IF_NTabRev( void )

  1619. {

  1620. void * Next;

  1621. struct Num * N;

  1622. long i=0, n;

  1623.    _VERIF_STACK_

  1624.    if (!isScalar()) {

  1625.        messErr(36); return;

  1626.    }

  1627.    n = (long)getVal();

  1628.    dropElt();

  1629.    if (n>0) {

  1630.     Next = StackN;

  1631.     while (Next != VIDE) {

  1632.        N = (struct Num*) Next;

  1633.        tabRev(Next);

  1634.        Next = N->n;

  1635.        i++;

  1636.        if (i==n) break;

  1637.     }

  1638.    } else messErr(29);

  1639. }

  1640. 

  1641. static void tabTransp (int sens)

  1642. {

  1643. void * Next, *Next2, **Suiv, *SNext, **Last;

  1644. struct Num * N, *N2;

  1645. long i=0, j, n;

  1646. uint32_t l;

  1647. short Doub=0;

  1648. double *D, *D2;

  1649. long long *L, *L2;

  1650.   _VERIF_STACK_

  1651.   if (!isScalar()) {

  1652.        messErr(36); return;

  1653.   }

  1654.   n = (long)getVal();

  1655.   dropElt();

  1656.   if (n>0) {

  1657.    if (n==1) {

  1658.       if (sens) toScalar(1);

  1659.       else toScalar(0);

  1660.       return;

  1661.    }

  1662.    /* the n elts on stack must have the same dim */

  1663.    Next = StackN;

  1664.    while (Next != VIDE) {

  1665.       N = (struct Num*) Next;

  1666.       if (i) {

  1667.          if (l != (N->t&MSK_T)) break;

  1668.       } else l = N->t&MSK_T;

  1669.       if (N->t&MSK_R) Doub=1;

  1670.       i++;

  1671.       if (i==n) break;

  1672.       Next = N->n;

  1673.    }

  1674.    if (i!=n) {

  1675.      if (Next == VIDE) messErr(4);

  1676.      else messErr(3);

  1677.    } else {

  1678.      /* make l elts of dim n */

  1679.      Suiv = &Next2;

  1680.      for (i=0;i<l;i++) {

  1681.         if ((*Suiv=malloc(sizeof(struct Num)+((n-1)*(sizeof(double)))))==NULL)

  1682.            stopErr("tabTransp","malloc");

  1683.         N2 = (struct Num*) *Suiv;

  1684.         N2->t = n;

  1685.         if (Doub) N2->t |= MSK_R;

  1686.         /* remplissage */

  1687.         if (sens) {

  1688.            j=0;

  1689.            if (sens==1) {

  1690.               N2->n = SNext;

  1691.               SNext = Next2;

  1692.               if (i==0) Last = &(N2->n);

  1693.            } else

  1694.               Suiv = &N2->n;

  1695.         } else {

  1696.            j=n-1;

  1697.            Suiv = &N2->n;

  1698.         }

  1699.         if (Doub) {

  1700.            D2 = &(N2->d);

  1701.         } else {

  1702.            L2 = &(N2->l);

  1703.         }

  1704.         Next = StackN;

  1705.         while (Next != VIDE) {

  1706.            N = (struct Num*) Next;

  1707.            if (Doub) {

  1708.               if (N->t&MSK_R) {

  1709.                  D = &(N->d); 

  1710.                  if (sens) D+=(l-i-1);

  1711.                  else D+=i;

  1712.                  *(D2+j) = *D;

  1713.               } else {

  1714.                  L = &(N->l);

  1715.                  if (sens) L+=(l-i-1);

  1716.                  else L+=i;

  1717.                  *(D2+j) = (double)*L;

  1718.               }

  1719.            } else {

  1720.               L = &(N->l);

  1721.               if (sens) L+=(l-i-1);

  1722.               else L+=i;

  1723.               *(L2+j) = *L;

  1724.               /* printf("%ld ",*L); */

  1725.            }

  1726.            if (sens) {

  1727.               j++;

  1728.               if (j>=n) break;

  1729.            } else {

  1730.               j--;

  1731.               if (j<0) break;

  1732.            }

  1733.            Next = N->n;

  1734.         }

  1735.         /* printf("\n"); */

  1736.      }

  1737.      if (sens!=1) Last = &(N2->n);

  1738.      /* drop n elts */

  1739.      for (i=0;i<n;i++) dropElt();

  1740.      /* put new elts on the stack */

  1741.      *Last = StackN;

  1742.      _MODIF_STACKN_(Next2);

  1743.    }

  1744.   } else messErr(29);

  1745. }

  1746. 

  1747. void IF_TabTransp (void) /* crot */

  1748. {

  1749.    tabTransp(0);

  1750. }

  1751. 

  1752. void IF_TabTranspN (void) /* transpose */

  1753. {

  1754.    tabTransp(1);

  1755. }

  1756. 

  1757. void IF_TabTranspT (void) /* trot */

  1758. {

  1759.    tabTransp(-1);

  1760. }

  1761. 

  1762. int is1Tab(void)

  1763. {

  1764.     if (dimTab(StackN) < 2L) return 0;

  1765.     return 1;

  1766. }

  1767. 

  1768. int is2Tab(void)

  1769. {

  1770. struct Num *N;

  1771.     if (dimTab(StackN) < 2L) return 0;

  1772.     N = (struct Num*)StackN;

  1773.     if (dimTab(N->n) < 2L) return 0;

  1774.     return 1;

  1775. }

  1776. 

  1777. int isNTabSameDim(int n)

  1778. {

  1779. void * Next;

  1780. struct Num * N;

  1781. long i=0;

  1782. uint32_t l;

  1783.    /* the n elts on stack must have the same dim */

  1784.    Next = StackN;

  1785.    while (Next != VIDE) {

  1786.       N = (struct Num*) Next;

  1787.       if (i) {

  1788.          if (l != (long)(N->t&MSK_T)) break;

  1789.       } else l = N->t&MSK_T;

  1790.       i++;

  1791.       if (i==n) return 1; /* OK */

  1792.       Next = N->n;

  1793.    }

  1794.    return 0;

  1795. }

  1796. 

  1797. /* []functions ****/

  1798. 

  1799. static void TAB_Fct(char C)

  1800. {

  1801. struct Num *Elt;

  1802. uint32_t n;

  1803. long long *L, L1, L2;

  1804. double *D, D1, D2;

  1805. int i;

  1806.   _VERIF_STACK_

  1807.   Elt = (struct Num *)StackN;

  1808.   n = Elt->t&MSK_T;

  1809.   if (n>1) {

  1810.     if (Elt->t&MSK_R) { /* double */

  1811.       switch(C) {

  1812.         case 'm' :

  1813.           D1 = Elt->d;

  1814.           D = &(Elt->d)+1;

  1815.           for(i=1;i<n;i++) { if (*D<D1) D1=*D; D++; }

  1816.           putDouble(D1);

  1817.           break;

  1818.         case 'M' :

  1819.           D1 = Elt->d;

  1820.           D = &(Elt->d)+1;

  1821.           for(i=1;i<n;i++) { if (*D>D1) D1=*D; D++; }

  1822.           putDouble(D1);

  1823.           break;

  1824.         case '+' :

  1825.           D1 = Elt->d;

  1826.           D = &(Elt->d)+1;

  1827.           for(i=1;i<n;i++)  D1 += *D++;

  1828.           putDouble(D1);

  1829.           break;

  1830.         case '*' :

  1831.           D1 = Elt->d;

  1832.           D = &(Elt->d)+1;

  1833.           for(i=1;i<n;i++)  D1 *= *D++;

  1834.           putDouble(D1);

  1835.           break;

  1836.         default :  /* E = extrems */

  1837.           D1 = D2 = Elt->d;

  1838.           D = &(Elt->d)+1;

  1839.           for(i=1;i<n;i++) {

  1840.               if (*D>D2) D2=*D;

  1841.               if (*D<D1) D1=*D; D++;

  1842.           }

  1843.           putDouble(D1);

  1844.           IF_swap();

  1845.           putDouble(D2);

  1846.           break;

  1847.       }

  1848.     } else {

  1849.       switch(C) {

  1850.         case 'm' :

  1851.           L1 = Elt->l;

  1852.           L = &(Elt->l)+1;

  1853.           for(i=1;i<n;i++) { if (*L<L1) L1=*L; L++; }

  1854.           putLong(L1);

  1855.           break;

  1856.         case 'M' :

  1857.           L1 = Elt->l;

  1858.           L = &(Elt->l)+1;

  1859.           for(i=1;i<n;i++) { if (*L>L1) L1=*L; L++; }

  1860.           putLong(L1);

  1861.           break;

  1862.         case '+' :

  1863.           L1 = Elt->l;

  1864.           L = &(Elt->l)+1;

  1865.           for(i=1;i<n;i++)  L1 += *L++;

  1866.           putLong(L1);

  1867.           break;

  1868.         case '*' :

  1869.           L1 = Elt->l;

  1870.           L = &(Elt->l)+1;

  1871.           for(i=1;i<n;i++)  L1 *= *L++;

  1872.           putLong(L1);

  1873.           break;

  1874.         default :  /* E = extrems */

  1875.           L1 = L2 = Elt->l;

  1876.           L = &(Elt->l)+1;

  1877.           for(i=1;i<n;i++) {

  1878.               if (*L>L2) L2=*L;

  1879.               if (*L<L1) L1=*L; L++;

  1880.           }

  1881.           putLong(L1);

  1882.           IF_swap();

  1883.           putLong(L2);

  1884.           break;

  1885.       }

  1886.     }

  1887.     IF_swap();

  1888.     dropElt();

  1889.   } else messErr(12);

  1890. }

  1891. 

  1892. void IF_TABMin(void) { TAB_Fct('m'); }

  1893. void IF_TABMax(void) { TAB_Fct('M'); }

  1894. void IF_TABProd(void) { TAB_Fct('*'); }

  1895. void IF_TABSum(void) { TAB_Fct('+'); }

  1896. void IF_TABMinMax(void) { TAB_Fct('E'); }