diff --git a/check/extra/forcer.frm b/check/extra/forcer.frm index d29bb274..78881f43 100644 --- a/check/extra/forcer.frm +++ b/check/extra/forcer.frm @@ -19,7 +19,6 @@ L F = B ep; P; .end -#pend_if valgrind? assert succeeded? assert result("F") =~ expr(" + ep^-3 * ( 1/24 ) @@ -141,6 +140,7 @@ ModuleOption noparallel; B ep; P; .end +# Too slow, but is supposed to pass. #pend_if valgrind? assert succeeded? assert result("F1") =~ expr(" @@ -269,6 +269,7 @@ ModuleOption noparallel; B ep; P; .end +# Too slow, but is supposed to pass. #pend_if valgrind? assert succeeded? assert result("F1") =~ expr(" @@ -289,3 +290,219 @@ assert result("F2") =~ expr(" z3 - 3705/8*z3^2 ") *--#] Forcer_1-expand : +*--#[ Forcer_2 : +* An easier version of the above, for checking with valgrind +* timeout = 60 seconds. +#include- forcer.h +CF f,f1,f2,f3; +V p2,p3; +S x3; + +* Give 1 or -1. n1 is not used. +Table randomsign(n1?); +Fill randomsign() = random_(2)*2-3; + +* Zip two functions as: +* zip(f1,f2(p1,...,pN),f3(q1,...,qN)) -> f1(p1,q1,...,pN,qN), +* for N >= 1. +Table zip(f1?(?a1),f2?(p2?,?a2),f3?(p3?,?a3)); +Fill zip() = + + thetap_(nargs_(?a2,?a3)) * zip(f1(?a1,p2,p3),f2(?a2),f3(?a3)) + + delta_(nargs_(?a2,?a3)) * f1(?a1,p2,p3) +; + +* Element-wise multiplication as: +* emul(f1,f2(p1,...,pN),f3(a1,...,aN)) -> f1(p1*a1,...,pN*aN) +* for N >= 1. +Table emul(f1?(?a1),f2?(p2?,?a2),f3?(x3?,?a3)); +Fill emul() = + + thetap_(nargs_(?a2,?a3)) * emul(f1(?a1,p2*x3),f2(?a2),f3(?a3)) + + delta_(nargs_(?a2,?a3)) * f1(?a1,p2*x3) +; + +L F1 = + #do i=1,2 + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,0,0,0) + #enddo +; + +L F2 = + #do i=1,2 + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,-1,0,0) + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,0,-1,0) + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,0,0,-1) + #enddo +; + +id Zno1(n1?,...,n14?) = + +vx(-Q,p4,p5) + *vx(p3,-p4,p10) + *vx(p2,-p3,p9) + *vx(p1,-p2,p11) + *vx(-p5,p6,-p11) + *vx(-p6,p7,-p10) + *vx(-p7,p8,-p9) + *vx(-p1,-p8,Q) + //.../ + /p2.p4^n12/Q.p2^n13/Q.p3^n14 +; + +id Zno2(n1?,...,n14?) = + +vx(-Q,p4,p5) + *vx(p3,-p4,p11) + *vx(p6,p7,p10) + *vx(p2,-p3,-p10) + *vx(p1,-p2,p9) + *vx(-p5,-p6,-p9) + *vx(-p7,p8,-p11) + *vx(-p1,-p8,Q) + //.../ + /Q.p2^n12/p1.p4^n13/Q.p3^n14 +; + +id Zno3(n1?,...,n14?) = + +vx(-Q,p3,p4) + *vx(p6,p8,p10) + *vx(p5,-p10,p11) + *vx(p1,-p3,-p5) + *vx(-p4,-p8,p9) + *vx(p7,-p9,-p11) + *vx(p2,-p6,-p7) + *vx(-p1,-p2,Q) + //.../ + /Q.p6^n12/Q.p8^n13/p3.p6^n14 +; + +* Make a random permutation of the loop momenta. The result should be the same. +multiply f1(p1,...,p11); +multiply ranperm_(f2,p1,...,p11); +multiply f3(,...,); +id f2(?a)*f3(?b) = emul(f2,f2(?a),f3(?b)); +id f1(?a)*f2(?b) = zip(f1,f1(?a),f2(?b)); +id f1(?a) = replace_(?a); + +ModuleOption noparallel; +.sort:input; + +#call Forcer(msbarexpand=4) +B ep; +P; +.end +assert succeeded? +assert result("F1") =~ expr(" + + ep^-1 * ( - 15*z5 ) + + + 21/2*z7 - 75/2*z6 + 55*z5 - 51*z3^2 +") +assert result("F2") =~ expr(" + + 161/2*z7 + 20*z5 + 18*z3^2 +") +*--#] Forcer_2 : +*--#[ Forcer_2-expand : +* An easier version of the above, for checking with valgrind +* timeout = 60 seconds. +#include- forcer.h +CF f,f1,f2,f3; +V p2,p3; +S x3; + +* Give 1 or -1. n1 is not used. +Table randomsign(n1?); +Fill randomsign() = random_(2)*2-3; + +* Zip two functions as: +* zip(f1,f2(p1,...,pN),f3(q1,...,qN)) -> f1(p1,q1,...,pN,qN), +* for N >= 1. +Table zip(f1?(?a1),f2?(p2?,?a2),f3?(p3?,?a3)); +Fill zip() = + + thetap_(nargs_(?a2,?a3)) * zip(f1(?a1,p2,p3),f2(?a2),f3(?a3)) + + delta_(nargs_(?a2,?a3)) * f1(?a1,p2,p3) +; + +* Element-wise multiplication as: +* emul(f1,f2(p1,...,pN),f3(a1,...,aN)) -> f1(p1*a1,...,pN*aN) +* for N >= 1. +Table emul(f1?(?a1),f2?(p2?,?a2),f3?(x3?,?a3)); +Fill emul() = + + thetap_(nargs_(?a2,?a3)) * emul(f1(?a1,p2*x3),f2(?a2),f3(?a3)) + + delta_(nargs_(?a2,?a3)) * f1(?a1,p2*x3) +; + +L F1 = + #do i=1,2 + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,0,0,0) + #enddo +; + +L F2 = + #do i=1,2 + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,-1,0,0) + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,0,-1,0) + + Zno`i'(1,1,1,1,1,1,1,1,1,1,1,0,0,-1) + #enddo +; + +id Zno1(n1?,...,n14?) = + +vx(-Q,p4,p5) + *vx(p3,-p4,p10) + *vx(p2,-p3,p9) + *vx(p1,-p2,p11) + *vx(-p5,p6,-p11) + *vx(-p6,p7,-p10) + *vx(-p7,p8,-p9) + *vx(-p1,-p8,Q) + //.../ + /p2.p4^n12/Q.p2^n13/Q.p3^n14 +; + +id Zno2(n1?,...,n14?) = + +vx(-Q,p4,p5) + *vx(p3,-p4,p11) + *vx(p6,p7,p10) + *vx(p2,-p3,-p10) + *vx(p1,-p2,p9) + *vx(-p5,-p6,-p9) + *vx(-p7,p8,-p11) + *vx(-p1,-p8,Q) + //.../ + /Q.p2^n12/p1.p4^n13/Q.p3^n14 +; + +id Zno3(n1?,...,n14?) = + +vx(-Q,p3,p4) + *vx(p6,p8,p10) + *vx(p5,-p10,p11) + *vx(p1,-p3,-p5) + *vx(-p4,-p8,p9) + *vx(p7,-p9,-p11) + *vx(p2,-p6,-p7) + *vx(-p1,-p2,Q) + //.../ + /Q.p6^n12/Q.p8^n13/p3.p6^n14 +; + +* Make a random permutation of the loop momenta. The result should be the same. +multiply f1(p1,...,p11); +multiply ranperm_(f2,p1,...,p11); +multiply f3(,...,); +id f2(?a)*f3(?b) = emul(f2,f2(?a),f3(?b)); +id f1(?a)*f2(?b) = zip(f1,f1(?a),f2(?b)); +id f1(?a) = replace_(?a); + +ModuleOption noparallel; +.sort:input; + +#call Forcer(msbarexpand=4,polyratfunexpand=15) +B ep; +P; +.end +assert succeeded? +assert result("F1") =~ expr(" + + ep^-1 * ( - 15*z5 ) + + + 21/2*z7 - 75/2*z6 + 55*z5 - 51*z3^2 +") +assert result("F2") =~ expr(" + + 161/2*z7 + 20*z5 + 18*z3^2 +") +*--#] Forcer_2-expand : diff --git a/sources/execute.c b/sources/execute.c index 002d2826..7c7bad27 100644 --- a/sources/execute.c +++ b/sources/execute.c @@ -2428,13 +2428,12 @@ void UpdatePositions(void) oldw = AS.Oldvflags; AS.Oldvflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"vflags pointers"); for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.Oldvflags[i] = oldw[i]; - AS.NumOldNumFactors = NumExpressions; M_free(oldw,"vflags pointers"); oldw = AS.Olduflags; AS.Olduflags = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"uflags pointers"); for ( i = 0; i < AS.NumOldNumFactors; i++ ) AS.Olduflags[i] = oldw[i]; - AS.NumOldNumFactors = NumExpressions; M_free(oldw,"uflags pointers"); + AS.NumOldNumFactors = NumExpressions; } else { AS.OldNumFactors = (WORD *)Malloc1(NumExpressions*sizeof(WORD),"numfactors pointers"); diff --git a/sources/pre.c b/sources/pre.c index 0700aa16..2953c80d 100644 --- a/sources/pre.c +++ b/sources/pre.c @@ -2569,6 +2569,7 @@ int DoCall(UBYTE *s) for ( i = NumProcedures-1; i >= 0; i-- ) { if ( StrCmp(Procedures[i].name,name) == 0 ) break; } + // AP.ProcList.num = NumProcedures is incremented inside FromList p = (PROCEDURE *)FromList(&AP.ProcList); if ( i < 0 ) { /* Try to find a file */ namesize = 0; @@ -2584,6 +2585,7 @@ int DoCall(UBYTE *s) while ( *v ) *t++ = *v++; *t = 0; p->loadmode = 0; /* buffer should be freed at end */ + p->mustfree = 1; p->p.buffer = LoadInputFile(p->name,PROCEDUREFILE); if ( p->p.buffer == 0 ) return(-1); t[-4] = 0; @@ -2592,6 +2594,7 @@ int DoCall(UBYTE *s) p->p.buffer = Procedures[i].p.buffer; p->name = Procedures[i].name; p->loadmode = 1; + p->mustfree = 0; // this is just a copy of pointers to a permanently stored procedure } t = p->p.buffer; SKIPBLANKS(t) @@ -3352,9 +3355,10 @@ int DoEndprocedure(UBYTE *s) if ( AP.PreSwitchModes[AP.PreSwitchLevel] != EXECUTINGPRESWITCH ) return(0); if ( AP.PreIfStack[AP.PreIfLevel] != EXECUTINGIF ) return(0); AC.CurrentStream = CloseStream(AC.CurrentStream); + do { NumProcedures--; - if ( Procedures[NumProcedures].loadmode == 0 ) { + if ( Procedures[NumProcedures].mustfree == 1 ) { M_free(Procedures[NumProcedures].p.buffer,"procedures buffer"); M_free(Procedures[NumProcedures].name,"procedures name"); } @@ -4015,10 +4019,25 @@ int DoProcedure(UBYTE *s) if ( PreSkip((UBYTE *)"procedure",(UBYTE *)"endprocedure",1) ) return(-1); return(0); } + // AP.ProcList.num = NumProcedures is incremented inside FromList p = (PROCEDURE *)FromList(&AP.ProcList); if ( PreLoad(&(p->p),(UBYTE *)"procedure",(UBYTE *)"endprocedure" ,1,(char *)"procedure") ) return(-1); + // If the procedure below is not local (loadmode 0) or has been called (loadmode 1), this is a + // nested procedure definition. We must free its allocations when we hit its DoEndprocedure. + // If it seems local (loadmode 2) but is tagged as "mustfree", it is multiply nested and we + // similarly must free its allocations. + if ( NumProcedures >= 2 && + ( Procedures[NumProcedures-2].loadmode != 2 || Procedures[NumProcedures-2].mustfree ) ) { + p->mustfree = 1; + } + // Otherwise, we are defining a local procedure at "ground level", and we keep the definition + // on the procedure stack until FORM terminates. + else { + p->mustfree = 0; + } + p->loadmode = 2; s = p->p.buffer + 10; while ( *s == ' ' || *s == LINEFEED ) s++; diff --git a/sources/structs.h b/sources/structs.h index 001fc5aa..035e3223 100644 --- a/sources/structs.h +++ b/sources/structs.h @@ -884,6 +884,7 @@ typedef struct { PRELOAD p; UBYTE *name; int loadmode; + int mustfree; PADPOINTER(0,1,0,0); } PROCEDURE;