81 static WORD tranarray[10] = { SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
83 int CoTransform(UBYTE *in)
86 UBYTE *s = in, c, *ss, *Tempbuf;
87 WORD number, type, num, i, *work = AT.WorkPointer+2, *wp, range[2], one = 1;
91 while ( *in ==
',' ) in++;
92 num = 0; wp = work + 1;
102 number = DoTempSet(s,in);
105 c = in[1]; in[1] = 0;
106 MesPrint(
"& %s: A set in a transform statement should be followed by a comma",s);
108 if ( error == 0 ) error = 1;
111 else if ( *in ==
'[' || FG.cTable[*in] == 0 ) {
114 if ( *in !=
',' )
break;
116 type = GetName(AC.varnames,s,&number,NOAUTO);
117 if ( type == CFUNCTION ) { number += MAXVARIABLES + FUNCTION; }
118 else if ( type != CSET ) {
119 MesPrint(
"& %s: A transform statement starts with sets of functions",s);
120 if ( error == 0 ) error = 1;
125 MesPrint(
"&Illegal syntax in Transform statement",s);
126 if ( error == 0 ) error = 1;
130 if ( number < MAXVARIABLES ) {
134 if ( Sets[number].type != CFUNCTION ) {
135 MesPrint(
"&A set in a transform statement should be a set of functions");
136 if ( error == 0 ) error = 1;
140 else if ( error == 0 ) error = 1;
146 while ( *in ==
',' ) in++;
157 if ( FG.cTable[*in] != 0 ) {
158 MesPrint(
"&Illegal character in Transform statement");
159 if ( error == 0 ) error = 1;
163 if ( *in ==
'>' || *in ==
'<' ) in++;
167 MesPrint(
"&Illegal syntax in specifying a transformation inside a Transform statement");
168 if ( error == 0 ) error = 1;
174 if ( StrICmp(s,(UBYTE *)
"replace") == 0 ) {
187 if ( ( in = ReadRange(in,range,0) ) == 0 ) {
188 if ( error == 0 ) error = 1;
199 if ( error == 0 ) error = 1;
205 if ( error == 0 ) error = 1;
209 if ( *in !=
',' && *in !=
'\0' ) {
211 if ( error == 0 ) error = 1;
215 ss = Tempbuf = (UBYTE *)Malloc1(i+5,
"CoTransform/replace");
216 *ss++ =
'd'; *ss++ =
'u'; *ss++ =
'm'; *ss++ =
'_';
219 AC.ProtoType = tranarray;
220 tranarray[4] = AC.cbufnum;
221 irhs = CompileAlgebra(Tempbuf,RHSIDE,AC.ProtoType);
222 M_free(Tempbuf,
"CoTransform/replace");
224 if ( error == 0 ) error = 1;
237 *wp++ = SUBEXPSIZE+4;
238 for ( i = 0; i < SUBEXPSIZE; i++ ) *wp++ = tranarray[i];
243 work = wp; *wp++ = 0;
250 else if ( StrICmp(s,(UBYTE *)
"decode" ) == 0 ) {
254 else if ( StrICmp(s,(UBYTE *)
"encode" ) == 0 ) {
257 if ( ( in = ReadRange(in,range,2) ) == 0 ) {
258 if ( error == 0 ) error = 1;
262 s = in;
while ( FG.cTable[*in] == 0 ) in++;
267 if ( StrICmp(s,(UBYTE *)
"base") == 0 ) {
270 MesPrint(
"&Illegal base specification in encode/decode transformation");
271 if ( error == 0 ) error = 1;
279 if ( GetName(AC.dollarnames,ss,&numdol,NOAUTO) != CDOLLAR ) {
280 MesPrint(
"&%s is undefined",ss-1);
281 numdol = AddDollar(ss,DOLINDEX,&one,1);
289 while ( FG.cTable[*in] == 1 ) {
290 x = 10*x + *in++ -
'0';
291 if ( x > MAXPOSITIVE2 ) {
292 illsize: MesPrint(
"&Illegal value for base in encode/decode transformation");
293 if ( error == 0 ) error = 1;
297 if ( x <= 1 )
goto illsize;
299 if ( *in !=
',' && *in !=
'\0' ) {
300 MesPrint(
"&Illegal termination of transformation");
301 if ( error == 0 ) error = 1;
306 MesPrint(
"&Illegal option in encode/decode transformation");
307 if ( error == 0 ) error = 1;
323 work = wp; *wp++ = 0;
330 else if ( StrICmp(s,(UBYTE *)
"implode") == 0
331 || StrICmp(s,(UBYTE *)
"tosumnotation") == 0 ) {
337 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
338 if ( error == 0 ) error = 1;
346 work = wp; *wp++ = 0;
353 else if ( StrICmp(s,(UBYTE *)
"explode") == 0
354 || StrICmp(s,(UBYTE *)
"tointegralnotation") == 0 ) {
360 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
361 if ( error == 0 ) error = 1;
369 work = wp; *wp++ = 0;
376 else if ( StrICmp(s,(UBYTE *)
"permute") == 0 ) {
381 *wp++ = MAXPOSITIVE2;
390 while ( FG.cTable[*in] == 1 ) {
391 x = 10*x + *in++ -
'0';
392 if ( x > MAXPOSITIVE2 ) {
393 MesPrint(
"&value in permute transformation too large");
394 if ( error == 0 ) error = 1;
399 MesPrint(
"&value 0 in permute transformation not allowed");
400 if ( error == 0 ) error = 1;
404 }
while ( *in ==
',' );
406 MesPrint(
"&Illegal syntax in permute transformation");
407 if ( error == 0 ) error = 1;
411 if ( *in !=
',' && *in !=
'(' && *in !=
'\0' ) {
412 MesPrint(
"&Illegal ending in permute transformation");
413 if ( error == 0 ) error = 1;
417 if ( *wstart == 1 ) wstart--;
418 }
while ( *in ==
'(' );
420 work = wp; *wp++ = 0;
427 else if ( StrICmp(s,(UBYTE *)
"reverse") == 0 ) {
430 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
431 if ( error == 0 ) error = 1;
439 work = wp; *wp++ = 0;
446 else if ( StrICmp(s,(UBYTE *)
"cycle") == 0 ) {
449 if ( ( in = ReadRange(in,range,0) ) == 0 ) {
450 if ( error == 0 ) error = 1;
463 else if ( *in ==
'-' ) {
467 MesPrint(
"&Cycle in a Transform statement should be followed by =+/-number");
468 if ( error == 0 ) error = 1;
472 while ( FG.cTable[*in] == 1 ) {
473 x = 10*x + *in++ -
'0';
474 if ( x > MAXPOSITIVE2 ) {
475 MesPrint(
"&Number in cycle in a Transform statement too big");
476 if ( error == 0 ) error = 1;
482 work = wp; *wp++ = 0;
489 else if ( StrICmp(s,(UBYTE *)
"islyndon" ) == 0 ) {
493 else if ( StrICmp(s,(UBYTE *)
"islyndon<" ) == 0 ) {
497 else if ( StrICmp(s,(UBYTE *)
"islyndon+" ) == 0 ) {
501 else if ( StrICmp(s,(UBYTE *)
"islyndon>" ) == 0 ) {
505 else if ( StrICmp(s,(UBYTE *)
"islyndon-" ) == 0 ) {
509 else if ( StrICmp(s,(UBYTE *)
"tolyndon" ) == 0 ) {
513 else if ( StrICmp(s,(UBYTE *)
"tolyndon<" ) == 0 ) {
517 else if ( StrICmp(s,(UBYTE *)
"tolyndon+" ) == 0 ) {
521 else if ( StrICmp(s,(UBYTE *)
"tolyndon>" ) == 0 ) {
525 else if ( StrICmp(s,(UBYTE *)
"tolyndon-" ) == 0 ) {
533 MesPrint(
"&Unknown transformation inside a Transform statement: %s",s);
535 if ( error == 0 ) error = 1;
538 while ( *s ==
',') s++;
540 AT.WorkPointer[0] = TYPETRANSFORM;
541 AT.WorkPointer[1] = i = wp - AT.WorkPointer;
542 AddNtoL(i,AT.WorkPointer);
557 WORD RunTransform(
PHEAD WORD *term, WORD *params)
559 WORD *t, *tstop, *w, *m, *out, *in, *tt, retval;
560 WORD *fun, *args, *info, *infoend, *onetransform, *funs, *endfun;
561 WORD *thearg = 0, *iterm, *newterm, *nt, *oldwork = AT.WorkPointer;
563 out = tstop = term + *term;
564 tstop -= ABS(tstop[-1]);
567 while ( t < tstop ) {
568 endfun = onetransform = params + *params;
570 if ( *t < FUNCTION ) {}
571 else if ( funs == endfun ) {
573 while ( in < t ) *out++ = *in++;
574 tt = t + t[1]; fun = out;
575 while ( in < tt ) *out++ = *in++;
577 args = onetransform + 1;
578 info = args;
while ( *info <= MAXRANGEINDICATOR ) {
579 if ( *info == ALLARGS ) info++;
580 else if ( *info == NUMARG ) info += 2;
581 else if ( *info == ARGRANGE ) info += 3;
582 else if ( *info == MAKEARGS ) info += 3;
586 if ( RunReplace(BHEAD fun,args,info) )
goto abo;
590 if ( RunEncode(BHEAD fun,args,info) )
goto abo;
594 if ( RunDecode(BHEAD fun,args,info) )
goto abo;
598 if ( RunImplode(fun,args) )
goto abo;
602 if ( RunExplode(BHEAD fun,args) )
goto abo;
606 if ( RunPermute(BHEAD fun,args,info) )
goto abo;
610 if ( RunReverse(BHEAD fun,args) )
goto abo;
614 if ( RunCycle(BHEAD fun,args,info) )
goto abo;
618 if ( ( retval = RunIsLyndon(BHEAD fun,args,1) ) < -1 )
goto abo;
622 if ( ( retval = RunIsLyndon(BHEAD fun,args,-1) ) < -1 )
goto abo;
626 if ( ( retval = RunToLyndon(BHEAD fun,args,1) ) < -1 )
goto abo;
630 if ( ( retval = RunToLyndon(BHEAD fun,args,-1) ) < -1 )
goto abo;
633 if ( retval == -1 )
break;
637 AT.WorkPointer += 2*AM.MaxTer;
638 if ( AT.WorkPointer > AT.WorkTop ) {
639 MLOCK(ErrorMessageLock);
641 MUNLOCK(ErrorMessageLock);
644 iterm = AT.WorkPointer;
646 for ( i = 0; i < *info; i++ ) iterm[i] = info[i];
647 AT.WorkPointer = iterm + *iterm;
650 if (
Generator(BHEAD iterm,AR.Cnumlhs) ) {
652 AT.WorkPointer = oldwork;
655 newterm = AT.WorkPointer;
656 if (
EndSort(BHEAD newterm,0) < 0 ) {}
657 if ( ( *newterm && *(newterm+*newterm) != 0 ) || *newterm == 0 ) {
658 MLOCK(ErrorMessageLock);
659 MesPrint(
"&yes/no information in islyndon/tolyndon does not evaluate into a single term");
660 MUNLOCK(ErrorMessageLock);
664 i = *newterm; tt = iterm; nt = newterm;
666 AT.WorkPointer = iterm + *iterm;
668 infoend = info+info[1];
675 if ( info >= infoend ) {
677 MLOCK(ErrorMessageLock);
678 MesPrint(
"There should be a yes and a no argument in islyndon/tolyndon");
679 MUNLOCK(ErrorMessageLock);
683 if ( info >= infoend ) goto abortlyndon;
686 else if ( retval == 1 ) {
690 if ( info >= infoend )
goto abortlyndon;
693 if ( info >= infoend ) goto abortlyndon;
696 if ( info < infoend ) goto abortlyndon;
705 if ( *thearg == -SNUMBER && thearg[1] == 0 ) {
706 *term = 0;
return(0);
708 if ( *thearg == -SNUMBER && thearg[1] == 1 ) { }
711 *out++ = EXPONENT; out++; *out++ = 1; FILLFUN3(out);
712 COPY1ARG(out,thearg);
713 *out++ = -SNUMBER; *out++ = 1;
718 MLOCK(ErrorMessageLock);
719 MesPrint(
"Irregular code in execution of transform statement");
720 MUNLOCK(ErrorMessageLock);
723 onetransform += *onetransform;
724 }
while ( *onetransform );
727 while ( funs < endfun ) {
728 if ( *funs > MAXVARIABLES ) {
729 if ( *t == *funs-MAXVARIABLES )
goto hit;
732 w = SetElements + Sets[*funs].first;
733 m = SetElements + Sets[*funs].last;
735 if ( *w == *t )
goto hit;
744 tt = term + *term;
while ( in < tt ) *out++ = *in++;
752 MLOCK(ErrorMessageLock);
753 MesCall("RunTransform");
754 MUNLOCK(ErrorMessageLock);
770 WORD RunEncode(
PHEAD WORD *fun, WORD *args, WORD *info)
772 WORD base, *f, *funstop, *fun1, *t, size1, size2, size3, *arg;
773 int num, num1, num2, n, i, i1, i2;
774 UWORD *scrat1, *scrat2, *scrat3;
775 WORD *tt, *tstop, totarg, arg1, arg2;
776 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
777 if ( *args != ARGRANGE ) {
778 MLOCK(ErrorMessageLock);
779 MesPrint(
"Illegal range encountered in RunEncode");
780 MUNLOCK(ErrorMessageLock);
783 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
784 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
786 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
788 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
789 if ( arg1 > totarg || arg2 > totarg )
return(0);
791 if ( info[2] == BASECODE ) {
795 base = DolToNumber(BHEAD i1);
796 if ( AN.ErrorInDollar || base < 2 ) {
797 MLOCK(ErrorMessageLock);
798 MesPrint(
"$%s does not have a number value > 1 in base/encode/transform statement in module %l",
799 DOLLARNAME(Dollars,i1),AC.CModule);
800 MUNLOCK(ErrorMessageLock);
807 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; }
808 else { num1 = arg1; num2 = arg2; }
810 WantAddPointers(num);
814 n = 1; funstop = fun+fun[1]; f = fun+FUNHEAD;
816 if ( f >= funstop )
return(0);
821 while ( n <= num2 ) {
822 if ( f >= funstop )
return(0);
823 if ( *f != -SNUMBER ) {
824 if ( *f < 0 )
return(0);
827 if ( (*f-i1) != (ARGHEAD+1) )
return(0);
831 if ( *t != 0 )
return(0);
835 AT.pWorkSpace[AT.pWorkPointer+i] = f;
847 t = AT.pWorkSpace[AT.pWorkPointer+i1];
848 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
849 AT.pWorkSpace[AT.pWorkPointer+i2] = t;
861 scrat1 = NumberMalloc(
"RunEncode");
862 scrat2 = NumberMalloc(
"RunEncode");
863 scrat3 = NumberMalloc(
"RunEncode");
864 arg = AT.pWorkSpace[AT.pWorkPointer];
865 size1 = PutArgInScratch(arg,scrat1);
868 if ( MulLong(scrat1,size1,(UWORD *)(&base),1,scrat2,&size2) ) {
869 NumberFree(scrat3,
"RunEncode");
870 NumberFree(scrat2,
"RunEncode");
871 NumberFree(scrat1,
"RunEncode");
875 size3 = PutArgInScratch(arg,scrat3);
876 if ( AddLong(scrat2,size2,scrat3,size3,scrat1,&size1) ) {
877 NumberFree(scrat3,
"RunEncode");
878 NumberFree(scrat2,
"RunEncode");
879 NumberFree(scrat1,
"RunEncode");
892 *fun1++ = -SNUMBER; *fun1++ = 0;
893 while ( f < funstop ) *fun1++ = *f++;
894 fun[1] = funstop-fun;
896 else if ( size1 == 1 && scrat1[0] <= MAXPOSITIVE ) {
897 *fun1++ = -SNUMBER; *fun1++ = scrat1[0];
898 while ( f < funstop ) *fun1++ = *f++;
901 else if ( size1 == -1 && scrat1[0] <= MAXPOSITIVE+1 ) {
903 if ( scrat1[0] < MAXPOSITIVE ) *fun1++ = scrat1[0];
904 else *fun1++ = (WORD)(MAXPOSITIVE+1);
905 while ( f < funstop ) *fun1++ = *f++;
908 else if ( ABS(size1)*2+2+ARGHEAD <= f-fun1 ) {
909 if ( size1 < 0 ) { size2 = size1*2-1; size1 = -size1; size3 = -size2; }
910 else { size2 = 2*size1+1; size3 = size2; }
911 *fun1++ = size3+ARGHEAD+1;
912 *fun1++ = 0; FILLARG(fun1);
914 for ( i = 0; i < size1; i++ ) *fun1++ = scrat1[i];
916 for ( i = 1; i < size1; i++ ) *fun1++ = 0;
918 while ( f < funstop ) *fun1++ = *f++;
923 if ( size1 < 0 ) { size2 = size1*2-1; size1 = -size1; size3 = -size2; }
924 else { size2 = 2*size1+1; size3 = size2; }
925 *t++ = size3+ARGHEAD+1;
926 *t++ = 0; FILLARG(t);
928 for ( i = 0; i < size1; i++ ) *t++ = scrat1[i];
930 for ( i = 1; i < size1; i++ ) *t++ = 0;
932 while ( f < funstop ) *t++ = *f++;
934 while ( f < t ) *fun1++ = *f++;
937 NumberFree(scrat3,
"RunEncode");
938 NumberFree(scrat2,
"RunEncode");
939 NumberFree(scrat1,
"RunEncode");
942 MLOCK(ErrorMessageLock);
943 MesPrint(
"Unimplemented type of encoding encountered in RunEncode");
944 MUNLOCK(ErrorMessageLock);
949 MLOCK(ErrorMessageLock);
950 MesCall(
"RunEncode");
951 MUNLOCK(ErrorMessageLock);
960 WORD RunDecode(
PHEAD WORD *fun, WORD *args, WORD *info)
962 WORD base, num, num1, num2, n, *f, *funstop, *fun1, size1, size2, size3, *t;
964 UWORD *scrat1, *scrat2, *scrat3;
965 WORD *tt, *tstop, totarg, arg1, arg2;
966 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
967 if ( *args != ARGRANGE ) {
968 MLOCK(ErrorMessageLock);
969 MesPrint(
"Illegal range encountered in RunDecode");
970 MUNLOCK(ErrorMessageLock);
973 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
974 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
976 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
978 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
979 if ( arg1 > totarg && arg2 > totarg )
return(0);
980 if ( info[2] == BASECODE ) {
984 base = DolToNumber(BHEAD i1);
985 if ( AN.ErrorInDollar || base < 2 ) {
986 MLOCK(ErrorMessageLock);
987 MesPrint(
"$%s does not have a number value > 1 in base/decode/transform statement in module %l",
988 DOLLARNAME(Dollars,i1),AC.CModule);
989 MUNLOCK(ErrorMessageLock);
996 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; }
997 else { num1 = arg1; num2 = arg2; }
999 if ( num <= 1 )
return(0);
1003 funstop = fun + fun[1];
1004 f = fun + FUNHEAD; n = 1;
1005 while ( f < funstop ) {
1006 if ( n == num1 )
break;
1009 if ( f >= funstop )
return(0);
1013 if ( *f == -SNUMBER ) {}
1014 else if ( *f < 0 )
return(0);
1018 if ( (*f-i1) != (ARGHEAD+1) )
return(0);
1022 if ( *t != 0 )
return(0);
1031 scrat1 = NumberMalloc(
"RunEncode");
1032 scrat2 = NumberMalloc(
"RunEncode");
1033 scrat3 = NumberMalloc(
"RunEncode");
1034 size1 = PutArgInScratch(fun1,scrat1);
1035 if ( size1 < 0 ) { sig = -1; size1 = -size1; }
1040 scrat2[0] = base; size2 = 1;
1041 if ( RaisPow(BHEAD scrat2,&size2,num) ) {
1042 NumberFree(scrat3,
"RunEncode");
1043 NumberFree(scrat2,
"RunEncode");
1044 NumberFree(scrat1,
"RunEncode");
1047 if ( BigLong(scrat1,size1,scrat2,size2) >= 0 ) {
1048 NumberFree(scrat3,
"RunEncode");
1049 NumberFree(scrat2,
"RunEncode");
1050 NumberFree(scrat1,
"RunEncode");
1056 if ( *fun1 > num*2 ) {
1057 t = fun1 + 2*num; f = fun1 + *fun1;
1058 while ( f < funstop ) *t++ = *f++;
1061 else if ( *fun1 < num*2 ) {
1063 fun[1] += (num-1)*2;
1064 t = funstop + (num-1)*2;
1067 fun[1] += 2*num - *fun1;
1068 t = funstop +2*num - *fun1;
1071 while ( f > fun1 ) *--t = *--f;
1076 for ( i = num-1; i >= 0; i-- ) {
1077 DivLong(scrat1,size1,(UWORD *)(&base),1,scrat2,&size2,scrat3,&size3);
1078 fun1[2*i] = -SNUMBER;
1079 if ( size3 == 0 ) fun1[2*i+1] = 0;
1080 else fun1[2*i+1] = (WORD)(scrat3[0])*sig;
1081 for ( i1 = 0; i1 < size2; i1++ ) scrat1[i1] = scrat2[i1];
1085 MLOCK(ErrorMessageLock);
1086 MesPrint(
"RunDecode: number to be decoded is too big");
1087 MUNLOCK(ErrorMessageLock);
1088 NumberFree(scrat3,
"RunEncode");
1089 NumberFree(scrat2,
"RunEncode");
1090 NumberFree(scrat1,
"RunEncode");
1096 if ( arg1 > arg2 ) {
1097 i1 = 1; i2 = 2*num-1;
1099 i = fun1[i1]; fun1[i1] = fun1[i2]; fun1[i2] = i;
1103 NumberFree(scrat3,
"RunEncode");
1104 NumberFree(scrat2,
"RunEncode");
1105 NumberFree(scrat1,
"RunEncode");
1108 MLOCK(ErrorMessageLock);
1109 MesPrint(
"Unimplemented type of encoding encountered in RunDecode");
1110 MUNLOCK(ErrorMessageLock);
1115 MLOCK(ErrorMessageLock);
1116 MesCall(
"RunDecode");
1117 MUNLOCK(ErrorMessageLock);
1133 WORD RunReplace(
PHEAD WORD *fun, WORD *args, WORD *info)
1135 int n = 0, i, dirty = 0, totarg, nfix, nwild, ngeneral;
1136 WORD *t, *tt, *u, *tstop, *info1, *infoend, *oldwork = AT.WorkPointer;
1137 WORD *term, *newterm, *nt, *term1, *term2;
1138 WORD wild[4], mask, *term3, *term4;
1141 t = fun; tstop = fun + fun[1]; u = tstop;
1142 for ( i = 0; i < FUNHEAD; i++ ) *u++ = *t++;
1144 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1146 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1149 totarg = tstop - tt;
1158 AT.WorkPointer += 2*AM.MaxTer;
1159 if ( AT.WorkPointer > AT.WorkTop ) {
1160 MLOCK(ErrorMessageLock);
1162 MUNLOCK(ErrorMessageLock);
1165 term = AT.WorkPointer;
1166 for ( i = 0; i < *info; i++ ) term[i] = info[i];
1167 AT.WorkPointer = term + *term;
1170 if (
Generator(BHEAD term,AR.Cnumlhs) ) {
1172 AT.WorkPointer = oldwork;
1175 newterm = AT.WorkPointer;
1176 if (
EndSort(BHEAD newterm,0) < 0 ) {}
1177 if ( ( *newterm && *(newterm+*newterm) != 0 ) || *newterm == 0 ) {
1178 MLOCK(ErrorMessageLock);
1179 MesPrint(
"&information in replace transformation does not evaluate into a single term");
1180 MUNLOCK(ErrorMessageLock);
1184 i = *newterm; tt = term; nt = newterm;
1186 AT.WorkPointer = term + *term;
1189 term1 = term + *term;
1191 *term2++ = REPLACEMENT;
1192 term2++; FILLFUN(term2)
1196 infoend = info + info[1];
1197 info1 = info + FUNHEAD;
1198 nfix = nwild = ngeneral = 0;
1199 while ( info1 < infoend ) {
1200 if ( *info1 == -SNUMBER ) {
1202 info1 += 2; NEXTARG(info1)
1204 else if ( *info1 <= -FUNCTION ) {
1205 if ( *info1 == -WILDARGFUN ) {
1207 info1++; NEXTARG(info1)
1210 *term2++ = *info1++; COPY1ARG(term2,info1)
1214 else if ( *info1 == -INDEX ) {
1215 if ( info1[1] == WILDARGINDEX + AM.OffsetIndex ) {
1217 info1 += 2; NEXTARG(info1)
1220 *term2++ = *info1++; *term2++ = *info1++; COPY1ARG(term2,info1)
1224 else if ( *info1 == -SYMBOL ) {
1225 if ( info1[1] == WILDARGSYMBOL ) {
1227 info1 += 2; NEXTARG(info1)
1230 *term2++ = *info1++; *term2++ = *info1++; COPY1ARG(term2,info1)
1234 else if ( *info1 == -MINVECTOR || *info1 == -VECTOR ) {
1235 if ( info1[1] == WILDARGVECTOR + AM.OffsetVector ) {
1237 info1 += 2; NEXTARG(info1)
1240 *term2++ = *info1++; *term2++ = *info1++; COPY1ARG(term2,info1)
1245 MLOCK(ErrorMessageLock);
1246 MesPrint(
"&irregular code found in replace transformation (RunReplace)");
1247 MUNLOCK(ErrorMessageLock);
1251 AT.WorkPointer = term2;
1252 *term1 = term2 - term1;
1253 term1[2] = *term1 - 1;
1257 while ( t < tstop ) {
1259 if ( TestArgNum(n,totarg,args) == 0 ) {
1260 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1261 if ( *t <= -FUNCTION ) { *u++ = *t++; }
1262 else if ( *t < 0 ) { *u++ = *t++; *u++ = *t++; }
1263 else { i = *t; NCOPY(u,t,i) }
1278 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1279 if ( *t == -SNUMBER ) {
1280 info1 = info + FUNHEAD;
1281 while ( info1 < infoend ) {
1282 if ( *info1 == -SNUMBER ) {
1283 if ( info1[1] == t[1] ) {
1284 if ( info1[2] == -SNUMBER ) {
1285 *u++ = -SNUMBER; *u++ = info1[3];
1290 if ( info1[0] <= -FUNCTION ) i = 1;
1291 else if ( info1[0] < 0 ) i = 2;
1308 if ( *t < AM.OffsetIndex && *t >= 0 ) {
1309 info1 = info + FUNHEAD;
1310 while ( info1 < infoend ) {
1311 if ( ( *info1 == -SNUMBER ) && ( info1[1] == *t )
1312 && ( ( ( info1[2] == -SNUMBER ) && ( info1[3] >= 0 )
1313 && ( info1[3] < AM.OffsetIndex ) )
1314 || ( info1[2] == -INDEX || info1[2] == -VECTOR
1315 || info1[2] == -MINVECTOR ) ) ) {
1334 if ( ngeneral > 0 ) {
1335 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1337 term3 = term1 + *term1;
1338 term4 = term1 + FUNHEAD;
1339 while ( term4 < term3 ) {
1340 if ( *term4 == *t && ( *t <= -FUNCTION ||
1341 ( t[1] == term4[1] ) ) )
break;
1344 if ( term4 < term3 )
goto dothisnow;
1348 term3 = term1 + *term1;
1349 term4 = term1 + FUNHEAD;
1350 while ( term4 < term3 ) {
1351 if ( ( term4[1] == *t ) &&
1352 ( ( *term4 == -INDEX || *term4 == -VECTOR ||
1353 ( *term4 == -SYMBOL && term4[1] < AM.OffsetIndex
1354 && term4[1] >= 0 ) ) ) )
break;
1357 if ( term4 < term3 )
goto dothisnow;
1374 info1 = info + FUNHEAD;
1375 while ( info1 < infoend ) {
1376 if ( *info1 == -SYMBOL && info1[1] == WILDARGSYMBOL
1377 && ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) ) {
1379 wild[2] = WILDARGSYMBOL;
1381 AN.WildValue = wild;
1382 AT.WildMask = &mask;
1385 if ( *t == -SYMBOL || ( *t > 0 && CheckWild(BHEAD WILDARGSYMBOL,SYMTOSUB,1,t) == 0 ) ) {
1390 n1 = SYMBOL; n2 = WILDARGSYMBOL;
1394 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1395 *term3++ = DUMFUN; term3++; FILLFUN(term3)
1396 COPY1ARG(term3,info1)
1399 *term3++ = fun[0]; term3++; FILLFUN(term3)
1402 term2[2] = term3 - term2 - 1;
1404 *term3++ = REPLACEMENT;
1405 term3++; FILLFUN(term3)
1407 if ( n1 < FUNCTION ) *term3++ = n2;
1408 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1410 COPY1ARG(term3,term4)
1416 *term3++ = 1; *term3++ = 1; *term3++ = 3;
1417 *term2 = term3 - term2;
1419 AT.WorkPointer = term3;
1421 if (
Generator(BHEAD term2,AR.Cnumlhs) ) {
1423 AT.WorkPointer = oldwork;
1426 term4 = AT.WorkPointer;
1427 if (
EndSort(BHEAD term4,0) < 0 ) {}
1428 if ( ( *term4 && *(term4+*term4) != 0 ) || *term4 == 0 ) {
1429 MLOCK(ErrorMessageLock);
1430 MesPrint(
"&information in replace transformation does not evaluate into a single term");
1431 MUNLOCK(ErrorMessageLock);
1437 i = term4[2]-FUNHEAD;
1438 term3 = term4+FUNHEAD+1;
1440 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1444 AT.WorkPointer = term2;
1448 info1 += 2; NEXTARG(info1)
1450 else if ( ( *info1 == -INDEX )
1451 && ( info[1] == WILDARGINDEX + AM.OffsetIndex ) ) {
1453 wild[2] = WILDARGINDEX+AM.OffsetIndex;
1455 AN.WildValue = wild;
1456 AT.WildMask = &mask;
1459 if ( ( functions[fun[0]-FUNCTION].spec == TENSORFUNCTION )
1460 || ( *t == -INDEX || ( *t > 0 && CheckWild(BHEAD WILDARGINDEX,INDTOSUB,1,t) == 0 ) ) ) {
1465 n1 = INDEX; n2 = WILDARGINDEX+AM.OffsetIndex;
1469 info1 += 2; NEXTARG(info1)
1471 else if ( ( *info1 == -VECTOR )
1472 && ( info1[1] == WILDARGVECTOR + AM.OffsetVector ) ) {
1474 wild[2] = WILDARGVECTOR+AM.OffsetVector;
1476 AN.WildValue = wild;
1477 AT.WildMask = &mask;
1480 if ( functions[fun[0]-FUNCTION].spec == TENSORFUNCTION ) {
1481 if ( *t < MINSPEC ) {
1482 n1 = VECTOR; n2 = WILDARGVECTOR+AM.OffsetVector;
1487 else if ( *t == -VECTOR || *t == -MINVECTOR ||
1488 ( *t > 0 && CheckWild(BHEAD WILDARGVECTOR,VECTOSUB,1,t) == 0 ) ) {
1493 n1 = VECTOR; n2 = WILDARGVECTOR+AM.OffsetVector;
1497 info1 += 2; NEXTARG(info1)
1499 else if ( *info1 == -WILDARGFUN ) {
1501 wild[2] = WILDARGFUN;
1503 AN.WildValue = wild;
1504 AT.WildMask = &mask;
1507 if ( *t <= -FUNCTION || ( *t > 0 && CheckWild(BHEAD WILDARGFUN,FUNTOFUN,1,t) == 0 ) ) {
1512 n2 = n1 = -WILDARGFUN;
1516 info1++; NEXTARG(info1)
1519 NEXTARG(info1) NEXTARG(info1)
1523 if ( ngeneral > 0 ) {
1531 term3 = term2; term4 = term1; i = *term1;
1532 NCOPY(term3,term4,i)
1534 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1535 *term3++ = DUMFUN; term3++; FILLFUN(term3);
1540 *term3++ = fun[0]; term3++; FILLFUN(term3); *term3++ = *t;
1542 term4[1] = term3-term4;
1543 *term3++ = 1; *term3++ = 1; *term3++ = 3;
1544 *term2 = term3-term2;
1545 AT.WorkPointer = term3;
1547 if (
Generator(BHEAD term2,AR.Cnumlhs) ) {
1549 AT.WorkPointer = oldwork;
1552 term4 = AT.WorkPointer;
1553 if (
EndSort(BHEAD term4,0) < 0 ) {}
1554 if ( ( *term4 && *(term4+*term4) != 0 ) || *term4 == 0 ) {
1555 MLOCK(ErrorMessageLock);
1556 MesPrint(
"&information in replace transformation does not evaluate into a single term");
1557 MUNLOCK(ErrorMessageLock);
1563 i = term4[2]-FUNHEAD;
1564 term3 = term4+FUNHEAD+1;
1567 AT.WorkPointer = term2;
1575 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1576 if ( *t <= -FUNCTION ) { *u++ = *t++; }
1577 else if ( *t < 0 ) { *u++ = *t++; *u++ = *t++; }
1578 else { i = *t; NCOPY(u,t,i) }
1585 i = u - tstop; tstop[1] = i; tstop[2] = dirty;
1586 t = fun; u = tstop; NCOPY(t,u,i)
1587 AT.WorkPointer = oldwork;
1598 WORD RunImplode(WORD *fun, WORD *args)
1600 WORD *tt, *tstop, totarg, arg1, arg2, num1, num2, i, i1, n;
1601 WORD *f, *t, *ttt, *t4, *ff, *fff;
1602 WORD moveup, numzero, outspace;
1603 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
1604 if ( *args != ARGRANGE ) {
1605 MLOCK(ErrorMessageLock);
1606 MesPrint(
"Illegal range encountered in RunImplode");
1607 MUNLOCK(ErrorMessageLock);
1610 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
1611 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1613 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
1615 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
1619 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; }
1620 else { num1 = arg1; num2 = arg2; }
1621 if ( num1 > totarg || num2 > totarg )
return(0);
1627 n = 1; f = fun+FUNHEAD;
1628 while ( n < num1 ) {
1629 if ( f >= tstop )
return(0);
1645 while ( n <= num2 ) {
1646 if ( f >= tstop )
return(0);
1647 if ( *f == -SNUMBER ) { *tt++ = -1; *tt++ = 0;
1648 if ( f[1] < 0 ) { *tt++ = -f[1]; *tt++ = -1; }
1649 else { *tt++ = f[1]; *tt++ = 1; }
1652 else if ( *f == -SYMBOL ) { *tt++ = f[1]; *tt++ = 1; *tt++ = 1; *tt++ = 1; f += 2; }
1653 else if ( *f < 0 )
return(0);
1655 if ( *f != ( f[ARGHEAD]+ARGHEAD ) )
return(0);
1658 if ( ( i1 > 3 ) || ( t[-1] != 1 ) )
return(0);
1659 if ( (UWORD)(t[-2]) > MAXPOSITIVE2 )
return(0);
1660 if ( f[ARGHEAD] == i1+1 ) {
1661 *tt++ = -1; *tt++ = 0; *tt++ = t[-2];
1662 if ( *t < 0 ) { *tt++ = -1; }
1665 else if ( ( f[ARGHEAD+1] != SYMBOL )
1666 || ( f[ARGHEAD+2] != 4 )
1667 || ( ( f+ARGHEAD+1+f[ARGHEAD+2] ) < ( t-i1 ) ) )
return(0);
1670 *tt++ = f[ARGHEAD+3];
1671 *tt++ = f[ARGHEAD+4];
1673 if ( *t < 0 ) { *tt++ = -1; }
1686 if ( arg1 > arg2 ) {
1690 t = tt - 4; numzero = 0;
1691 while ( t >= tstop ) {
1692 if ( t[2] == 0 ) numzero++;
1694 if ( numzero > 0 ) {
1697 ttt = t4 + 4*numzero;
1698 while ( ttt < tt ) *t4++ = *ttt++;
1708 numzero = 0; ttt = t;
1710 if ( t[2] == 0 ) numzero++;
1712 if ( numzero > 0 ) {
1715 while ( t4 < tt ) *ttt++ = *t4++;
1735 t = tstop; outspace = 0;
1738 if ( t[2] > MAXPOSITIVE2 ) {
return(0); }
1741 else if ( t[1] == 1 && t[2] == 1 && t[3] == 1 ) { outspace += 2; }
1742 else { outspace += 8 + ARGHEAD; }
1745 if ( outspace < (fff-ff) ) {
1748 if ( t[0] == -1 ) { *ff++ = -SNUMBER; *ff++ = t[2]*t[3]; }
1749 else if ( t[1] == 1 && t[2] == 1 && t[3] == 1 ) {
1750 *ff++ = -SYMBOL; *ff++ = t[0];
1753 *ff++ = 8+ARGHEAD; *ff++ = 0; FILLARG(ff);
1754 *ff++ = 8; *ff++ = SYMBOL; *ff++ = 4; *ff++ = t[0]; *ff++ = t[1];
1755 *ff++ = t[2]; *ff++ = 1; *ff++ = t[3] > 0 ? 3: -3;
1759 while ( fff < tstop ) *ff++ = *fff++;
1762 else if ( outspace > (fff-ff) ) {
1768 moveup = outspace-(fff-ff);
1771 while ( t > fff ) *--ttt = *--t;
1772 tt += moveup; tstop += moveup;
1781 if ( t[0] == -1 ) { *ff++ = -SNUMBER; *ff++ = t[2]*t[3]; }
1782 else if ( t[1] == 1 && t[2] == 1 && t[3] == 1 ) {
1783 *ff++ = -SYMBOL; *ff++ = t[0];
1786 *ff++ = 8+ARGHEAD; *ff++ = 0; FILLARG(ff);
1787 *ff++ = 8; *ff++ = SYMBOL; *ff++ = 4; *ff++ = t[0]; *ff++ = t[1];
1788 *ff++ = t[2]; *ff++ = 1; *ff++ = t[3] > 0 ? 3: -3;
1801 WORD RunExplode(
PHEAD WORD *fun, WORD *args)
1803 WORD arg1, arg2, num1, num2, *tt, *tstop, totarg, *tonew, *newfun;
1805 int reverse = 0, iarg, i, numzero;
1806 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
1807 if ( *args != ARGRANGE ) {
1808 MLOCK(ErrorMessageLock);
1809 MesPrint(
"Illegal range encountered in RunExplode");
1810 MUNLOCK(ErrorMessageLock);
1813 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
1814 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1816 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
1818 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
1822 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; reverse = 1; }
1823 else { num1 = arg1; num2 = arg2; }
1824 if ( num1 > totarg || num2 > totarg )
return(0);
1825 if ( tstop + AM.MaxTer > AT.WorkTop )
goto OverWork;
1830 tonew = newfun = tstop;
1831 ff = fun + FUNHEAD; iarg = 0;
1832 while ( ff < tstop ) {
1834 if ( iarg == num1 ) {
1835 i = ff - fun; f = fun;
1844 while ( iarg <= num2 ) {
1845 if ( *ff == -SYMBOL ) { *tonew++ = *ff++; *tonew++ = *ff++; }
1846 else if ( *ff == -SNUMBER ) {
1847 numzero = ABS(ff[1])-1;
1849 *tonew++ = -SNUMBER; *tonew++ = ff[1] < 0 ? -1: 1;
1850 while ( numzero > 0 ) {
1851 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
1855 while ( numzero > 0 ) {
1856 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
1858 *tonew++ = -SNUMBER; *tonew++ = ff[1] < 0 ? -1: 1;
1862 else if ( *ff < 0 ) {
return(0); }
1864 if ( *ff != ARGHEAD+8 || ff[ARGHEAD] != 8
1865 || ff[ARGHEAD+1] != SYMBOL || ABS(ff[ARGHEAD+7]) != 3
1866 || ff[ARGHEAD+6] != 1 )
return(0);
1867 numzero = ff[ARGHEAD+5];
1868 if ( numzero >= MAXPOSITIVE2 )
return(0);
1871 if ( ff[ARGHEAD+7] > 0 ) { *tonew++ = -SNUMBER; *tonew++ = 1; }
1873 *tonew++ = ARGHEAD+8; *tonew++ = 0; FILLARG(tonew)
1874 *tonew++ = 8; *tonew++ = SYMBOL; *tonew++ = ff[ARGHEAD+3];
1875 *tonew++ = ff[ARGHEAD+4]; *tonew++ = 1; *tonew++ = 1;
1878 while ( numzero > 0 ) {
1879 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
1883 while ( numzero > 0 ) {
1884 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
1886 if ( ff[ARGHEAD+7] > 0 ) { *tonew++ = -SNUMBER; *tonew++ = 1; }
1888 *tonew++ = ARGHEAD+8; *tonew++ = 0; FILLARG(tonew)
1889 *tonew++ = 8; *tonew++ = SYMBOL; *tonew++ = ff[ARGHEAD+3];
1890 *tonew++ = ff[ARGHEAD+4]; *tonew++ = 1; *tonew++ = 1;
1896 if ( tonew > AT.WorkTop )
goto OverWork;
1902 while ( ff < tstop ) *tonew++ = *ff++;
1903 i = newfun[1] = tonew-newfun;
1907 MLOCK(ErrorMessageLock);
1909 MUNLOCK(ErrorMessageLock);
1918 WORD RunPermute(
PHEAD WORD *fun, WORD *args, WORD *info)
1920 WORD *tt, totarg, *tstop, arg1, arg2, n, num, i, *f, *f1, *f2, *infostop;
1921 if ( *args != ARGRANGE ) {
1922 MLOCK(ErrorMessageLock);
1923 MesPrint(
"Illegal range encountered in RunPermute");
1924 MUNLOCK(ErrorMessageLock);
1927 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1928 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
1929 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1930 arg1 = 1; arg2 = totarg;
1939 WantAddPointers(num);
1940 f = fun+FUNHEAD; n = 1; i = 0;
1941 while ( n < arg1 ) { n++; NEXTARG(f) }
1943 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
1949 infostop = info + *info;
1951 if ( *info > totarg )
return(0);
1952 tt = AT.pWorkSpace[AT.pWorkPointer+*info];
1954 while ( info < infostop ) {
1955 if ( *info > totarg )
return(0);
1956 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = AT.pWorkSpace[AT.pWorkPointer+*info];
1959 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = tt;
1964 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
1966 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
1971 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop-tt;
1972 arg1 = 1; arg2 = totarg;
1974 WantAddPointers(num);
1975 f = fun+FUNHEAD; n = 1; i = 0;
1976 while ( n < arg1 ) { n++; f++; }
1978 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; f++; }
1984 infostop = info + *info;
1986 if ( *info > totarg )
return(0);
1987 tt = AT.pWorkSpace[AT.pWorkPointer+*info];
1989 while ( info < infostop ) {
1990 if ( *info > totarg )
return(0);
1991 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = AT.pWorkSpace[AT.pWorkPointer+*info];
1994 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = tt;
1999 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2001 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; *f2++= *f++; }
2007 MLOCK(ErrorMessageLock);
2009 MUNLOCK(ErrorMessageLock);
2018 WORD RunReverse(
PHEAD WORD *fun, WORD *args)
2020 WORD *tt, totarg, *tstop, arg1, arg2, n, num, i, *f, *f1, *f2, i1, i2;
2021 if ( *args != ARGRANGE ) {
2022 MLOCK(ErrorMessageLock);
2023 MesPrint(
"Illegal range encountered in RunReverse");
2024 MUNLOCK(ErrorMessageLock);
2027 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
2028 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2029 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2031 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
2033 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
2041 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2042 if ( arg2 > totarg )
return(0);
2045 WantAddPointers(num);
2046 f = fun+FUNHEAD; n = 1; i = 0;
2047 while ( n < arg1 ) { n++; NEXTARG(f) }
2049 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2052 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2053 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2054 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2057 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2059 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
2064 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop - tt;
2066 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
2068 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
2076 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2077 if ( arg2 > totarg )
return(0);
2080 WantAddPointers(num);
2081 f = fun+FUNHEAD; n = 1; i = 0;
2082 while ( n < arg1 ) { n++; f++; }
2084 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; f++; }
2087 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2088 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2089 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2092 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2094 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; *f2++ = *f++; }
2100 MLOCK(ErrorMessageLock);
2102 MUNLOCK(ErrorMessageLock);
2111 WORD RunCycle(
PHEAD WORD *fun, WORD *args, WORD *info)
2113 WORD *tt, totarg, *tstop, arg1, arg2, n, num, i, j, *f, *f1, *f2, x;
2114 if ( *args != ARGRANGE ) {
2115 MLOCK(ErrorMessageLock);
2116 MesPrint(
"Illegal range encountered in RunCycle");
2117 MUNLOCK(ErrorMessageLock);
2120 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
2121 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2122 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2123 arg1 = args[1]; arg2 = args[2];
2124 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
2125 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
2126 if ( arg1 > arg2 ) { n = arg1; arg1 = arg2; arg2 = n; }
2127 if ( arg2 > totarg )
return(0);
2136 WantAddPointers(num);
2137 f = fun+FUNHEAD; n = 1; i = 0;
2138 while ( n < arg1 ) { n++; NEXTARG(f) }
2140 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2148 if ( x > i/2 ) x -= i;
2150 else if ( x <= -i ) {
2152 if ( x <= -i/2 ) x += i;
2156 tt = AT.pWorkSpace[AT.pWorkPointer+i-1];
2157 for ( j = i-1; j > 0; j-- )
2158 AT.pWorkSpace[AT.pWorkPointer+j] = AT.pWorkSpace[AT.pWorkPointer+j-1];
2159 AT.pWorkSpace[AT.pWorkPointer] = tt;
2163 tt = AT.pWorkSpace[AT.pWorkPointer];
2164 for ( j = 1; j < i; j++ )
2165 AT.pWorkSpace[AT.pWorkPointer+j-1] = AT.pWorkSpace[AT.pWorkPointer+j];
2166 AT.pWorkSpace[AT.pWorkPointer+j-1] = tt;
2173 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2175 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
2180 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop - tt;
2181 arg1 = args[1]; arg2 = args[2];
2182 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
2183 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
2184 if ( arg1 > arg2 ) { n = arg1; arg1 = arg2; arg2 = n; }
2185 if ( arg2 > totarg )
return(0);
2194 WantAddPointers(num);
2195 f = fun+FUNHEAD; n = 1; i = 0;
2196 while ( n < arg1 ) { n++; f++; }
2198 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; f++; }
2206 if ( x > i/2 ) x -= i;
2208 else if ( x <= -i ) {
2210 if ( x <= -i/2 ) x += i;
2214 tt = AT.pWorkSpace[AT.pWorkPointer+i-1];
2215 for ( j = i-1; j > 0; j-- )
2216 AT.pWorkSpace[AT.pWorkPointer+j] = AT.pWorkSpace[AT.pWorkPointer+j-1];
2217 AT.pWorkSpace[AT.pWorkPointer] = tt;
2221 tt = AT.pWorkSpace[AT.pWorkPointer];
2222 for ( j = 1; j < i; j++ )
2223 AT.pWorkSpace[AT.pWorkPointer+j-1] = AT.pWorkSpace[AT.pWorkPointer+j];
2224 AT.pWorkSpace[AT.pWorkPointer+j-1] = tt;
2231 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2233 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; *f2++ = *f++; }
2239 MLOCK(ErrorMessageLock);
2241 MUNLOCK(ErrorMessageLock);
2254 WORD RunIsLyndon(
PHEAD WORD *fun, WORD *args,
int par)
2256 WORD *tt, totarg, *tstop, arg1, arg2, arg, num, *f, n, i;
2258 WORD sign, i1, i2, retval;
2259 if ( fun[0] <= GAMMASEVEN && fun[0] >= GAMMA )
return(0);
2260 if ( *args != ARGRANGE ) {
2261 MLOCK(ErrorMessageLock);
2262 MesPrint(
"Illegal range encountered in RunIsLyndon");
2263 MUNLOCK(ErrorMessageLock);
2266 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2267 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2269 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
2271 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
2272 if ( arg1 > totarg || arg2 > totarg )
return(-1);
2276 if ( arg1 == arg2 )
return(1);
2277 if ( arg2 < arg1 ) {
2278 arg = arg1; arg1 = arg2; arg2 = arg; sign = 1;
2283 WantAddPointers(num);
2284 f = fun+FUNHEAD; n = 1; i = 0;
2285 while ( n < arg1 ) { n++; NEXTARG(f) }
2287 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2294 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2295 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2296 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2304 for ( i1 = 1; i1 < num; i1++ ) {
2305 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+i1],
2306 AT.pWorkSpace[AT.pWorkPointer]);
2307 if ( retval > 0 )
continue;
2308 if ( retval < 0 )
return(0);
2309 for ( i2 = 1; i2 < num; i2++ ) {
2310 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+(i1+i2)%num],
2311 AT.pWorkSpace[AT.pWorkPointer+i2]);
2312 if ( retval < 0 )
return(0);
2313 if ( retval > 0 )
goto nexti1;
2335 WORD RunToLyndon(
PHEAD WORD *fun, WORD *args,
int par)
2337 WORD *tt, totarg, *tstop, arg1, arg2, arg, num, *f, *f1, *f2, n, i;
2338 WORD sign, i1, i2, retval, unique;
2339 if ( fun[0] <= GAMMASEVEN && fun[0] >= GAMMA )
return(0);
2340 if ( *args != ARGRANGE ) {
2341 MLOCK(ErrorMessageLock);
2342 MesPrint(
"Illegal range encountered in RunToLyndon");
2343 MUNLOCK(ErrorMessageLock);
2346 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2347 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2349 if ( arg1 >= MAXPOSITIVE2 ) { arg1 = totarg-(arg1-MAXPOSITIVE2); }
2351 if ( arg2 >= MAXPOSITIVE2 ) { arg2 = totarg-(arg2-MAXPOSITIVE2); }
2352 if ( arg1 > totarg || arg2 > totarg )
return(-1);
2356 if ( arg1 == arg2 )
return(1);
2357 if ( arg2 < arg1 ) {
2358 arg = arg1; arg1 = arg2; arg2 = arg; sign = 1;
2363 WantAddPointers((2*num));
2364 f = fun+FUNHEAD; n = 1; i = 0;
2365 while ( n < arg1 ) { n++; NEXTARG(f) }
2367 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2374 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2375 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2376 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2385 for ( i1 = 1; i1 < num; i1++ ) {
2386 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+i1],
2387 AT.pWorkSpace[AT.pWorkPointer]);
2388 if ( retval > 0 )
continue;
2394 for ( i2 = 0; i2 < num; i2++ ) {
2395 AT.pWorkSpace[AT.pWorkPointer+num+i2] =
2396 AT.pWorkSpace[AT.pWorkPointer+(i1+i2)%num];
2398 for ( i2 = 0; i2 < num; i2++ ) {
2399 AT.pWorkSpace[AT.pWorkPointer+i2] =
2400 AT.pWorkSpace[AT.pWorkPointer+i2+num];
2405 for ( i2 = 1; i2 < num; i2++ ) {
2406 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+(i1+i2)%num],
2407 AT.pWorkSpace[AT.pWorkPointer+i2]);
2408 if ( retval < 0 )
goto Rotate;
2409 if ( retval > 0 )
goto nexti1;
2420 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2421 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2422 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2429 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2431 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
2439 MLOCK(ErrorMessageLock);
2441 MUNLOCK(ErrorMessageLock);
2458 int TestArgNum(
int n,
int totarg, WORD *args)
2466 if ( n == args[1] )
return(1);
2467 if ( args[1] >= MAXPOSITIVE2 ) {
2468 x1 = args[1]-MAXPOSITIVE2;
2469 if ( totarg-x1 == n )
return(1);
2474 if ( args[1] >= MAXPOSITIVE2 ) {
2475 x1 = totarg-(args[1]-MAXPOSITIVE2);
2478 if ( args[2] >= MAXPOSITIVE2 ) {
2479 x2 = totarg-(args[2]-MAXPOSITIVE2);
2483 if ( n >= x2 && n <= x1 )
return(1);
2486 if ( n >= x1 && n <= x2 )
return(1);
2504 WORD PutArgInScratch(WORD *arg,UWORD *scrat)
2507 if ( *arg == -SNUMBER ) {
2508 scrat[0] = ABS(arg[1]);
2509 if ( arg[1] < 0 ) size = -1;
2514 if ( *t < 0 ) { i = ((-*t)-1)/2; size = -i; }
2515 else { i = ( *t -1)/2; size = i; }
2540 UBYTE *ReadRange(UBYTE *s, WORD *out,
int par)
2542 UBYTE *in = s, *ss, c;
2546 if ( par == 0 && in[1] != '=' ) {
2547 MesPrint(
"&A range in this type of transform statement should be followed by a = sign");
2550 else if ( par == 1 && in[1] !=
',' && in[1] !=
'\0' ) {
2551 MesPrint(
"&A range in this type of transform statement should be followed by a comma or end-of-statement");
2554 else if ( par == 2 && in[1] !=
':' ) {
2555 MesPrint(
"&A range in this type of transform statement should be followed by a :");
2559 if ( FG.cTable[*s] == 0 ) {
2560 ss = s;
while ( FG.cTable[*s] == 0 ) s++;
2562 if ( StrICmp(ss,(UBYTE *)
"first") == 0 ) {
2566 else if ( StrICmp(ss,(UBYTE *)
"last") == 0 ) {
2570 while ( *s >=
'0' && *s <=
'9' ) {
2571 x1 = 10*x1 + *s++ -
'0';
2572 if ( x1 >= MAXPOSITIVE2 ) {
2573 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE2);
2579 else x1 = MAXPOSITIVE2;
2582 MesPrint(
"&Illegal keyword inside range specification");
2586 else if ( FG.cTable[*s] == 1 ) {
2588 while ( *s >=
'0' && *s <=
'9' ) {
2589 x1 = x1*10 + *s++ -
'0';
2590 if ( x1 >= MAXPOSITIVE2 ) {
2591 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE2);
2597 MesPrint(
"&Illegal character in range specification");
2601 MesPrint(
"&A range is two indicators, separated by a comma or blank");
2605 if ( FG.cTable[*s] == 0 ) {
2606 ss = s;
while ( FG.cTable[*s] == 0 ) s++;
2608 if ( StrICmp(ss,(UBYTE *)
"first") == 0 ) {
2612 else if ( StrICmp(ss,(UBYTE *)
"last") == 0 ) {
2616 while ( *s >=
'0' && *s <=
'9' ) {
2617 x2 = 10*x2 + *s++ -
'0';
2618 if ( x2 >= MAXPOSITIVE2 ) {
2619 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE2);
2625 else x2 = MAXPOSITIVE2;
2628 MesPrint(
"&Illegal keyword inside range specification");
2632 else if ( FG.cTable[*s] == 1 ) {
2634 while ( *s >=
'0' && *s <=
'9' ) {
2635 x2 = x2*10 + *s++ -
'0';
2636 if ( x2 >= MAXPOSITIVE2 ) {
2637 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE2);
2643 MesPrint(
"&Illegal character in range specification");
2647 MesPrint(
"&A range is two indicators, separated by a comma or blank between parentheses");
2650 out[0] = x1; out[1] = x2;
WORD Generator(PHEAD WORD *, WORD)
LONG EndSort(PHEAD WORD *, int)