/* Copyright (C) 2011-2016 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