/* Copyright (C) 2011-2022 Patrick H. E. Foubet - S.E.R.I.A.N.E. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see *******************************************************************/ /* stackN.c */ #include "conf.h" #include #include #include #include #include #include #include "nife.h" #include "mth.h" #include "err.h" #include "lib.h" #include "stackN.h" #include "stackL.h" #include "stackF.h" #include "stackV.h" #include "debug.h" #include "net.h" #include "scs.h" #define _VERIF_STACK_ if (StackN == VIDE) { messErr(2); return; } void IF_vars(void) { char * L; printf("DEBUG : "); if (Debug) printf("ON"); else printf("OFF"); printf("\nDefault type="); if (DOUBLE) printf("REAL"); else printf("INTEGER"); printf("\nPRINT MODE : "); switch(MODEPR) { case 1 : printf("HEX"); break; case 2 : printf("OCT"); break; case 3 : printf("BIN"); break; default : printf("DEC"); break; } printf("\nDefault echo="); if (ECHOOFF) printf("OFF"); else printf("ON"); printf("\nNetServer : \"%s\"",NetServer); printf("\nSCS Key : 0x%lx",(long)getScs()); printf("\nNetKey : 0x%lx",(long)NetKey); printf("\nVARS : "); switch(VARS) { case 1 : printf("DOWN"); break; case 2 : printf("UP"); break; default : printf("OFF"); break; } printf("\nVariable Function : "); if ((L=libByAddr(FCT_INST)) != NULL) printf("%s (std lib)",L); else { if ((L=fctByAddr(FCT_INST)) != NULL) printf("%s (user function)",L); else { if ((L=varByAddr(FCT_INST)) != NULL) printf("%s (variable)",L); else printf("none"); } } printf("\nNBTAB=%d\nNBLIG=%d\n",NBTAB,NBLIG); } void IFD_vars(void) { _IFD_BEGIN_ IF_vars(); _IFD_END_ } void IF_REAL(void) { _MODIF_DOUBLE_(1); } void IF_INTEGER(void) { _MODIF_DOUBLE_(0); } void IF_DEC(void) { _MODIF_MODEPR_(0); } void IF_HEX(void) { _MODIF_MODEPR_(1); } void IF_OCT(void) { _MODIF_MODEPR_(2); } void IF_BIN(void) { _MODIF_MODEPR_(3); } void IF_ECHOFF(void) { _MODIF_ECHOOFF_(1); } void IF_ECHOON(void) { _MODIF_ECHOOFF_(0); } /* IMPORTANT ************************** la taille t est codee sur 30 bits + a droite B31 = 1 si Var B32 = 1 si REAL **********************/ #define MSK_T (uint32_t)(0x3FFFFFFF) #define MSK_V (uint32_t)(0x40000000) #define MSK_R (uint32_t)(0x80000000) struct Num { uint32_t t; /* taille : cf precisions ci-dessus */ uint32_t key; /* net key */ void *n; union { long long l; double d; }; }; int lAdrNum(void) { struct Num N; return((char*)&(N.l) - (char*)&(N.n)); } void putLong(long long l) { void * M; struct Num * N; if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("putLong","malloc"); N = (struct Num*)M; N->t = 1; N->n = StackN; N->l = l; _MODIF_STACKN_(M); } void putDouble(double d) { void * M; struct Num * N; if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("putDouble","malloc"); N = (struct Num*)M; N->t = 1 | MSK_R; N->n = StackN; N->d = d; _MODIF_STACKN_(M); } int putVal(char *V) { void * M; char * R; struct Num * N; long long l; double d; #ifdef DEBUG printf("putVal (%s) \n",V); #endif l = strtoll(V,&R,0); if (strlen(R)==0) { if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("putVal","malloc"); N = (struct Num*)M; N->t = 1; N->n = StackN; N->l = l; if (fctEnCours) makeFct(T_NUM,M); else _MODIF_STACKN_(M); return 1; } else { d = strtod(V,&R); if (strlen(R)==0) { if ((M=malloc(sizeof(struct Num))) == NULL) stopErr("putVal","malloc"); N = (struct Num*)M; N->t = 1 | MSK_R; N->n = StackN; N->d = d; if (fctEnCours) makeFct(T_NUM,M); else _MODIF_STACKN_(M); return 1; } } return 0; } static int isScalar(void) { struct Num *Elt; int t; if(StackN == VIDE) return 0; Elt = (struct Num *)StackN; if ((t = Elt->t&MSK_T) == 1) return 1; return 0; } static int dropElt(void) { struct Num *Elt; if(StackN == VIDE) return 0; Elt = (struct Num *)StackN; _MODIF_STACKN_(Elt->n); if (!(Elt->t&MSK_V)) free((void*)Elt); return 1; } void IF_drop(void) { _VERIF_STACK_ dropElt(); } static long long getVal(void) { struct Num *Elt; Elt = (struct Num *)StackN; if (Elt->t & MSK_R) return((long long)Elt->d); else return(Elt->l); } void IF_vers(void) { putDouble(atof(VERSION)); } /* fonction pour les autres */ int getParLong(long *V) { if (StackN == VIDE) { messErr(2); return 0 ; } if (!isScalar()) { messErr(36); return 0 ; } *V = (long)getVal(); dropElt(); return 1; } void putVar(void * V) { struct Num *Elt; if (V==VIDE) return; Elt = (struct Num *)V; Elt->n = StackN; _MODIF_STACKN_(V); } void * getVar(void) { void * N; struct Num *Elt; N = StackN; if (N != VIDE) { Elt = (struct Num *)N; _MODIF_STACKN_(Elt->n); /* drop no free !! */ Elt->n = VIDE; Elt->t = Elt->t|MSK_V; /* VARIABLE ! */ } return N; } void IF_NBTAB(void) { long V; if (getParLong(&V)) _MODIF_NBTAB_(V); } void IF_NBLIG(void) { long V; if (getParLong(&V)) _MODIF_NBLIG_(V); } void IF_VAROFF(void) { _MODIF_VARS_(0); } void IF_VARDOWN(void) { _MODIF_VARS_(1); } void IF_VARUP(void) { _MODIF_VARS_(2); } void insertVal(void*A) { void * M; struct Num *Elt; if ((M = malloc(sizeof(struct Num))) == NULL) stopErr("insertVal","malloc"); bcopy(A,M,sizeof(struct Num)); Elt=(struct Num*)M; Elt->n = StackN; _MODIF_STACKN_(M); } static void Ramp(int D) { long n, i, dep=1; void * M; struct Num * N; long long *T; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n > 1) { if (D) { /* double ramp */ dep = -n; n = (2*n) +1; } if ((M = malloc(sizeof(struct Num)+((n-1)*(sizeof(double))))) == NULL) stopErr("Ramp","malloc"); N = (struct Num*)M; N->t = n; N->n = StackN; _MODIF_STACKN_(M); T = &(N->l); for(i=0;i>= 1; } printf("%s ",buf+i); } else printf("0 "); } else { strcpy(buf,F); buf[3]=c; printf(buf,l); } } #define ELT_POINT -9 static void printElt(struct Num * N, long I) { long n, i, m, nt, IB; long long *l; double *d; IB = I; n = N->t&MSK_T; if (IB < 0) nt = 3; else nt = NBTAB; if (n > nt) m=nt-1; else m=n-1; if (I==ELT_POINT) { IB=0; n=2; m=1; } if (IB) printf(" "); if(N->t & MSK_R) { if (n==1) printf("%g (REAL)",N->d); else { d = &N->d; for(i=0;i nt) printf("... "); printf("%g (REAL)[%ld]",*(&N->d+(n-1)),n); } } else { if (n==1) { printLL("%lld ",N->l); printf("(INTEGER)"); } else { l = &N->l; for(i=0;i nt) printf("... "); printLL("%lld ",*(&N->l+(n-1))); printf("(INTEGER)[%ld]",n); } } if ((IB>0) && (N->t&MSK_V)) printf(" Var. %s",varByAddrA((void*)N)); if (IB==1) printf(" <- top"); if (IB) printf("\n"); } void printNumber(void * E) { printElt((struct Num*)E, 0); } void numVarOff(void * A) { struct Num * N; N = (struct Num*) A; N->t = N->t & ~MSK_V; } void IF_show_stack(void) { void * Next; struct Num * N; long i=0,Nbl; char s; Nbl=NBLIG; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; i++; if (i<=Nbl) printElt(N,i); Next = N->n; } if (i<=Nbl) printf("\n"); else { if (i==Nbl+1) s = ' '; else s = 's'; printf(" ... and %ld other%c element%c !\n",i-Nbl,s,s); } } void IFD_show_stack(void) { _IFD_BEGIN_ IF_show_stack(); _IFD_END_ } void IF_point(void) { struct Num *Elt; _VERIF_STACK_ Elt = (struct Num *)StackN; printElt(Elt,ELT_POINT); /* printf("\n"); */ dropElt(); } void * duplicateNum(void * S, int vSoff) { struct Num *Elt, *NElt; void * M; uint32_t n; int s; Elt = (struct Num*)S; n = Elt->t&MSK_T; s = sizeof(struct Num)+((n-1)*(sizeof(double))); if ((M = malloc(s)) == NULL) stopErr("dupElt","malloc"); bcopy((void*)Elt,M,s); NElt = (struct Num *)M; NElt->n = VIDE; NElt->t = Elt->t; if (vSoff) Elt->t = Elt->t & ~MSK_V; /* Source no more a Var */ return(M); } static void dupElt(struct Num * Elt) { struct Num *NElt; void * M; uint32_t n; int s; n = Elt->t&MSK_T; s = sizeof(struct Num)+((n-1)*(sizeof(double))); if ((M = malloc(s)) == NULL) stopErr("dupElt","malloc"); bcopy((void*)Elt,M,s); NElt = (struct Num *)M; NElt->n = StackN; NElt->t = Elt->t & ~MSK_V; /* au cas ou Var */ _MODIF_STACKN_(M); } void IF_dup(void) { _VERIF_STACK_ dupElt((struct Num *)StackN); } void IF_swap(void) { struct Num *Elt, *Elt2; _VERIF_STACK_ Elt = (struct Num *)StackN; if (Elt->n != VIDE) { _MODIF_STACKN_(Elt->n); Elt2 = (struct Num *)StackN; Elt->n = Elt2->n; Elt2->n = (void*)Elt; } else messErr(4); } void IF_over (void) { struct Num *Elt; _VERIF_STACK_ Elt = (struct Num *)StackN; if (Elt->n != VIDE) dupElt((struct Num *)Elt->n); else messErr(4); } void IF_pick(void) { void * Next; struct Num * N; long n, i; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>0) { Next = StackN; i=1; while (Next != VIDE) { if (i==n) break; N = (struct Num*) Next; Next = N->n; i++; } if (Next != VIDE) dupElt((struct Num *)Next); else messErr(4); } else messErr(29); } static int rotateBid(long n, int d) /* d=0 : rot d=1 : unrot */ { void **ANext; struct Num * N, *N1; long i; ANext = _ADDR_STACKN_; i=1; while (*ANext != VIDE) { if (i==n) break; N = (struct Num*) *ANext; ANext = &N->n; i++; } if (*ANext != VIDE) { N = (struct Num*) *ANext; if (d) { /* unrot */ N1 = (struct Num*) StackN; _MODIF_STACKN_(N1->n); N1->n = N->n; N->n = (void*)N1; } else { /* rot */ *ANext = N->n; N->n = StackN; _MODIF_STACKN_((void*)N); } return 1; } else return 0; } void IF_rot(void) { if (!rotateBid(3L,0)) messErr(4); } void IF_unrot(void) { if (!rotateBid(3L,1)) messErr(4); } void IF_roll(void) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>1) { if (!rotateBid(n,0)) messErr(4); } else messErr(30); } void IF_unroll(void) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>1) { if (!rotateBid(n,1)) messErr(4); } else messErr(30); } void IF_depth(void) { void * Next; struct Num * N; long long i=0; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; i++; Next = N->n; } putLong(i); } int nbOnStack(void* A) { void * Next; struct Num * N; int i=0; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; if (Next == A) i++; Next = N->n; } return i; } static uint32_t nbSizeTypeOnStack(uint32_t n,uint32_t *T) { void * Next; struct Num * N; uint32_t i=0, D=0, S=0; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; S += N->t&MSK_T; if (N->t&MSK_R) D=1; Next = N->n; i++; if (i==n) break; } if (D) S = S|MSK_R; *T = S; return i; } void IF_Ndrop(void) { long n, i; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); for(i=0;i0) { NewS=VIDE; P=&NewS; Next = StackN; while (Next != VIDE) { Elt = (struct Num*) Next; t = Elt->t&MSK_T; s = sizeof(struct Num)+((t-1)*(sizeof(double))); if ((M = malloc(s)) == NULL) stopErr("IF_Ndup","malloc"); bcopy(Next,M,s); *P = M; NElt = (struct Num *)M; NElt->t = NElt->t & ~MSK_V; /* au cas ou Var */ P=&NElt->n; i++; if (i==n) break; Next = Elt->n; } NElt->n = StackN; _MODIF_STACKN_(NewS); if (it & MSK_R) return; n = N->t&MSK_T; d = &N->d; l = &N->l; for(i=0; it = N->t|MSK_R; } /* NET Functions for STSP */ void IF_NetKey (void) { _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } _MODIF_NetKey_((uint32_t)getVal()); dropElt(); } void IF_NetErrVal (void) { putLong(-(long long)NetKey); } void StackToNet(long n) { struct Num *Elt; int i; uint32_t t, l; for (i=0; it&MSK_T; l=(sizeof(struct Num)+((t-1)*(sizeof(double)))); Elt->key = NetKey; sendDataC(StackN, l); dropElt(); } } int NetDepth(uint32_t k) { void * Next; struct Num * N; int v=0; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; if (N->key == k) v++; Next = N->n; } return v; } void NetToStack(int s, uint32_t k) { void * Next; struct Num * N; uint32_t t, l; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; if (N->key == k) { t = N->t&MSK_T; l=(sizeof(struct Num)+((t-1)*(sizeof(double)))); sendData(s, Next, l); } Next = N->n; } } void IF_show_netStack(uint32_t k) { void * Next; struct Num * N; Next = StackN; printf("\n"); while (Next != VIDE) { N = (struct Num*) Next; if (k == UNI_KEY) { printf("<0x%.8lx> ",(long)N->key); printElt(N,(long)-1); } else { if (N->key == k) printElt(N,(long)-1); } Next = N->n; } printf(" key=0x%lx\n",(long)k); } void IF_netDrop(uint32_t k) { void * Next, **ANext; struct Num * N; Next = StackN; ANext = _ADDR_STACKN_; while (Next != VIDE) { N = (struct Num*) Next; if (k == N->key) { *ANext = N->n; free(Next); Next = *ANext; continue; } Next = N->n; ANext = &(N->n); } } /* end of Net functions */ static void IF_fct_2(char O) { struct Num *Elt, *Elt2; long long ConstL, *l1, *l2; double ConstD, *d1, *d2; int D1=0, D2=0, T1, T2, i; int M_C, M_D, M_S; /* Mode Const : 1 ou 0 | Double : 1 ou 0 | Swap : 1 ou 0 */ bool B=TRUE; _VERIF_STACK_ Elt = (struct Num *)StackN; T1 = Elt->t&MSK_T; D1 = Elt->t&MSK_R; if (Elt->n == VIDE) { messErr(4); return; } Elt2 = (struct Num *)Elt->n; T2 = Elt2->t&MSK_T; D2 = Elt2->t&MSK_R; /* si 2 tab de dim diff pas possible !! */ if ((T1>1) && (T2>1) && (T1!=T2)) { messErr(3); return; } M_S = M_C = M_D = 0; if ((T1>1) && (T2==1)) { /* on swap */ IF_swap(); D1=D2=0; Elt = (struct Num *)StackN; T1 = Elt->t&MSK_T; D1 = Elt->t&MSK_R; Elt2 = (struct Num *)Elt->n; T2 = Elt2->t&MSK_T; D2 = Elt2->t&MSK_R; M_S=1; } if (D1!=D2) { /* on transforme long en double */ if (D2) toDouble(Elt); else toDouble(Elt2); M_D = 1; } else if(D1) M_D = 1; l1 = &Elt->l; l2 = &Elt2->l; d1 = &Elt->d; d2 = &Elt2->d; if (T1==1) { M_C=1; if (M_D) ConstD = *d1; else ConstL = *l1; } /* pour debug printf("T1=%d T2=%d M_C=%d M_D=%d M_S=%d ",T1,T2,M_C,M_D,M_S); if (M_C) if (M_D) printf("ConstD=%g",ConstD); else printf("ConstL=%lld",ConstL); printf("\n"); *****/ switch(O) { case '+' : if (M_C) { if (M_D) for (i=0;iConstD) *d2=ConstD; d2++; } else for(i=0;iConstL) *l2=ConstL; l2++; } } else { if (M_D) for (i=0;i*d1) *d2=*d1; d2++; d1++; } else for (i=0;i*l1) *l2=*l1; l2++; l1++; } } break; case 'M' : /* max */ if (M_C) { if (M_D) for(i=0;i= ConstD) {B=FALSE; break;} d2++; } else for (i=0;i= ConstL) {B=FALSE; break;} l2++; } } } else { if (M_D) for (i=0;i= *d1) {B=FALSE; break;} d1++; d2++; } else for (i=0;i= *l1) {B=FALSE; break;} l1++; l2++; } } putBool(B); dropElt(); /* suppression des 2 !! */ break; case '>' : /* test sup */ if (M_C) { if (M_S) { if (M_D) for(i=0;i ConstD) {B=FALSE; break;} d2++; } else for (i=0;i ConstL) {B=FALSE; break;} l2++; } } else { if (M_D) for(i=0;i ConstD) {B=FALSE; break;} d2++; } else for (i=0;i ConstL) {B=FALSE; break;} l2++; } } } else { if (M_D) for (i=0;i *d1) {B=FALSE; break;} d1++; d2++; } else for (i=0;i *l1) {B=FALSE; break;} l1++; l2++; } } putBool(B); dropElt(); /* suppression des 2 !! */ break; case 's' : /* test sup ou egal */ if (M_C) { if (M_S) { if (M_D) for(i=0;i= ConstD) {B=FALSE; break;} d2++; } else for (i=0;i= ConstL) {B=FALSE; break;} l2++; } } else { if (M_D) for(i=0;i'); } void IF_Linf(void) { IF_fct_2('<'); } void IF_Lsupeg(void) { IF_fct_2('s'); } void IF_Linfeg(void) { IF_fct_2('i'); } void IF_fctD_1(double(*f)(double)) { struct Num *Elt; uint32_t n; long long *L; double *D; int i; _VERIF_STACK_ Elt = (struct Num *)StackN; n = Elt->t&MSK_T; if (Elt->t&MSK_R) { /* double */ D = &(Elt->d); for(i=0;id); L = &(Elt->l); for(i=0;it = Elt->t | MSK_R; } } void IF_fctB_1(long long (*f1)(long long), double(*f2)(double)) { struct Num *Elt; uint32_t n; long long *L; double *D; int i; _VERIF_STACK_ Elt = (struct Num *)StackN; n = Elt->t&MSK_T; if (Elt->t&MSK_R) { /* double */ D = &(Elt->d); for(i=0;il); for(i=0;it&MSK_T; if (Elt->t&MSK_R) { /* double */ D = &(Elt->d); L = &(Elt->l); for(i=0;it = Elt->t & ~MSK_R; /* change type */ } /* rien si long */ } void IF_fctD_1LB(long long(*f)(double)) { struct Num *Elt; uint32_t n; long long *L; double *D; int i; _VERIF_STACK_ Elt = (struct Num *)StackN; n = Elt->t&MSK_T; D = &(Elt->d); L = &(Elt->l); if (Elt->t&MSK_R) { /* double */ for(i=0;it = Elt->t & ~MSK_R; /* change type */ } else { for(i=0;it&MSK_T; if (Elt->t&MSK_R) { /* double */ D = &(Elt->d); for(i=0;il); for(i=0;it&MSK_T; if (Elt->t&MSK_R) { /* double */ D = &(Elt->d); for(i=0;il); for(i=0;it&MSK_T; Elt2 = Elt->n; n2 = Elt2->t&MSK_T; if (n>n2) n=n2; if (Elt->t&MSK_R) { /* double */ D = &(Elt->d); if (Elt2->t&MSK_R) { /* double */ D2 = &(Elt2->d); for(i=0;il); for(i=0;il); if (Elt2->t&MSK_R) { /* double */ D2 = &(Elt2->d); for(i=0;il); for(i=0;it&MSK_T; return (int)l; } static long transLongTo(long long * C) { struct Num *Elt; int i; uint32_t l; long long *L; double *D; Elt = (struct Num *)StackN; l = Elt->t&MSK_T; L = &(Elt->l)+l-1; D = &(Elt->d)+l-1; if (Elt->t & MSK_R) for (i=0;it&MSK_T; L = &(Elt->l)+l-1; D = &(Elt->d)+l-1; if (Elt->t & MSK_R) for (i=0;i1) { i = nbSizeTypeOnStack(n,&t); if (it = t; if (t & MSK_R) { D = &(N->d)+(T-1); for(i=0;il)+(T-1); for(i=0;in = StackN; _MODIF_STACKN_(M); } } else messErr(30); } static void toScalar( int s ) { struct Num *Elt; uint32_t l; int i; double *D; long long * L; _VERIF_STACK_ Elt = (struct Num *)StackN; l = Elt->t&MSK_T; if (l==1) return; _MODIF_STACKN_(Elt->n); /* depile */ if (s) { L = &(Elt->l); D = &(Elt->d); if (Elt->t & MSK_R) for(i=0;il)+l-1; D = &(Elt->d)+l-1; if (Elt->t & MSK_R) for(i=0;it&MSK_V)) free((void*)Elt); } void IF_toScalar( void ) { toScalar(1); } void IF_toScalarR( void ) { toScalar(0); } static void tabShift(void **A,long s) { struct Num *Elt, *NElt; void * M; long j, k; uint32_t l; long long *L, *NL; _VERIF_STACK_ Elt = (struct Num *)*A; l = Elt->t&MSK_T; if (l==1) return; if (s>0) while (s>=l) s-=l; else while (-s>=l) s+=l; if (s==0) return; if (s>0) j=s; else j=l+s; k = sizeof(struct Num)+((l-1)*(sizeof(double))); if ((M = malloc(k)) == NULL) stopErr("tabShift","malloc"); NElt = (struct Num *)M; *A = M; NElt->t = Elt->t; NElt->n = Elt->n; L = &(Elt->l); NL = &(NElt->l); k=l-j; bcopy((void*)&L[0],(void*)&NL[j],k*sizeof(long long)); bcopy((void*)&L[k],(void*)&NL[0],j*sizeof(long long)); if (!(Elt->t&MSK_V)) free((void*)Elt); } void IF_TShiftR( void ) { tabShift(_ADDR_STACKN_,1); } void IF_TShiftL( void ) { tabShift(_ADDR_STACKN_,-1); } static void nTabShift( int v ) { void ** ANext; struct Num * N; long i=0, n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>0) { ANext = _ADDR_STACKN_; while (*ANext != VIDE) { tabShift(ANext,v); N = (struct Num*) *ANext; ANext = &(N->n); i++; if (i==n) break; } } else messErr(29); } void IF_NTShiftR( void ) { nTabShift(1); } void IF_NTShiftL( void ) { nTabShift(-1); } void IF_TNShiftR( void ) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); tabShift(_ADDR_STACKN_,n); } void IF_TNShiftL( void ) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); tabShift(_ADDR_STACKN_,-n); } static void nTNShift( int s ) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); nTabShift(n*s); } void IF_NTNShiftR( void ) { nTNShift(1); } void IF_NTNShiftL( void ) { nTNShift(-1); } static void subTab(void **pA , long n, char r) /* r=1 : right else left */ { struct Num *Elt, *Elt2; uint32_t l; long k; long long *L, *Lf; void *A, * M; double *D, *Df; _VERIF_STACK_ A = *pA; Elt = (struct Num *)A; l = Elt->t&MSK_T; if (l==n) return; k = sizeof(struct Num)+((n-1)*(sizeof(long long))); if ((M = malloc(k)) == NULL) stopErr("subTab","malloc"); Elt2 = (struct Num *)M; Elt2->n = Elt->n; Elt2->t = (Elt->t&MSK_R) | n; *pA = M; if (nl); if (r) L += (l-n); bcopy((void*)L,(void*)&(Elt2->l),n*sizeof(long long)); } else { /* fill with zero */ L = &(Elt2->l); if (!r) L += (n-l); bcopy((void*)&(Elt->l),(void*)L,l*sizeof(long long)); if (Elt->t&MSK_R) { D = &(Elt2->d); if (r) D += l; Df = D + (n-l); while (D < Df) *D++ = (double)0; } else { L = &(Elt2->l); if (r) L += l; Lf = L + (n-l); while (L < Lf) *L++ = 0L; } } if (!(Elt->t&MSK_V)) free(A); } void IF_subTab(void) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>0) subTab(_ADDR_STACKN_, n, 0); else messErr(29); } void IF_subTabR(void) { long n; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>0) subTab(_ADDR_STACKN_, n, (char)1); else messErr(29); } static void NSubTab( char r ) { void **pNext; struct Num * N; long i=0, n, l; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } l = (long)getVal(); dropElt(); if (l>0) { if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>0) { pNext = _ADDR_STACKN_; while (*pNext != VIDE) { subTab(pNext,l,r); N = (struct Num*) *pNext; pNext = &(N->n); i++; if (i==n) break; } } else messErr(29); } else messErr(29); } void IF_NsubTab(void) { NSubTab((char)0); } void IF_NsubTabR(void) { NSubTab((char)1); } static void tabRev( void* A ) { struct Num *Elt; uint32_t l; double *D, *FD, vD; long long * L, *FL, vL; _VERIF_STACK_ Elt = (struct Num *)A; l = Elt->t&MSK_T; if (l==1) return; if (Elt->t & MSK_R) { D = &(Elt->d); FD = D+l-1; while (Dl); FL=L+l-1; while (L0) { Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; tabRev(Next); Next = N->n; i++; if (i==n) break; } } else messErr(29); } static void tabTransp (int sens) { void * Next, *Next2, **Suiv, *SNext, **Last; struct Num * N, *N2; long i=0, j, n; uint32_t l; short Doub=0; double *D, *D2; long long *L, *L2; _VERIF_STACK_ if (!isScalar()) { messErr(36); return; } n = (long)getVal(); dropElt(); if (n>0) { if (n==1) { if (sens) toScalar(1); else toScalar(0); return; } /* the n elts on stack must have the same dim */ Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; if (i) { if (l != (N->t&MSK_T)) break; } else l = N->t&MSK_T; if (N->t&MSK_R) Doub=1; i++; if (i==n) break; Next = N->n; } if (i!=n) { if (Next == VIDE) messErr(4); else messErr(3); } else { /* make l elts of dim n */ Suiv = &Next2; for (i=0;it = n; if (Doub) N2->t |= MSK_R; /* remplissage */ if (sens) { j=0; if (sens==1) { N2->n = SNext; SNext = Next2; if (i==0) Last = &(N2->n); } else Suiv = &N2->n; } else { j=n-1; Suiv = &N2->n; } if (Doub) { D2 = &(N2->d); } else { L2 = &(N2->l); } Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; if (Doub) { if (N->t&MSK_R) { D = &(N->d); if (sens) D+=(l-i-1); else D+=i; *(D2+j) = *D; } else { L = &(N->l); if (sens) L+=(l-i-1); else L+=i; *(D2+j) = (double)*L; } } else { L = &(N->l); if (sens) L+=(l-i-1); else L+=i; *(L2+j) = *L; /* printf("%ld ",*L); */ } if (sens) { j++; if (j>=n) break; } else { j--; if (j<0) break; } Next = N->n; } /* printf("\n"); */ } if (sens!=1) Last = &(N2->n); /* drop n elts */ for (i=0;in) < 2L) return 0; return 1; } int isNTabSameDim(int n) { void * Next; struct Num * N; long i=0; uint32_t l; /* the n elts on stack must have the same dim */ Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; if (i) { if (l != (long)(N->t&MSK_T)) break; } else l = N->t&MSK_T; i++; if (i==n) return 1; /* OK */ Next = N->n; } return 0; } /* []functions ****/ static void TAB_Fct(char C) { struct Num *Elt; uint32_t n; long long *L, L1, L2; double *D, D1, D2; int i; _VERIF_STACK_ Elt = (struct Num *)StackN; n = Elt->t&MSK_T; if (n>1) { if (Elt->t&MSK_R) { /* double */ switch(C) { case 'm' : D1 = Elt->d; D = &(Elt->d)+1; for(i=1;id; D = &(Elt->d)+1; for(i=1;iD1) D1=*D; D++; } putDouble(D1); break; case '+' : D1 = Elt->d; D = &(Elt->d)+1; for(i=1;id; D = &(Elt->d)+1; for(i=1;id; D = &(Elt->d)+1; for(i=1;iD2) D2=*D; if (*Dl; L = &(Elt->l)+1; for(i=1;il; L = &(Elt->l)+1; for(i=1;iL1) L1=*L; L++; } putLong(L1); break; case '+' : L1 = Elt->l; L = &(Elt->l)+1; for(i=1;il; L = &(Elt->l)+1; for(i=1;il; L = &(Elt->l)+1; for(i=1;iL2) L2=*L; if (*Lt; if ((MSK) && (t & MSK_V)) { v = (long long)iVarByAddrA(A); t = 1 | MSK_V; write(fd, (void*)&t, sizeof(t)); write(fd, (void*)&v, sizeof(v)); } else { /* t &= ~MSK_V; */ write(fd, (void*)&t, sizeof(t)); l = t & MSK_T; write(fd, (void*)&(N->l), (size_t)(l*sizeof(double))); } } static int NbARIV; void restore_links_stackN(void) { void **ANext, *A; struct Num * N, *T; if (NbARIV == 0) return; ANext = &StackN; while (*ANext != VIDE) { N = (struct Num*) *ANext; if (N->t & MSK_V) { A = varAddrAByInd(N->l); T = (struct Num*) A; T->n = N->n; *ANext = A; free((void*)N); } ANext = &(N->n); } rest_links_pr(NbARIV, "variable", "numerical"); } void dump_stackN(int fd) { void * Next; struct Num * N; uint32_t n=0; int i,j; Next = StackN; while (Next != VIDE) { N = (struct Num*) Next; n++; Next = N->n; } write(fd, (void*)&n, sizeof(n)); for (i=n; i>0; i--) { Next = StackN; j=0; while (Next != VIDE) { N = (struct Num*) Next; j++; if (i==j) break; Next = N->n; } dump_eltN(fd, Next, MSK_V); } dump_rest_pr(0,n,"numerical"); } static void * restore_eltN_l(int fd, int K) { uint32_t t, u; int s; void * M; struct Num * N; read(fd, (void*)&t, sizeof(t)); u = t & MSK_T; if ((t & MSK_V) && K) NbARIV++; /* printf("%u : %d\n", u, NbARIV); /* debug */ s = sizeof(struct Num)+((u-1)*(sizeof(double))); if ((M = malloc(s)) == NULL) stopErr("restore_eltN","malloc"); N = (struct Num*)M; N->t = t; N->n = StackN; read(fd, (void*)&(N->l), u*sizeof(double)); return M; } void * restore_eltN(int fd) { return restore_eltN_l(fd,0); } void restore_stackN(int fd) { uint32_t n=0, i; void * M; NbARIV = 0; if (read(fd, (void*)&n, sizeof(n)) != sizeof(n)) return; IF_stack_clear(); for (i=0; i