40 static UBYTE underscore[2] = {
'_',0};
54 int 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 < 32 ) newsize = 32;
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();
209 int 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 < 32 ) {
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 < 32 ) {
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);
596 UBYTE *WriteDollarToBuffer(WORD numdollar, WORD par)
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);
687 UBYTE *WriteDollarFactorToBuffer(WORD numdollar, WORD numfac, WORD par)
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 ( d->factors[numfac-1].where == 0 ) {
723 if ( d->factors[numfac-1].value < 0 ) {
724 n[0] = 4; n[1] = -d->factors[numfac-1].value; n[2] = 1; n[3] = -3; n[4] = 0; t = n;
727 n[0] = 4; n[1] = d->factors[numfac-1].value; n[2] = 1; n[3] = 3; n[4] = 0; t = n;
730 else { t = d->factors[numfac-1].where; }
732 if ( WriteTerm(t,&lbrac,first,PRINTON,0) ) {
737 AC.OutputMode = oldOutputMode;
739 AO.InFbrack = oldinfbrack;
740 AO.CurBufWrt = oldcurbufwrt;
741 AO.CurrentDictionary = dict;
743 MLOCK(ErrorMessageLock);
744 MesPrint(
"&Illegal dollar object for writing");
745 MUNLOCK(ErrorMessageLock);
746 M_free(AO.DollarOutBuffer,
"DollarOutBuffer");
747 AO.DollarOutBuffer = 0;
748 AO.DollarOutSizeBuffer = 0;
751 return(AO.DollarOutBuffer);
759 void AddToDollarBuffer(UBYTE *s)
762 UBYTE *t = s, *u, *newdob;
764 while ( *t ) { t++; }
766 while ( i + AO.DollarInOutBuffer >= AO.DollarOutSizeBuffer ) {
767 j = AO.DollarInOutBuffer;
768 AO.DollarOutSizeBuffer *= 2;
769 t = AO.DollarOutBuffer;
770 newdob = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,
"DollarOutBuffer");
772 while ( --j >= 0 ) *u++ = *t++;
773 M_free(AO.DollarOutBuffer,
"DollarOutBuffer");
774 AO.DollarOutBuffer = newdob;
776 t = AO.DollarOutBuffer + AO.DollarInOutBuffer-1;
777 while ( t == AO.DollarOutBuffer && ( *s ==
'+' || *s ==
' ' ) ) s++;
779 if ( AO.CurrentDictionary == 0 ) {
781 if ( *s ==
' ' ) { s++;
continue; }
786 while ( *s ) { *t++ = *s++; i++; }
789 AO.DollarInOutBuffer += i;
800 void TermAssign(WORD *term)
803 WORD *t, *tstop, *astop, *w, *m;
806 astop = term + *term;
807 tstop = astop - ABS(astop[-1]);
809 while ( t < tstop ) {
810 if ( *t == AM.termfunnum && t[1] == FUNHEAD+2
811 && t[FUNHEAD] == -DOLLAREXPRESSION ) {
812 d = Dollars + t[FUNHEAD+1];
813 newsize = *term - FUNHEAD - 1;
814 if ( newsize < 32 ) newsize = 32;
815 newsize = ((newsize+7)/8)*8;
816 if ( d->size > 2*newsize && d->size > 1000 ) {
817 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
819 d->where = &(AM.dollarzero);
821 if ( d->size < newsize ) {
822 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
824 d->where = (WORD *)Malloc1(newsize*
sizeof(WORD),
"dollar contents");
826 cbuf[AM.dbufnum].rhs[t[FUNHEAD+1]] = w = d->where;
828 while ( m < t ) *w++ = *m++;
830 while ( m < tstop ) {
831 if ( *m == AM.termfunnum && m[1] == FUNHEAD+2
832 && m[FUNHEAD] == -DOLLAREXPRESSION ) { m += m[1]; }
835 while ( --i >= 0 ) *w++ = *m++;
838 while ( m < astop ) *w++ = *m++;
839 *(d->where) = w - d->where;
843 while ( m < astop ) *w++ = *m++;
849 if ( t >= tstop )
return;
862 void WildDollars(
PHEAD WORD *term)
866 WORD *m, *t, *w, *ww, *orig = 0, *wildvalue, *wildstop;
875 m = wildvalue = AN.WildValue;
876 wildstop = AN.WildStop;
879 ww = term + *term; ww -= ABS(ww[-1]); w = term+1;
880 while ( w < ww && *w != SUBEXPRESSION ) w += w[1];
881 if ( w >= ww )
return;
886 while ( m < wildstop ) {
887 if ( *m != LOADDOLLAR ) { m += m[1];
continue; }
889 while ( *t == LOADDOLLAR || *t == FROMSET || *t == SETTONUM ) t -= 4;
890 if ( t < wildvalue ) {
891 MLOCK(ErrorMessageLock);
892 MesPrint(
"&Serious bug in wildcard prototype. Found in WildDollars");
893 MUNLOCK(ErrorMessageLock);
897 d = Dollars + numdollar;
902 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
903 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
904 if ( numdollar == ModOptdollars[nummodopt].number )
break;
906 if ( nummodopt < NumModOptdollars ) {
907 dtype = ModOptdollars[nummodopt].type;
908 if ( dtype == MODLOCAL ) {
909 d = ModOptdollars[nummodopt].dstruct+AT.identity;
912 MLOCK(ErrorMessageLock);
913 MesPrint(
"&Illegal attempt to use $-variable %s in module %l",
914 DOLLARNAME(Dollars,numdollar),AC.CModule);
915 MUNLOCK(ErrorMessageLock);
936 orig = cbuf[AT.ebufnum].rhs[t[3]];
937 w = orig;
while ( *w ) w += *w;
938 weneed = w - orig + 1;
949 orig = cbuf[AT.ebufnum].rhs[t[3]];
950 if ( *orig > 0 ) weneed = *orig+2;
952 w = orig+1;
while ( *w ) { NEXTARG(w) }
953 weneed = w - orig + 1;
960 if ( weneed < 32 ) weneed = 32;
961 weneed = ((weneed+7)/8)*8;
962 if ( d->size > 2*weneed && d->size > 1000 ) {
963 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollarspace");
964 d->where = &(AM.dollarzero);
967 if ( d->size < weneed ) {
968 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollarspace");
969 d->where = (WORD *)Malloc1(weneed*
sizeof(WORD),
"dollarspace");
977 cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
978 cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
980 cbuf[AM.dbufnum].rhs[numdollar] = (WORD *)(1);
989 d->where[0] = 4; d->where[2] = 1;
990 if ( t[3] >= 0 ) { d->where[1] = t[3]; d->where[3] = 3; }
991 else { d->where[1] = -t[3]; d->where[3] = -3; }
992 if ( t[3] == 0 ) { d->type = DOLZERO; d->where[0] = 0; }
993 else { d->type = DOLNUMBER; d->where[4] = 0; }
1010 i = *orig;
while ( --i >= 0 ) *w++ = *orig++;
1018 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[3];
1019 *w++ = 1; *w++ = 1; *w++ = -3; *w = 0;
1022 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[3];
1023 *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
1026 d->type = DOLINDEX; d->index = t[3]; *w = 0;
1029 *w++ = FUNHEAD+4; *w++ = t[3]; *w++ = FUNHEAD;
1031 *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
1034 if ( *orig > 0 ) ww = orig + *orig + 1;
1036 ww = orig+1;
while ( *ww ) { NEXTARG(ww) }
1038 while ( orig < ww ) *w++ = *orig++;
1040 d->type = DOLWILDARGS;
1043 d->type = DOLUNDEFINED;
1055 WORD DolToTensor(
PHEAD WORD numdollar)
1058 DOLLARS d = Dollars + numdollar;
1061 int nummodopt, dtype = -1;
1062 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1063 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1064 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1066 if ( nummodopt < NumModOptdollars ) {
1067 dtype = ModOptdollars[nummodopt].type;
1068 if ( dtype == MODLOCAL ) {
1069 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1072 LOCK(d->pthreadslockread);
1077 AN.ErrorInDollar = 0;
1078 if ( d->type == DOLTERMS && d->where[0] == FUNHEAD+4 &&
1079 d->where[FUNHEAD+4] == 0 && d->where[FUNHEAD+3] == 3 &&
1080 d->where[FUNHEAD+2] == 1 && d->where[FUNHEAD+1] == 1 &&
1081 d->where[1] >= FUNCTION && d->where[1] < FUNCTION+WILDOFFSET
1082 && functions[d->where[1]-FUNCTION].spec >= TENSORFUNCTION ) {
1083 retval = d->where[1];
1085 else if ( d->type == DOLARGUMENT &&
1086 d->where[0] <= -FUNCTION && d->where[0] > -FUNCTION-WILDOFFSET
1087 && functions[-d->where[0]-FUNCTION].spec >= TENSORFUNCTION ) {
1088 retval = -d->where[0];
1090 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1091 && d->where[1] <= -FUNCTION && d->where[1] > -FUNCTION-WILDOFFSET
1093 && functions[-d->where[1]-FUNCTION].spec >= TENSORFUNCTION ) {
1094 retval = -d->where[1];
1096 else if ( d->type == DOLSUBTERM &&
1097 d->where[0] >= FUNCTION && d->where[0] < FUNCTION+WILDOFFSET
1098 && functions[d->where[0]-FUNCTION].spec >= TENSORFUNCTION ) {
1099 retval = d->where[0];
1102 AN.ErrorInDollar = 1;
1106 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1116 WORD DolToFunction(
PHEAD WORD numdollar)
1119 DOLLARS d = Dollars + numdollar;
1122 int nummodopt, dtype = -1;
1123 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1124 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1125 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1127 if ( nummodopt < NumModOptdollars ) {
1128 dtype = ModOptdollars[nummodopt].type;
1129 if ( dtype == MODLOCAL ) {
1130 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1133 LOCK(d->pthreadslockread);
1138 AN.ErrorInDollar = 0;
1139 if ( d->type == DOLTERMS && d->where[0] == FUNHEAD+4 &&
1140 d->where[FUNHEAD+4] == 0 && d->where[FUNHEAD+3] == 3 &&
1141 d->where[FUNHEAD+2] == 1 && d->where[FUNHEAD+1] == 1 &&
1142 d->where[1] >= FUNCTION && d->where[1] < FUNCTION+WILDOFFSET ) {
1143 retval = d->where[1];
1145 else if ( d->type == DOLARGUMENT &&
1146 d->where[0] <= -FUNCTION && d->where[0] > -FUNCTION-WILDOFFSET ) {
1147 retval = -d->where[0];
1149 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1150 && d->where[1] <= -FUNCTION && d->where[1] > -FUNCTION-WILDOFFSET
1151 && d->where[2] == 0 ) {
1152 retval = -d->where[1];
1154 else if ( d->type == DOLSUBTERM &&
1155 d->where[0] >= FUNCTION && d->where[0] < FUNCTION+WILDOFFSET ) {
1156 retval = d->where[0];
1159 AN.ErrorInDollar = 1;
1163 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1173 WORD DolToVector(
PHEAD WORD numdollar)
1176 DOLLARS d = Dollars + numdollar;
1179 int nummodopt, dtype = -1;
1180 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1181 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1182 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1184 if ( nummodopt < NumModOptdollars ) {
1185 dtype = ModOptdollars[nummodopt].type;
1186 if ( dtype == MODLOCAL ) {
1187 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1190 LOCK(d->pthreadslockread);
1195 AN.ErrorInDollar = 0;
1196 if ( d->type == DOLINDEX && d->index < 0 ) {
1199 else if ( d->type == DOLARGUMENT && ( d->where[0] == -VECTOR
1200 || d->where[0] == -MINVECTOR ) ) {
1201 retval = d->where[1];
1203 else if ( d->type == DOLSUBTERM && d->where[0] == INDEX
1204 && d->where[1] == 3 && d->where[2] < 0 ) {
1205 retval = d->where[2];
1207 else if ( d->type == DOLTERMS && d->where[0] == 7 &&
1208 d->where[7] == 0 && d->where[6] == 3 &&
1209 d->where[5] == 1 && d->where[4] == 1 &&
1210 d->where[1] >= INDEX && d->where[3] < 0 ) {
1211 retval = d->where[3];
1213 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1214 && ( d->where[1] == -VECTOR || d->where[1] == -MINVECTOR )
1215 && d->where[3] == 0 ) {
1216 retval = d->where[2];
1218 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1219 && d->where[1] < 0 ) {
1220 retval = d->where[1];
1223 AN.ErrorInDollar = 1;
1227 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1237 WORD DolToNumber(
PHEAD WORD numdollar)
1240 DOLLARS d = Dollars + numdollar;
1242 int nummodopt, dtype = -1;
1243 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1244 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1245 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1247 if ( nummodopt < NumModOptdollars ) {
1248 dtype = ModOptdollars[nummodopt].type;
1249 if ( dtype == MODLOCAL ) {
1250 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1255 AN.ErrorInDollar = 0;
1256 if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
1257 && d->where[0] == 4 &&
1258 d->where[4] == 0 && ( d->where[3] == 3 || d->where[3] == -3 )
1259 && d->where[2] == 1 && ( d->where[1] & TOPBITONLY ) == 0 ) {
1260 if ( d->where[3] > 0 )
return(d->where[1]);
1261 else return(-d->where[1]);
1263 else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER ) {
1264 return(d->where[1]);
1266 else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
1267 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1268 return(d->where[1]);
1270 else if ( d->type == DOLZERO )
return(0);
1271 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1272 && d->where[1] == -SNUMBER && d->where[3] == 0 ) {
1273 return(d->where[2]);
1275 else if ( d->type == DOLINDEX && d->index >= 0 && d->index < AM.OffsetIndex ) {
1278 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1279 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1280 return(d->where[1]);
1282 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1283 && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0
1284 && d->where[2] < AM.OffsetIndex ) {
1285 return(d->where[2]);
1287 AN.ErrorInDollar = 1;
1296 WORD DolToSymbol(
PHEAD WORD numdollar)
1299 DOLLARS d = Dollars + numdollar;
1302 int nummodopt, dtype = -1;
1303 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1304 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1305 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1307 if ( nummodopt < NumModOptdollars ) {
1308 dtype = ModOptdollars[nummodopt].type;
1309 if ( dtype == MODLOCAL ) {
1310 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1313 LOCK(d->pthreadslockread);
1318 AN.ErrorInDollar = 0;
1319 if ( d->type == DOLTERMS && d->where[0] == 8 &&
1320 d->where[8] == 0 && d->where[7] == 3 && d->where[6] == 1
1321 && d->where[5] == 1 && d->where[4] == 1 && d->where[1] == SYMBOL ) {
1322 retval = d->where[3];
1324 else if ( d->type == DOLARGUMENT && d->where[0] == -SYMBOL ) {
1325 retval = d->where[1];
1327 else if ( d->type == DOLSUBTERM && d->where[0] == SYMBOL
1328 && d->where[1] == 4 && d->where[3] == 1 ) {
1329 retval = d->where[2];
1331 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1332 && d->where[1] == -SYMBOL && d->where[3] == 0 ) {
1333 retval = d->where[2];
1336 AN.ErrorInDollar = 1;
1340 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1350 WORD DolToIndex(
PHEAD WORD numdollar)
1353 DOLLARS d = Dollars + numdollar;
1356 int nummodopt, dtype = -1;
1357 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1358 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1359 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1361 if ( nummodopt < NumModOptdollars ) {
1362 dtype = ModOptdollars[nummodopt].type;
1363 if ( dtype == MODLOCAL ) {
1364 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1367 LOCK(d->pthreadslockread);
1372 AN.ErrorInDollar = 0;
1373 if ( d->type == DOLTERMS && d->where[0] == 7 &&
1374 d->where[7] == 0 && d->where[6] == 3 && d->where[5] == 1
1375 && d->where[4] == 1 && d->where[1] == INDEX && d->where[3] >= 0 ) {
1376 retval = d->where[3];
1378 else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER
1379 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1380 retval = d->where[1];
1382 else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
1383 && d->where[1] >= 0 ) {
1384 retval = d->where[1];
1386 else if ( d->type == DOLZERO )
return(0);
1387 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1388 && d->where[1] == -SNUMBER && d->where[3] == 0 && d->where[2] >= 0
1389 && d->where[2] < AM.OffsetIndex ) {
1390 retval = d->where[2];
1392 else if ( d->type == DOLINDEX && d->index >= 0 ) {
1395 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1396 && d->where[1] >= 0 ) {
1397 retval = d->where[1];
1399 else if ( d->type == DOLSUBTERM && d->where[0] == INDEX
1400 && d->where[1] == 3 && d->where[2] >= 0 ) {
1401 retval = d->where[2];
1403 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1404 && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0 ) {
1405 retval = d->where[2];
1408 AN.ErrorInDollar = 1;
1412 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1431 DOLLARS d = Dollars + numdollar, newd;
1434 int nummodopt, dtype = -1;
1435 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1436 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1437 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1439 if ( nummodopt < NumModOptdollars ) {
1440 dtype = ModOptdollars[nummodopt].type;
1441 if ( dtype == MODLOCAL ) {
1442 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1447 AN.ErrorInDollar = 0;
1448 switch ( d->type ) {
1454 if ( t[0] <= -FUNCTION ) {
1455 *w++ = FUNHEAD+4; *w++ = -t[0];
1456 *w++ = FUNHEAD; FILLFUN(w)
1457 *w++ = 1; *w++ = 1; *w++ = 3;
1459 else if ( t[0] == -SYMBOL ) {
1460 *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = t[1];
1461 *w++ = 1; *w++ = 1; *w++ = 1; *w++ = 3;
1463 else if ( t[0] == -VECTOR || t[0] == -INDEX ) {
1464 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[1];
1465 *w++ = 1; *w++ = 1; *w++ = 3;
1467 else if ( t[0] == -MINVECTOR ) {
1468 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[1];
1469 *w++ = 1; *w++ = 1; *w++ = -3;
1471 else if ( t[0] == -SNUMBER ) {
1474 *w++ = -t[1]; *w++ = 1; *w++ = -3;
1477 *w++ = t[1]; *w++ = 1; *w++ = 3;
1480 *w = 0; size = w - AT.WorkPointer;
1487 while ( *t ) t += *t;
1488 size = t - d->where;
1494 *w++ = size+4; t = d->where; NCOPY(w,t,size)
1495 *w++ = 1; *w++ = 1; *w++ = 3;
1496 w = AT.WorkPointer; size = d->where[1]+4;
1500 *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = d->index;
1501 *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
1502 w = AT.WorkPointer; size = 7;
1509 if ( *t == 0 )
return(0);
1512 MLOCK(ErrorMessageLock);
1513 MesPrint(
"Trying to convert a $ with an argument field into an expression");
1514 MUNLOCK(ErrorMessageLock);
1521 if ( *t < 0 )
goto ShortArgument;
1522 size = *t - ARGHEAD;
1526 MLOCK(ErrorMessageLock);
1527 MesPrint(
"Trying to use an undefined $ in an expression");
1528 MUNLOCK(ErrorMessageLock);
1531 if ( d->where ) { d->where[0] = 0; }
1532 else d->where = &(AM.dollarzero);
1539 newd = (
DOLLARS)Malloc1(
sizeof(
struct DoLlArS)+(size+1)*
sizeof(WORD),
1540 "Copy of dollar variable");
1541 t = (WORD *)(newd+1);
1543 newd->name = d->name;
1544 newd->node = d->node;
1545 newd->type = DOLTERMS;
1547 newd->numdummies = d->numdummies;
1549 newd->pthreadslockread = dummylock;
1550 newd->pthreadslockwrite = dummylock;
1554 newd->nfactors = d->nfactors;
1555 if ( d->nfactors > 1 ) {
1556 newd->factors = (
FACDOLLAR *)Malloc1(d->nfactors*
sizeof(
FACDOLLAR),
"Dollar factors");
1557 for ( i = 0; i < d->nfactors; i++ ) {
1558 newd->factors[i].where = 0;
1559 newd->factors[i].size = 0;
1560 newd->factors[i].type = DOLUNDEFINED;
1561 newd->factors[i].value = d->factors[i].value;
1564 else { newd->factors = 0; }
1573 LONG DolToLong(
PHEAD WORD numdollar)
1576 DOLLARS d = Dollars + numdollar;
1579 int nummodopt, dtype = -1;
1580 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1581 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1582 if ( numdollar == ModOptdollars[nummodopt].number )
break;
1584 if ( nummodopt < NumModOptdollars ) {
1585 dtype = ModOptdollars[nummodopt].type;
1586 if ( dtype == MODLOCAL ) {
1587 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1592 AN.ErrorInDollar = 0;
1593 if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
1594 && d->where[0] == 4 &&
1595 d->where[4] == 0 && ( d->where[3] == 3 || d->where[3] == -3 )
1596 && d->where[2] == 1 && ( d->where[1] & TOPBITONLY ) == 0 ) {
1598 if ( d->where[3] > 0 )
return(x);
1601 else if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
1602 && d->where[0] == 6 &&
1603 d->where[6] == 0 && ( d->where[5] == 5 || d->where[5] == -5 )
1604 && d->where[3] == 1 && d->where[4] == 1 && ( d->where[2] & TOPBITONLY ) == 0 ) {
1605 x = d->where[1] + ( (LONG)(d->where[2]) << BITSINWORD );
1606 if ( d->where[5] > 0 )
return(x);
1609 else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER ) {
1613 else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
1614 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1618 else if ( d->type == DOLZERO )
return(0);
1619 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1620 && d->where[1] == -SNUMBER && d->where[3] == 0 ) {
1624 else if ( d->type == DOLINDEX && d->index >= 0 && d->index < AM.OffsetIndex ) {
1628 else if ( d->type == DOLWILDARGS && d->where[0] == 1
1629 && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
1633 else if ( d->type == DOLWILDARGS && d->where[0] == 0
1634 && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0
1635 && d->where[2] < AM.OffsetIndex ) {
1639 AN.ErrorInDollar = 1;
1648 int ExecInside(UBYTE *s)
1655 if ( AC.insidelevel >= MAXNEST ) {
1656 MLOCK(ErrorMessageLock);
1657 MesPrint(
"@Nesting of inside statements more than %d levels",(WORD)MAXNEST);
1658 MUNLOCK(ErrorMessageLock);
1661 AC.insidesumcheck[AC.insidelevel] = NestingChecksum();
1662 AC.insidestack[AC.insidelevel] = cbuf[AC.cbufnum].Pointer
1663 - cbuf[AC.cbufnum].Buffer + 2;
1668 while ( *s ==
',' ) s++;
1669 if ( *s == 0 )
break;
1672 if ( FG.cTable[*s] != 0 ) {
1673 MLOCK(ErrorMessageLock);
1674 MesPrint(
"Illegal name for $ variable: %s",s-1);
1675 MUNLOCK(ErrorMessageLock);
1678 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
1680 if ( ( number = GetDollar(t) ) < 0 ) {
1681 number = AddDollar(t,0,0,0);
1688 MLOCK(ErrorMessageLock);
1689 MesPrint(
"&Illegal object in Inside statement");
1690 MUNLOCK(ErrorMessageLock);
1692 while ( *s && *s !=
',' && s[1] !=
'$' ) s++;
1693 if ( *s == 0 )
break;
1696 AT.WorkPointer[1] = w - AT.WorkPointer;
1697 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
1713 int InsideDollar(
PHEAD WORD *ll, WORD level)
1716 int numvar = (int)(ll[1]-3), j, error = 0;
1717 WORD numdol, *oldcterm, *oldwork = AT.WorkPointer, olddefer, *r, *m;
1718 WORD oldnumlhs, *dbuffer;
1720 oldcterm = AN.cTerm; AN.cTerm = 0;
1721 oldnumlhs = AR.Cnumlhs; AR.Cnumlhs = ll[2];
1723 olddefer = AR.DeferFlag;
1725 while ( --numvar >= 0 ) {
1727 d = Dollars + numdol;
1730 int nummodopt, dtype = -1;
1731 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1732 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1733 if ( numdol == ModOptdollars[nummodopt].number )
break;
1735 if ( nummodopt < NumModOptdollars ) {
1736 dtype = ModOptdollars[nummodopt].type;
1737 if ( dtype == MODLOCAL ) {
1738 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1742 LOCK(d->pthreadslockread);
1747 newd = DolToTerms(BHEAD numdol);
1748 if ( newd == 0 || newd->where[0] == 0 )
continue;
1754 while ( --j >= 0 ) *m++ = *r++;
1761 error = -1;
goto idcall;
1763 AT.WorkPointer = oldwork;
1766 if (
EndSort(BHEAD (WORD *)((VOID *)(&dbuffer)),2) < 0 ) { error = 1;
break; }
1767 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"old buffer of dollar");
1769 if ( dbuffer == 0 || *dbuffer == 0 ) {
1771 if ( dbuffer ) M_free(dbuffer,
"buffer of dollar");
1772 d->where = &(AM.dollarzero); d->size = 0;
1776 r = d->where;
while ( *r ) r += *r;
1777 d->size = (r-d->where)+1;
1780 cbuf[AM.dbufnum].rhs[numdol] = (WORD *)(1);
1785 if ( dtype > 0 && dtype != MODLOCAL ) {
1787 UNLOCK(d->pthreadslockread);
1790 if ( newd->factors ) M_free(newd->factors,
"Dollar factors");
1791 M_free(newd,
"Copy of dollar variable");
1795 AR.Cnumlhs = oldnumlhs;
1796 AR.DeferFlag = olddefer;
1797 AN.cTerm = oldcterm;
1798 AT.WorkPointer = oldwork;
1807 void ExchangeDollars(
int num1,
int num2)
1812 d1 = Dollars + num1; node1 = d1->node;
1813 d2 = Dollars + num2; node2 = d2->node;
1814 nam = d1->name; d1->name = d2->name; d2->name = nam;
1815 d1->node = node2; d2->node = node1;
1816 AC.dollarnames->namenode[node1].number = num2;
1817 AC.dollarnames->namenode[node2].number = num1;
1825 LONG TermsInDollar(WORD num)
1832 int nummodopt, dtype = -1;
1833 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1834 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1835 if ( num == ModOptdollars[nummodopt].number )
break;
1837 if ( nummodopt < NumModOptdollars ) {
1838 dtype = ModOptdollars[nummodopt].type;
1839 if ( dtype == MODLOCAL ) {
1840 d = ModOptdollars[nummodopt].dstruct+AT.identity;
1843 LOCK(d->pthreadslockread);
1848 if ( d->type == DOLTERMS ) {
1851 while ( *t ) { t += *t; n++; }
1853 else if ( d->type == DOLWILDARGS ) {
1855 if ( d->where[0] == 0 ) {
1857 while ( *t != 0 ) { NEXTARG(t); n++; }
1859 else if ( d->where[0] == 1 ) n = 1;
1861 else if ( d->type == DOLZERO ) n = 0;
1864 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1884 UBYTE *PreIfDollarEval(UBYTE *s,
int *value)
1887 UBYTE *s1,*s2,*s3,*s4,*s5,*t,c,c1,c2,c3;
1889 WORD *buf1 = 0, *buf2 = 0, numset, *oldwork = AT.WorkPointer;
1894 while ( *s ==
' ' || *s ==
'\t' || *s ==
'\n' || *s ==
'\r' ) s++;
1896 while ( *t !=
'=' && *t !=
'!' && *t !=
'>' && *t !=
'<' ) {
1897 if ( *t ==
'[' ) { SKIPBRA1(t) }
1898 else if ( *t ==
'{' ) { SKIPBRA2(t) }
1899 else if ( *t ==
'(' ) { SKIPBRA3(t) }
1900 else if ( *t ==
']' || *t ==
'}' || *t ==
')' ) {
1901 MLOCK(ErrorMessageLock);
1902 MesPrint(
"@Improper bracketting in #if");
1903 MUNLOCK(ErrorMessageLock);
1909 while ( *t ==
'=' || *t ==
'!' || *t ==
'>' || *t ==
'<' ) t++;
1911 while ( *t && *t !=
')' ) {
1912 if ( *t ==
'[' ) { SKIPBRA1(t) }
1913 else if ( *t ==
'{' ) { SKIPBRA2(t) }
1914 else if ( *t ==
'(' ) { SKIPBRA3(t) }
1915 else if ( *t ==
']' || *t ==
'}' ) {
1916 MLOCK(ErrorMessageLock);
1917 MesPrint(
"@Improper brackets in #if");
1918 MUNLOCK(ErrorMessageLock);
1924 MLOCK(ErrorMessageLock);
1925 MesPrint(
"@Missing ) to match $( in #if");
1926 MUNLOCK(ErrorMessageLock);
1929 s4 = t; c2 = *s4; *s4 = 0;
1930 if ( s2+2 < s3 || s2 == s3 ) {
1932 MLOCK(ErrorMessageLock);
1933 MesPrint(
"@Illegal operator in $( option of #if");
1934 MUNLOCK(ErrorMessageLock);
1938 if ( *s2 ==
'=' ) oprtr = EQUAL;
1939 else if ( *s2 ==
'>' ) oprtr = GREATER;
1940 else if ( *s2 ==
'<' ) oprtr = LESS;
1943 else if ( *s2 ==
'!' && s2[1] ==
'=' ) oprtr = NOTEQUAL;
1944 else if ( *s2 ==
'=' && s2[1] ==
'=' ) oprtr = EQUAL;
1945 else if ( *s2 ==
'<' && s2[1] ==
'=' ) oprtr = LESSEQUAL;
1946 else if ( *s2 ==
'>' && s2[1] ==
'=' ) oprtr = GREATEREQUAL;
1953 while ( *s3 ==
' ' || *s3 ==
'\t' || *s3 ==
'\n' || *s3 ==
'\r' ) s3++;
1955 while ( chartype[*t] == 0 ) t++;
1957 t++; c = *t; *t = 0;
1958 if ( StrICmp(s3,(UBYTE *)
"set_") == 0 ) {
1959 if ( oprtr != EQUAL && oprtr != NOTEQUAL ) {
1961 MLOCK(ErrorMessageLock);
1962 MesPrint(
"@Improper operator for special keyword in $( ) option");
1963 MUNLOCK(ErrorMessageLock);
1968 else if ( StrICmp(s3,(UBYTE *)
"multipleof_") == 0 ) {
1969 if ( oprtr != EQUAL && oprtr != NOTEQUAL )
goto ImpOp;
1980 else { type = 0; c = *t; }
1982 *t++ = c; s3 = t; s5 = s4-1;
1983 while ( *s5 !=
')' ) {
1984 if ( *s5 ==
' ' || *s5 ==
'\t' || *s5 ==
'\n' || *s5 ==
'\r' ) s5--;
1986 MLOCK(ErrorMessageLock);
1987 MesPrint(
"@Improper use of special keyword in $( ) option");
1988 MUNLOCK(ErrorMessageLock);
1994 else { c3 = c2; s5 = s4; }
1998 if ( ( buf1 = TranslateExpression(s1) ) == 0 ) {
1999 AT.WorkPointer = oldwork;
2006 numset = DoTempSet(t,s3);
2010 MLOCK(ErrorMessageLock);
2011 MesPrint(
"@Argument of set_ is not a valid set");
2012 MUNLOCK(ErrorMessageLock);
2018 while ( FG.cTable[*s3] == 0 || FG.cTable[*s3] == 1
2019 || *s3 ==
'_' ) s3++;
2021 if ( GetName(AC.varnames,t,&numset,NOAUTO) != CSET ) {
2022 *s3 = c;
goto noset;
2026 while ( *s3 ==
' ' || *s3 ==
'\t' || *s3 ==
'\n' || *s3 ==
'\r' ) s3++;
2027 if ( s3 != s5 )
goto noset;
2028 *value = IsSetMember(buf1,numset);
2029 if ( oprtr == NOTEQUAL ) *value ^= 1;
2032 if ( ( buf2 = TranslateExpression(s3) ) == 0 )
goto onerror;
2035 *value = TwoExprCompare(buf1,buf2,oprtr);
2037 else if ( type == 2 ) {
2038 *value = IsMultipleOf(buf1,buf2);
2039 if ( oprtr == NOTEQUAL ) *value ^= 1;
2047 if ( buf1 ) M_free(buf1,
"Buffer in $()");
2048 if ( buf2 ) M_free(buf2,
"Buffer in $()");
2049 *s5 = c3; *s4++ = c2; *s2 = c1;
2050 AT.WorkPointer = oldwork;
2054 if ( buf1 ) M_free(buf1,
"Buffer in $()");
2055 if ( buf2 ) M_free(buf2,
"Buffer in $()");
2056 AT.WorkPointer = oldwork;
2066 WORD *TranslateExpression(UBYTE *s)
2069 CBUF *C = cbuf+AC.cbufnum;
2070 WORD oldnumrhs = C->numrhs;
2071 LONG oldcpointer = C->Pointer - C->Buffer;
2072 WORD *w = AT.WorkPointer;
2073 WORD retcode, oldEside;
2075 *w++ = SUBEXPSIZE + 4;
2077 *w++ = SUBEXPRESSION;
2083 *w++ = 1; *w++ = 1; *w++ = 3; *w++ = 0;
2085 if ( ( retcode = CompileAlgebra(s,RHSIDE,AC.ProtoType) ) < 0 ) {
2086 MLOCK(ErrorMessageLock);
2087 MesPrint(
"@Error translating first expression in $( ) option");
2088 MUNLOCK(ErrorMessageLock);
2091 else { AC.ProtoType[2] = retcode; }
2096 AN.RepPoint = AT.RepCount + 1;
2097 oldEside = AR.Eside; AR.Eside = RHSIDE;
2098 AR.Cnumlhs = C->numlhs;
2099 if (
Generator(BHEAD AC.ProtoType-1,C->numlhs) ) {
2100 AR.Eside = oldEside;
2103 AR.Eside = oldEside;
2108 C->Pointer = C->Buffer + oldcpointer;
2109 C->numrhs = oldnumrhs;
2110 AT.WorkPointer = AC.ProtoType - 1;
2123 int IsSetMember(WORD *buffer, WORD numset)
2125 WORD *t = buffer, *tt, num, csize, num1;
2128 if ( numset < AM.NumFixedSets ) {
2129 if ( t[*t] != 0 )
return(0);
2131 if ( numset == POS0_ || numset == NEG0_ || numset == EVEN_
2132 || numset == Z_ || numset == Q_ )
return(1);
2135 if ( numset == SYMBOL_ ) {
2136 if ( *t == 8 && t[1] == SYMBOL && t[7] == 3 && t[6] == 1
2137 && t[5] == 1 && t[4] == 1 )
return(1);
2140 if ( numset == INDEX_ ) {
2141 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2142 && t[4] == 1 && t[3] > 0 )
return(1);
2143 if ( *t == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex)
2147 if ( numset == FIXED_ ) {
2148 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2149 && t[4] == 1 && t[3] > 0 && t[3] < AM.OffsetIndex )
return(1);
2150 if ( *t == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex)
2154 if ( numset == DUMMYINDEX_ ) {
2155 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2156 && t[4] == 1 && t[3] >= AM.IndDum && t[3] < AM.IndDum+MAXDUMMIES )
return(1);
2157 if ( *t == 4 && t[3] == 3 && t[2] == 1
2158 && t[1] >= AM.IndDum && t[1] < AM.IndDum+MAXDUMMIES )
return(1);
2161 if ( numset == VECTOR_ ) {
2162 if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2163 && t[4] == 1 && t[3] < (AM.OffsetVector+WILDOFFSET) && t[3] >= AM.OffsetVector )
return(1);
2167 if ( ABS(tt[0]) != *t-1 )
return(0);
2168 if ( numset == Q_ )
return(1);
2169 if ( numset == POS_ || numset == POS0_ )
return(tt[0]>0);
2170 else if ( numset == NEG_ || numset == NEG0_ )
return(tt[0]<0);
2171 i = (ABS(tt[0])-1)/2;
2173 if ( tt[0] != 1 )
return(0);
2174 for ( j = 1; j < i; j++ ) {
if ( tt[j] != 0 )
return(0); }
2175 if ( numset == Z_ )
return(1);
2176 if ( numset == ODD_ )
return(t[1]&1);
2177 if ( numset == EVEN_ )
return(1-(t[1]&1));
2180 if ( t[*t] != 0 )
return(0);
2181 type = Sets[numset].type;
2184 if ( t[0] == 8 && t[1] == SYMBOL && t[7] == 3 && t[6] == 1
2185 && t[5] == 1 && t[4] == 1 ) {
2188 else if ( t[0] == 4 && t[2] == 1 && t[1] <= MAXPOWER ) {
2190 if ( t[3] < 0 ) num = -num;
2196 if ( t[0] == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2197 && t[4] == 1 && t[3] < 0 ) {
2203 if ( t[0] == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
2204 && t[4] == 1 && t[3] > 0 ) {
2207 else if ( t[0] == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex ) {
2213 if ( t[0] == 4+FUNHEAD && t[3+FUNHEAD] == 3 && t[2+FUNHEAD] == 1
2214 && t[1+FUNHEAD] == 1 && t[1] >= FUNCTION ) {
2220 if ( t[0] == 4 && t[2] == 1 && t[1] <= AM.OffsetIndex && t[3] == 3 ) {
2228 if ( csize != t[0]-1 )
return(0);
2229 if ( Sets[numset].first < 3*MAXPOWER ) {
2230 num1 = num = Sets[numset].first;
2231 if ( num >= MAXPOWER ) num -= 2*MAXPOWER;
2233 if ( num1 < MAXPOWER ) {
2234 if ( t[t[0]-1] >= 0 )
return(0);
2236 else if ( t[t[0]-1] > 0 )
return(0);
2239 bufterm[0] = 4; bufterm[1] = ABS(num);
2241 if ( num < 0 ) bufterm[3] = -3;
2242 else bufterm[3] = 3;
2244 if ( num1 < MAXPOWER ) {
2245 if ( num >= 0 )
return(0);
2247 else if ( num > 0 )
return(0);
2250 if ( Sets[numset].last > -3*MAXPOWER ) {
2251 num1 = num = Sets[numset].last;
2252 if ( num <= -MAXPOWER ) num += 2*MAXPOWER;
2254 if ( num1 > -MAXPOWER ) {
2255 if ( t[t[0]-1] <= 0 )
return(0);
2257 else if ( t[t[0]-1] < 0 )
return(0);
2260 bufterm[0] = 4; bufterm[1] = ABS(num);
2262 if ( num < 0 ) bufterm[3] = -3;
2263 else bufterm[3] = 3;
2265 if ( num1 > -MAXPOWER ) {
2266 if ( num <= 0 )
return(0);
2268 else if ( num < 0 )
return(0);
2275 t = SetElements + Sets[numset].first;
2276 tt = SetElements + Sets[numset].last;
2278 if ( num == *t )
return(1);
2304 int IsMultipleOf(WORD *buf1, WORD *buf2)
2308 WORD *t1, *t2, *m1, *m2, *r1, *r2, nc1, nc2, ni1, ni2;
2309 UWORD *IfScrat1, *IfScrat2;
2311 if ( *buf1 == 0 && *buf2 == 0 )
return(1);
2315 t1 = buf1; t2 = buf2; num1 = 0; num2 = 0;
2316 while ( *t1 ) { t1 += *t1; num1++; }
2317 while ( *t2 ) { t2 += *t2; num2++; }
2318 if ( num1 != num2 )
return(0);
2322 t1 = buf1; t2 = buf2;
2324 m1 = t1+1; m2 = t2+1; t1 += *t1; t2 += *t2;
2325 r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
2326 if ( r1-m1 != r2-m2 )
return(0);
2328 if ( *m1 != *m2 )
return(0);
2335 IfScrat1 = (UWORD *)(TermMalloc(
"IsMultipleOf")); IfScrat2 = (UWORD *)(TermMalloc(
"IsMultipleOf"));
2336 t1 = buf1; t2 = buf2;
2337 t1 += *t1; t2 += *t2;
2338 if ( *t1 == 0 && *t2 == 0 )
return(1);
2339 r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
2340 nc1 = REDLENG(t1[-1]); nc2 = REDLENG(t2[-1]);
2341 if ( DivRat(BHEAD (UWORD *)r1,nc1,(UWORD *)r2,nc2,IfScrat1,&ni1) ) {
2342 MLOCK(ErrorMessageLock);
2343 MesPrint(
"@Called from MultipleOf in $( )");
2344 MUNLOCK(ErrorMessageLock);
2345 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2349 t1 += *t1; t2 += *t2;
2350 r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
2351 nc1 = REDLENG(t1[-1]); nc2 = REDLENG(t2[-1]);
2352 if ( DivRat(BHEAD (UWORD *)r1,nc1,(UWORD *)r2,nc2,IfScrat2,&ni2) ) {
2353 MLOCK(ErrorMessageLock);
2354 MesPrint(
"@Called from MultipleOf in $( )");
2355 MUNLOCK(ErrorMessageLock);
2356 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2359 if ( ni1 != ni2 )
return(0);
2361 for ( j = 0; j < i; j++ ) {
2362 if ( IfScrat1[j] != IfScrat2[j] ) {
2363 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2368 TermFree(IfScrat1,
"IsMultipleOf"); TermFree(IfScrat2,
"IsMultipleOf");
2379 int TwoExprCompare(WORD *buf1, WORD *buf2,
int oprtr)
2382 WORD *t1, *t2, cond;
2383 t1 = buf1; t2 = buf2;
2384 while ( *t1 && *t2 ) {
2385 cond = CompareTerms(BHEAD t1,t2,1);
2389 case EQUAL:
return(0);
2390 case NOTEQUAL:
return(1);
2391 case GREATEREQUAL:
return(0);
2392 case GREATER:
return(0);
2393 case LESS:
return(1);
2394 case LESSEQUAL:
return(1);
2399 case EQUAL:
return(0);
2400 case NOTEQUAL:
return(1);
2401 case GREATEREQUAL:
return(1);
2402 case GREATER:
return(1);
2403 case LESS:
return(0);
2404 case LESSEQUAL:
return(0);
2408 t1 += *t1; t2 += *t2;
2412 case EQUAL:
return(1);
2413 case NOTEQUAL:
return(0);
2414 case GREATEREQUAL:
return(1);
2415 case GREATER:
return(0);
2416 case LESS:
return(0);
2417 case LESSEQUAL:
return(1);
2422 case EQUAL:
return(0);
2423 case NOTEQUAL:
return(1);
2424 case GREATEREQUAL:
return(1);
2425 case GREATER:
return(1);
2426 case LESS:
return(0);
2427 case LESSEQUAL:
return(0);
2432 case EQUAL:
return(0);
2433 case NOTEQUAL:
return(1);
2434 case GREATEREQUAL:
return(0);
2435 case GREATER:
return(0);
2436 case LESS:
return(1);
2437 case LESSEQUAL:
return(1);
2440 MLOCK(ErrorMessageLock);
2441 MesPrint(
"@Internal problems with operator in $( )");
2442 MUNLOCK(ErrorMessageLock);
2455 static UWORD *dscrat = 0;
2456 static WORD ndscrat;
2458 int DollarRaiseLow(UBYTE *name, LONG value)
2464 WORD lnum[4], nnum, *t1, *t2, i;
2466 s = name;
while ( *s ) s++;
2467 if ( s[-1] ==
'-' && s[-2] ==
'-' && s > name+2 ) s -= 2;
2468 else if ( s[-1] ==
'+' && s[-2] ==
'+' && s > name+2 ) s -= 2;
2470 num = GetDollar(name);
2473 if ( value < 0 ) { value = -value; sgn = -1; }
2474 if ( d->type == DOLZERO ) {
2475 if ( d->where ) M_free(d->where,
"DollarRaiseLow");
2477 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"DollarRaiseLow");
2478 if ( ( value & AWORDMASK ) != 0 ) {
2479 d->where[0] = 6; d->where[1] = value >> BITSINWORD;
2480 d->where[2] = (WORD)value; d->where[3] = 1; d->where[4] = 0;
2481 d->where[5] = 5*sgn; d->where[6] = 0;
2485 d->where[0] = 4; d->where[1] = (WORD)value; d->where[2] = 1;
2486 d->where[3] = 3*sgn; d->where[4] = 0;
2487 d->type = DOLNUMBER;
2490 else if ( d->type == DOLNUMBER || ( d->type == DOLTERMS
2491 && d->where[d->where[0]] == 0
2492 && d->where[0] == ABS(d->where[d->where[0]-1])+1 ) ) {
2493 if ( ( value & AWORDMASK ) != 0 ) {
2494 lnum[0] = value >> BITSINWORD;
2495 lnum[1] = (WORD)value; lnum[2] = 1; lnum[3] = 0;
2499 lnum[0] = (WORD)value; lnum[1] = 1; nnum = sgn;
2501 i = d->where[d->where[0]-1];
2503 if ( dscrat == 0 ) {
2504 dscrat = (UWORD *)Malloc1((AM.MaxTal+2)*
sizeof(UWORD),
"DollarRaiseLow");
2506 if ( AddRat(BHEAD (UWORD *)(d->where+1),i,
2507 (UWORD *)lnum,nnum,dscrat,&ndscrat) ) {
2508 MLOCK(ErrorMessageLock);
2509 MesCall(
"DollarRaiseLow");
2510 MUNLOCK(ErrorMessageLock);
2513 ndscrat = INCLENG(ndscrat);
2516 M_free(d->where,
"DollarRaiseLow");
2522 if ( i+2 > d->size ) {
2523 M_free(d->where,
"DollarRaiseLow");
2525 if ( d->size < 32 ) d->size = 32;
2526 d->size = ((d->size+7)/8)*8;
2527 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"DollarRaiseLow");
2529 t1 = d->where; *t1++ = i+1; t2 = (WORD *)dscrat;
2530 while ( --i > 0 ) *t1++ = *t2++;
2531 *t1++ = ndscrat; *t1 = 0;
2559 WORD num, type, *td;
2561 if ( *arg == SNUMBER )
return(arg[1]);
2562 if ( *arg == DOLLAREXPR2 && arg[1] < 0 )
return(-arg[1]-1);
2563 d = Dollars + arg[1];
2566 int nummodopt, dtype = -1;
2567 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2568 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2569 if ( arg[1] == ModOptdollars[nummodopt].number )
break;
2571 if ( nummodopt < NumModOptdollars ) {
2572 dtype = ModOptdollars[nummodopt].type;
2573 if ( dtype == MODLOCAL ) {
2574 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2580 if ( *arg == DOLLAREXPRESSION ) {
2581 if ( arg[2] != DOLLAREXPR2 ) {
2584 if ( type == DOLZERO ) {}
2585 else if ( type == DOLNUMBER ) {
2587 if ( ( td[0] != 4 ) || ( (td[1]&SPECMASK) != 0 ) || ( td[2] != 1 ) ) {
2588 MLOCK(ErrorMessageLock);
2590 MesPrint(
"$-variable is not a short number in print statement");
2593 MesPrint(
"$-variable is not a short number in do loop");
2595 MUNLOCK(ErrorMessageLock);
2598 return( td[3] > 0 ? td[1]: -td[1] );
2601 MLOCK(ErrorMessageLock);
2603 MesPrint(
"$-variable is not a number in print statement");
2606 MesPrint(
"$-variable is not a number in do loop");
2608 MUNLOCK(ErrorMessageLock);
2615 else if ( *arg == DOLLAREXPR2 ) {
2616 if ( arg[1] < 0 ) { num = -arg[1]-1; }
2617 else if ( arg[2] != DOLLAREXPR2 && par == -1 ) {
2623 MLOCK(ErrorMessageLock);
2625 MesPrint(
"Invalid $-variable in print statement");
2628 MesPrint(
"Invalid $-variable in do loop");
2630 MUNLOCK(ErrorMessageLock);
2634 if ( num == 0 )
return(d->nfactors);
2635 if ( num > d->nfactors || num < 1 ) {
2636 MLOCK(ErrorMessageLock);
2638 MesPrint(
"Not a valid factor number for $-variable in print statement");
2641 MesPrint(
"Not a valid factor number for $-variable in do loop");
2643 MUNLOCK(ErrorMessageLock);
2647 if ( d->factors[num].type == DOLNUMBER )
2648 return(d->factors[num].value);
2650 MLOCK(ErrorMessageLock);
2652 MesPrint(
"$-variable in print statement is not a number");
2655 MesPrint(
"$-variable in do loop is not a number");
2657 MUNLOCK(ErrorMessageLock);
2668 WORD TestDoLoop(
PHEAD WORD *lhsbuf, WORD level)
2671 WORD start,finish,incr;
2676 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2677 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2680 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2681 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2685 if ( ( finish == start ) || ( finish > start && incr > 0 )
2686 || ( finish < start && incr < 0 ) ) {}
2687 else { level = lhsbuf[3]; }
2691 d = Dollars + lhsbuf[2];
2694 int nummodopt, dtype = -1;
2695 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2696 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2697 if ( lhsbuf[2] == ModOptdollars[nummodopt].number )
break;
2699 if ( nummodopt < NumModOptdollars ) {
2700 dtype = ModOptdollars[nummodopt].type;
2701 if ( dtype == MODLOCAL ) {
2702 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2709 if ( d->size < 32 ) {
2710 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
2712 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"dollar contents");
2716 d->where[1] = start;
2720 d->type = DOLNUMBER;
2722 else if ( start < 0 ) {
2724 d->where[1] = -start;
2728 d->type = DOLNUMBER;
2733 if ( d == Dollars + lhsbuf[2] ) {
2734 cbuf[AM.dbufnum].CanCommu[lhsbuf[2]] = 0;
2735 cbuf[AM.dbufnum].NumTerms[lhsbuf[2]] = 1;
2736 cbuf[AM.dbufnum].rhs[lhsbuf[2]] = d->where;
2746 WORD TestEndDoLoop(
PHEAD WORD *lhsbuf, WORD level)
2749 WORD start,finish,incr,value;
2754 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2755 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2758 while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
2759 && ( h[2] == DOLLAREXPR2 ) ) h += 2;
2763 if ( ( finish == start ) || ( finish > start && incr > 0 )
2764 || ( finish < start && incr < 0 ) ) {}
2765 else { level = lhsbuf[3]; }
2769 d = Dollars + lhsbuf[2];
2772 int nummodopt, dtype = -1;
2773 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2774 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2775 if ( lhsbuf[2] == ModOptdollars[nummodopt].number )
break;
2777 if ( nummodopt < NumModOptdollars ) {
2778 dtype = ModOptdollars[nummodopt].type;
2779 if ( dtype == MODLOCAL ) {
2780 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2789 if ( d->type == DOLZERO ) {
2792 else if ( ( d->type == DOLNUMBER || d->type == DOLTERMS )
2793 && ( d->where[4] == 0 ) && ( d->where[0] == 4 )
2794 && ( d->where[1] > 0 ) && ( d->where[2] == 1 ) ) {
2795 value = ( d->where[3] < 0 ) ? -d->where[1]: d->where[1];
2798 MLOCK(ErrorMessageLock);
2799 MesPrint(
"Wrong type of object in do loop parameter");
2800 MUNLOCK(ErrorMessageLock);
2805 if ( ( finish > start && value <= finish ) ||
2806 ( finish < start && value >= finish ) ||
2807 ( finish == start && value == finish ) ) {}
2808 else level = lhsbuf[3];
2810 if ( d->size < 32 ) {
2811 if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,
"dollar contents");
2813 d->where = (WORD *)Malloc1(d->size*
sizeof(WORD),
"dollar contents");
2817 d->where[1] = value;
2821 d->type = DOLNUMBER;
2823 else if ( start < 0 ) {
2825 d->where[1] = -value;
2829 d->type = DOLNUMBER;
2834 if ( d == Dollars + lhsbuf[2] ) {
2835 cbuf[AM.dbufnum].CanCommu[lhsbuf[2]] = 0;
2836 cbuf[AM.dbufnum].NumTerms[lhsbuf[2]] = 1;
2837 cbuf[AM.dbufnum].rhs[lhsbuf[2]] = d->where;
2861 int DollarFactorize(
PHEAD WORD numdollar)
2864 DOLLARS d = Dollars + numdollar;
2866 WORD *oldworkpointer;
2867 WORD *buf1, *t, *term, *buf1content, *buf2, *termextra;
2868 WORD *buf3, *argextra;
2870 WORD *tstop, pow, *r;
2872 int i, j, jj, action = 0, sign = 1;
2874 WORD startebuf = cbuf[AT.ebufnum].numrhs;
2875 WORD nfactors, factorsincontent, extrafactor = 0;
2876 WORD oldsorttype = AR.SortType;
2879 int nummodopt, dtype;
2881 if ( AS.MultiThreaded ) {
2882 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2883 if ( numdollar == ModOptdollars[nummodopt].number )
break;
2885 if ( nummodopt < NumModOptdollars ) {
2886 dtype = ModOptdollars[nummodopt].type;
2887 if ( dtype == MODLOCAL ) {
2888 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2891 LOCK(d->pthreadslockread);
2896 CleanDollarFactors(d);
2898 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
2900 if ( d->type != DOLTERMS ) {
2901 if ( d->type != DOLZERO ) d->nfactors = 1;
2904 if ( d->where[d->where[0]] == 0 ) {
2917 AR.SortType = SORTHIGHFIRST;
2918 if ( oldsorttype != AR.SortType ) {
2922 if ( AN.ncmod != 0 ) {
2923 if ( AN.ncmod != 1 || ( (WORD)AN.cmod[0] < 0 ) ) {
2924 AR.SortType = oldsorttype;
2925 MLOCK(ErrorMessageLock);
2926 MesPrint(
"Factorization modulus a number, greater than a WORD not implemented.");
2927 MUNLOCK(ErrorMessageLock);
2930 if ( Modulus(term) ) {
2931 AR.SortType = oldsorttype;
2932 MLOCK(ErrorMessageLock);
2933 MesCall(
"DollarFactorize");
2934 MUNLOCK(ErrorMessageLock);
2937 if ( !*term) { term = t;
continue; }
2943 EndSort(BHEAD (WORD *)((
void *)(&buf1)),2);
2944 t = buf1;
while ( *t ) t += *t;
2948 t = term;
while ( *t ) t += *t;
2949 ii = insize = t - term;
2950 buf1 = (WORD *)Malloc1((insize+1)*
sizeof(WORD),
"DollarFactorize-1");
2960 buf1content = TermMalloc(
"DollarContent");
2962 if ( ( buf2 =
TakeContent(BHEAD buf1,buf1content) ) == 0 ) {
2964 TermFree(buf1content,
"DollarContent");
2965 M_free(buf1,
"DollarFactorize-1");
2966 AR.SortType = oldsorttype;
2967 MLOCK(ErrorMessageLock);
2968 MesCall(
"DollarFactorize");
2969 MUNLOCK(ErrorMessageLock);
2973 else if ( ( buf1content[0] == 4 ) && ( buf1content[1] == 1 ) &&
2974 ( buf1content[2] == 1 ) && ( buf1content[3] == 3 ) ) {
2976 if ( buf2 != buf1 ) {
2977 M_free(buf2,
"DollarFactorize-2");
2980 factorsincontent = 0;
2987 if ( buf2 != buf1 ) M_free(buf1,
"DollarFactorize-1");
2989 t = buf1;
while ( *t ) t += *t;
2994 factorsincontent = 0;
2996 tstop = term + *term;
2997 if ( tstop[-1] < 0 ) factorsincontent++;
2998 if ( ABS(tstop[-1]) == 3 && tstop[-2] == 1 && tstop[-3] == 1 ) {
2999 tstop -= ABS(tstop[-1]);
3003 tstop -= ABS(tstop[-1]);
3006 while ( term < tstop ) {
3009 t = term+2; i = (term[1]-2)/2;
3011 factorsincontent += ABS(t[1]);
3016 t = term+2; i = (term[1]-2)/3;
3018 factorsincontent += ABS(t[2]);
3024 factorsincontent += (term[1]-2)/2;
3027 factorsincontent += term[1]-2;
3030 if ( *term >= FUNCTION ) factorsincontent++;
3037 factorsincontent = 0;
3049 if ( ( t[1] != SYMBOL ) && ( *t != (ABS(t[*t-1])+1) ) ) {
3054 if ( DetCommu(buf1) > 1 ) {
3055 MesPrint(
"Cannot factorize a $-expression with more than one noncommuting object");
3056 AR.SortType = oldsorttype;
3057 M_free(buf1,
"DollarFactorize-2");
3058 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3059 MesCall(
"DollarFactorize");
3065 termextra = AT.WorkPointer;
3071 AR.SortType = oldsorttype;
3072 M_free(buf1,
"DollarFactorize-2");
3073 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3074 MesCall(
"DollarFactorize");
3082 if (
EndSort(BHEAD (WORD *)((
void *)(&buf2)),2) < 0 ) {
goto getout; }
3084 t = buf2;
while ( *t > 0 ) t += *t;
3093 if ( ( buf3 = poly_factorize_dollar(BHEAD buf2) ) == 0 ) {
3094 MesCall(
"DollarFactorize");
3095 AR.SortType = oldsorttype;
3096 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-3");
3097 M_free(buf1,
"DollarFactorize-3");
3098 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3102 if ( buf2 != buf1 && buf2 ) {
3103 M_free(buf2,
"DollarFactorize-3");
3107 AR.SortType = oldsorttype;
3114 if ( *term == 4 && term[4] == 0 && term[3] == -3 && term[2] == 1
3116 WORD *tt1, *tt2, *ttstop;
3118 tt1 = term; tt2 = term + *term + 1;
3121 while ( *ttstop ) ttstop += *ttstop;
3124 while ( tt2 < ttstop ) *tt1++ = *tt2++;
3133 while ( *term ) { term += *term; }
3148 if ( dtype > 0 && dtype != MODLOCAL ) { LOCK(d->pthreadslockread); }
3150 if ( nfactors == 1 && extrafactor == 0 ) {
3151 if ( factorsincontent == 0 ) {
3154 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3163 term = buf1;
while ( *term ) term += *term;
3164 d->factors[0].size = i = term - buf1;
3165 d->factors[0].where = t = (WORD *)Malloc1(
sizeof(WORD)*(i+1),
"DollarFactorize-5");
3166 term = buf1; NCOPY(t,term,i); *t = 0;
3167 AR.SortType = oldsorttype;
3168 M_free(buf3,
"DollarFactorize-4");
3169 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-4");
3170 M_free(buf1,
"DollarFactorize-4");
3171 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3175 d->factors = (
FACDOLLAR *)Malloc1(
sizeof(
FACDOLLAR)*(nfactors+factorsincontent),
"factors in dollar");
3176 term = buf1;
while ( *term ) term += *term;
3177 d->factors[0].size = i = term - buf1;
3178 d->factors[0].where = t = (WORD *)Malloc1(
sizeof(WORD)*(i+1),
"DollarFactorize-5");
3179 term = buf1; NCOPY(t,term,i); *t = 0;
3180 M_free(buf3,
"DollarFactorize-4");
3182 if ( buf2 != buf1 && buf2 ) {
3183 M_free(buf2,
"DollarFactorize-4");
3188 else if ( action ) {
3189 C = cbuf+AC.cbufnum;
3190 CC = cbuf+AT.ebufnum;
3191 oldworkpointer = AT.WorkPointer;
3192 d->factors = (
FACDOLLAR *)Malloc1(
sizeof(
FACDOLLAR)*(nfactors+factorsincontent),
"factors in dollar");
3194 for ( i = 0; i < nfactors; i++ ) {
3195 argextra = AT.WorkPointer;
3199 if ( ConvertFromPoly(BHEAD term,argextra,numxsymbol,CC->numrhs-startebuf+numxsymbol
3200 ,startebuf-numxsymbol,1) <= 0 ) {
3202 getout2: AR.SortType = oldsorttype;
3203 M_free(d->factors,
"factors in dollar");
3206 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3208 M_free(buf3,
"DollarFactorize-4");
3209 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-4");
3210 M_free(buf1,
"DollarFactorize-4");
3211 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3214 AT.WorkPointer = argextra + *argextra;
3218 if (
Generator(BHEAD argextra,C->numlhs+1) ) {
3224 AT.WorkPointer = oldworkpointer;
3226 EndSort(BHEAD (WORD *)((
void *)(&(d->factors[i].where))),2);
3228 d->factors[i].type = DOLTERMS;
3229 t = d->factors[i].where;
3230 while ( *t ) t += *t;
3231 d->factors[i].size = t - d->factors[i].where;
3233 CC->numrhs = startebuf;
3236 C = cbuf+AC.cbufnum;
3237 oldworkpointer = AT.WorkPointer;
3238 d->factors = (
FACDOLLAR *)Malloc1(
sizeof(
FACDOLLAR)*(nfactors+factorsincontent),
"factors in dollar");
3240 for ( i = 0; i < nfactors; i++ ) {
3243 argextra = oldworkpointer;
3245 NCOPY(argextra,term,j)
3246 AT.WorkPointer = argextra;
3247 if (
Generator(BHEAD oldworkpointer,C->numlhs+1) ) {
3252 AT.WorkPointer = oldworkpointer;
3254 EndSort(BHEAD (WORD *)((
void *)(&(d->factors[i].where))),2);
3255 d->factors[i].type = DOLTERMS;
3256 t = d->factors[i].where;
3257 while ( *t ) t += *t;
3258 d->factors[i].size = t - d->factors[i].where;
3261 d->nfactors = nfactors + factorsincontent;
3266 if ( buf3 ) M_free(buf3,
"DollarFactorize-5");
3267 if ( buf2 != buf1 && buf2 ) M_free(buf2,
"DollarFactorize-5");
3268 M_free(buf1,
"DollarFactorize-5");
3272 tstop = term + *term;
3273 if ( tstop[-1] < 0 ) { tstop[-1] = -tstop[-1]; sign = -sign; }
3276 while ( term < tstop ) {
3279 t = term+2; i = (term[1]-2)/2;
3281 if ( t[1] < 0 ) { t[1] = -t[1]; pow = -1; }
3283 for ( jj = 0; jj < t[1]; jj++ ) {
3284 r = d->factors[j].where = (WORD *)Malloc1(9*
sizeof(WORD),
"factor");
3285 r[0] = 8; r[1] = SYMBOL; r[2] = 4; r[3] = *t; r[4] = pow;
3286 r[5] = 1; r[6] = 1; r[7] = 3; r[8] = 0;
3287 d->factors[j].type = DOLTERMS;
3288 d->factors[j].size = 8;
3295 t = term+2; i = (term[1]-2)/3;
3297 if ( t[2] < 0 ) { t[2] = -t[2]; pow = -1; }
3299 for ( jj = 0; jj < t[2]; jj++ ) {
3300 r = d->factors[j].where = (WORD *)Malloc1(10*
sizeof(WORD),
"factor");
3301 r[0] = 9; r[1] = DOTPRODUCT; r[2] = 5; r[3] = t[0]; r[4] = t[1];
3302 r[5] = pow; r[6] = 1; r[7] = 1; r[8] = 3; r[9] = 0;
3303 d->factors[j].type = DOLTERMS;
3304 d->factors[j].size = 9;
3312 t = term+2; i = (term[1]-2)/2;
3314 for ( jj = 0; jj < t[1]; jj++ ) {
3315 r = d->factors[j].where = (WORD *)Malloc1(9*
sizeof(WORD),
"factor");
3316 r[0] = 8; r[1] = *term; r[2] = 4; r[3] = *t; r[4] = t[1];
3317 r[5] = 1; r[6] = 1; r[7] = 3; r[8] = 0;
3318 d->factors[j].type = DOLTERMS;
3319 d->factors[j].size = 8;
3326 t = term+2; i = term[1]-2;
3328 for ( jj = 0; jj < t[1]; jj++ ) {
3329 r = d->factors[j].where = (WORD *)Malloc1(8*
sizeof(WORD),
"factor");
3330 r[0] = 7; r[1] = *term; r[2] = 3; r[3] = *t;
3331 r[4] = 1; r[5] = 1; r[6] = 3; r[7] = 0;
3332 d->factors[j].type = DOLTERMS;
3333 d->factors[j].size = 7;
3340 if ( *term >= FUNCTION ) {
3341 r = d->factors[j].where = (WORD *)Malloc1((term[1]+5)*
sizeof(WORD),
"factor");
3342 *r++ = d->factors[j].size = term[1]+4;
3343 for ( jj = 0; jj < t[1]; jj++ ) *r++ = term[jj];
3344 *r++ = 1; *r++ = 1; *r++ = 3; *r = 0;
3358 tstop = term + *term;
3359 if ( tstop[-1] == 3 && tstop[-2] == 1 && tstop[-3] == 1 ) {}
3360 else if ( tstop[-1] == 3 && tstop[-2] == 1 && (UWORD)(tstop[-3]) <= MAXPOSITIVE ) {
3361 d->factors[j].where = 0;
3362 d->factors[j].size = 0;
3363 d->factors[j].type = DOLNUMBER;
3364 d->factors[j].value = sign*tstop[-3];
3369 d->factors[j].where = r = (WORD *)Malloc1((tstop[-1]+2)*
sizeof(WORD),
"numfactor");
3370 d->factors[j].size = tstop[-1]+1;
3371 d->factors[j].type = DOLTERMS;
3372 d->factors[j].value = 0;
3379 r = d->factors[j].where;
3381 r += *r; r[-1] = -r[-1];
3389 for ( jj = j; jj > 0; jj-- ) {
3390 d->factors[jj] = d->factors[jj-1];
3392 d->factors[0].where = 0;
3393 d->factors[0].size = 0;
3394 d->factors[0].type = DOLNUMBER;
3395 d->factors[0].value = -1;
3399 if ( buf1content ) TermFree(buf1content,
"DollarContent");
3407 if ( d->nfactors > 1 ) {
3408 WORD ***fac, j1, j2, k, ret, *s1, *s2, *s3;
3410 facsize = (LONG **)Malloc1((
sizeof(WORD **)+
sizeof(LONG *))*d->nfactors,
"SortDollarFactors");
3411 fac = (WORD ***)(facsize+d->nfactors);
3413 for ( j = 0; j < d->nfactors; j++ ) {
3414 if ( d->factors[j].where ) {
3415 fac[k] = &(d->factors[j].where);
3416 facsize[k] = &(d->factors[j].size);
3421 for ( j = 1; j < k; j++ ) {
3424 s1 = *(fac[j1]); s2 = *(fac[j2]);
3425 while ( *s1 && *s2 ) {
3426 if ( ( ret = CompareTerms(BHEAD s2, s1, (WORD)2) ) == 0 ) {
3427 s1 += *s1; s2 += *s2;
3429 else if ( ret > 0 )
goto nextj;
3432 s3 = *(fac[j1]); *(fac[j1]) = *(fac[j2]); *(fac[j2]) = s3;
3433 x = *(facsize[j1]); *(facsize[j1]) = *(facsize[j2]); *(facsize[j2]) = x;
3435 if ( j1 > 0 )
goto nextj1;
3439 if ( *s1 )
goto nextj;
3440 if ( *s2 )
goto exch;
3444 M_free(facsize,
"SortDollarFactors");
3450 if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3460 void CleanDollarFactors(
DOLLARS d)
3463 if ( d->nfactors > 1 ) {
3464 for ( i = 0; i < d->nfactors; i++ ) {
3465 if ( d->factors[i].where )
3466 M_free(d->factors[i].where,
"dollar factors");
3470 M_free(d->factors,
"dollar factors");
3481 WORD *TakeDollarContent(
PHEAD WORD *dollarbuffer, WORD **factor)
3488 t = dollarbuffer; pow = 1;
3494 t += *t; t[-1] = -t[-1];
3500 if ( AN.cmod != 0 ) {
3501 if ( ( *factor =
MakeDollarMod(BHEAD dollarbuffer,&remain) ) == 0 ) {
3505 (*factor)[**factor-1] = -(*factor)[**factor-1];
3506 (*factor)[**factor-1] += AN.cmod[0];
3514 (*factor)[**factor-1] = -(*factor)[**factor-1];
3536 UWORD *GCDbuffer, *GCDbuffer2, *LCMbuffer, *LCMb, *LCMc;
3537 WORD *r, *r1, *r2, *r3, *rnext, i, k, j, *oldworkpointer, *factor;
3538 WORD kGCD, kLCM, kGCD2, kkLCM, jLCM, jGCD;
3539 CBUF *C = cbuf+AC.cbufnum;
3541 GCDbuffer = NumberMalloc(
"MakeDollarInteger");
3542 GCDbuffer2 = NumberMalloc(
"MakeDollarInteger");
3543 LCMbuffer = NumberMalloc(
"MakeDollarInteger");
3544 LCMb = NumberMalloc(
"MakeDollarInteger");
3545 LCMc = NumberMalloc(
"MakeDollarInteger");
3554 if ( k < 0 ) k = -k;
3555 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3556 for ( kGCD = 0; kGCD < k; kGCD++ ) GCDbuffer[kGCD] = r3[kGCD];
3558 if ( k < 0 ) k = -k;
3560 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3561 for ( kLCM = 0; kLCM < k; kLCM++ ) LCMbuffer[kLCM] = r3[kLCM];
3571 if ( k < 0 ) k = -k;
3572 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3573 if ( ( ( GCDbuffer[0] == 1 ) && ( kGCD == 1 ) ) ) {
3578 else if ( ( ( k != 1 ) || ( r3[0] != 1 ) ) ) {
3579 if ( GcdLong(BHEAD GCDbuffer,kGCD,(UWORD *)r3,k,GCDbuffer2,&kGCD2) ) {
3580 goto MakeDollarIntegerErr;
3583 for ( i = 0; i < kGCD; i++ ) GCDbuffer[i] = GCDbuffer2[i];
3586 kGCD = 1; GCDbuffer[0] = 1;
3589 if ( k < 0 ) k = -k;
3591 while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
3592 if ( ( ( LCMbuffer[0] == 1 ) && ( kLCM == 1 ) ) ) {
3593 for ( kLCM = 0; kLCM < k; kLCM++ )
3594 LCMbuffer[kLCM] = r3[kLCM];
3596 else if ( ( k != 1 ) || ( r3[0] != 1 ) ) {
3597 if ( GcdLong(BHEAD LCMbuffer,kLCM,(UWORD *)r3,k,LCMb,&kkLCM) ) {
3598 goto MakeDollarIntegerErr;
3600 DivLong((UWORD *)r3,k,LCMb,kkLCM,LCMb,&kkLCM,LCMc,&jLCM);
3601 MulLong(LCMbuffer,kLCM,LCMb,kkLCM,LCMc,&jLCM);
3602 for ( kLCM = 0; kLCM < jLCM; kLCM++ )
3603 LCMbuffer[kLCM] = LCMc[kLCM];
3611 r3 = (WORD *)(GCDbuffer);
3612 if ( kGCD == kLCM ) {
3613 for ( jGCD = 0; jGCD < kGCD; jGCD++ )
3614 r3[jGCD+kGCD] = LCMbuffer[jGCD];
3617 else if ( kGCD > kLCM ) {
3618 for ( jGCD = 0; jGCD < kLCM; jGCD++ )
3619 r3[jGCD+kGCD] = LCMbuffer[jGCD];
3620 for ( jGCD = kLCM; jGCD < kGCD; jGCD++ )
3625 for ( jGCD = kGCD; jGCD < kLCM; jGCD++ )
3627 for ( jGCD = 0; jGCD < kLCM; jGCD++ )
3628 r3[jGCD+kLCM] = LCMbuffer[jGCD];
3635 factor = r1 = (WORD *)Malloc1((j+2)*
sizeof(WORD),
"MakeDollarInteger");
3636 *r1++ = j+1; r2 = r3;
3637 for ( i = 0; i < k; i++ ) { *r1++ = *r2++; *r1++ = *r2++; }
3650 oldworkpointer = AT.WorkPointer;
3655 r2 = oldworkpointer;
3656 while ( r < r3 ) *r2++ = *r++;
3658 if ( DivRat(BHEAD (UWORD *)r3,j,GCDbuffer,k,(UWORD *)r2,&i) ) {
3659 goto MakeDollarIntegerErr;
3663 if ( rnext[-1] < 0 ) r2[-1] = -i;
3665 *oldworkpointer = r2-oldworkpointer;
3666 AT.WorkPointer = r2;
3667 if (
Generator(BHEAD oldworkpointer,C->numlhs) ) {
3668 goto MakeDollarIntegerErr;
3672 AT.WorkPointer = oldworkpointer;
3674 EndSort(BHEAD (WORD *)bufout,2);
3678 NumberFree(LCMc,
"MakeDollarInteger");
3679 NumberFree(LCMb,
"MakeDollarInteger");
3680 NumberFree(LCMbuffer,
"MakeDollarInteger");
3681 NumberFree(GCDbuffer2,
"MakeDollarInteger");
3682 NumberFree(GCDbuffer,
"MakeDollarInteger");
3685 MakeDollarIntegerErr:
3686 NumberFree(LCMc,
"MakeDollarInteger");
3687 NumberFree(LCMb,
"MakeDollarInteger");
3688 NumberFree(LCMbuffer,
"MakeDollarInteger");
3689 NumberFree(GCDbuffer2,
"MakeDollarInteger");
3690 NumberFree(GCDbuffer,
"MakeDollarInteger");
3691 MesCall(
"MakeDollarInteger");
3710 WORD *r, *r1, x, xx, ix, ip;
3711 WORD *factor, *oldworkpointer;
3713 CBUF *C = cbuf+AC.cbufnum;
3716 if ( r[*r-1] < 0 ) x += AN.cmod[0];
3720 factor = (WORD *)Malloc1(5*
sizeof(WORD),
"MakeDollarMod");
3721 factor[0] = 4; factor[1] = x; factor[2] = 1; factor[3] = 3; factor[4] = 0;
3729 oldworkpointer = AT.WorkPointer;
3731 r1 = oldworkpointer; i = *r;
3733 xx = r1[-3];
if ( r1[-1] < 0 ) xx += AN.cmod[0];
3734 r1[-1] = (WORD)((((LONG)xx)*ix) % AN.cmod[0]);
3735 *r1 = 0; AT.WorkPointer = r1;
3736 if (
Generator(BHEAD oldworkpointer,C->numlhs) ) {
3740 AT.WorkPointer = oldworkpointer;
3742 EndSort(BHEAD (WORD *)bufout,2);
3752 int GetDolNum(
PHEAD WORD *t, WORD *tstop)
3756 if ( t+3 < tstop && t[3] == DOLLAREXPR2 ) {
3760 int nummodopt, dtype;
3762 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3763 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3764 if ( t[2] == ModOptdollars[nummodopt].number )
break;
3766 if ( nummodopt < NumModOptdollars ) {
3767 dtype = ModOptdollars[nummodopt].type;
3768 if ( dtype == MODLOCAL ) {
3769 d = ModOptdollars[nummodopt].dstruct+AT.identity;
3772 MLOCK(ErrorMessageLock);
3773 MesPrint(
"&Illegal attempt to use $-variable %s in module %l",
3774 DOLLARNAME(Dollars,t[2]),AC.CModule);
3775 MUNLOCK(ErrorMessageLock);
3782 if ( d->factors == 0 ) {
3783 MLOCK(ErrorMessageLock);
3784 MesPrint(
"Attempt to use a factor of an unfactored $-variable");
3785 MUNLOCK(ErrorMessageLock);
3788 num = GetDolNum(BHEAD t+t[1],tstop);
3789 if ( num == 0 )
return(d->nfactors);
3790 if ( num > d->nfactors ) {
3791 MLOCK(ErrorMessageLock);
3792 MesPrint(
"Attempt to use an nonexisting factor %d of a $-variable",num);
3793 MUNLOCK(ErrorMessageLock);
3796 w = d->factors[num-1].where;
3797 if ( w == 0 )
return(d->factors[num-1].value);
3798 if ( w[0] == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1 && w[1] > 0
3799 && w[1] < MAXPOSITIVE )
return(w[1]);
3801 MLOCK(ErrorMessageLock);
3802 MesPrint(
"Illegal type of factor number of a $-variable");
3803 MUNLOCK(ErrorMessageLock);
3807 else if ( t[2] < 0 ) {
3814 int nummodopt, dtype;
3816 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3817 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3818 if ( t[2] == ModOptdollars[nummodopt].number )
break;
3820 if ( nummodopt < NumModOptdollars ) {
3821 dtype = ModOptdollars[nummodopt].type;
3822 if ( dtype == MODLOCAL ) {
3823 d = ModOptdollars[nummodopt].dstruct+AT.identity;
3826 MLOCK(ErrorMessageLock);
3827 MesPrint(
"&Illegal attempt to use $-variable %s in module %l",
3828 DOLLARNAME(Dollars,t[2]),AC.CModule);
3829 MUNLOCK(ErrorMessageLock);
3836 if ( d->type == DOLZERO )
return(0);
3837 if ( d->type == DOLTERMS || d->type == DOLNUMBER ) {
3838 if ( d->where[0] == 4 && d->where[4] == 0 && d->where[3] == 3
3839 && d->where[2] == 1 && d->where[1] > 0
3840 && d->where[1] < MAXPOSITIVE )
return(d->where[1]);
3841 MLOCK(ErrorMessageLock);
3842 MesPrint(
"Attempt to use an nonexisting factor of a $-variable");
3843 MUNLOCK(ErrorMessageLock);
3846 MLOCK(ErrorMessageLock);
3847 MesPrint(
"Illegal type of factor number of a $-variable");
3848 MUNLOCK(ErrorMessageLock);
3867 int i, n = NumPotModdollars;
3868 for ( i = 0; i < n; i++ ) {
3869 if ( numdollar == PotModdollars[i] )
break;
3872 *(WORD *)FromList(&AC.PotModDolList) = numdollar;
WORD * MakeDollarMod(PHEAD WORD *buffer, WORD **bufout)
WORD EvalDoLoopArg(PHEAD WORD *arg, WORD par)
int LocalConvertToPoly(PHEAD WORD *, WORD *, WORD, WORD)
int GetModInverses(WORD, WORD, WORD *, WORD *)
WORD StoreTerm(PHEAD WORD *)
void AddPotModdollar(WORD numdollar)
WORD * MakeDollarInteger(PHEAD WORD *bufin, WORD **bufout)
int PF_BroadcastPreDollar(WORD **dbuffer, LONG *newsize, int *numterms)
WORD Generator(PHEAD WORD *, WORD)
WORD * TakeContent(PHEAD WORD *, WORD *)
WORD CompCoef(WORD *, WORD *)
LONG EndSort(PHEAD WORD *, int)