|
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108 |
- /* Copyright (C) 2011-2024 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 <http://www.gnu.org/licenses/>
- *******************************************************************/
- /* stackN.c */
- #include "conf.h"
-
- #include <stdio.h>
- #include <stdlib.h>
- #include <string.h>
- #include <strings.h>
- #include <sys/types.h>
- #include <math.h>
-
- #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<n;i++) T[i]=i+dep;
- } else messErr(30);
- }
-
- void IF_ramp(void)
- {
- Ramp(0);
- }
-
- void IF_dramp(void)
- {
- Ramp(1);
- }
-
- void IF_stack_clear(void)
- {
- while (StackN != VIDE) dropElt();
- }
-
- static void printLL(char * F, long long l)
- {
- char c, buf[68];
- unsigned long long v;
- int i;
- switch(MODEPR) {
- case 1 :
- c='x';
- printf("0x");
- break;
- case 2 :
- c='o';
- printf("0");
- break;
- case 3 :
- c='b';
- break;
- default :
- c='d';
- }
- if (c =='b') {
- if (l) {
- v = (unsigned long long)l;
- buf[67]='\0';
- i = 67;
- while (v) {
- i--;
- if (v & 1) buf[i]='1';
- else buf[i]='0';
- v >>= 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<m;i++) printf("%g ",*d++);
- if (I==ELT_POINT) return;
- if (n > 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<m;i++) printLL("%lld ",*l++);
- if (I==ELT_POINT) return;
- if (n > 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("<end of stack>\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;i<n;i++) if (!dropElt()) break;
- if (i<n) messErr(4); /* erreur pour la rigueur ! */
- }
-
- void IF_Ndup(void)
- {
- void *Next, *M, *NewS, **P;
- struct Num * Elt, * NElt;
- uint32_t n, i=0, t;
- int s;
- _VERIF_STACK_
- if (!isScalar()) {
- messErr(36); return;
- }
- n = (long)getVal();
- dropElt();
- if (n>0) {
- 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 (i<n) messErr(4); /* erreur pour la rigueur ! */
- } else messErr(29);
- }
-
- static void toDouble(struct Num * N)
- {
- uint32_t n;
- int i;
- double *d;
- long long *l;
- if (N->t & MSK_R) return;
- n = N->t&MSK_T;
- d = &N->d;
- l = &N->l;
- for(i=0; i<n; i++) *d++ = (double)*l++;
- N->t = 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; i<n ; i++) {
- if(StackN == VIDE) break;
- Elt = (struct Num *)StackN;
- t = Elt->t&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("<bottom of net stack>\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("<top of net stack> 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;i<T2;i++) *d2++ += ConstD;
- else for (i=0;i<T2;i++) *l2++ += ConstL;
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ += *d1++;
- else for (i=0;i<T2;i++) *l2++ += *l1++;
- }
- break;
- case '-' :
- if (M_C) {
- if (M_S) {
- if (M_D) for (i=0;i<T2;i++) *d2++ = ConstD - *d2;
- else for (i=0;i<T2;i++) *l2++ = ConstL - *l2;
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ -= ConstD;
- else for (i=0;i<T2;i++) *l2++ -= ConstL;
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ -= *d1++;
- else for (i=0;i<T2;i++) *l2++ -= *l1++;
- }
- break;
- case '*' :
- if (M_C) {
- if (M_D) for (i=0;i<T2;i++) *d2++ *= ConstD;
- else for (i=0;i<T2;i++) *l2++ *= ConstL;
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ *= *d1++;
- else for (i=0;i<T2;i++) *l2++ *= *l1++;
- }
- break;
- case '/' :
- if (M_C) {
- if (M_S) {
- if (M_D) for (i=0;i<T2;i++) *d2++ = ConstD / *d2;
- else for (i=0;i<T2;i++) *l2++ = ConstL / *l2;
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ /= ConstD;
- else for (i=0;i<T2;i++) *l2++ /= ConstL;
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ /= *d1++;
- else for (i=0;i<T2;i++) *l2++ /= *l1++;
- }
- break;
- case 'm' : /* min */
- if (M_C) {
- if (M_D) for(i=0;i<T2;i++) { if (*d2>ConstD) *d2=ConstD; d2++; }
- else for(i=0;i<T2;i++) { if (*l2>ConstL) *l2=ConstL; l2++; }
- } else {
- if (M_D) for (i=0;i<T2;i++) { if (*d2>*d1) *d2=*d1; d2++; d1++; }
- else for (i=0;i<T2;i++) { if (*l2>*l1) *l2=*l1; l2++; l1++; }
- }
- break;
- case 'M' : /* max */
- if (M_C) {
- if (M_D) for(i=0;i<T2;i++) { if (*d2<ConstD) *d2=ConstD; d2++; }
- else for(i=0;i<T2;i++) { if (*l2<ConstL) *l2=ConstL; l2++; }
- } else {
- if (M_D) for (i=0;i<T2;i++) { if (*d2<*d1) *d2=*d1; d2++; d1++; }
- else for (i=0;i<T2;i++) { if (*l2<*l1) *l2=*l1; l2++; l1++; }
- }
- break;
- case '%' : /* modulo */
- if (M_C) {
- if (M_S) {
- if (M_D) for (i=0;i<T2;i++) *d2++ = fmod(ConstD,*d2);
- else for (i=0;i<T2;i++) *l2++ = ConstL % *l2;
- } else {
- if (M_D) for (i=0;i<T2;i++) *d2++ = fmod(*d2,ConstD);
- else for (i=0;i<T2;i++) *l2++ %= ConstL;
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) { *d2++ = fmod(*d2,*d1); d1++; }
- else for (i=0;i<T2;i++) *l2++ %= *l1++;
- }
- break;
- case '^' : /* puissance */
- if (! M_D) { /* passage en double force car + pratique */
- toDouble(Elt); toDouble(Elt2);
- if (M_C) ConstD=*d1;
- }
- if (M_C) {
- if (M_S) {
- for (i=0;i<T2;i++) *d2++ = pow(ConstD,*d2);
- } else {
- for (i=0;i<T2;i++) *d2++ = pow(*d2,ConstD);
- }
- } else {
- for (i=0;i<T2;i++) { *d2++ = pow(*d2,*d1); d1++; }
- }
- break;
- case '=' : /* test egal */
- if (M_C) {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 != ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 != ConstL) {B=FALSE; break;} l2++; }
- } else {
- if (M_D) for (i=0;i<T2;i++) {
- if (*d2 != *d1) {B=FALSE; break;} d1++; d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 != *l1) {B=FALSE; break;} l1++; l2++; }
- }
- putBool(B);
- dropElt(); /* suppression des 2 !! */
- break;
- case '#' : /* test different */
- if (M_C) {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 == ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 == ConstL) {B=FALSE; break;} l2++; }
- } else {
- if (M_D) for (i=0;i<T2;i++) {
- if (*d2 == *d1) {B=FALSE; break;} d1++; d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 == *l1) {B=FALSE; break;} l1++; l2++; }
- }
- putBool(B);
- dropElt(); /* suppression des 2 !! */
- break;
- case '<' : /* test inf */
- if (M_C) {
- if (M_S) {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 < ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 < ConstL) {B=FALSE; break;} l2++; }
- } else {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 >= ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 >= ConstL) {B=FALSE; break;} l2++; }
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) {
- if (*d2 >= *d1) {B=FALSE; break;} d1++; d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 >= *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<T2;i++) {
- if (*d2 > ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 > ConstL) {B=FALSE; break;} l2++; }
- } else {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 <= ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 <= ConstL) {B=FALSE; break;} l2++; }
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) {
- if (*d2 <= *d1) {B=FALSE; break;} d1++; d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 <= *l1) {B=FALSE; break;} l1++; l2++; }
- }
- putBool(B);
- dropElt(); /* suppression des 2 !! */
- break;
- case 'i' : /* test inf ou egal */
- if (M_C) {
- if (M_S) {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 <= ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 <= ConstL) {B=FALSE; break;} l2++; }
- } else {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 > ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 > ConstL) {B=FALSE; break;} l2++; }
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) {
- if (*d2 > *d1) {B=FALSE; break;} d1++; d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 > *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<T2;i++) {
- if (*d2 >= ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 >= ConstL) {B=FALSE; break;} l2++; }
- } else {
- if (M_D) for(i=0;i<T2;i++) {
- if (*d2 < ConstD) {B=FALSE; break;} d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 < ConstL) {B=FALSE; break;} l2++; }
- }
- } else {
- if (M_D) for (i=0;i<T2;i++) {
- if (*d2 < *d1) {B=FALSE; break;} d1++; d2++; }
- else for (i=0;i<T2;i++) {
- if (*l2 < *l1) {B=FALSE; break;} l1++; l2++; }
- }
- putBool(B);
- dropElt(); /* suppression des 2 !! */
- break;
- default :
- printf("%c : not yet implemented !\n",O);
- break;
- }
- dropElt(); /* suppression du 1er */
- }
-
- void IF_plus(void) { IF_fct_2('+'); }
- void IF_moins(void) { IF_fct_2('-'); }
- void IF_mult(void) { IF_fct_2('*'); }
- void IF_div(void) { IF_fct_2('/'); }
- void IF_min(void) { IF_fct_2('m'); }
- void IF_max(void) { IF_fct_2('M'); }
- void IF_modulo(void) { IF_fct_2('%'); }
- void IF_puiss(void) { IF_fct_2('^'); }
- void IF_neg(void)
- {
- putLong((long long)-1);
- IF_mult();
- }
-
- void IF_Legal(void) { IF_fct_2('='); }
- void IF_Ldiff(void) { IF_fct_2('#'); }
- void IF_Lsup(void) { IF_fct_2('>'); }
- 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;i<n;i++) *D++ = f(*D);
- } else {
- D = &(Elt->d);
- L = &(Elt->l);
- for(i=0;i<n;i++) *D++ = f((double)*L++);
- Elt->t = 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;i<n;i++) *D++ = f2(*D);
- } else {
- L = &(Elt->l);
- for(i=0;i<n;i++) *L++ = f1(*L);
- }
- }
-
- void IF_fctD_1L(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;
- if (Elt->t&MSK_R) { /* double */
- D = &(Elt->d);
- L = &(Elt->l);
- for(i=0;i<n;i++) *L++ = f(*D++);
- Elt->t = 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;i<n;i++) *L++ = f(*D++);
- Elt->t = Elt->t & ~MSK_R; /* change type */
- } else {
- for(i=0;i<n;i++) *L++ = f(*L);
- }
- }
-
- void IF_inFile_1d(FILE * fd, char delim, int virg)
- {
- struct Num *Elt;
- uint32_t n;
- long long *L;
- double *D;
- int i;
- char buf[40], *pt;
- _VERIF_STACK_
- Elt = (struct Num *)StackN;
- n = Elt->t&MSK_T;
- if (Elt->t&MSK_R) { /* double */
- D = &(Elt->d);
- for(i=0;i<n;i++) {
- sprintf(buf,"%.15f%c",*D++,delim);
- pt = buf + strlen(buf) - 2;
- while (*pt == '0') pt--;
- pt++;
- *pt++ = delim;
- *pt='\0';
- if (virg)
- if ((pt = strchr(buf, (int)'.')) != NULL) *pt = ',';
- fprintf(fd,buf);
- }
- } else {
- L = &(Elt->l);
- for(i=0;i<n;i++) fprintf(fd,"%lld%c",*L++,delim);
- }
- fprintf(fd,"\n");
- dropElt(); /* suppression */
- }
-
- void IF_inFile_1(FILE * fd)
- {
- 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;i<n;i++) fprintf(fd,"%d %g\n",i,*D++);
- } else {
- L = &(Elt->l);
- for(i=0;i<n;i++) fprintf(fd,"%d %lld\n",i,*L++);
- }
- }
-
- void IF_inFile_2(FILE * fd)
- {
- struct Num *Elt, *Elt2;
- uint32_t n, n2;
- long long *L, *L2;
- double *D, *D2;
- int i;
- _VERIF_STACK_
- Elt = (struct Num *)StackN;
- n = Elt->t&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;i<n;i++) fprintf(fd,"%g %g\n",*D2++,*D++);
- } else {
- L2 = &(Elt2->l);
- for(i=0;i<n;i++) fprintf(fd,"%lld %g\n",*L2++,*D++);
- }
- } else {
- L = &(Elt->l);
- if (Elt2->t&MSK_R) { /* double */
- D2 = &(Elt2->d);
- for(i=0;i<n;i++) fprintf(fd,"%g %lld\n",*D2++,*L++);
- } else {
- L2 = &(Elt2->l);
- for(i=0;i<n;i++) fprintf(fd,"%lld %lld\n",*L2++,*L++);
- }
- }
- }
-
- static int dimTab(void * A)
- {
- struct Num *N;
- uint32_t l;
- if (A==VIDE) return 0L;
- N = (struct Num*)A;
- l = N->t&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;i<l;i++) *C--=(long long)*D--;
- else
- for (i=0;i<l;i++) *C--=*L--;
- dropElt();
- return(l);
- }
-
- static long transDoubTo(double * 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;i<l;i++) *C--=*D--;
- else
- for (i=0;i<l;i++) *C--=(double)*L--;
- dropElt();
- return(l);
- }
-
- void IF_toArray( void )
- {
- uint32_t n, i, l, T, t;
- long long *L;
- double *D;
- void * M;
- struct Num *N;
- _VERIF_STACK_
- if (!isScalar()) {
- messErr(36); return;
- }
- n = (uint32_t)getVal();
- dropElt();
- if (n>1) {
- i = nbSizeTypeOnStack(n,&t);
- if (i<n) messErr(4);
- else {
- T = t & MSK_T;
- if ((M = malloc(sizeof(struct Num)+((T-1)*(sizeof(double))))) == NULL)
- stopErr("IF_toArray","malloc");
- N = (struct Num*)M;
- N->t = t;
- if (t & MSK_R) {
- D = &(N->d)+(T-1);
- for(i=0;i<n;i++) { l=transDoubTo(D); D -= l; }
- } else {
- L = &(N->l)+(T-1);
- for(i=0;i<n;i++) { l=transLongTo(L); L -= l; }
- }
- /* on the stack */
- N->n = 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;i<l;i++) putDouble(*D++);
- else
- for(i=0;i<l;i++) putLong(*L++);
- } else {
- L = &(Elt->l)+l-1;
- D = &(Elt->d)+l-1;
- if (Elt->t & MSK_R)
- for(i=0;i<l;i++) putDouble(*D--);
- else
- for(i=0;i<l;i++) putLong(*L--);
- }
- if (!(Elt->t&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 (n<l) {
- L = &(Elt->l);
- 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 (D<FD) {
- vD=*D; *D=*FD; *FD=vD;
- D++; FD--;
- }
- } else {
- L = &(Elt->l);
- FL=L+l-1;
- while (L<FL) {
- vL=*L; *L=*FL; *FL=vL;
- L++; FL--;
- }
- }
- }
-
- void IF_TabRev( void )
- {
- tabRev(StackN);
- }
-
- void IF_NTabRev( void )
- {
- void * Next;
- struct Num * N;
- long i=0, n;
- _VERIF_STACK_
- if (!isScalar()) {
- messErr(36); return;
- }
- n = (long)getVal();
- dropElt();
- if (n>0) {
- 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;i<l;i++) {
- if ((*Suiv=malloc(sizeof(struct Num)+((n-1)*(sizeof(double)))))==NULL)
- stopErr("tabTransp","malloc");
- N2 = (struct Num*) *Suiv;
- N2->t = 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;i<n;i++) dropElt();
- /* put new elts on the stack */
- *Last = StackN;
- _MODIF_STACKN_(Next2);
- }
- } else messErr(29);
- }
-
- void IF_TabTransp (void) /* crot */
- {
- tabTransp(0);
- }
-
- void IF_TabTranspN (void) /* transpose */
- {
- tabTransp(1);
- }
-
- void IF_TabTranspT (void) /* trot */
- {
- tabTransp(-1);
- }
-
- int is1Tab(void)
- {
- if (dimTab(StackN) < 2L) return 0;
- return 1;
- }
-
- int is2Tab(void)
- {
- struct Num *N;
- if (dimTab(StackN) < 2L) return 0;
- N = (struct Num*)StackN;
- if (dimTab(N->n) < 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;i<n;i++) { if (*D<D1) D1=*D; D++; }
- putDouble(D1);
- break;
- case 'M' :
- D1 = Elt->d;
- D = &(Elt->d)+1;
- for(i=1;i<n;i++) { if (*D>D1) D1=*D; D++; }
- putDouble(D1);
- break;
- case '+' :
- D1 = Elt->d;
- D = &(Elt->d)+1;
- for(i=1;i<n;i++) D1 += *D++;
- putDouble(D1);
- break;
- case '*' :
- D1 = Elt->d;
- D = &(Elt->d)+1;
- for(i=1;i<n;i++) D1 *= *D++;
- putDouble(D1);
- break;
- default : /* E = extrems */
- D1 = D2 = Elt->d;
- D = &(Elt->d)+1;
- for(i=1;i<n;i++) {
- if (*D>D2) D2=*D;
- if (*D<D1) D1=*D; D++;
- }
- putDouble(D1);
- IF_swap();
- putDouble(D2);
- break;
- }
- } else {
- switch(C) {
- case 'm' :
- L1 = Elt->l;
- L = &(Elt->l)+1;
- for(i=1;i<n;i++) { if (*L<L1) L1=*L; L++; }
- putLong(L1);
- break;
- case 'M' :
- L1 = Elt->l;
- L = &(Elt->l)+1;
- for(i=1;i<n;i++) { if (*L>L1) L1=*L; L++; }
- putLong(L1);
- break;
- case '+' :
- L1 = Elt->l;
- L = &(Elt->l)+1;
- for(i=1;i<n;i++) L1 += *L++;
- putLong(L1);
- break;
- case '*' :
- L1 = Elt->l;
- L = &(Elt->l)+1;
- for(i=1;i<n;i++) L1 *= *L++;
- putLong(L1);
- break;
- default : /* E = extrems */
- L1 = L2 = Elt->l;
- L = &(Elt->l)+1;
- for(i=1;i<n;i++) {
- if (*L>L2) L2=*L;
- if (*L<L1) L1=*L; L++;
- }
- putLong(L1);
- IF_swap();
- putLong(L2);
- break;
- }
- }
- IF_swap();
- dropElt();
- } else messErr(12);
- }
-
- void IF_TABMin(void) { TAB_Fct('m'); }
- void IF_TABMax(void) { TAB_Fct('M'); }
- void IF_TABProd(void) { TAB_Fct('*'); }
- void IF_TABSum(void) { TAB_Fct('+'); }
- void IF_TABMinMax(void) { TAB_Fct('E'); }
-
- #define LENT 20
- void dump_eltN(int fd, void *A, uint32_t MSK)
- {
- struct Num * N;
- long l;
- long long v;
- uint32_t t;
- N = (struct Num*)A;
- t = N->t;
- 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<n; i++) {
- M = restore_eltN_l(fd,1);
- _MODIF_STACKN_(M);
- }
- dump_rest_pr(1,n,"numerical");
- }
-
- /* gestion des meta-stacks */
-
- void IF_new_stackN(void)
- {
- if (G_i_TStackN == LSTACKS) {
- messErr(60); return;
- }
- G_TStackN[G_i_TStackN++] = StackN;
- StackN = G_TStackN[G_i_TStackN];
- }
-
- void IF_old_stackN(void)
- {
- if (G_i_TStackN == 0) {
- messErr(61); return;
- }
- G_TStackN[G_i_TStackN--] = StackN;
- StackN = G_TStackN[G_i_TStackN];
- }
-
- void IF_show_TStacks(void)
- {
- printf("Indices of meta-stacks :\n");
- printf("Numerical stack = %d\n",G_i_TStackN+1);
- printf("Character stack = %d\n",G_i_TStackC+1);
- printf("Logical stack = %d\n",G_i_TStackL+1);
- }
|