40static UBYTE underscore[2] = {
'_',0};
54int CatchDollar(
int par)
57 CBUF *C = cbuf + AC.cbufnum;
58 int error = 0, numterms = 0, numdollar, resetmods = 0;
60 WORD *w, *t, n, nsize, *oldwork = AT.WorkPointer, *dbuffer;
61 WORD oldncmod = AN.ncmod;
63 if ( AN.ncmod && ( ( AC.modmode & ALSODOLLARS ) == 0 ) ) AN.ncmod = 0;
64 if ( AN.ncmod && AN.cmod == 0 ) { SetMods(); resetmods = 1; }
66 numdollar = C->lhs[C->numlhs][2];
68 d = Dollars+numdollar;
70 d->type = DOLUNDEFINED;
71 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
72 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
73 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"$-buffer old");
74 d->size = 0; d->where = &(AM.dollarzero);
75 cbuf[AM.dbufnum].rhs[numdollar] = d->where;
77 if ( resetmods ) UnSetMods();
94 if ( PF.me == MASTER || !AC.RhsExprInModuleFlag ) {
99 if (
NewSort(BHEAD0) ) {
if ( !error ) error = 1;
goto onerror; }
102 if ( !error ) error = 1;
105 AN.RepPoint = AT.RepCount + 1;
106 w = C->rhs[C->lhs[C->numlhs][5]];
111 AR.Cnumlhs = C->numlhs;
112 if (
Generator(BHEAD oldwork,C->numlhs) ) { error = 1;
break; }
114 AT.WorkPointer = oldwork;
117 if ( ( retval =
EndSort(BHEAD (WORD *)((VOID *)(&dbuffer)),2) ) < 0 ) { error = 1; }
119 if ( retval <= 1 || dbuffer == 0 ) {
121 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"$-buffer old");
122 d->size = 0; d->where = &(AM.dollarzero);
123 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
124 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
129 while ( *w ) { w += *w; numterms++; }
132 newsize = (w-dbuffer)+1;
135 if ( AC.RhsExprInModuleFlag )
140 if ( newsize < MINALLOC ) newsize = MINALLOC;
141 newsize = ((newsize+7)/8)*8;
142 if ( numterms == 0 ) {
146 else if ( numterms == 1 ) {
150 if ( nsize < 0 ) { nsize = -nsize; }
151 if ( nsize == (n-1) ) {
154 if ( *w != 1 )
goto doterms;
155 w++;
while ( w < ( t + n - 1 ) ) {
if ( *w )
break; w++; }
156 if ( w < ( t + n - 1 ) )
goto doterms;
160 else if ( n == 7 && t[6] == 3 && t[5] == 1 && t[4] == 1
161 && t[1] == INDEX && t[2] == 3 ) {
171 cbuf[AM.dbufnum].CanCommu[numdollar] = numcommute(dbuffer,
172 &(cbuf[AM.dbufnum].NumTerms[numdollar]));
174 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"$-buffer old");
175 d->size = newsize; d->where = dbuffer;
177 cbuf[AM.dbufnum].rhs[numdollar] = d->where;
179 if ( C->Pointer > C->rhs[C->numrhs] ) C->Pointer = C->rhs[C->numrhs];
180 C->numlhs--; C->numrhs--;
183 if ( PF.me == MASTER || !AC.RhsExprInModuleFlag )
187 if ( resetmods ) UnSetMods();
209int AssignDollar(PHEAD WORD *term, WORD level)
212 CBUF *C = cbuf+AM.rbufnum;
213 int numterms = 0, numdollar = C->lhs[level][2];
215 DOLLARS d = Dollars + numdollar;
216 WORD *w, *t, n, nsize, *rh = cbuf[C->lhs[level][7]].rhs[C->lhs[level][5]];
218 WORD olddefer, oldcompress, oldncmod = AN.ncmod;
220 int nummodopt, dtype = -1, dw;
222 if ( AN.ncmod && ( ( AC.modmode & ALSODOLLARS ) == 0 ) ) AN.ncmod = 0;
223 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
229 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
230 if ( numdollar == ModOptdollars[nummodopt].number )
break;
232 if ( nummodopt >= NumModOptdollars ) {
233 MLOCK(ErrorMessageLock);
234 MesPrint(
"Illegal attempt to change $-variable in multi-threaded module %l",AC.CModule);
235 MUNLOCK(ErrorMessageLock);
238 dtype = ModOptdollars[nummodopt].type;
239 if ( dtype == MODLOCAL ) {
240 d = ModOptdollars[nummodopt].dstruct+AT.identity;
256 LOCK(d->pthreadslockread);
259 case DOLZERO:
goto NoChangeZero;
262 if ( ( dw = d->where[0] ) > 0 && d->where[dw] != 0 ) {
265 if ( dtype == MODMAX && d->where[dw-1] >= 0 )
goto NoChangeZero;
266 if ( dtype == MODMIN && d->where[dw-1] <= 0 )
goto NoChangeZero;
269 numvalue = DolToNumber(BHEAD numdollar);
270 if ( AN.ErrorInDollar != 0 )
break;
271 if ( dtype == MODMAX && numvalue >= 0 )
goto NoChangeZero;
272 if ( dtype == MODMIN && numvalue <= 0 )
goto NoChangeZero;
277 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
278 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
280 CleanDollarFactors(d);
282 UNLOCK(d->pthreadslockread);
292 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
293 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
294 CleanDollarFactors(d);
298 else if ( *w == 4 && w[4] == 0 && w[2] == 1 ) {
305 LOCK(d->pthreadslockread);
306 if ( d->size < MINALLOC ) {
307 WORD oldsize, *oldwhere, i;
308 oldsize = d->size; oldwhere = d->where;
310 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"dollar contents");
311 cbuf[AM.dbufnum].rhs[numdollar] = d->where;
313 for ( i = 0; i < oldsize; i++ ) d->where[i] = oldwhere[i];
315 else d->where[0] = 0;
316 if ( oldwhere && oldwhere != &(AM.dollarzero) ) M_free(oldwhere,
"dollar contents");
321 if ( dtype == MODMAX && w[3] <= 0 )
goto NoChangeOne;
322 if ( dtype == MODMIN && w[3] >= 0 )
goto NoChangeOne;
326 if ( ( dw = d->where[0] ) > 0 && d->where[dw] != 0 ) {
329 if ( dtype == MODMAX &&
CompCoef(d->where,w) >= 0 )
goto NoChangeOne;
330 if ( dtype == MODMIN &&
CompCoef(d->where,w) <= 0 )
goto NoChangeOne;
338 numvalue = DolToNumber(BHEAD numdollar);
339 if ( AN.ErrorInDollar != 0 )
break;
340 if ( numvalue == 0 ) {
343 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
344 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
347 d->where[0] = extraterm[0] = 4;
348 d->where[1] = extraterm[1] = ABS(numvalue);
349 d->where[2] = extraterm[2] = 1;
350 d->where[3] = extraterm[3] = numvalue > 0 ? 3 : -3;
353 if ( dtype == MODMAX &&
CompCoef(extraterm,w) >= 0 )
goto NoChangeOne;
354 if ( dtype == MODMIN &&
CompCoef(extraterm,w) <= 0 )
goto NoChangeOne;
364 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
365 cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
367 CleanDollarFactors(d);
369 UNLOCK(d->pthreadslockread);
377 if ( d->size < MINALLOC ) {
378 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
380 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"dollar contents");
381 cbuf[AM.dbufnum].rhs[numdollar] = d->where;
389 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
390 cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
391 CleanDollarFactors(d);
401 if ( dtype == MODSUM ) {
403 LOCK(d->pthreadslockread);
406 CleanDollarFactors(d);
426 olddefer = AR.DeferFlag; AR.DeferFlag = 0;
427 oldcompress = AR.NoCompress; AR.NoCompress = 1;
429 n = *w; t = ww = AT.WorkPointer;
435 AR.DeferFlag = olddefer;
442 if ( ( newsize =
EndSort(BHEAD (WORD *)((VOID *)(&ss)),2) ) < 0 ) {
446 numterms = 0; t = ss;
while ( *t ) { numterms++; t += *t; }
449 if ( dtype != MODSUM ) {
451 LOCK(d->pthreadslockread);
454 if ( numterms == 0 ) {
459 if ( dtype == MODMAX || dtype == MODMIN ) {
460 if ( ss ) { M_free(ss,
"Sort of $"); ss = 0; }
461 AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
467 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
468 d->where = &(AM.dollarzero);
470 cbuf[AM.dbufnum].rhs[numdollar] = 0;
471 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
472 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
475 if ( ss ) { M_free(ss,
"Sort of $"); ss = 0; }
482 if ( dtype == MODMAX || dtype == MODMIN ) {
483 if ( numterms == 1 && ( *ss-1 == ABS(ss[*ss-1]) ) ) {
487 if ( dtype == MODMAX && ss[*ss-1] > 0 )
break;
488 if ( dtype == MODMIN && ss[*ss-1] < 0 )
break;
489 if ( ss ) { M_free(ss,
"Sort of $"); ss = 0; }
490 AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
494 if ( ( dw = d->where[0] ) > 0 && d->where[dw] != 0 )
break;
495 if ( dtype == MODMAX &&
CompCoef(ss,d->where) > 0 )
break;
496 if ( dtype == MODMIN &&
CompCoef(ss,d->where) < 0 )
break;
497 if ( ss ) { M_free(ss,
"Sort of $"); ss = 0; }
498 AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
502 numvalue = DolToNumber(BHEAD numdollar);
503 if ( AN.ErrorInDollar != 0 )
break;
504 if ( numvalue == 0 ) {
507 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
508 cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
511 d->where[0] = extraterm[0] = 4;
512 d->where[1] = extraterm[1] = ABS(numvalue);
513 d->where[2] = extraterm[2] = 1;
514 d->where[3] = extraterm[3] = numvalue > 0 ? 3 : -3;
517 if ( dtype == MODMAX &&
CompCoef(ss,extraterm) > 0 )
break;
518 if ( dtype == MODMIN &&
CompCoef(ss,extraterm) < 0 )
break;
519 if ( ss ) { M_free(ss,
"Sort of $"); ss = 0; }
520 AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
526 if ( ss ) { M_free(ss,
"Sort of $"); ss = 0; }
527 AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
536 if ( d->where && d->where != &(AM.dollarzero) ) { M_free(d->where,
"dollar contents"); d->where = 0; }
537 d->size = newsize + 1;
539 cbuf[AM.dbufnum].rhs[numdollar] = w = d->where;
541 AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
545 if ( numterms == 0 ) {
548 else if ( numterms == 1 ) {
552 if ( nsize < 0 ) { nsize = -nsize; }
553 if ( nsize == (n-1) ) {
557 w++;
while ( w < ( t + n - 1 ) ) {
if ( *w )
break; w++; }
558 if ( w >= ( t + n - 1 ) ) d->type = DOLNUMBER;
561 else if ( n == 7 && t[6] == 3 && t[5] == 1 && t[4] == 1
562 && t[1] == INDEX && t[2] == 3 ) {
567 if ( d->type == DOLTERMS ) {
568 cbuf[AM.dbufnum].CanCommu[numdollar] = numcommute(d->where,
569 &(cbuf[AM.dbufnum].NumTerms[numdollar]));
572 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
573 cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
578 UNLOCK(d->pthreadslockread);
596UBYTE *WriteDollarToBuffer(WORD numdollar, WORD par)
598 DOLLARS d = Dollars+numdollar;
599 UBYTE *s, *oldcurbufwrt = AO.CurBufWrt;
600 WORD *t, lbrac = 0, first = 0, arg[2], oldOutputMode = AC.OutputMode;
601 WORD oldinfbrack = AO.InFbrack;
603 int dict = AO.CurrentDictionary;
605 AO.DollarOutSizeBuffer = 32;
606 AO.DollarOutBuffer = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,
"DollarOutBuffer");
607 AO.DollarInOutBuffer = 1;
610 s = AO.DollarOutBuffer;
612 if ( par > 0 && AO.CurDictInDollars == 0 ) {
613 AC.OutputMode = NORMALFORMAT;
614 AO.CurrentDictionary = 0;
617 AO.CurBufWrt = (UBYTE *)underscore;
622 WriteArgument(d->where);
625 WriteSubTerm(d->where,1);
631 if ( WriteTerm(t,&lbrac,first,PRINTON,0) ) {
642 if ( *t ) TokenToLine((UBYTE *)(
","));
646 arg[0] = -INDEX; arg[1] = d->index;
651 AO.DollarInOutBuffer = 1;
655 AO.DollarInOutBuffer = 1;
658 AC.OutputMode = oldOutputMode;
660 AO.InFbrack = oldinfbrack;
661 AO.CurBufWrt = oldcurbufwrt;
662 AO.CurrentDictionary = dict;
664 MLOCK(ErrorMessageLock);
665 MesPrint(
"&Illegal dollar object for writing");
666 MUNLOCK(ErrorMessageLock);
667 M_free(AO.DollarOutBuffer,
"DollarOutBuffer");
668 AO.DollarOutBuffer = 0;
669 AO.DollarOutSizeBuffer = 0;
672 return(AO.DollarOutBuffer);
687UBYTE *WriteDollarFactorToBuffer(WORD numdollar, WORD numfac, WORD par)
689 DOLLARS d = Dollars+numdollar;
690 UBYTE *s, *oldcurbufwrt = AO.CurBufWrt;
691 WORD *t, lbrac = 0, first = 0, n[5], oldOutputMode = AC.OutputMode;
692 WORD oldinfbrack = AO.InFbrack;
694 int dict = AO.CurrentDictionary;
696 if ( numfac > d->nfactors || numfac < 0 ) {
697 MLOCK(ErrorMessageLock);
698 MesPrint(
"&Illegal factor number for this dollar variable: %d",numfac);
699 MesPrint(
"&There are %d factors",d->nfactors);
700 MUNLOCK(ErrorMessageLock);
704 AO.DollarOutSizeBuffer = 32;
705 AO.DollarOutBuffer = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,
"DollarOutBuffer");
706 AO.DollarInOutBuffer = 1;
709 s = AO.DollarOutBuffer;
712 AC.OutputMode = NORMALFORMAT;
713 AO.CurrentDictionary = 0;
716 AO.CurBufWrt = (UBYTE *)underscore;
720 n[0] = 4; n[1] = d->nfactors; n[2] = 1; n[3] = 3; n[4] = 0; t = n;
722 else if ( numfac == 1 && d->factors == 0 ) {
725 else if ( d->factors[numfac-1].where == 0 ) {
726 if ( d->factors[numfac-1].value < 0 ) {
727 n[0] = 4; n[1] = -d->factors[numfac-1].value; n[2] = 1; n[3] = -3; n[4] = 0; t = n;
730 n[0] = 4; n[1] = d->factors[numfac-1].value; n[2] = 1; n[3] = 3; n[4] = 0; t = n;
733 else { t = d->factors[numfac-1].where; }
735 if ( WriteTerm(t,&lbrac,first,PRINTON,0) ) {
740 AC.OutputMode = oldOutputMode;
742 AO.InFbrack = oldinfbrack;
743 AO.CurBufWrt = oldcurbufwrt;
744 AO.CurrentDictionary = dict;
746 MLOCK(ErrorMessageLock);
747 MesPrint(
"&Illegal dollar object for writing");
748 MUNLOCK(ErrorMessageLock);
749 M_free(AO.DollarOutBuffer,
"DollarOutBuffer");
750 AO.DollarOutBuffer = 0;
751 AO.DollarOutSizeBuffer = 0;
754 return(AO.DollarOutBuffer);
762void AddToDollarBuffer(UBYTE *s)
765 UBYTE *t = s, *u, *newdob;
767 while ( *t ) { t++; }
769 while ( i + AO.DollarInOutBuffer >= AO.DollarOutSizeBuffer ) {
770 j = AO.DollarInOutBuffer;
771 AO.DollarOutSizeBuffer *= 2;
772 t = AO.DollarOutBuffer;
773 newdob = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,
"DollarOutBuffer");
775 while ( --j >= 0 ) *u++ = *t++;
776 M_free(AO.DollarOutBuffer,
"DollarOutBuffer");
777 AO.DollarOutBuffer = newdob;
779 t = AO.DollarOutBuffer + AO.DollarInOutBuffer-1;
780 while ( t == AO.DollarOutBuffer && ( *s ==
'+' || *s ==
' ' ) ) s++;
782 if ( AO.CurrentDictionary == 0 ) {
784 if ( *s ==
' ' ) { s++;
continue; }
789 while ( *s ) { *t++ = *s++; i++; }
792 AO.DollarInOutBuffer += i;
803void TermAssign(WORD *term)
806 WORD *t, *tstop, *astop, *w, *m;
809 astop = term + *term;
810 tstop = astop - ABS(astop[-1]);
812 while ( t < tstop ) {
813 if ( *t == AM.termfunnum && t[1] == FUNHEAD+2
814 && t[FUNHEAD] == -DOLLAREXPRESSION ) {
815 d = Dollars + t[FUNHEAD+1];
816 newsize = *term - FUNHEAD - 1;
817 if ( newsize < MINALLOC ) newsize = MINALLOC;
818 newsize = ((newsize+7)/8)*8;
819 if ( d->size > 2*newsize && d->size > 1000 ) {
820 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
822 d->where = &(AM.dollarzero);
824 if ( d->size < newsize ) {
825 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
827 d->where = (WORD *)Malloc1(newsize*
sizeof(WORD),
"dollar contents");
829 cbuf[AM.dbufnum].rhs[t[FUNHEAD+1]] = w = d->where;
831 while ( m < t ) *w++ = *m++;
833 while ( m < tstop ) {
834 if ( *m == AM.termfunnum && m[1] == FUNHEAD+2
835 && m[FUNHEAD] == -DOLLAREXPRESSION ) { m += m[1]; }
838 while ( --i >= 0 ) *w++ = *m++;
841 while ( m < astop ) *w++ = *m++;
842 *(d->where) = w - d->where;
846 while ( m < astop ) *w++ = *m++;
852 if ( t >= tstop )
return;
863int PutTermInDollar(WORD *term, WORD numdollar)
865 DOLLARS d = Dollars+numdollar;
867 if ( term == 0 || *term == 0 ) {
871 if ( d->size < *term || d->size > 2*term[0] || d->where == 0 ) {
872 if ( d->size > 0 && d->where ) {
873 M_free(d->where,
"dollar contents");
875 d->where = Malloc1((term[0]+1)*
sizeof(WORD),
"dollar contents");
879 for ( i = 0; i < term[0]; i++ ) d->where[i] = term[i];
893void WildDollars(PHEAD WORD *term)
897 WORD *m, *t, *w, *ww, *orig = 0, *wildvalue, *wildstop;
906 m = wildvalue = AN.WildValue;
907 wildstop = AN.WildStop;
910 ww = term + *term; ww -= ABS(ww[-1]); w = term+1;
911 while ( w < ww && *w != SUBEXPRESSION ) w += w[1];
912 if ( w >= ww )
return;
917 while ( m < wildstop ) {
918 if ( *m != LOADDOLLAR ) { m += m[1];
continue; }
920 while ( *t == LOADDOLLAR || *t == FROMSET || *t == SETTONUM ) t -= 4;
921 if ( t < wildvalue ) {
922 MLOCK(ErrorMessageLock);
923 MesPrint(
"&Serious bug in wildcard prototype. Found in WildDollars");
924 MUNLOCK(ErrorMessageLock);
928 d = Dollars + numdollar;
933 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
934 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
935 if ( numdollar == ModOptdollars[nummodopt].number )
break;
937 if ( nummodopt < NumModOptdollars ) {
938 dtype = ModOptdollars[nummodopt].type;
939 if ( dtype == MODLOCAL ) {
940 d = ModOptdollars[nummodopt].dstruct+AT.identity;
943 MLOCK(ErrorMessageLock);
944 MesPrint(
"&Illegal attempt to use $-variable %s in module %l",
945 DOLLARNAME(Dollars,numdollar),AC.CModule);
946 MUNLOCK(ErrorMessageLock);
967 orig = cbuf[AT.ebufnum].rhs[t[3]];
968 w = orig;
while ( *w ) w += *w;
969 weneed = w - orig + 1;
980 orig = cbuf[AT.ebufnum].rhs[t[3]];
981 if ( *orig > 0 ) weneed = *orig+2;
983 w = orig+1;
while ( *w ) { NEXTARG(w) }
984 weneed = w - orig + 1;
991 if ( weneed < MINALLOC ) weneed = MINALLOC;
992 weneed = ((weneed+7)/8)*8;
993 if ( d->size > 2*weneed && d->size > 1000 ) {
994 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollarspace");
995 d->where = &(AM.dollarzero);
998 if ( d->size < weneed ) {
999 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollarspace");
1000 d->where = (WORD *)Malloc1(weneed*
sizeof(WORD),
"dollarspace");
1008 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
1009 cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
1011 cbuf[AM.dbufnum].rhs[numdollar] = (WORD *)(1);
1020 d->where[0] = 4; d->where[2] = 1;
1021 if ( t[3] >= 0 ) { d->where[1] = t[3]; d->where[3] = 3; }
1022 else { d->where[1] = -t[3]; d->where[3] = -3; }
1023 if ( t[3] == 0 ) { d->type = DOLZERO; d->where[0] = 0; }
1024 else { d->type = DOLNUMBER; d->where[4] = 0; }
1041 i = *orig;
while ( --i >= 0 ) *w++ = *orig++;
1049 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[3];
1050 *w++ = 1; *w++ = 1; *w++ = -3; *w = 0;
1053 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[3];
1054 *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
1057 d->type = DOLINDEX; d->index = t[3]; *w = 0;
1060 *w++ = FUNHEAD+4; *w++ = t[3]; *w++ = FUNHEAD;
1062 *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
1065 if ( *orig > 0 ) ww = orig + *orig + 1;
1067 ww = orig+1;
while ( *ww ) { NEXTARG(ww) }
1069 while ( orig < ww ) *w++ = *orig++;
1071 d->type = DOLWILDARGS;
1074 d->type = DOLUNDEFINED;
1086WORD DolToTensor(PHEAD WORD numdollar)
1089 DOLLARS d = Dollars + numdollar;
1092 int nummodopt, dtype = -1;
1093 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1094 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1095 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1097 if ( nummodopt < NumModOptdollars ) {
1098 dtype = ModOptdollars[nummodopt].type;
1099 if ( dtype == MODLOCAL ) {
1100 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1103 LOCK(d->pthreadslockread);
1108 AN.ErrorInDollar = 0;
1109 if ( d->type == DOLTERMS && d->where[0] == FUNHEAD+4 &&
1110 d->where[FUNHEAD+4] == 0 && d->where[FUNHEAD+3] == 3 &&
1111 d->where[FUNHEAD+2] == 1 && d->where[FUNHEAD+1] == 1 &&
1112 d->where[1] >= FUNCTION && d->where[1] < FUNCTION+WILDOFFSET
1113 && functions[d->where[1]-FUNCTION].spec >= TENSORFUNCTION ) {
1114 retval = d->where[1];
1116 else if ( d->type == DOLARGUMENT &&
1117 d->where[0] <= -FUNCTION && d->where[0] > -FUNCTION-WILDOFFSET
1118 && functions[-d->where[0]-FUNCTION].spec >= TENSORFUNCTION ) {
1119 retval = -d->where[0];
1121 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1122 && d->where[1] <= -FUNCTION && d->where[1] > -FUNCTION-WILDOFFSET
1124 && functions[-d->where[1]-FUNCTION].spec >= TENSORFUNCTION ) {
1125 retval = -d->where[1];
1127 else if ( d->type == DOLSUBTERM &&
1128 d->where[0] >= FUNCTION && d->where[0] < FUNCTION+WILDOFFSET
1129 && functions[d->where[0]-FUNCTION].spec >= TENSORFUNCTION ) {
1130 retval = d->where[0];
1133 AN.ErrorInDollar = 1;
1137 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1147WORD DolToFunction(PHEAD WORD numdollar)
1150 DOLLARS d = Dollars + numdollar;
1153 int nummodopt, dtype = -1;
1154 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1155 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1156 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1158 if ( nummodopt < NumModOptdollars ) {
1159 dtype = ModOptdollars[nummodopt].type;
1160 if ( dtype == MODLOCAL ) {
1161 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1164 LOCK(d->pthreadslockread);
1169 AN.ErrorInDollar = 0;
1170 if ( d->type == DOLTERMS && d->where[0] == FUNHEAD+4 &&
1171 d->where[FUNHEAD+4] == 0 && d->where[FUNHEAD+3] == 3 &&
1172 d->where[FUNHEAD+2] == 1 && d->where[FUNHEAD+1] == 1 &&
1173 d->where[1] >= FUNCTION && d->where[1] < FUNCTION+WILDOFFSET ) {
1174 retval = d->where[1];
1176 else if ( d->type == DOLARGUMENT &&
1177 d->where[0] <= -FUNCTION && d->where[0] > -FUNCTION-WILDOFFSET ) {
1178 retval = -d->where[0];
1180 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1181 && d->where[1] <= -FUNCTION && d->where[1] > -FUNCTION-WILDOFFSET
1182 && d->where[2] == 0 ) {
1183 retval = -d->where[1];
1185 else if ( d->type == DOLSUBTERM &&
1186 d->where[0] >= FUNCTION && d->where[0] < FUNCTION+WILDOFFSET ) {
1187 retval = d->where[0];
1190 AN.ErrorInDollar = 1;
1194 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1204WORD DolToVector(PHEAD WORD numdollar)
1207 DOLLARS d = Dollars + numdollar;
1210 int nummodopt, dtype = -1;
1211 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1212 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1213 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1215 if ( nummodopt < NumModOptdollars ) {
1216 dtype = ModOptdollars[nummodopt].type;
1217 if ( dtype == MODLOCAL ) {
1218 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1221 LOCK(d->pthreadslockread);
1226 AN.ErrorInDollar = 0;
1227 if ( d->type == DOLINDEX && d->index < 0 ) {
1230 else if ( d->type == DOLARGUMENT && ( d->where[0] == -VECTOR
1231 || d->where[0] == -MINVECTOR ) ) {
1232 retval = d->where[1];
1234 else if ( d->type == DOLSUBTERM && d->where[0] == INDEX
1235 && d->where[1] == 3 && d->where[2] < 0 ) {
1236 retval = d->where[2];
1238 else if ( d->type == DOLTERMS && d->where[0] == 7 &&
1239 d->where[7] == 0 && d->where[6] == 3 &&
1240 d->where[5] == 1 && d->where[4] == 1 &&
1241 d->where[1] >= INDEX && d->where[3] < 0 ) {
1242 retval = d->where[3];
1244 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1245 && ( d->where[1] == -VECTOR || d->where[1] == -MINVECTOR )
1246 && d->where[3] == 0 ) {
1247 retval = d->where[2];
1249 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1250 && d->where[1] < 0 ) {
1251 retval = d->where[1];
1254 AN.ErrorInDollar = 1;
1258 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1268WORD DolToNumber(PHEAD WORD numdollar)
1271 DOLLARS d = Dollars + numdollar;
1273 int nummodopt, dtype = -1;
1274 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1275 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1276 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1278 if ( nummodopt < NumModOptdollars ) {
1279 dtype = ModOptdollars[nummodopt].type;
1280 if ( dtype == MODLOCAL ) {
1281 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1286 AN.ErrorInDollar = 0;
1287 if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
1288 && d->where[0] == 4 &&
1289 d->where[4] == 0 && ( d->where[3] == 3 || d->where[3] == -3 )
1290 && d->where[2] == 1 && ( d->where[1] & TOPBITONLY ) == 0 ) {
1291 if ( d->where[3] > 0 )
return(d->where[1]);
1292 else return(-d->where[1]);
1294 else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER ) {
1295 return(d->where[1]);
1297 else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
1298 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1299 return(d->where[1]);
1301 else if ( d->type == DOLZERO )
return(0);
1302 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1303 && d->where[1] == -SNUMBER && d->where[3] == 0 ) {
1304 return(d->where[2]);
1306 else if ( d->type == DOLINDEX && d->index >= 0 && d->index < AM.OffsetIndex ) {
1309 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1310 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1311 return(d->where[1]);
1313 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1314 && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0
1315 && d->where[2] < AM.OffsetIndex ) {
1316 return(d->where[2]);
1318 AN.ErrorInDollar = 1;
1327WORD DolToSymbol(PHEAD WORD numdollar)
1330 DOLLARS d = Dollars + numdollar;
1333 int nummodopt, dtype = -1;
1334 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1335 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1336 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1338 if ( nummodopt < NumModOptdollars ) {
1339 dtype = ModOptdollars[nummodopt].type;
1340 if ( dtype == MODLOCAL ) {
1341 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1344 LOCK(d->pthreadslockread);
1349 AN.ErrorInDollar = 0;
1350 if ( d->type == DOLTERMS && d->where[0] == 8 &&
1351 d->where[8] == 0 && d->where[7] == 3 && d->where[6] == 1
1352 && d->where[5] == 1 && d->where[4] == 1 && d->where[1] == SYMBOL ) {
1353 retval = d->where[3];
1355 else if ( d->type == DOLARGUMENT && d->where[0] == -SYMBOL ) {
1356 retval = d->where[1];
1358 else if ( d->type == DOLSUBTERM && d->where[0] == SYMBOL
1359 && d->where[1] == 4 && d->where[3] == 1 ) {
1360 retval = d->where[2];
1362 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1363 && d->where[1] == -SYMBOL && d->where[3] == 0 ) {
1364 retval = d->where[2];
1367 AN.ErrorInDollar = 1;
1371 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1381WORD DolToIndex(PHEAD WORD numdollar)
1384 DOLLARS d = Dollars + numdollar;
1387 int nummodopt, dtype = -1;
1388 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1389 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1390 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1392 if ( nummodopt < NumModOptdollars ) {
1393 dtype = ModOptdollars[nummodopt].type;
1394 if ( dtype == MODLOCAL ) {
1395 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1398 LOCK(d->pthreadslockread);
1403 AN.ErrorInDollar = 0;
1404 if ( d->type == DOLTERMS && d->where[0] == 7 &&
1405 d->where[7] == 0 && d->where[6] == 3 && d->where[5] == 1
1406 && d->where[4] == 1 && d->where[1] == INDEX && d->where[3] >= 0 ) {
1407 retval = d->where[3];
1409 else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER
1410 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1411 retval = d->where[1];
1413 else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
1414 && d->where[1] >= 0 ) {
1415 retval = d->where[1];
1417 else if ( d->type == DOLZERO )
return(0);
1418 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1419 && d->where[1] == -SNUMBER && d->where[3] == 0 && d->where[2] >= 0
1420 && d->where[2] < AM.OffsetIndex ) {
1421 retval = d->where[2];
1423 else if ( d->type == DOLINDEX && d->index >= 0 ) {
1426 else if ( d->type == DOLNUMBER && d->where[0] == 4 && d->where[2] == 1
1427 && d->where[3] == 3 && d->where[4] == 0 && d->where[1] < AM.OffsetIndex ) {
1428 retval = d->where[1];
1430 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1431 && d->where[1] >= 0 ) {
1432 retval = d->where[1];
1434 else if ( d->type == DOLSUBTERM && d->where[0] == INDEX
1435 && d->where[1] == 3 && d->where[2] >= 0 ) {
1436 retval = d->where[2];
1438 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1439 && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0 ) {
1440 retval = d->where[2];
1443 AN.ErrorInDollar = 1;
1447 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1462DOLLARS DolToTerms(PHEAD WORD numdollar)
1466 DOLLARS d = Dollars + numdollar, newd;
1469 int nummodopt, dtype = -1;
1470 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1471 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1472 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1474 if ( nummodopt < NumModOptdollars ) {
1475 dtype = ModOptdollars[nummodopt].type;
1476 if ( dtype == MODLOCAL ) {
1477 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1482 AN.ErrorInDollar = 0;
1483 switch ( d->type ) {
1489 if ( t[0] <= -FUNCTION ) {
1490 *w++ = FUNHEAD+4; *w++ = -t[0];
1491 *w++ = FUNHEAD; FILLFUN(w)
1492 *w++ = 1; *w++ = 1; *w++ = 3;
1494 else if ( t[0] == -SYMBOL ) {
1495 *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = t[1];
1496 *w++ = 1; *w++ = 1; *w++ = 1; *w++ = 3;
1498 else if ( t[0] == -VECTOR || t[0] == -INDEX ) {
1499 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[1];
1500 *w++ = 1; *w++ = 1; *w++ = 3;
1502 else if ( t[0] == -MINVECTOR ) {
1503 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[1];
1504 *w++ = 1; *w++ = 1; *w++ = -3;
1506 else if ( t[0] == -SNUMBER ) {
1509 *w++ = -t[1]; *w++ = 1; *w++ = -3;
1512 *w++ = t[1]; *w++ = 1; *w++ = 3;
1515 *w = 0; size = w - AT.WorkPointer;
1523 while ( *t ) t += *t;
1524 size = t - d->where;
1530 *w++ = size+4; t = d->where; NCOPY(w,t,size)
1531 *w++ = 1; *w++ = 1; *w++ = 3;
1532 w = AT.WorkPointer; size = d->where[1]+4;
1536 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = d->index;
1537 *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
1538 w = AT.WorkPointer; size = 7;
1545 if ( *t == 0 )
return(0);
1548 MLOCK(ErrorMessageLock);
1549 MesPrint(
"Trying to convert a $ with an argument field into an expression");
1550 MUNLOCK(ErrorMessageLock);
1557 if ( *t < 0 )
goto ShortArgument;
1558 size = *t - ARGHEAD;
1562 MLOCK(ErrorMessageLock);
1563 MesPrint(
"Trying to use an undefined $ in an expression");
1564 MUNLOCK(ErrorMessageLock);
1568 if ( d->where ) { d->where[0] = 0; }
1569 else d->where = &(AM.dollarzero);
1576 newd = (DOLLARS)Malloc1(
sizeof(
struct DoLlArS)+(size+1)*
sizeof(WORD),
1577 "Copy of dollar variable");
1578 t = (WORD *)(newd+1);
1580 newd->name = d->name;
1581 newd->node = d->node;
1582 newd->type = DOLTERMS;
1584 newd->numdummies = d->numdummies;
1586 newd->pthreadslockread = dummylock;
1587 newd->pthreadslockwrite = dummylock;
1591 newd->nfactors = d->nfactors;
1592 if ( d->nfactors > 1 ) {
1593 newd->factors = (FACDOLLAR *)Malloc1(d->nfactors*
sizeof(FACDOLLAR),
"Dollar factors");
1594 for ( i = 0; i < d->nfactors; i++ ) {
1595 newd->factors[i].where = 0;
1596 newd->factors[i].size = 0;
1597 newd->factors[i].type = DOLUNDEFINED;
1598 newd->factors[i].value = d->factors[i].value;
1601 else { newd->factors = 0; }
1610LONG DolToLong(PHEAD WORD numdollar)
1613 DOLLARS d = Dollars + numdollar;
1616 int nummodopt, dtype = -1;
1617 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1618 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1619 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1621 if ( nummodopt < NumModOptdollars ) {
1622 dtype = ModOptdollars[nummodopt].type;
1623 if ( dtype == MODLOCAL ) {
1624 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1629 AN.ErrorInDollar = 0;
1630 if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
1631 && d->where[0] == 4 &&
1632 d->where[4] == 0 && ( d->where[3] == 3 || d->where[3] == -3 )
1633 && d->where[2] == 1 && ( d->where[1] & TOPBITONLY ) == 0 ) {
1635 if ( d->where[3] > 0 )
return(x);
1638 else if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
1639 && d->where[0] == 6 &&
1640 d->where[6] == 0 && ( d->where[5] == 5 || d->where[5] == -5 )
1641 && d->where[3] == 1 && d->where[4] == 1 && ( d->where[2] & TOPBITONLY ) == 0 ) {
1642 x = d->where[1] + ( (LONG)(d->where[2]) << BITSINWORD );
1643 if ( d->where[5] > 0 )
return(x);
1646 else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER ) {
1650 else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
1651 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1655 else if ( d->type == DOLZERO )
return(0);
1656 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1657 && d->where[1] == -SNUMBER && d->where[3] == 0 ) {
1661 else if ( d->type == DOLINDEX && d->index >= 0 && d->index < AM.OffsetIndex ) {
1665 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1666 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1670 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1671 && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0
1672 && d->where[2] < AM.OffsetIndex ) {
1676 AN.ErrorInDollar = 1;
1685int ExecInside(UBYTE *s)
1692 if ( AC.insidelevel >= MAXNEST ) {
1693 MLOCK(ErrorMessageLock);
1694 MesPrint(
"@Nesting of inside statements more than %d levels",(WORD)MAXNEST);
1695 MUNLOCK(ErrorMessageLock);
1698 AC.insidesumcheck[AC.insidelevel] = NestingChecksum();
1699 AC.insidestack[AC.insidelevel] = cbuf[AC.cbufnum].Pointer
1700 - cbuf[AC.cbufnum].Buffer + 2;
1705 while ( *s ==
',' ) s++;
1706 if ( *s == 0 )
break;
1709 if ( FG.cTable[*s] != 0 ) {
1710 MLOCK(ErrorMessageLock);
1711 MesPrint(
"Illegal name for $ variable: %s",s-1);
1712 MUNLOCK(ErrorMessageLock);
1715 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
1717 if ( ( number = GetDollar(t) ) < 0 ) {
1718 number = AddDollar(t,0,0,0);
1725 MLOCK(ErrorMessageLock);
1726 MesPrint(
"&Illegal object in Inside statement");
1727 MUNLOCK(ErrorMessageLock);
1729 while ( *s && *s !=
',' && s[1] !=
'$' ) s++;
1730 if ( *s == 0 )
break;
1733 AT.WorkPointer[1] = w - AT.WorkPointer;
1734 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1750int InsideDollar(PHEAD WORD *ll, WORD level)
1753 int numvar = (int)(ll[1]-3), j, error = 0;
1754 WORD numdol, *oldcterm, *oldwork = AT.WorkPointer, olddefer, *r, *m;
1755 WORD oldnumlhs, *dbuffer;
1757 oldcterm = AN.cTerm; AN.cTerm = 0;
1758 oldnumlhs = AR.Cnumlhs; AR.Cnumlhs = ll[2];
1760 olddefer = AR.DeferFlag;
1762 while ( --numvar >= 0 ) {
1764 d = Dollars + numdol;
1767 int nummodopt, dtype = -1;
1768 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1769 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1770 if ( numdol == ModOptdollars[nummodopt].number )
break;
1772 if ( nummodopt < NumModOptdollars ) {
1773 dtype = ModOptdollars[nummodopt].type;
1774 if ( dtype == MODLOCAL ) {
1775 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1779 LOCK(d->pthreadslockread);
1784 newd = DolToTerms(BHEAD numdol);
1785 if ( newd == 0 || newd->where[0] == 0 )
continue;
1791 while ( --j >= 0 ) *m++ = *r++;
1798 error = -1;
goto idcall;
1800 AT.WorkPointer = oldwork;
1803 if (
EndSort(BHEAD (WORD *)((VOID *)(&dbuffer)),2) < 0 ) { error = 1;
break; }
1804 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"old buffer of dollar");
1806 if ( dbuffer == 0 || *dbuffer == 0 ) {
1808 if ( dbuffer ) M_free(dbuffer,
"buffer of dollar");
1809 d->where = &(AM.dollarzero); d->size = 0;
1813 r = d->where;
while ( *r ) r += *r;
1814 d->size = (r-d->where)+1;
1817 cbuf[AM.dbufnum].rhs[numdol] = (WORD *)(1);
1822 if ( dtype > 0 && dtype != MODLOCAL ) {
1824 UNLOCK(d->pthreadslockread);
1827 if ( newd->factors ) M_free(newd->factors,
"Dollar factors");
1828 M_free(newd,
"Copy of dollar variable");
1832 AR.Cnumlhs = oldnumlhs;
1833 AR.DeferFlag = olddefer;
1834 AN.cTerm = oldcterm;
1835 AT.WorkPointer = oldwork;
1844void ExchangeDollars(
int num1,
int num2)
1849 d1 = Dollars + num1; node1 = d1->node;
1850 d2 = Dollars + num2; node2 = d2->node;
1851 nam = d1->name; d1->name = d2->name; d2->name = nam;
1852 d1->node = node2; d2->node = node1;
1853 AC.dollarnames->namenode[node1].number = num2;
1854 AC.dollarnames->namenode[node2].number = num1;
1862LONG TermsInDollar(WORD num)
1865 DOLLARS d = Dollars + num;
1869 int nummodopt, dtype = -1;
1870 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1871 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1872 if ( num == ModOptdollars[nummodopt].number )
break;
1874 if ( nummodopt < NumModOptdollars ) {
1875 dtype = ModOptdollars[nummodopt].type;
1876 if ( dtype == MODLOCAL ) {
1877 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1880 LOCK(d->pthreadslockread);
1885 if ( d->type == DOLTERMS ) {
1888 while ( *t ) { t += *t; n++; }
1890 else if ( d->type == DOLWILDARGS ) {
1892 if ( d->where[0] == 0 ) {
1894 while ( *t != 0 ) { NEXTARG(t); n++; }
1896 else if ( d->where[0] == 1 ) n = 1;
1898 else if ( d->type == DOLZERO ) n = 0;
1901 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1911LONG SizeOfDollar(WORD num)
1914 DOLLARS d = Dollars + num;
1918 int nummodopt, dtype = -1;
1919 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1920 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1921 if ( num == ModOptdollars[nummodopt].number )
break;
1923 if ( nummodopt < NumModOptdollars ) {
1924 dtype = ModOptdollars[nummodopt].type;
1925 if ( dtype == MODLOCAL ) {
1926 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1929 LOCK(d->pthreadslockread);
1934 if ( d->type == DOLTERMS ) {
1936 while ( *t ) t += *t;
1938 n = (LONG)(t - d->where);
1940 else if ( d->type == DOLWILDARGS ) {
1942 if ( d->where[0] == 0 ) {
1944 while ( *t != 0 ) { NEXTARG(t); n++; }
1946 n = (LONG)(t - d->where);
1948 else if ( d->where[0] == 1 ) n = 1;
1950 else if ( d->type == DOLZERO ) n = 0;
1953 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1973UBYTE *PreIfDollarEval(UBYTE *s,
int *value)
1976 UBYTE *s1,*s2,*s3,*s4,*s5,*t,c,c1,c2,c3;
1978 WORD *buf1 = 0, *buf2 = 0, numset, *oldwork = AT.WorkPointer;
1983 while ( *s ==
' ' || *s ==
'\t' || *s ==
'\n' || *s ==
'\r' ) s++;
1985 while ( *t !=
'=' && *t !=
'!' && *t !=
'>' && *t !=
'<' ) {
1986 if ( *t ==
'[' ) { SKIPBRA1(t) }
1987 else if ( *t ==
'{' ) { SKIPBRA2(t) }
1988 else if ( *t ==
'(' ) { SKIPBRA3(t) }
1989 else if ( *t ==
']' || *t ==
'}' || *t ==
')' ) {
1990 MLOCK(ErrorMessageLock);
1991 MesPrint(
"@Improper bracketting in #if");
1992 MUNLOCK(ErrorMessageLock);
1998 while ( *t ==
'=' || *t ==
'!' || *t ==
'>' || *t ==
'<' ) t++;
2000 while ( *t && *t !=
')' ) {
2001 if ( *t ==
'[' ) { SKIPBRA1(t) }
2002 else if ( *t ==
'{' ) { SKIPBRA2(t) }
2003 else if ( *t ==
'(' ) { SKIPBRA3(t) }
2004 else if ( *t ==
']' || *t ==
'}' ) {
2005 MLOCK(ErrorMessageLock);
2006 MesPrint(
"@Improper brackets in #if");
2007 MUNLOCK(ErrorMessageLock);
2013 MLOCK(ErrorMessageLock);
2014 MesPrint(
"@Missing ) to match $( in #if");
2015 MUNLOCK(ErrorMessageLock);
2018 s4 = t; c2 = *s4; *s4 = 0;
2019 if ( s2+2 < s3 || s2 == s3 ) {
2021 MLOCK(ErrorMessageLock);
2022 MesPrint(
"@Illegal operator in $( option of #if");
2023 MUNLOCK(ErrorMessageLock);
2027 if ( *s2 ==
'=' ) oprtr = EQUAL;
2028 else if ( *s2 ==
'>' ) oprtr = GREATER;
2029 else if ( *s2 ==
'<' ) oprtr = LESS;
2032 else if ( *s2 ==
'!' && s2[1] ==
'=' ) oprtr = NOTEQUAL;
2033 else if ( *s2 ==
'=' && s2[1] ==
'=' ) oprtr = EQUAL;
2034 else if ( *s2 ==
'<' && s2[1] ==
'=' ) oprtr = LESSEQUAL;
2035 else if ( *s2 ==
'>' && s2[1] ==
'=' ) oprtr = GREATEREQUAL;
2042 while ( *s3 ==
' ' || *s3 ==
'\t' || *s3 ==
'\n' || *s3 ==
'\r' ) s3++;
2044 while ( chartype[*t] == 0 ) t++;
2046 t++; c = *t; *t = 0;
2047 if ( StrICmp(s3,(UBYTE *)
"set_") == 0 ) {
2048 if ( oprtr != EQUAL && oprtr != NOTEQUAL ) {
2050 MLOCK(ErrorMessageLock);
2051 MesPrint(
"@Improper operator for special keyword in $( ) option");
2052 MUNLOCK(ErrorMessageLock);
2057 else if ( StrICmp(s3,(UBYTE *)
"multipleof_") == 0 ) {
2058 if ( oprtr != EQUAL && oprtr != NOTEQUAL )
goto ImpOp;
2069 else { type = 0; c = *t; }
2071 *t++ = c; s3 = t; s5 = s4-1;
2072 while ( *s5 !=
')' ) {
2073 if ( *s5 ==
' ' || *s5 ==
'\t' || *s5 ==
'\n' || *s5 ==
'\r' ) s5--;
2075 MLOCK(ErrorMessageLock);
2076 MesPrint(
"@Improper use of special keyword in $( ) option");
2077 MUNLOCK(ErrorMessageLock);
2083 else { c3 = c2; s5 = s4; }
2087 if ( ( buf1 = TranslateExpression(s1) ) == 0 ) {
2088 AT.WorkPointer = oldwork;
2095 numset = DoTempSet(t,s3);
2099 MLOCK(ErrorMessageLock);
2100 MesPrint(
"@Argument of set_ is not a valid set");
2101 MUNLOCK(ErrorMessageLock);
2107 while ( FG.cTable[*s3] == 0 || FG.cTable[*s3] == 1
2108 || *s3 ==
'_' ) s3++;
2110 if ( GetName(AC.varnames,t,&numset,NOAUTO) != CSET ) {
2111 *s3 = c;
goto noset;
2115 while ( *s3 ==
' ' || *s3 ==
'\t' || *s3 ==
'\n' || *s3 ==
'\r' ) s3++;
2116 if ( s3 != s5 )
goto noset;
2117 *value = IsSetMember(buf1,numset);
2118 if ( oprtr == NOTEQUAL ) *value ^= 1;
2121 if ( ( buf2 = TranslateExpression(s3) ) == 0 )
goto onerror;
2124 *value = TwoExprCompare(buf1,buf2,oprtr);
2126 else if ( type == 2 ) {
2127 *value = IsMultipleOf(buf1,buf2);
2128 if ( oprtr == NOTEQUAL ) *value ^= 1;
2136 if ( buf1 ) M_free(buf1,
"Buffer in $()");
2137 if ( buf2 ) M_free(buf2,
"Buffer in $()");
2138 *s5 = c3; *s4++ = c2; *s2 = c1;
2139 AT.WorkPointer = oldwork;
2143 if ( buf1 ) M_free(buf1,
"Buffer in $()");
2144 if ( buf2 ) M_free(buf2,
"Buffer in $()");
2145 AT.WorkPointer = oldwork;
2155WORD *TranslateExpression(UBYTE *s)
2158 CBUF *C = cbuf+AC.cbufnum;
2159 WORD oldnumrhs = C->numrhs;
2160 LONG oldcpointer = C->Pointer - C->Buffer;
2161 WORD *w = AT.WorkPointer;
2162 WORD retcode, oldEside;
2164 *w++ = SUBEXPSIZE + 4;
2166 *w++ = SUBEXPRESSION;
2172 *w++ = 1; *w++ = 1; *w++ = 3; *w++ = 0;
2174 if ( ( retcode = CompileAlgebra(s,RHSIDE,AC.ProtoType) ) < 0 ) {
2175 MLOCK(ErrorMessageLock);
2176 MesPrint(
"@Error translating first expression in $( ) option");
2177 MUNLOCK(ErrorMessageLock);
2180 else { AC.ProtoType[2] = retcode; }
2185 AN.RepPoint = AT.RepCount + 1;
2186 oldEside = AR.Eside; AR.Eside = RHSIDE;
2187 AR.Cnumlhs = C->numlhs;
2188 if (
Generator(BHEAD AC.ProtoType-1,C->numlhs) ) {
2189 AR.Eside = oldEside;
2192 AR.Eside = oldEside;
2197 C->Pointer = C->Buffer + oldcpointer;
2198 C->numrhs = oldnumrhs;
2199 AT.WorkPointer = AC.ProtoType - 1;
2212int IsSetMember(WORD *buffer, WORD numset)
2214 WORD *t = buffer, *tt, num, csize, num1;
2217 if ( numset < AM.NumFixedSets ) {
2218 if ( t[*t] != 0 )
return(0);
2220 if ( numset == POS0_ || numset == NEG0_ || numset == EVEN_
2221 || numset == Z_ || numset == Q_ )
return(1);
2224 if ( numset == SYMBOL_ ) {
2225 if ( *t == 8 && t[1] == SYMBOL && t[7] == 3 && t[6] == 1
2226 && t[5] == 1 && t[4] == 1 )
return(1);
2229 if ( numset == INDEX_ ) {
2230 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2231 && t[4] == 1 && t[3] > 0 )
return(1);
2232 if ( *t == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex)
2236 if ( numset == FIXED_ ) {
2237 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2238 && t[4] == 1 && t[3] > 0 && t[3] < AM.OffsetIndex )
return(1);
2239 if ( *t == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex)
2243 if ( numset == DUMMYINDEX_ ) {
2244 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2245 && t[4] == 1 && t[3] >= AM.IndDum && t[3] < AM.IndDum+MAXDUMMIES )
return(1);
2246 if ( *t == 4 && t[3] == 3 && t[2] == 1
2247 && t[1] >= AM.IndDum && t[1] < AM.IndDum+MAXDUMMIES )
return(1);
2250 if ( numset == VECTOR_ ) {
2251 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2252 && t[4] == 1 && t[3] < (AM.OffsetVector+WILDOFFSET) && t[3] >= AM.OffsetVector )
return(1);
2256 if ( ABS(tt[0]) != *t-1 )
return(0);
2257 if ( numset == Q_ )
return(1);
2258 if ( numset == POS_ || numset == POS0_ )
return(tt[0]>0);
2259 else if ( numset == NEG_ || numset == NEG0_ )
return(tt[0]<0);
2260 i = (ABS(tt[0])-1)/2;
2262 if ( tt[0] != 1 )
return(0);
2263 for ( j = 1; j < i; j++ ) {
if ( tt[j] != 0 )
return(0); }
2264 if ( numset == Z_ )
return(1);
2265 if ( numset == ODD_ )
return(t[1]&1);
2266 if ( numset == EVEN_ )
return(1-(t[1]&1));
2269 if ( t[*t] != 0 )
return(0);
2270 type = Sets[numset].type;
2273 if ( t[0] == 8 && t[1] == SYMBOL && t[7] == 3 && t[6] == 1
2274 && t[5] == 1 && t[4] == 1 ) {
2277 else if ( t[0] == 4 && t[2] == 1 && t[1] <= MAXPOWER ) {
2279 if ( t[3] < 0 ) num = -num;
2285 if ( t[0] == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2286 && t[4] == 1 && t[3] < 0 ) {
2292 if ( t[0] == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2293 && t[4] == 1 && t[3] > 0 ) {
2296 else if ( t[0] == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex ) {
2302 if ( t[0] == 4+FUNHEAD && t[3+FUNHEAD] == 3 && t[2+FUNHEAD] == 1
2303 && t[1+FUNHEAD] == 1 && t[1] >= FUNCTION ) {
2309 if ( t[0] == 4 && t[2] == 1 && t[1] <= AM.OffsetIndex && t[3] == 3 ) {
2317 if ( csize != t[0]-1 )
return(0);
2318 if ( Sets[numset].first < 3*MAXPOWER ) {
2319 num1 = num = Sets[numset].first;
2320 if ( num >= MAXPOWER ) num -= 2*MAXPOWER;
2322 if ( num1 < MAXPOWER ) {
2323 if ( t[t[0]-1] >= 0 )
return(0);
2325 else if ( t[t[0]-1] > 0 )
return(0);
2328 bufterm[0] = 4; bufterm[1] = ABS(num);
2330 if ( num < 0 ) bufterm[3] = -3;
2331 else bufterm[3] = 3;
2333 if ( num1 < MAXPOWER ) {
2334 if ( num >= 0 )
return(0);
2336 else if ( num > 0 )
return(0);
2339 if ( Sets[numset].last > -3*MAXPOWER ) {
2340 num1 = num = Sets[numset].last;
2341 if ( num <= -MAXPOWER ) num += 2*MAXPOWER;
2343 if ( num1 > -MAXPOWER ) {
2344 if ( t[t[0]-1] <= 0 )
return(0);
2346 else if ( t[t[0]-1] < 0 )
return(0);
2349 bufterm[0] = 4; bufterm[1] = ABS(num);
2351 if ( num < 0 ) bufterm[3] = -3;
2352 else bufterm[3] = 3;
2354 if ( num1 > -MAXPOWER ) {
2355 if ( num <= 0 )
return(0);
2357 else if ( num < 0 )
return(0);
2364 t = SetElements + Sets[numset].first;
2365 tt = SetElements + Sets[numset].last;
2367 if ( num == *t )
return(1);
2393int IsMultipleOf(WORD *buf1, WORD *buf2)
2397 WORD *t1, *t2, *m1, *m2, *r1, *r2, nc1, nc2, ni1, ni2;
2398 UWORD *IfScrat1, *IfScrat2;
2400 if ( *buf1 == 0 && *buf2 == 0 )
return(1);
2404 t1 = buf1; t2 = buf2; num1 = 0; num2 = 0;
2405 while ( *t1 ) { t1 += *t1; num1++; }
2406 while ( *t2 ) { t2 += *t2; num2++; }
2407 if ( num1 != num2 )
return(0);
2411 t1 = buf1; t2 = buf2;
2413 m1 = t1+1; m2 = t2+1; t1 += *t1; t2 += *t2;
2414 r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
2415 if ( r1-m1 != r2-m2 )
return(0);
2417 if ( *m1 != *m2 )
return(0);
2424 IfScrat1 = (UWORD *)(TermMalloc(
"IsMultipleOf")); IfScrat2 = (UWORD *)(TermMalloc(
"IsMultipleOf"));
2425 t1 = buf1; t2 = buf2;
2426 t1 += *t1; t2 += *t2;
2427 if ( *t1 == 0 && *t2 == 0 )
return(1);
2428 r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
2429 nc1 = REDLENG(t1[-1]); nc2 = REDLENG(t2[-1]);
2430 if ( DivRat(BHEAD (UWORD *)r1,nc1,(UWORD *)r2,nc2,IfScrat1,&ni1) ) {
2431 MLOCK(ErrorMessageLock);
2432 MesPrint(
"@Called from MultipleOf in $( )");
2433 MUNLOCK(ErrorMessageLock);
2434 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2438 t1 += *t1; t2 += *t2;
2439 r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
2440 nc1 = REDLENG(t1[-1]); nc2 = REDLENG(t2[-1]);
2441 if ( DivRat(BHEAD (UWORD *)r1,nc1,(UWORD *)r2,nc2,IfScrat2,&ni2) ) {
2442 MLOCK(ErrorMessageLock);
2443 MesPrint(
"@Called from MultipleOf in $( )");
2444 MUNLOCK(ErrorMessageLock);
2445 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2448 if ( ni1 != ni2 )
return(0);
2450 for ( j = 0; j < i; j++ ) {
2451 if ( IfScrat1[j] != IfScrat2[j] ) {
2452 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2457 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2468int TwoExprCompare(WORD *buf1, WORD *buf2,
int oprtr)
2471 WORD *t1, *t2, cond;
2472 t1 = buf1; t2 = buf2;
2473 while ( *t1 && *t2 ) {
2474 cond = CompareTerms(t1,t2,1);
2478 case EQUAL:
return(0);
2479 case NOTEQUAL:
return(1);
2480 case GREATEREQUAL:
return(0);
2481 case GREATER:
return(0);
2482 case LESS:
return(1);
2483 case LESSEQUAL:
return(1);
2488 case EQUAL:
return(0);
2489 case NOTEQUAL:
return(1);
2490 case GREATEREQUAL:
return(1);
2491 case GREATER:
return(1);
2492 case LESS:
return(0);
2493 case LESSEQUAL:
return(0);
2497 t1 += *t1; t2 += *t2;
2501 case EQUAL:
return(1);
2502 case NOTEQUAL:
return(0);
2503 case GREATEREQUAL:
return(1);
2504 case GREATER:
return(0);
2505 case LESS:
return(0);
2506 case LESSEQUAL:
return(1);
2511 case EQUAL:
return(0);
2512 case NOTEQUAL:
return(1);
2513 case GREATEREQUAL:
return(1);
2514 case GREATER:
return(1);
2515 case LESS:
return(0);
2516 case LESSEQUAL:
return(0);
2521 case EQUAL:
return(0);
2522 case NOTEQUAL:
return(1);
2523 case GREATEREQUAL:
return(0);
2524 case GREATER:
return(0);
2525 case LESS:
return(1);
2526 case LESSEQUAL:
return(1);
2529 MLOCK(ErrorMessageLock);
2530 MesPrint(
"@Internal problems with operator in $( )");
2531 MUNLOCK(ErrorMessageLock);
2544static UWORD *dscrat = 0;
2547int DollarRaiseLow(UBYTE *name, LONG value)
2553 WORD lnum[4], nnum, *t1, *t2, i;
2555 s = name;
while ( *s ) s++;
2556 if ( s[-1] ==
'-' && s[-2] ==
'-' && s > name+2 ) s -= 2;
2557 else if ( s[-1] ==
'+' && s[-2] ==
'+' && s > name+2 ) s -= 2;
2559 num = GetDollar(name);
2562 if ( value < 0 ) { value = -value; sgn = -1; }
2563 if ( d->type == DOLZERO ) {
2564 if ( d->where ) M_free(d->where,
"DollarRaiseLow");
2566 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"DollarRaiseLow");
2567 if ( ( value & AWORDMASK ) != 0 ) {
2568 d->where[0] = 6; d->where[1] = value >> BITSINWORD;
2569 d->where[2] = (WORD)value; d->where[3] = 1; d->where[4] = 0;
2570 d->where[5] = 5*sgn; d->where[6] = 0;
2574 d->where[0] = 4; d->where[1] = (WORD)value; d->where[2] = 1;
2575 d->where[3] = 3*sgn; d->where[4] = 0;
2576 d->type = DOLNUMBER;
2579 else if ( d->type == DOLNUMBER || ( d->type == DOLTERMS
2580 && d->where[d->where[0]] == 0
2581 && d->where[0] == ABS(d->where[d->where[0]-1])+1 ) ) {
2582 if ( ( value & AWORDMASK ) != 0 ) {
2583 lnum[0] = value >> BITSINWORD;
2584 lnum[1] = (WORD)value; lnum[2] = 1; lnum[3] = 0;
2588 lnum[0] = (WORD)value; lnum[1] = 1; nnum = sgn;
2590 i = d->where[d->where[0]-1];
2592 if ( dscrat == 0 ) {
2593 dscrat = (UWORD *)Malloc1((AM.MaxTal+2)*
sizeof(UWORD),
"DollarRaiseLow");
2595 if ( AddRat(BHEAD (UWORD *)(d->where+1),i,
2596 (UWORD *)lnum,nnum,dscrat,&ndscrat) ) {
2597 MLOCK(ErrorMessageLock);
2598 MesCall(
"DollarRaiseLow");
2599 MUNLOCK(ErrorMessageLock);
2602 ndscrat = INCLENG(ndscrat);
2605 M_free(d->where,
"DollarRaiseLow");
2611 if ( i+2 > d->size ) {
2612 M_free(d->where,
"DollarRaiseLow");
2614 if ( d->size < MINALLOC ) d->size = MINALLOC;
2615 d->size = ((d->size+7)/8)*8;
2616 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"DollarRaiseLow");
2618 t1 = d->where; *t1++ = i+1; t2 = (WORD *)dscrat;
2619 while ( --i > 0 ) *t1++ = *t2++;
2620 *t1++ = ndscrat; *t1 = 0;
2648 WORD num, type, *td;
2650 if ( *arg == SNUMBER )
return(arg[1]);
2651 if ( *arg == DOLLAREXPR2 && arg[1] < 0 )
return(-arg[1]-1);
2652 d = Dollars + arg[1];
2655 int nummodopt, dtype = -1;
2656 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2657 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2658 if ( arg[1] == ModOptdollars[nummodopt].number )
break;
2660 if ( nummodopt < NumModOptdollars ) {
2661 dtype = ModOptdollars[nummodopt].type;
2662 if ( dtype == MODLOCAL ) {
2663 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2669 if ( *arg == DOLLAREXPRESSION ) {
2670 if ( arg[2] != DOLLAREXPR2 ) {
2673 if ( type == DOLZERO ) {}
2674 else if ( type == DOLNUMBER ) {
2676 if ( ( td[0] != 4 ) || ( (td[1]&SPECMASK) != 0 ) || ( td[2] != 1 ) ) {
2677 MLOCK(ErrorMessageLock);
2679 MesPrint(
"$-variable is not a short number in print statement");
2682 MesPrint(
"$-variable is not a short number in do loop");
2684 MUNLOCK(ErrorMessageLock);
2687 return( td[3] > 0 ? td[1]: -td[1] );
2690 MLOCK(ErrorMessageLock);
2692 MesPrint(
"$-variable is not a number in print statement");
2695 MesPrint(
"$-variable is not a number in do loop");
2697 MUNLOCK(ErrorMessageLock);
2704 else if ( *arg == DOLLAREXPR2 ) {
2705 if ( arg[1] < 0 ) { num = -arg[1]-1; }
2706 else if ( arg[2] != DOLLAREXPR2 && par == -1 ) {
2712 MLOCK(ErrorMessageLock);
2714 MesPrint(
"Invalid $-variable in print statement");
2717 MesPrint(
"Invalid $-variable in do loop");
2719 MUNLOCK(ErrorMessageLock);
2723 if ( num == 0 )
return(d->nfactors);
2724 if ( num > d->nfactors || num < 1 ) {
2725 MLOCK(ErrorMessageLock);
2727 MesPrint(
"Not a valid factor number for $-variable in print statement");
2730 MesPrint(
"Not a valid factor number for $-variable in do loop");
2732 MUNLOCK(ErrorMessageLock);
2736 if ( d->factors[num].type == DOLNUMBER )
2737 return(d->factors[num].value);
2739 MLOCK(ErrorMessageLock);
2741 MesPrint(
"$-variable in print statement is not a number");
2744 MesPrint(
"$-variable in do loop is not a number");
2746 MUNLOCK(ErrorMessageLock);
2757WORD TestDoLoop(PHEAD WORD *lhsbuf, WORD level)
2760 WORD start,finish,incr;
2765 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2766 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2769 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2770 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2774 if ( ( finish == start ) || ( finish > start && incr > 0 )
2775 || ( finish < start && incr < 0 ) ) {}
2776 else { level = lhsbuf[3]; }
2780 d = Dollars + lhsbuf[2];
2783 int nummodopt, dtype = -1;
2784 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2785 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2786 if ( lhsbuf[2] == ModOptdollars[nummodopt].number )
break;
2788 if ( nummodopt < NumModOptdollars ) {
2789 dtype = ModOptdollars[nummodopt].type;
2790 if ( dtype == MODLOCAL ) {
2791 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2798 if ( d->size < MINALLOC ) {
2799 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
2801 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"dollar contents");
2805 d->where[1] = start;
2809 d->type = DOLNUMBER;
2811 else if ( start < 0 ) {
2813 d->where[1] = -start;
2817 d->type = DOLNUMBER;
2822 if ( d == Dollars + lhsbuf[2] ) {
2823 cbuf[AM.dbufnum].CanCommu[lhsbuf[2]] = 0;
2824 cbuf[AM.dbufnum].NumTerms[lhsbuf[2]] = 1;
2825 cbuf[AM.dbufnum].rhs[lhsbuf[2]] = d->where;
2835WORD TestEndDoLoop(PHEAD WORD *lhsbuf, WORD level)
2838 WORD start,finish,incr,value;
2843 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2844 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2847 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2848 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2852 if ( ( finish == start ) || ( finish > start && incr > 0 )
2853 || ( finish < start && incr < 0 ) ) {}
2854 else { level = lhsbuf[3]; }
2858 d = Dollars + lhsbuf[2];
2861 int nummodopt, dtype = -1;
2862 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2863 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2864 if ( lhsbuf[2] == ModOptdollars[nummodopt].number )
break;
2866 if ( nummodopt < NumModOptdollars ) {
2867 dtype = ModOptdollars[nummodopt].type;
2868 if ( dtype == MODLOCAL ) {
2869 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2878 if ( d->type == DOLZERO ) {
2881 else if ( ( d->type == DOLNUMBER || d->type == DOLTERMS )
2882 && ( d->where[4] == 0 ) && ( d->where[0] == 4 )
2883 && ( d->where[1] > 0 ) && ( d->where[2] == 1 ) ) {
2884 value = ( d->where[3] < 0 ) ? -d->where[1]: d->where[1];
2887 MLOCK(ErrorMessageLock);
2888 MesPrint(
"Wrong type of object in do loop parameter");
2889 MUNLOCK(ErrorMessageLock);
2894 if ( ( finish > start && value <= finish ) ||
2895 ( finish < start && value >= finish ) ||
2896 ( finish == start && value == finish ) ) {}
2897 else level = lhsbuf[3];
2899 if ( d->size < MINALLOC ) {
2900 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
2902 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"dollar contents");
2906 d->where[1] = value;
2910 d->type = DOLNUMBER;
2912 else if ( start < 0 ) {
2914 d->where[1] = -value;
2918 d->type = DOLNUMBER;
2923 if ( d == Dollars + lhsbuf[2] ) {
2924 cbuf[AM.dbufnum].CanCommu[lhsbuf[2]] = 0;
2925 cbuf[AM.dbufnum].NumTerms[lhsbuf[2]] = 1;
2926 cbuf[AM.dbufnum].rhs[lhsbuf[2]] = d->where;
2950int DollarFactorize(PHEAD WORD numdollar)
2953 DOLLARS d = Dollars + numdollar;
2955 WORD *oldworkpointer;
2956 WORD *buf1, *t, *term, *buf1content, *buf2, *termextra;
2957 WORD *buf3, *argextra;
2959 WORD *tstop, pow, *r;
2961 int i, j, jj, action = 0, sign = 1;
2963 WORD startebuf = cbuf[AT.ebufnum].numrhs;
2964 WORD nfactors, factorsincontent, extrafactor = 0;
2965 WORD oldsorttype = AR.SortType;
2968 int nummodopt, dtype;
2970 if ( AS.MultiThreaded ) {
2971 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2972 if ( numdollar == ModOptdollars[nummodopt].number )
break;
2974 if ( nummodopt < NumModOptdollars ) {
2975 dtype = ModOptdollars[nummodopt].type;
2976 if ( dtype == MODLOCAL ) {
2977 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2980 LOCK(d->pthreadslockread);
2985 CleanDollarFactors(d);
2987 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2989 if ( d->type != DOLTERMS ) {
2990 if ( d->type != DOLZERO ) d->nfactors = 1;
2993 if ( d->where[d->where[0]] == 0 ) {
3006 AR.SortType = SORTHIGHFIRST;
3007 if ( oldsorttype != AR.SortType ) {
3011 if ( AN.ncmod != 0 ) {
3012 if ( AN.ncmod != 1 || ( (WORD)AN.cmod[0] < 0 ) ) {
3013 AR.SortType = oldsorttype;
3014 MLOCK(ErrorMessageLock);
3015 MesPrint(
"Factorization modulus a number, greater than a WORD not implemented.");
3016 MUNLOCK(ErrorMessageLock);
3019 if ( Modulus(term) ) {
3020 AR.SortType = oldsorttype;
3021 MLOCK(ErrorMessageLock);
3022 MesCall(
"DollarFactorize");
3023 MUNLOCK(ErrorMessageLock);
3026 if ( !*term) { term = t;
continue; }
3032 EndSort(BHEAD (WORD *)((
void *)(&buf1)),2);
3033 t = buf1;
while ( *t ) t += *t;
3037 t = term;
while ( *t ) t += *t;
3038 ii = insize = t - term;
3039 buf1 = (WORD *)Malloc1((insize+1)*
sizeof(WORD),
"DollarFactorize-1");
3049 buf1content = TermMalloc(
"DollarContent");
3051 if ( ( buf2 =
TakeContent(BHEAD buf1,buf1content) ) == 0 ) {
3053 TermFree(buf1content,
"DollarContent");
3054 M_free(buf1,
"DollarFactorize-1");
3055 AR.SortType = oldsorttype;
3056 MLOCK(ErrorMessageLock);
3057 MesCall(
"DollarFactorize");
3058 MUNLOCK(ErrorMessageLock);
3062 else if ( ( buf1content[0] == 4 ) && ( buf1content[1] == 1 ) &&
3063 ( buf1content[2] == 1 ) && ( buf1content[3] == 3 ) ) {
3065 if ( buf2 != buf1 ) {
3066 M_free(buf2,
"DollarFactorize-2");
3069 factorsincontent = 0;
3076 if ( buf2 != buf1 ) M_free(buf1,
"DollarFactorize-1");
3078 t = buf1;
while ( *t ) t += *t;
3083 factorsincontent = 0;
3085 tstop = term + *term;
3086 if ( tstop[-1] < 0 ) factorsincontent++;
3087 if ( ABS(tstop[-1]) == 3 && tstop[-2] == 1 && tstop[-3] == 1 ) {
3088 tstop -= ABS(tstop[-1]);
3092 tstop -= ABS(tstop[-1]);
3095 while ( term < tstop ) {
3098 t = term+2; i = (term[1]-2)/2;
3100 factorsincontent += ABS(t[1]);
3105 t = term+2; i = (term[1]-2)/3;
3107 factorsincontent += ABS(t[2]);
3113 factorsincontent += (term[1]-2)/2;
3116 factorsincontent += term[1]-2;
3119 if ( *term >= FUNCTION ) factorsincontent++;
3126 factorsincontent = 0;
3138 if ( ( t[1] != SYMBOL ) && ( *t != (ABS(t[*t-1])+1) ) ) {
3143 if ( DetCommu(buf1) > 1 ) {
3144 MesPrint(
"Cannot factorize a $-expression with more than one noncommuting object");
3145 AR.SortType = oldsorttype;
3146 M_free(buf1,
"DollarFactorize-2");
3147 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3148 MesCall(
"DollarFactorize");
3154 termextra = AT.WorkPointer;
3160 AR.SortType = oldsorttype;
3161 M_free(buf1,
"DollarFactorize-2");
3162 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3163 MesCall(
"DollarFactorize");
3171 if (
EndSort(BHEAD (WORD *)((
void *)(&buf2)),2) < 0 ) {
goto getout; }
3173 t = buf2;
while ( *t > 0 ) t += *t;
3183 MesCall(
"DollarFactorize");
3184 AR.SortType = oldsorttype;
3185 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-3");
3186 M_free(buf1,
"DollarFactorize-3");
3187 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3191 if ( buf2 != buf1 && buf2 ) {
3192 M_free(buf2,
"DollarFactorize-3");
3196 AR.SortType = oldsorttype;
3203 if ( *term == 4 && term[4] == 0 && term[3] == -3 && term[2] == 1
3205 WORD *tt1, *tt2, *ttstop;
3207 tt1 = term; tt2 = term + *term + 1;
3210 while ( *ttstop ) ttstop += *ttstop;
3213 while ( tt2 < ttstop ) *tt1++ = *tt2++;
3222 while ( *term ) { term += *term; }
3237 if ( dtype > 0 && dtype != MODLOCAL ) { LOCK(d->pthreadslockread); }
3239 if ( nfactors == 1 && extrafactor == 0 ) {
3240 if ( factorsincontent == 0 ) {
3243 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3251 d->factors = (FACDOLLAR *)Malloc1(
sizeof(FACDOLLAR),
"factors in dollar");
3252 term = buf1;
while ( *term ) term += *term;
3253 d->factors[0].size = i = term - buf1;
3254 d->factors[0].where = t = (WORD *)Malloc1(
sizeof(WORD)*(i+1),
"DollarFactorize-5");
3255 term = buf1; NCOPY(t,term,i); *t = 0;
3256 AR.SortType = oldsorttype;
3257 M_free(buf3,
"DollarFactorize-4");
3258 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-4");
3259 M_free(buf1,
"DollarFactorize-4");
3260 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3264 d->factors = (FACDOLLAR *)Malloc1(
sizeof(FACDOLLAR)*(nfactors+factorsincontent),
"factors in dollar");
3265 term = buf1;
while ( *term ) term += *term;
3266 d->factors[0].size = i = term - buf1;
3267 d->factors[0].where = t = (WORD *)Malloc1(
sizeof(WORD)*(i+1),
"DollarFactorize-5");
3268 term = buf1; NCOPY(t,term,i); *t = 0;
3269 M_free(buf3,
"DollarFactorize-4");
3271 if ( buf2 != buf1 && buf2 ) {
3272 M_free(buf2,
"DollarFactorize-4");
3277 else if ( action ) {
3278 C = cbuf+AC.cbufnum;
3279 CC = cbuf+AT.ebufnum;
3280 oldworkpointer = AT.WorkPointer;
3281 d->factors = (FACDOLLAR *)Malloc1(
sizeof(FACDOLLAR)*(nfactors+factorsincontent),
"factors in dollar");
3283 for ( i = 0; i < nfactors; i++ ) {
3284 argextra = AT.WorkPointer;
3288 if ( ConvertFromPoly(BHEAD term,argextra,numxsymbol,CC->numrhs-startebuf+numxsymbol
3289 ,startebuf-numxsymbol,1) <= 0 ) {
3291getout2: AR.SortType = oldsorttype;
3292 M_free(d->factors,
"factors in dollar");
3295 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3297 M_free(buf3,
"DollarFactorize-4");
3298 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-4");
3299 M_free(buf1,
"DollarFactorize-4");
3300 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3303 AT.WorkPointer = argextra + *argextra;
3307 if (
Generator(BHEAD argextra,C->numlhs+1) ) {
3313 AT.WorkPointer = oldworkpointer;
3315 EndSort(BHEAD (WORD *)((
void *)(&(d->factors[i].where))),2);
3317 d->factors[i].type = DOLTERMS;
3318 t = d->factors[i].where;
3319 while ( *t ) t += *t;
3320 d->factors[i].size = t - d->factors[i].where;
3322 CC->numrhs = startebuf;
3325 C = cbuf+AC.cbufnum;
3326 oldworkpointer = AT.WorkPointer;
3327 d->factors = (FACDOLLAR *)Malloc1(
sizeof(FACDOLLAR)*(nfactors+factorsincontent),
"factors in dollar");
3329 for ( i = 0; i < nfactors; i++ ) {
3332 argextra = oldworkpointer;
3334 NCOPY(argextra,term,j)
3335 AT.WorkPointer = argextra;
3336 if (
Generator(BHEAD oldworkpointer,C->numlhs+1) ) {
3341 AT.WorkPointer = oldworkpointer;
3343 EndSort(BHEAD (WORD *)((
void *)(&(d->factors[i].where))),2);
3344 d->factors[i].type = DOLTERMS;
3345 t = d->factors[i].where;
3346 while ( *t ) t += *t;
3347 d->factors[i].size = t - d->factors[i].where;
3350 d->nfactors = nfactors + factorsincontent;
3355 if ( buf3 ) M_free(buf3,
"DollarFactorize-5");
3356 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-5");
3357 M_free(buf1,
"DollarFactorize-5");
3361 tstop = term + *term;
3362 if ( tstop[-1] < 0 ) { tstop[-1] = -tstop[-1]; sign = -sign; }
3365 while ( term < tstop ) {
3368 t = term+2; i = (term[1]-2)/2;
3370 if ( t[1] < 0 ) { t[1] = -t[1]; pow = -1; }
3372 for ( jj = 0; jj < t[1]; jj++ ) {
3373 r = d->factors[j].where = (WORD *)Malloc1(9*
sizeof(WORD),
"factor");
3374 r[0] = 8; r[1] = SYMBOL; r[2] = 4; r[3] = *t; r[4] = pow;
3375 r[5] = 1; r[6] = 1; r[7] = 3; r[8] = 0;
3376 d->factors[j].type = DOLTERMS;
3377 d->factors[j].size = 8;
3384 t = term+2; i = (term[1]-2)/3;
3386 if ( t[2] < 0 ) { t[2] = -t[2]; pow = -1; }
3388 for ( jj = 0; jj < t[2]; jj++ ) {
3389 r = d->factors[j].where = (WORD *)Malloc1(10*
sizeof(WORD),
"factor");
3390 r[0] = 9; r[1] = DOTPRODUCT; r[2] = 5; r[3] = t[0]; r[4] = t[1];
3391 r[5] = pow; r[6] = 1; r[7] = 1; r[8] = 3; r[9] = 0;
3392 d->factors[j].type = DOLTERMS;
3393 d->factors[j].size = 9;
3401 t = term+2; i = (term[1]-2)/2;
3403 for ( jj = 0; jj < t[1]; jj++ ) {
3404 r = d->factors[j].where = (WORD *)Malloc1(9*
sizeof(WORD),
"factor");
3405 r[0] = 8; r[1] = *term; r[2] = 4; r[3] = *t; r[4] = t[1];
3406 r[5] = 1; r[6] = 1; r[7] = 3; r[8] = 0;
3407 d->factors[j].type = DOLTERMS;
3408 d->factors[j].size = 8;
3415 t = term+2; i = term[1]-2;
3417 for ( jj = 0; jj < t[1]; jj++ ) {
3418 r = d->factors[j].where = (WORD *)Malloc1(8*
sizeof(WORD),
"factor");
3419 r[0] = 7; r[1] = *term; r[2] = 3; r[3] = *t;
3420 r[4] = 1; r[5] = 1; r[6] = 3; r[7] = 0;
3421 d->factors[j].type = DOLTERMS;
3422 d->factors[j].size = 7;
3429 if ( *term >= FUNCTION ) {
3430 r = d->factors[j].where = (WORD *)Malloc1((term[1]+5)*
sizeof(WORD),
"factor");
3431 *r++ = d->factors[j].size = term[1]+4;
3432 for ( jj = 0; jj < t[1]; jj++ ) *r++ = term[jj];
3433 *r++ = 1; *r++ = 1; *r++ = 3; *r = 0;
3447 tstop = term + *term;
3448 if ( tstop[-1] == 3 && tstop[-2] == 1 && tstop[-3] == 1 ) {}
3449 else if ( tstop[-1] == 3 && tstop[-2] == 1 && (UWORD)(tstop[-3]) <= MAXPOSITIVE ) {
3450 d->factors[j].where = 0;
3451 d->factors[j].size = 0;
3452 d->factors[j].type = DOLNUMBER;
3453 d->factors[j].value = sign*tstop[-3];
3458 d->factors[j].where = r = (WORD *)Malloc1((tstop[-1]+2)*
sizeof(WORD),
"numfactor");
3459 d->factors[j].size = tstop[-1]+1;
3460 d->factors[j].type = DOLTERMS;
3461 d->factors[j].value = 0;
3468 r = d->factors[j].where;
3470 r += *r; r[-1] = -r[-1];
3478 for ( jj = j; jj > 0; jj-- ) {
3479 d->factors[jj] = d->factors[jj-1];
3481 d->factors[0].where = 0;
3482 d->factors[0].size = 0;
3483 d->factors[0].type = DOLNUMBER;
3484 d->factors[0].value = -1;
3488 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3496 if ( d->nfactors > 1 ) {
3497 WORD ***fac, j1, j2, k, ret, *s1, *s2, *s3;
3499 facsize = (LONG **)Malloc1((
sizeof(WORD **)+
sizeof(LONG *))*d->nfactors,
"SortDollarFactors");
3500 fac = (WORD ***)(facsize+d->nfactors);
3502 for ( j = 0; j < d->nfactors; j++ ) {
3503 if ( d->factors[j].where ) {
3504 fac[k] = &(d->factors[j].where);
3505 facsize[k] = &(d->factors[j].size);
3510 for ( j = 1; j < k; j++ ) {
3513 s1 = *(fac[j1]); s2 = *(fac[j2]);
3514 while ( *s1 && *s2 ) {
3515 if ( ( ret = CompareTerms(s2, s1, (WORD)2) ) == 0 ) {
3516 s1 += *s1; s2 += *s2;
3518 else if ( ret > 0 )
goto nextj;
3521 s3 = *(fac[j1]); *(fac[j1]) = *(fac[j2]); *(fac[j2]) = s3;
3522 x = *(facsize[j1]); *(facsize[j1]) = *(facsize[j2]); *(facsize[j2]) = x;
3524 if ( j1 > 0 )
goto nextj1;
3528 if ( *s1 )
goto nextj;
3529 if ( *s2 )
goto exch;
3533 M_free(facsize,
"SortDollarFactors");
3539 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3549void CleanDollarFactors(DOLLARS d)
3552 if ( d->nfactors > 1 ) {
3553 for ( i = 0; i < d->nfactors; i++ ) {
3554 if ( d->factors[i].where )
3555 M_free(d->factors[i].where,
"dollar factors");
3559 M_free(d->factors,
"dollar factors");
3570WORD *TakeDollarContent(PHEAD WORD *dollarbuffer, WORD **factor)
3577 t = dollarbuffer; pow = 1;
3583 t += *t; t[-1] = -t[-1];
3589 if ( AN.cmod != 0 ) {
3590 if ( ( *factor =
MakeDollarMod(BHEAD dollarbuffer,&remain) ) == 0 ) {
3594 (*factor)[**factor-1] = -(*factor)[**factor-1];
3595 (*factor)[**factor-1] += AN.cmod[0];
3603 (*factor)[**factor-1] = -(*factor)[**factor-1];
3625 UWORD *GCDbuffer, *GCDbuffer2, *LCMbuffer, *LCMb, *LCMc;
3626 WORD *r, *r1, *r2, *r3, *rnext, i, k, j, *oldworkpointer, *factor;
3627 WORD kGCD, kLCM, kGCD2, kkLCM, jLCM, jGCD;
3628 CBUF *C = cbuf+AC.cbufnum;
3630 GCDbuffer = NumberMalloc(
"MakeDollarInteger");
3631 GCDbuffer2 = NumberMalloc(
"MakeDollarInteger");
3632 LCMbuffer = NumberMalloc(
"MakeDollarInteger");
3633 LCMb = NumberMalloc(
"MakeDollarInteger");
3634 LCMc = NumberMalloc(
"MakeDollarInteger");
3643 if ( k < 0 ) k = -k;
3644 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3645 for ( kGCD = 0; kGCD < k; kGCD++ ) GCDbuffer[kGCD] = r3[kGCD];
3647 if ( k < 0 ) k = -k;
3649 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3650 for ( kLCM = 0; kLCM < k; kLCM++ ) LCMbuffer[kLCM] = r3[kLCM];
3660 if ( k < 0 ) k = -k;
3661 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3662 if ( ( ( GCDbuffer[0] == 1 ) && ( kGCD == 1 ) ) ) {
3667 else if ( ( ( k != 1 ) || ( r3[0] != 1 ) ) ) {
3668 if ( GcdLong(BHEAD GCDbuffer,kGCD,(UWORD *)r3,k,GCDbuffer2,&kGCD2) ) {
3669 goto MakeDollarIntegerErr;
3672 for ( i = 0; i < kGCD; i++ ) GCDbuffer[i] = GCDbuffer2[i];
3675 kGCD = 1; GCDbuffer[0] = 1;
3678 if ( k < 0 ) k = -k;
3680 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3681 if ( ( ( LCMbuffer[0] == 1 ) && ( kLCM == 1 ) ) ) {
3682 for ( kLCM = 0; kLCM < k; kLCM++ )
3683 LCMbuffer[kLCM] = r3[kLCM];
3685 else if ( ( k != 1 ) || ( r3[0] != 1 ) ) {
3686 if ( GcdLong(BHEAD LCMbuffer,kLCM,(UWORD *)r3,k,LCMb,&kkLCM) ) {
3687 goto MakeDollarIntegerErr;
3689 DivLong((UWORD *)r3,k,LCMb,kkLCM,LCMb,&kkLCM,LCMc,&jLCM);
3690 MulLong(LCMbuffer,kLCM,LCMb,kkLCM,LCMc,&jLCM);
3691 for ( kLCM = 0; kLCM < jLCM; kLCM++ )
3692 LCMbuffer[kLCM] = LCMc[kLCM];
3700 r3 = (WORD *)(GCDbuffer);
3701 if ( kGCD == kLCM ) {
3702 for ( jGCD = 0; jGCD < kGCD; jGCD++ )
3703 r3[jGCD+kGCD] = LCMbuffer[jGCD];
3706 else if ( kGCD > kLCM ) {
3707 for ( jGCD = 0; jGCD < kLCM; jGCD++ )
3708 r3[jGCD+kGCD] = LCMbuffer[jGCD];
3709 for ( jGCD = kLCM; jGCD < kGCD; jGCD++ )
3714 for ( jGCD = kGCD; jGCD < kLCM; jGCD++ )
3716 for ( jGCD = 0; jGCD < kLCM; jGCD++ )
3717 r3[jGCD+kLCM] = LCMbuffer[jGCD];
3724 factor = r1 = (WORD *)Malloc1((j+2)*
sizeof(WORD),
"MakeDollarInteger");
3725 *r1++ = j+1; r2 = r3;
3726 for ( i = 0; i < k; i++ ) { *r1++ = *r2++; *r1++ = *r2++; }
3739 oldworkpointer = AT.WorkPointer;
3744 r2 = oldworkpointer;
3745 while ( r < r3 ) *r2++ = *r++;
3747 if ( DivRat(BHEAD (UWORD *)r3,j,GCDbuffer,k,(UWORD *)r2,&i) ) {
3748 goto MakeDollarIntegerErr;
3752 if ( rnext[-1] < 0 ) r2[-1] = -i;
3754 *oldworkpointer = r2-oldworkpointer;
3755 AT.WorkPointer = r2;
3756 if (
Generator(BHEAD oldworkpointer,C->numlhs) ) {
3757 goto MakeDollarIntegerErr;
3761 AT.WorkPointer = oldworkpointer;
3763 EndSort(BHEAD (WORD *)bufout,2);
3767 NumberFree(LCMc,
"MakeDollarInteger");
3768 NumberFree(LCMb,
"MakeDollarInteger");
3769 NumberFree(LCMbuffer,
"MakeDollarInteger");
3770 NumberFree(GCDbuffer2,
"MakeDollarInteger");
3771 NumberFree(GCDbuffer,
"MakeDollarInteger");
3774MakeDollarIntegerErr:
3775 NumberFree(LCMc,
"MakeDollarInteger");
3776 NumberFree(LCMb,
"MakeDollarInteger");
3777 NumberFree(LCMbuffer,
"MakeDollarInteger");
3778 NumberFree(GCDbuffer2,
"MakeDollarInteger");
3779 NumberFree(GCDbuffer,
"MakeDollarInteger");
3780 MesCall(
"MakeDollarInteger");
3799 WORD *r, *r1, x, xx, ix, ip;
3800 WORD *factor, *oldworkpointer;
3802 CBUF *C = cbuf+AC.cbufnum;
3805 if ( r[*r-1] < 0 ) x += AN.cmod[0];
3809 factor = (WORD *)Malloc1(5*
sizeof(WORD),
"MakeDollarMod");
3810 factor[0] = 4; factor[1] = x; factor[2] = 1; factor[3] = 3; factor[4] = 0;
3818 oldworkpointer = AT.WorkPointer;
3820 r1 = oldworkpointer; i = *r;
3822 xx = r1[-3];
if ( r1[-1] < 0 ) xx += AN.cmod[0];
3823 r1[-1] = (WORD)((((LONG)xx)*ix) % AN.cmod[0]);
3824 *r1 = 0; AT.WorkPointer = r1;
3825 if (
Generator(BHEAD oldworkpointer,C->numlhs) ) {
3829 AT.WorkPointer = oldworkpointer;
3831 EndSort(BHEAD (WORD *)bufout,2);
3841int GetDolNum(PHEAD WORD *t, WORD *tstop)
3845 if ( t+3 < tstop && t[3] == DOLLAREXPR2 ) {
3849 int nummodopt, dtype;
3851 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3852 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3853 if ( t[2] == ModOptdollars[nummodopt].number )
break;
3855 if ( nummodopt < NumModOptdollars ) {
3856 dtype = ModOptdollars[nummodopt].type;
3857 if ( dtype == MODLOCAL ) {
3858 d = ModOptdollars[nummodopt].dstruct+AT.identity;
3861 MLOCK(ErrorMessageLock);
3862 MesPrint(
"&Illegal attempt to use $-variable %s in module %l",
3863 DOLLARNAME(Dollars,t[2]),AC.CModule);
3864 MUNLOCK(ErrorMessageLock);
3871 if ( d->factors == 0 ) {
3872 MLOCK(ErrorMessageLock);
3873 MesPrint(
"Attempt to use a factor of an unfactored $-variable");
3874 MUNLOCK(ErrorMessageLock);
3877 num = GetDolNum(BHEAD t+t[1],tstop);
3878 if ( num == 0 )
return(d->nfactors);
3879 if ( num > d->nfactors ) {
3880 MLOCK(ErrorMessageLock);
3881 MesPrint(
"Attempt to use an nonexisting factor %d of a $-variable",num);
3882 MUNLOCK(ErrorMessageLock);
3885 w = d->factors[num-1].where;
3886 if ( w == 0 )
return(d->factors[num-1].value);
3887 if ( w[0] == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1 && w[1] > 0
3888 && w[1] < MAXPOSITIVE )
return(w[1]);
3890 MLOCK(ErrorMessageLock);
3891 MesPrint(
"Illegal type of factor number of a $-variable");
3892 MUNLOCK(ErrorMessageLock);
3896 else if ( t[2] < 0 ) {
3903 int nummodopt, dtype;
3905 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3906 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3907 if ( t[2] == ModOptdollars[nummodopt].number )
break;
3909 if ( nummodopt < NumModOptdollars ) {
3910 dtype = ModOptdollars[nummodopt].type;
3911 if ( dtype == MODLOCAL ) {
3912 d = ModOptdollars[nummodopt].dstruct+AT.identity;
3915 MLOCK(ErrorMessageLock);
3916 MesPrint(
"&Illegal attempt to use $-variable %s in module %l",
3917 DOLLARNAME(Dollars,t[2]),AC.CModule);
3918 MUNLOCK(ErrorMessageLock);
3925 if ( d->type == DOLZERO )
return(0);
3926 if ( d->type == DOLTERMS || d->type == DOLNUMBER ) {
3927 if ( d->where[0] == 4 && d->where[4] == 0 && d->where[3] == 3
3928 && d->where[2] == 1 && d->where[1] > 0
3929 && d->where[1] < MAXPOSITIVE )
return(d->where[1]);
3930 MLOCK(ErrorMessageLock);
3931 MesPrint(
"Attempt to use an nonexisting factor of a $-variable");
3932 MUNLOCK(ErrorMessageLock);
3935 MLOCK(ErrorMessageLock);
3936 MesPrint(
"Illegal type of factor number of a $-variable");
3937 MUNLOCK(ErrorMessageLock);
3956 int i, n = NumPotModdollars;
3957 for ( i = 0; i < n; i++ ) {
3958 if ( numdollar == PotModdollars[i] )
break;
3961 *(WORD *)FromList(&AC.PotModDolList) = numdollar;
int LocalConvertToPoly(PHEAD WORD *, WORD *, WORD, WORD)
WORD * poly_factorize_dollar(PHEAD WORD *)
WORD CompCoef(WORD *, WORD *)
LONG EndSort(PHEAD WORD *, int)
WORD * TakeContent(PHEAD WORD *, WORD *)
WORD Generator(PHEAD WORD *, WORD)
WORD StoreTerm(PHEAD WORD *)
int GetModInverses(WORD, WORD, WORD *, WORD *)
WORD * MakeDollarInteger(PHEAD WORD *bufin, WORD **bufout)
void AddPotModdollar(WORD numdollar)
WORD EvalDoLoopArg(PHEAD WORD *arg, WORD par)
WORD * MakeDollarMod(PHEAD WORD *buffer, WORD **bufout)
int PF_BroadcastPreDollar(WORD **dbuffer, LONG *newsize, int *numterms)