53 int NormPolyTerm(
PHEAD WORD *term)
55 WORD *tcoef, ncoef, *tstop, *tfill, *t, *tt;
57 WORD *r1, *r2, *r3, *r4, *r5, *rfirst, rv;
64 tstop = tcoef - ABS(tcoef[-1]);
67 if ( t >= tstop ) {
return(*term); }
77 r2 = rfirst+4; tt = r3 = t + t[1]; equal = 0;
80 if ( *r2 > *r1 ) { r2 += 2;
continue; }
81 if ( *r2 == *r1 ) { r2 += 2; equal = 1;
continue; }
82 rv = *r1; *r1 = *r2; *r2 = rv;
83 r1 -= 2; r2 -= 2; r4 = r2 + 2;
85 if ( *r2 >= *r1 ) { r2 = r4;
break; }
86 rv = *r1; *r1 = *r2; *r2 = rv;
100 while ( r4 < r3 ) *r2++ = *r4++;
102 r2 = r1 + 2; r3 -= 2;
111 r1 = t + 2; tt = r3 = t + t[1];
113 r2 = rfirst+2; r4 = rfirst + rfirst[1];
119 else if ( *r2 > *r1 ) {
121 while ( r5 > r2 ) { r5[1] = r5[-1]; r5[0] = r5[-2]; r5 -= 2; }
123 *r2 = *r1; r2[1] = r1[1];
130 *r2++ = *r1++; *r2++ = *r1++;
143 if ( t[3] & 1 ) ncoef = -ncoef;
145 else if ( t[2] == 0 ) {
146 if ( t[3] < 0 )
goto NormInf;
149 lnum = TermMalloc(
"lnum");
152 if ( t[3] && RaisPow(BHEAD (UWORD *)lnum,&nnum,(UWORD)(ABS(t[3]))) )
goto FromNorm;
153 ncoef = REDLENG(ncoef);
155 if ( Divvy(BHEAD (UWORD *)tstop,&ncoef,(UWORD *)lnum,nnum) )
158 else if ( t[3] > 0 ) {
159 if ( Mully(BHEAD (UWORD *)tstop,&ncoef,(UWORD *)lnum,nnum) )
162 ncoef = INCLENG(ncoef);
164 TermFree(lnum,
"lnum");
167 ncoef = REDLENG(ncoef);
168 if ( Mully(BHEAD (UWORD *)tstop,&ncoef,(UWORD *)(t+3),t[2]) )
goto FromNorm;
169 ncoef = INCLENG(ncoef);
173 MLOCK(ErrorMessageLock);
174 MesPrint(
"Illegal code in NormPolyTerm");
175 MUNLOCK(ErrorMessageLock);
185 r3 = rfirst + rfirst[1];
189 while ( r1 < r3 ) { r1[-2] = r1[0]; r1[-1] = r1[1]; r1 += 2; }
195 if ( rfirst[1] < 4 ) rfirst = 0;
202 NCOPY(tfill,rfirst,i)
207 *term = tfill - term;
213 MLOCK(ErrorMessageLock);
214 MesPrint(
"0^0 in NormPolyTerm");
215 MUNLOCK(ErrorMessageLock);
219 MLOCK(ErrorMessageLock);
220 MesCall(
"NormPolyTerm");
221 MUNLOCK(ErrorMessageLock);
251 #ifdef WITHCOMPAREPOLY 253 WORD ComparePoly(WORD *term1, WORD *term2, WORD level)
255 WORD *t1, *t2, *t3, *t4, *tstop1, *tstop2;
256 tstop1 = term1 + *term1;
257 tstop1 -= ABS(tstop1[-1]);
258 tstop2 = term2 + *term2;
259 tstop2 -= ABS(tstop2[-1]);
262 while ( t1 < tstop1 && t2 < tstop2 ) {
264 if ( *t1 == HAAKJE ) {
265 if ( t1[2] != t2[2] )
return(t2[2]-t1[2]);
266 t1 += t1[1]; t2 += t2[1];
269 t3 = t1 + t1[1]; t4 = t2 + t2[1];
271 while ( t1 < t3 && t2 < t4 ) {
272 if ( *t1 != *t2 )
return(*t2-*t1);
273 if ( t1[1] != t2[1] )
return(t2[1]-t1[1]);
276 if ( t1 < t3 )
return(-1);
277 if ( t2 < t4 )
return(1);
280 else return(*t2-*t1);
282 if ( t1 < tstop1 )
return(-1);
283 if ( t2 < tstop2 )
return(1);
305 static int FirstWarnConvertToPoly = 1;
307 int ConvertToPoly(
PHEAD WORD *term, WORD *outterm, WORD *comlist, WORD par)
309 WORD *tout, *tstop, ncoef, *t, *r, *tt, *ttwo = 0;
316 if ( comlist[2] == DOALL ) {
317 while ( t < tstop ) {
318 if ( *t == SYMBOL ) {
333 i = FindSubterm(tout+1);
336 *tout++ = MAXVARIABLES-i;
343 else if ( *t == DOTPRODUCT ) {
347 tout[1] = DOTPRODUCT;
357 i = FindSubterm(tout+1);
360 *tout++ = MAXVARIABLES-i;
366 else if ( *t == VECTOR ) {
374 i = FindSubterm(tout+1);
377 *tout++ = MAXVARIABLES-i;
383 else if ( *t == INDEX ) {
390 i = FindSubterm(tout+1);
393 *tout++ = MAXVARIABLES-i;
399 else if ( *t == HAAKJE) {
401 tout[0] = 1; tout[1] = 1; tout[2] = 3;
402 *outterm = (tout+3)-outterm;
403 if ( NormPolyTerm(BHEAD outterm) < 0 )
return(-1);
404 tout = outterm + *outterm;
406 i = t[1]; NCOPY(tout,t,i);
411 else if ( *t >= FUNCTION ) {
416 *tout++ = MAXVARIABLES-i;
421 if ( FirstWarnConvertToPoly ) {
422 MLOCK(ErrorMessageLock);
423 MesPrint(
"Illegal object in conversion to polynomial notation");
424 MUNLOCK(ErrorMessageLock);
425 FirstWarnConvertToPoly = 0;
430 NCOPY(tout,tstop,ncoef)
434 if ( ( i = NormPolyTerm(BHEAD ttwo) ) >= 0 ) i = action;
437 *outterm = tout - outterm;
440 *outterm = tout-outterm;
441 if ( ( i = NormPolyTerm(BHEAD outterm) ) >= 0 ) i = action;
444 else if ( comlist[2] == ONLYFUNCTIONS ) {
445 while ( t < tstop ) {
446 if ( *t >= FUNCTION ) {
447 if ( comlist[1] == 3 ) {
452 *tout++ = MAXVARIABLES-i;
457 for ( i = 3; i < comlist[1]; i++ ) {
458 if ( *t == comlist[i] )
break;
460 if ( i < comlist[1] ) {
465 *tout++ = MAXVARIABLES-i;
470 i = t[1]; NCOPY(tout,t,i);
475 i = t[1]; NCOPY(tout,t,i);
478 NCOPY(tout,tstop,ncoef)
479 *outterm = tout-outterm;
480 Normalize(BHEAD outterm);
484 MLOCK(ErrorMessageLock);
485 MesPrint(
"Illegal internal code in conversion to polynomial notation");
486 MUNLOCK(ErrorMessageLock);
512 WORD *tout, *tstop, ncoef, *t, *r, *tt, *ttwo = 0;
519 while ( t < tstop ) {
520 if ( *t == SYMBOL ) {
535 i = FindLocalSubterm(BHEAD tout+1,startebuf);
538 *tout++ = MAXVARIABLES-i;
545 else if ( *t == DOTPRODUCT ) {
549 tout[1] = DOTPRODUCT;
559 i = FindLocalSubterm(BHEAD tout+1,startebuf);
562 *tout++ = MAXVARIABLES-i;
568 else if ( *t == VECTOR ) {
576 i = FindLocalSubterm(BHEAD tout+1,startebuf);
579 *tout++ = MAXVARIABLES-i;
585 else if ( *t == INDEX ) {
592 i = FindLocalSubterm(BHEAD tout+1,startebuf);
595 *tout++ = MAXVARIABLES-i;
601 else if ( *t == HAAKJE) {
603 tout[0] = 1; tout[1] = 1; tout[2] = 3;
604 *outterm = (tout+3)-outterm;
605 if ( NormPolyTerm(BHEAD outterm) < 0 )
return(-1);
606 tout = outterm + *outterm;
608 i = t[1]; NCOPY(tout,t,i);
613 else if ( *t >= FUNCTION ) {
614 i = FindLocalSubterm(BHEAD t,startebuf);
618 *tout++ = MAXVARIABLES-i;
623 if ( FirstWarnConvertToPoly ) {
624 MLOCK(ErrorMessageLock);
625 MesPrint(
"Illegal object in conversion to polynomial notation");
626 MUNLOCK(ErrorMessageLock);
627 FirstWarnConvertToPoly = 0;
632 NCOPY(tout,tstop,ncoef)
636 if ( ( i = NormPolyTerm(BHEAD ttwo) ) >= 0 ) i = action;
639 *outterm = tout - outterm;
642 *outterm = tout-outterm;
643 if ( ( i = NormPolyTerm(BHEAD outterm) ) >= 0 ) i = action;
660 int ConvertFromPoly(
PHEAD WORD *term, WORD *outterm, WORD from, WORD to, WORD offset, WORD par)
662 WORD *tout, *tstop, *tstop1, ncoef, *t, *r, *tt;
720 while ( t < tstop ) {
721 if ( *t == SYMBOL ) {
724 while ( tt < tstop1 ) {
725 if ( ( *tt < MAXVARIABLES - to )
726 || ( *tt >= MAXVARIABLES - from ) ) {
730 *tout++ = SUBEXPRESSION;
731 *tout++ = SUBEXPSIZE;
732 *tout++ = MAXVARIABLES - *tt++ + offset;
734 if ( par ) *tout++ = AT.ebufnum;
735 else *tout++ = AM.sbufnum;
740 *tout++ = SYMBOL; *tout++ = 0;
741 while ( t < tstop1 ) {
742 if ( ( *t < MAXVARIABLES - to )
743 || ( *t >= MAXVARIABLES - from ) ) {
750 if ( r[1] <= 2 ) tout = r;
753 i = t[1]; NCOPY(tout,t,i)
756 NCOPY(tout,tstop,ncoef)
757 *outterm = tout-outterm;
773 WORD FindSubterm(WORD *subterm)
775 WORD old[5], *ss, *term, number;
776 CBUF *C = cbuf + AM.sbufnum;
779 ss = subterm+subterm[1];
783 old[0] = *term; old[1] = ss[0]; old[2] = ss[1]; old[3] = ss[2]; old[4] = ss[3];
784 ss[0] = 1; ss[1] = 1; ss[2] = 3; ss[3] = 0; *term = subterm[1]+4;
794 AddNtoC(AM.sbufnum,*term,term,8);
799 number = InsTree(AM.sbufnum,C->numrhs);
803 if ( number < (C->numrhs) ) {
809 WORD dim = DimensionSubterm(subterm);
811 if ( dim == -MAXPOSITIVE ) {
812 WORD *old = AN.currentTerm;
813 AN.currentTerm = term;
814 MLOCK(ErrorMessageLock);
815 MesPrint(
"Dimension out of range in %t");
816 MUNLOCK(ErrorMessageLock);
817 AN.currentTerm = old;
826 *term = old[0]; ss[0] = old[1]; ss[1] = old[2]; ss[2] = old[3]; ss[3] = old[4];
842 WORD FindLocalSubterm(
PHEAD WORD *subterm, WORD startebuf)
844 WORD old[5], *ss, *term, number, i, j, *t1, *t2;
845 CBUF *C = cbuf + AT.ebufnum;
847 ss = subterm+subterm[1];
851 old[0] = *term; old[1] = ss[0]; old[2] = ss[1]; old[3] = ss[2]; old[4] = ss[3];
852 ss[0] = 1; ss[1] = 1; ss[2] = 3; ss[3] = 0; *term = subterm[1]+4;
856 number = FindTree(AM.sbufnum,term);
857 if ( number > 0 )
goto wearehappy;
862 for ( i = startebuf+1; i <= C->numrhs; i++ ) {
863 t1 = C->
rhs[i]; t2 = term;
866 while ( *t1 == *t2 && j > 0 ) { t1++; t2++; j--; }
868 number = i-startebuf+numxsymbol;
877 AddNtoC(AT.ebufnum,*term,term,9);
879 number = C->numrhs-startebuf+numxsymbol;
881 *term = old[0]; ss[0] = old[1]; ss[1] = old[2]; ss[2] = old[3]; ss[3] = old[4];
895 void PrintSubtermList(
int from,
int to)
897 UBYTE buffer[80], *out, outbuffer[300];
898 int first, i, ii, inc = 1;
900 CBUF *C = cbuf + AM.sbufnum;
911 AO.OutFill = AO.OutputLine = outbuffer;
912 AO.OutStop = AO.OutputLine+AC.LineLength;
916 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) {
917 TokenToLine((UBYTE *)
" ");
920 else if ( ( AO.Optimize.debugflags & 1 ) == 1 ) {}
921 else if ( AO.OutSkip > 0 ) {
922 for ( i = 0; i < AO.OutSkip; i++ ) TokenToLine((UBYTE *)
" ");
926 if ( ( AO.Optimize.debugflags & 1 ) == 1 ) {
927 TokenToLine((UBYTE *)
"id ");
928 for ( ii = 3; ii < AO.OutSkip; ii++ ) TokenToLine((UBYTE *)
" ");
935 else if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) {}
936 else { TokenToLine((UBYTE *)
" "); }
938 out = StrCopy((UBYTE *)AC.extrasym,buffer);
939 if ( AC.extrasymbols == 0 ) {
940 out = NumCopy(i,out);
941 out = StrCopy((UBYTE *)
"_",out);
943 else if ( AC.extrasymbols == 1 ) {
944 out = AddArrayIndex(i,out);
946 out = StrCopy((UBYTE *)
"=",out);
951 out = StrCopy((UBYTE *)
"0",buffer);
952 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE ) {
953 out = StrCopy((UBYTE *)
";",out);
959 if ( WriteInnerTerm(term,first) ) Terminate(-1);
963 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE ) {
964 out = StrCopy((UBYTE *)
";",buffer);
981 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) {
1007 void PrintExtraSymbol(
int num, WORD *terms,
int par)
1009 UBYTE buffer[80], *out, outbuffer[300];
1013 AO.OutFill = AO.OutputLine = outbuffer;
1014 AO.OutStop = AO.OutputLine+AC.LineLength;
1017 if ( AC.OutputMode == FORTRANMODE || AC.OutputMode == PFORTRANMODE ) {
1018 TokenToLine((UBYTE *)
" ");
1021 else if ( ( AO.Optimize.debugflags & 1 ) == 1 ) {
1022 TokenToLine((UBYTE *)
"id ");
1023 for ( i = 3; i < AO.OutSkip; i++ ) TokenToLine((UBYTE *)
" ");
1025 else if ( AO.OutSkip > 0 ) {
1026 for ( i = 0; i < AO.OutSkip; i++ ) TokenToLine((UBYTE *)
" ");
1031 if ( num >= MAXVARIABLES-cbuf[AM.sbufnum].numrhs ) {
1032 num = MAXVARIABLES-num;
1035 out = StrCopy(FindSymbol(num),out);
1040 out = StrCopy(FindExtraSymbol(num),out);
1052 case EXPRESSIONNUMBER:
1053 out = StrCopy(EXPRNAME(num),out);
1056 MesPrint(
"Illegal option in PrintExtraSymbol");
1059 out = StrCopy((UBYTE *)
"=",out);
1060 TokenToLine(buffer);
1064 out = StrCopy((UBYTE *)
"0",buffer);
1065 TokenToLine(buffer);
1069 if ( WriteInnerTerm(term,first) ) Terminate(-1);
1074 if ( AC.OutputMode != FORTRANMODE && AC.OutputMode != PFORTRANMODE ) {
1075 out = StrCopy((UBYTE *)
";",buffer);
1076 TokenToLine(buffer);
1093 WORD FindSubexpression(WORD *subexpr)
1096 CBUF *C = cbuf + AM.sbufnum;
1100 while ( *term ) term += *term;
1101 number = term - subexpr;
1113 AddNtoC(AM.sbufnum,number,subexpr,10);
1118 number = InsTree(AM.sbufnum,C->numrhs);
1122 if ( number < (C->numrhs) ) {
1128 WORD dim = DimensionExpression(BHEAD subexpr);
1135 UNLOCK(AM.sbuflock);
1145 int ExtraSymFun(
PHEAD WORD *term,WORD level)
1147 WORD *oldworkpointer = AT.WorkPointer;
1148 WORD *termout, *t1, *t2, *t3, *tstop, *tend, i;
1150 tend = termout = term + *term;
1151 tstop = tend - ABS(tend[-1]);
1152 t3 = t1 = term+1; t2 = termout+1;
1156 while ( t1 < tstop ) {
1157 if ( *t1 == EXTRASYMFUN && t1[1] == FUNHEAD+2 ) {
1158 if ( t1[FUNHEAD] == -SNUMBER && t1[FUNHEAD+1] <= numxsymbol
1159 && t1[FUNHEAD+1] > 0 ) {
1162 else if ( t1[FUNHEAD] == -SYMBOL && t1[FUNHEAD+1] < MAXVARIABLES
1163 && t1[FUNHEAD+1] >= MAXVARIABLES-numxsymbol ) {
1164 i = MAXVARIABLES - t1[FUNHEAD+1];
1167 while ( t3 < t1 ) *t2++ = *t3++;
1171 *t2++ = SUBEXPRESSION;
1177 t3 = t1 = t1 + t1[1];
1179 else if ( *t1 == EXTRASYMFUN && t1[1] == FUNHEAD ) {
1180 while ( t3 < t1 ) *t2++ = *t3++;
1181 t3 = t1 = t1 + t1[1];
1188 while ( t3 < tend ) *t2++ = *t3++;
1189 *termout = t2 - termout;
1190 AT.WorkPointer = t2;
1191 if ( AT.WorkPointer >= AT.WorkTop ) {
1192 MLOCK(ErrorMessageLock);
1194 MUNLOCK(ErrorMessageLock);
1195 AT.WorkPointer = oldworkpointer;
1198 retval =
Generator(BHEAD termout,level);
1199 AT.WorkPointer = oldworkpointer;
1201 MLOCK(ErrorMessageLock);
1202 MesCall(
"ExtraSymFun");
1203 MUNLOCK(ErrorMessageLock);
1213 int PruneExtraSymbols(WORD downto)
1215 CBUF *C = cbuf + AM.sbufnum;
1216 if ( downto < C->numrhs && downto >= 0 ) {
1217 ClearTree(AM.sbufnum);
1219 if ( downto == 0 ) {
1223 WORD *w = C->
rhs[downto], i;
1224 while ( *w ) w += *w;
1226 for ( i = 1; i <= downto; i++ ) {
1227 InsTree(AM.sbufnum,i);
int LocalConvertToPoly(PHEAD WORD *term, WORD *outterm, WORD startebuf, WORD par)
WORD Generator(PHEAD WORD *, WORD)