85static WORD tranarray[10] = { SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
87int CoTransform(UBYTE *in)
90 UBYTE *s = in, c, *ss, *Tempbuf;
91 WORD number, type, num, i, *work = AT.WorkPointer+2, *wp, range[2], one = 1;
95 while ( *in ==
',' ) in++;
96 num = 0; wp = work + 1;
106 number = DoTempSet(s,in);
109 c = in[1]; in[1] = 0;
110 MesPrint(
"& %s: A set in a transform statement should be followed by a comma",s);
112 if ( error == 0 ) error = 1;
115 else if ( *in ==
'[' || FG.cTable[*in] == 0 ) {
118 if ( *in !=
',' )
break;
120 type = GetName(AC.varnames,s,&number,NOAUTO);
121 if ( type == CFUNCTION ) { number += MAXVARIABLES + FUNCTION; }
122 else if ( type != CSET ) {
123 MesPrint(
"& %s: A transform statement starts with sets of functions",s);
124 if ( error == 0 ) error = 1;
129 MesPrint(
"&Illegal syntax in Transform statement",s);
130 if ( error == 0 ) error = 1;
134 if ( number < MAXVARIABLES ) {
138 if ( Sets[number].type != CFUNCTION ) {
139 MesPrint(
"&A set in a transform statement should be a set of functions");
140 if ( error == 0 ) error = 1;
144 else if ( error == 0 ) error = 1;
150 while ( *in ==
',' ) in++;
161 if ( FG.cTable[*in] != 0 ) {
162 MesPrint(
"&Illegal character in Transform statement");
163 if ( error == 0 ) error = 1;
167 if ( *in ==
'>' || *in ==
'<' ) in++;
171 MesPrint(
"&Illegal syntax in specifying a transformation inside a Transform statement");
172 if ( error == 0 ) error = 1;
178 if ( StrICmp(s,(UBYTE *)
"replace") == 0 ) {
191 if ( ( in = ReadRange(in,range,0) ) == 0 ) {
192 if ( error == 0 ) error = 1;
203 if ( error == 0 ) error = 1;
209 if ( error == 0 ) error = 1;
213 if ( *in !=
',' && *in !=
'\0' ) {
215 if ( error == 0 ) error = 1;
219 ss = Tempbuf = (UBYTE *)Malloc1(i+5,
"CoTransform/replace");
220 *ss++ =
'd'; *ss++ =
'u'; *ss++ =
'm'; *ss++ =
'_';
223 AC.ProtoType = tranarray;
224 tranarray[4] = AC.cbufnum;
225 irhs = CompileAlgebra(Tempbuf,RHSIDE,AC.ProtoType);
226 M_free(Tempbuf,
"CoTransform/replace");
228 if ( error == 0 ) error = 1;
241 *wp++ = SUBEXPSIZE+4;
242 for ( i = 0; i < SUBEXPSIZE; i++ ) *wp++ = tranarray[i];
247 work = wp; *wp++ = 0;
254 else if ( StrICmp(s,(UBYTE *)
"decode" ) == 0 ) {
258 else if ( StrICmp(s,(UBYTE *)
"encode" ) == 0 ) {
261 if ( ( in = ReadRange(in,range,2) ) == 0 ) {
262 if ( error == 0 ) error = 1;
266 s = in;
while ( FG.cTable[*in] == 0 ) in++;
271 if ( StrICmp(s,(UBYTE *)
"base") == 0 ) {
274 MesPrint(
"&Illegal base specification in encode/decode transformation");
275 if ( error == 0 ) error = 1;
283 if ( GetName(AC.dollarnames,ss,&numdol,NOAUTO) != CDOLLAR ) {
284 MesPrint(
"&%s is undefined",ss-1);
285 numdol = AddDollar(ss,DOLINDEX,&one,1);
293 while ( FG.cTable[*in] == 1 ) {
294 x = 10*x + *in++ -
'0';
295 if ( x > MAXPOSITIVE4 ) {
296illsize: MesPrint(
"&Illegal value for base in encode/decode transformation");
297 if ( error == 0 ) error = 1;
301 if ( x <= 1 )
goto illsize;
303 if ( *in !=
',' && *in !=
'\0' ) {
304 MesPrint(
"&Illegal termination of transformation");
305 if ( error == 0 ) error = 1;
310 MesPrint(
"&Illegal option in encode/decode transformation");
311 if ( error == 0 ) error = 1;
327 work = wp; *wp++ = 0;
334 else if ( StrICmp(s,(UBYTE *)
"implode") == 0
335 || StrICmp(s,(UBYTE *)
"tosumnotation") == 0 ) {
341 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
342 if ( error == 0 ) error = 1;
350 work = wp; *wp++ = 0;
357 else if ( StrICmp(s,(UBYTE *)
"explode") == 0
358 || StrICmp(s,(UBYTE *)
"tointegralnotation") == 0 ) {
364 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
365 if ( error == 0 ) error = 1;
373 work = wp; *wp++ = 0;
380 else if ( StrICmp(s,(UBYTE *)
"permute") == 0 ) {
385 *wp++ = MAXPOSITIVE4;
395 WORD number; UBYTE *t;
397 while ( FG.cTable[*in] < 2 ) in++;
399 if ( ( number = GetDollar(t) ) < 0 ) {
400 MesPrint(
"&Undefined variable $%s",t);
401 if ( !error ) error = 1;
402 number = AddDollar(t,0,0,0);
409 while ( FG.cTable[*in] == 1 ) {
410 x = 10*x + *in++ -
'0';
411 if ( x > MAXPOSITIVE4 ) {
412 MesPrint(
"&value in permute transformation too large");
413 if ( error == 0 ) error = 1;
418 MesPrint(
"&value 0 in permute transformation not allowed");
419 if ( error == 0 ) error = 1;
424 }
while ( *in ==
',' );
426 MesPrint(
"&Illegal syntax in permute transformation");
427 if ( error == 0 ) error = 1;
431 if ( *in !=
',' && *in !=
'(' && *in !=
'\0' ) {
432 MesPrint(
"&Illegal ending in permute transformation");
433 if ( error == 0 ) error = 1;
437 if ( *wstart == 1 ) wstart--;
438 }
while ( *in ==
'(' );
440 work = wp; *wp++ = 0;
447 else if ( StrICmp(s,(UBYTE *)
"reverse") == 0 ) {
450 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
451 if ( error == 0 ) error = 1;
459 work = wp; *wp++ = 0;
466 else if ( StrICmp(s,(UBYTE *)
"dedup") == 0 ) {
469 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
470 if ( error == 0 ) error = 1;
478 work = wp; *wp++ = 0;
485 else if ( StrICmp(s,(UBYTE *)
"cycle") == 0 ) {
488 if ( ( in = ReadRange(in,range,0) ) == 0 ) {
489 if ( error == 0 ) error = 1;
502 else if ( *in ==
'-' ) {
506 MesPrint(
"&Cycle in a Transform statement should be followed by =+/-number/$");
507 if ( error == 0 ) error = 1;
514 while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
516 if ( ( x = GetDollar(si) ) < 0 ) {
517 MesPrint(
"&Undefined $-variable in transform,cycle statement.");
521 if ( one < 0 ) x += MAXPOSITIVE4;
526 while ( FG.cTable[*in] == 1 ) {
527 x = 10*x + *in++ -
'0';
528 if ( x > MAXPOSITIVE4 ) {
529 MesPrint(
"&Number in cycle in a Transform statement too big");
530 if ( error == 0 ) error = 1;
537 work = wp; *wp++ = 0;
544 else if ( StrICmp(s,(UBYTE *)
"islyndon" ) == 0 ) {
548 else if ( StrICmp(s,(UBYTE *)
"islyndon<" ) == 0 ) {
552 else if ( StrICmp(s,(UBYTE *)
"islyndon+" ) == 0 ) {
556 else if ( StrICmp(s,(UBYTE *)
"islyndon>" ) == 0 ) {
560 else if ( StrICmp(s,(UBYTE *)
"islyndon-" ) == 0 ) {
564 else if ( StrICmp(s,(UBYTE *)
"tolyndon" ) == 0 ) {
568 else if ( StrICmp(s,(UBYTE *)
"tolyndon<" ) == 0 ) {
572 else if ( StrICmp(s,(UBYTE *)
"tolyndon+" ) == 0 ) {
576 else if ( StrICmp(s,(UBYTE *)
"tolyndon>" ) == 0 ) {
580 else if ( StrICmp(s,(UBYTE *)
"tolyndon-" ) == 0 ) {
588 else if ( StrICmp(s,(UBYTE *)
"addargs" ) == 0 ) {
591 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
592 if ( error == 0 ) error = 1;
600 work = wp; *wp++ = 0;
607 else if ( ( StrICmp(s,(UBYTE *)
"mulargs" ) == 0 )
608 || ( StrICmp(s,(UBYTE *)
"multiplyargs" ) == 0 ) ) {
611 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
612 if ( error == 0 ) error = 1;
620 work = wp; *wp++ = 0;
627 else if ( StrICmp(s,(UBYTE *)
"dropargs" ) == 0 ) {
630 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
631 if ( error == 0 ) error = 1;
639 work = wp; *wp++ = 0;
646 else if ( StrICmp(s,(UBYTE *)
"selectargs" ) == 0 ) {
649 if ( ( in = ReadRange(in,range,1) ) == 0 ) {
650 if ( error == 0 ) error = 1;
658 work = wp; *wp++ = 0;
665 MesPrint(
"&Unknown transformation inside a Transform statement: %s",s);
667 if ( error == 0 ) error = 1;
670 while ( *s ==
',') s++;
672 AT.WorkPointer[0] = TYPETRANSFORM;
673 AT.WorkPointer[1] = i = wp - AT.WorkPointer;
689WORD RunTransform(PHEAD WORD *term, WORD *params)
691 WORD *t, *tstop, *w, *m, *out, *in, *tt, retval;
692 WORD *fun, *args, *info, *infoend, *onetransform, *funs, *endfun;
693 WORD *thearg = 0, *iterm, *newterm, *nt, *oldwork = AT.WorkPointer;
695 out = tstop = term + *term;
696 tstop -= ABS(tstop[-1]);
699 while ( t < tstop ) {
700 endfun = onetransform = params + *params;
702 if ( *t < FUNCTION ) {}
703 else if ( funs == endfun ) {
705 while ( in < t ) *out++ = *in++;
706 tt = t + t[1]; fun = out;
707 while ( in < tt ) *out++ = *in++;
709 args = onetransform + 1;
710 info = args;
while ( *info <= MAXRANGEINDICATOR ) {
711 if ( *info == ALLARGS ) info++;
712 else if ( *info == NUMARG ) info += 2;
713 else if ( *info == ARGRANGE ) info += 3;
714 else if ( *info == MAKEARGS ) info += 3;
718 if ( RunReplace(BHEAD fun,args,info) )
goto abo;
722 if ( RunEncode(BHEAD fun,args,info) )
goto abo;
726 if ( RunDecode(BHEAD fun,args,info) )
goto abo;
730 if ( RunImplode(fun,args) )
goto abo;
734 if ( RunExplode(BHEAD fun,args) )
goto abo;
738 if ( RunPermute(BHEAD fun,args,info) )
goto abo;
742 if ( RunReverse(BHEAD fun,args) )
goto abo;
746 if ( RunDedup(BHEAD fun,args) )
goto abo;
750 if ( RunCycle(BHEAD fun,args,info) )
goto abo;
754 if ( RunAddArg(BHEAD fun,args) )
goto abo;
758 if ( RunMulArg(BHEAD fun,args) )
goto abo;
762 if ( ( retval = RunIsLyndon(BHEAD fun,args,1) ) < -1 )
goto abo;
766 if ( ( retval = RunIsLyndon(BHEAD fun,args,-1) ) < -1 )
goto abo;
770 if ( ( retval = RunToLyndon(BHEAD fun,args,1) ) < -1 )
goto abo;
774 if ( ( retval = RunToLyndon(BHEAD fun,args,-1) ) < -1 )
goto abo;
777 if ( retval == -1 )
break;
781 AT.WorkPointer += 2*AM.MaxTer;
782 if ( AT.WorkPointer > AT.WorkTop ) {
783 MLOCK(ErrorMessageLock);
785 MUNLOCK(ErrorMessageLock);
788 iterm = AT.WorkPointer;
790 for ( i = 0; i < *info; i++ ) iterm[i] = info[i];
791 AT.WorkPointer = iterm + *iterm;
794 if (
Generator(BHEAD iterm,AR.Cnumlhs) ) {
796 AT.WorkPointer = oldwork;
799 newterm = AT.WorkPointer;
800 if (
EndSort(BHEAD newterm,0) < 0 ) {}
801 if ( ( *newterm && *(newterm+*newterm) != 0 ) || *newterm == 0 ) {
802 MLOCK(ErrorMessageLock);
803 MesPrint(
"&yes/no information in islyndon/tolyndon does not evaluate into a single term");
804 MUNLOCK(ErrorMessageLock);
808 i = *newterm; tt = iterm; nt = newterm;
810 AT.WorkPointer = iterm + *iterm;
812 infoend = info+info[1];
819 if ( info >= infoend ) {
821 MLOCK(ErrorMessageLock);
822 MesPrint(
"There should be a yes and a no argument in islyndon/tolyndon");
823 MUNLOCK(ErrorMessageLock);
827 if ( info >= infoend )
goto abortlyndon;
830 else if ( retval == 1 ) {
834 if ( info >= infoend )
goto abortlyndon;
837 if ( info >= infoend )
goto abortlyndon;
840 if ( info < infoend )
goto abortlyndon;
849 if ( *thearg == -SNUMBER && thearg[1] == 0 ) {
850 *term = 0;
return(0);
852 if ( *thearg == -SNUMBER && thearg[1] == 1 ) { }
855 *out++ = EXPONENT; out++; *out++ = 1; FILLFUN3(out);
856 COPY1ARG(out,thearg);
857 *out++ = -SNUMBER; *out++ = 1;
862 if ( RunDropArg(BHEAD fun,args) )
goto abo;
866 if ( RunSelectArg(BHEAD fun,args) )
goto abo;
870 MLOCK(ErrorMessageLock);
871 MesPrint(
"Irregular code in execution of transform statement");
872 MUNLOCK(ErrorMessageLock);
875 onetransform += *onetransform;
876 }
while ( *onetransform );
879 while ( funs < endfun ) {
880 if ( *funs > MAXVARIABLES ) {
881 if ( *t == *funs-MAXVARIABLES )
goto hit;
884 w = SetElements + Sets[*funs].first;
885 m = SetElements + Sets[*funs].last;
887 if ( *w == *t )
goto hit;
896 tt = term + *term;
while ( in < tt ) *out++ = *in++;
904 MLOCK(ErrorMessageLock);
905 MesCall(
"RunTransform");
906 MUNLOCK(ErrorMessageLock);
922WORD RunEncode(PHEAD WORD *fun, WORD *args, WORD *info)
924 WORD base, *f, *funstop, *fun1, *t, size1, size2, size3, *arg;
925 int num, num1, num2, n, i, i1, i2;
926 UWORD *scrat1, *scrat2, *scrat3;
927 WORD *tt, *tstop, totarg, arg1, arg2;
928 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
929 if ( *args != ARGRANGE ) {
930 MLOCK(ErrorMessageLock);
931 MesPrint(
"Illegal range encountered in RunEncode");
932 MUNLOCK(ErrorMessageLock);
935 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
936 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
937 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
938 if ( arg1 > totarg || arg2 > totarg )
return(0);
940 if ( info[2] == BASECODE ) {
944 base = DolToNumber(BHEAD i1);
945 if ( AN.ErrorInDollar || base < 2 ) {
946 MLOCK(ErrorMessageLock);
947 MesPrint(
"$%s does not have a number value > 1 in base/encode/transform statement in module %l",
948 DOLLARNAME(Dollars,i1),AC.CModule);
949 MUNLOCK(ErrorMessageLock);
956 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; }
957 else { num1 = arg1; num2 = arg2; }
959 WantAddPointers(num);
963 n = 1; funstop = fun+fun[1]; f = fun+FUNHEAD;
965 if ( f >= funstop )
return(0);
970 while ( n <= num2 ) {
971 if ( f >= funstop )
return(0);
972 if ( *f != -SNUMBER ) {
973 if ( *f < 0 )
return(0);
976 if ( (*f-i1) != (ARGHEAD+1) )
return(0);
980 if ( *t != 0 )
return(0);
984 AT.pWorkSpace[AT.pWorkPointer+i] = f;
996 t = AT.pWorkSpace[AT.pWorkPointer+i1];
997 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
998 AT.pWorkSpace[AT.pWorkPointer+i2] = t;
1010 scrat1 = NumberMalloc(
"RunEncode");
1011 scrat2 = NumberMalloc(
"RunEncode");
1012 scrat3 = NumberMalloc(
"RunEncode");
1013 arg = AT.pWorkSpace[AT.pWorkPointer];
1014 size1 = PutArgInScratch(arg,scrat1);
1017 if ( MulLong(scrat1,size1,(UWORD *)(&base),1,scrat2,&size2) ) {
1018 NumberFree(scrat3,
"RunEncode");
1019 NumberFree(scrat2,
"RunEncode");
1020 NumberFree(scrat1,
"RunEncode");
1024 size3 = PutArgInScratch(arg,scrat3);
1025 if ( AddLong(scrat2,size2,scrat3,size3,scrat1,&size1) ) {
1026 NumberFree(scrat3,
"RunEncode");
1027 NumberFree(scrat2,
"RunEncode");
1028 NumberFree(scrat1,
"RunEncode");
1041 *fun1++ = -SNUMBER; *fun1++ = 0;
1042 while ( f < funstop ) *fun1++ = *f++;
1043 fun[1] = funstop-fun;
1045 else if ( size1 == 1 && scrat1[0] <= MAXPOSITIVE ) {
1046 *fun1++ = -SNUMBER; *fun1++ = scrat1[0];
1047 while ( f < funstop ) *fun1++ = *f++;
1050 else if ( size1 == -1 && scrat1[0] <= MAXPOSITIVE+1 ) {
1052 if ( scrat1[0] < MAXPOSITIVE ) *fun1++ = scrat1[0];
1053 else *fun1++ = (WORD)(MAXPOSITIVE+1);
1054 while ( f < funstop ) *fun1++ = *f++;
1057 else if ( ABS(size1)*2+2+ARGHEAD <= f-fun1 ) {
1058 if ( size1 < 0 ) { size2 = size1*2-1; size1 = -size1; size3 = -size2; }
1059 else { size2 = 2*size1+1; size3 = size2; }
1060 *fun1++ = size3+ARGHEAD+1;
1061 *fun1++ = 0; FILLARG(fun1);
1063 for ( i = 0; i < size1; i++ ) *fun1++ = scrat1[i];
1065 for ( i = 1; i < size1; i++ ) *fun1++ = 0;
1067 while ( f < funstop ) *fun1++ = *f++;
1072 if ( size1 < 0 ) { size2 = size1*2-1; size1 = -size1; size3 = -size2; }
1073 else { size2 = 2*size1+1; size3 = size2; }
1074 *t++ = size3+ARGHEAD+1;
1075 *t++ = 0; FILLARG(t);
1077 for ( i = 0; i < size1; i++ ) *t++ = scrat1[i];
1079 for ( i = 1; i < size1; i++ ) *t++ = 0;
1081 while ( f < funstop ) *t++ = *f++;
1083 while ( f < t ) *fun1++ = *f++;
1086 NumberFree(scrat3,
"RunEncode");
1087 NumberFree(scrat2,
"RunEncode");
1088 NumberFree(scrat1,
"RunEncode");
1091 MLOCK(ErrorMessageLock);
1092 MesPrint(
"Unimplemented type of encoding encountered in RunEncode");
1093 MUNLOCK(ErrorMessageLock);
1098 MLOCK(ErrorMessageLock);
1099 MesCall(
"RunEncode");
1100 MUNLOCK(ErrorMessageLock);
1109WORD RunDecode(PHEAD WORD *fun, WORD *args, WORD *info)
1111 WORD base, num, num1, num2, n, *f, *funstop, *fun1, size1, size2, size3, *t;
1112 WORD i1, i2, i, sig;
1113 UWORD *scrat1, *scrat2, *scrat3;
1114 WORD *tt, *tstop, totarg, arg1, arg2;
1115 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
1116 if ( *args != ARGRANGE ) {
1117 MLOCK(ErrorMessageLock);
1118 MesPrint(
"Illegal range encountered in RunDecode");
1119 MUNLOCK(ErrorMessageLock);
1122 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
1123 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1124 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
1125 if ( arg1 > totarg && arg2 > totarg )
return(0);
1126 if ( info[2] == BASECODE ) {
1130 base = DolToNumber(BHEAD i1);
1131 if ( AN.ErrorInDollar || base < 2 ) {
1132 MLOCK(ErrorMessageLock);
1133 MesPrint(
"$%s does not have a number value > 1 in base/decode/transform statement in module %l",
1134 DOLLARNAME(Dollars,i1),AC.CModule);
1135 MUNLOCK(ErrorMessageLock);
1142 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; }
1143 else { num1 = arg1; num2 = arg2; }
1145 if ( num <= 1 )
return(0);
1149 funstop = fun + fun[1];
1150 f = fun + FUNHEAD; n = 1;
1151 while ( f < funstop ) {
1152 if ( n == num1 )
break;
1155 if ( f >= funstop )
return(0);
1159 if ( *f == -SNUMBER ) {}
1160 else if ( *f < 0 )
return(0);
1164 if ( (*f-i1) != (ARGHEAD+1) )
return(0);
1168 if ( *t != 0 )
return(0);
1177 scrat1 = NumberMalloc(
"RunEncode");
1178 scrat2 = NumberMalloc(
"RunEncode");
1179 scrat3 = NumberMalloc(
"RunEncode");
1180 size1 = PutArgInScratch(fun1,scrat1);
1181 if ( size1 < 0 ) { sig = -1; size1 = -size1; }
1186 scrat2[0] = base; size2 = 1;
1187 if ( RaisPow(BHEAD scrat2,&size2,num) ) {
1188 NumberFree(scrat3,
"RunEncode");
1189 NumberFree(scrat2,
"RunEncode");
1190 NumberFree(scrat1,
"RunEncode");
1193 if ( BigLong(scrat1,size1,scrat2,size2) >= 0 ) {
1194 NumberFree(scrat3,
"RunEncode");
1195 NumberFree(scrat2,
"RunEncode");
1196 NumberFree(scrat1,
"RunEncode");
1202 if ( *fun1 > num*2 ) {
1203 t = fun1 + 2*num; f = fun1 + *fun1;
1204 while ( f < funstop ) *t++ = *f++;
1207 else if ( *fun1 < num*2 ) {
1209 fun[1] += (num-1)*2;
1210 t = funstop + (num-1)*2;
1213 fun[1] += 2*num - *fun1;
1214 t = funstop +2*num - *fun1;
1217 while ( f > fun1 ) *--t = *--f;
1222 for ( i = num-1; i >= 0; i-- ) {
1223 DivLong(scrat1,size1,(UWORD *)(&base),1,scrat2,&size2,scrat3,&size3);
1224 fun1[2*i] = -SNUMBER;
1225 if ( size3 == 0 ) fun1[2*i+1] = 0;
1226 else fun1[2*i+1] = (WORD)(scrat3[0])*sig;
1227 for ( i1 = 0; i1 < size2; i1++ ) scrat1[i1] = scrat2[i1];
1231 MLOCK(ErrorMessageLock);
1232 MesPrint(
"RunDecode: number to be decoded is too big");
1233 MUNLOCK(ErrorMessageLock);
1234 NumberFree(scrat3,
"RunEncode");
1235 NumberFree(scrat2,
"RunEncode");
1236 NumberFree(scrat1,
"RunEncode");
1242 if ( arg1 > arg2 ) {
1243 i1 = 1; i2 = 2*num-1;
1245 i = fun1[i1]; fun1[i1] = fun1[i2]; fun1[i2] = i;
1249 NumberFree(scrat3,
"RunEncode");
1250 NumberFree(scrat2,
"RunEncode");
1251 NumberFree(scrat1,
"RunEncode");
1254 MLOCK(ErrorMessageLock);
1255 MesPrint(
"Unimplemented type of encoding encountered in RunDecode");
1256 MUNLOCK(ErrorMessageLock);
1261 MLOCK(ErrorMessageLock);
1262 MesCall(
"RunDecode");
1263 MUNLOCK(ErrorMessageLock);
1279WORD RunReplace(PHEAD WORD *fun, WORD *args, WORD *info)
1281 int n = 0, i, dirty = 0, totarg, nfix, nwild, ngeneral;
1282 WORD *t, *tt, *u, *tstop, *info1, *infoend, *oldwork = AT.WorkPointer;
1283 WORD *term, *newterm, *nt, *term1, *term2;
1284 WORD wild[4], mask, *term3, *term4, *oldmask = AT.WildMask;
1285 WORD n1, n2, doanyway;
1287 t = fun; tstop = fun + fun[1]; u = tstop;
1288 for ( i = 0; i < FUNHEAD; i++ ) *u++ = *t++;
1290 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1292 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1295 totarg = tstop - tt;
1304 AT.WorkPointer += 2*AM.MaxTer;
1305 if ( AT.WorkPointer > AT.WorkTop ) {
1306 MLOCK(ErrorMessageLock);
1308 MUNLOCK(ErrorMessageLock);
1311 term = AT.WorkPointer;
1312 for ( i = 0; i < *info; i++ ) term[i] = info[i];
1313 AT.WorkPointer = term + *term;
1316 if (
Generator(BHEAD term,AR.Cnumlhs) ) {
1318 AT.WorkPointer = oldwork;
1321 newterm = AT.WorkPointer;
1322 if (
EndSort(BHEAD newterm,0) < 0 ) {}
1323 if ( ( *newterm && *(newterm+*newterm) != 0 ) || *newterm == 0 ) {
1324 MLOCK(ErrorMessageLock);
1325 MesPrint(
"&information in replace transformation does not evaluate into a single term");
1326 MUNLOCK(ErrorMessageLock);
1330 i = *newterm; tt = term; nt = newterm;
1332 AT.WorkPointer = term + *term;
1335 term1 = term + *term;
1337 *term2++ = REPLACEMENT;
1338 term2++; FILLFUN(term2)
1342 infoend = info + info[1];
1343 info1 = info + FUNHEAD;
1344 nfix = nwild = ngeneral = 0;
1345 while ( info1 < infoend ) {
1346 if ( *info1 == -SNUMBER ) {
1348 info1 += 2; NEXTARG(info1)
1350 else if ( *info1 <= -FUNCTION ) {
1351 if ( *info1 == -WILDARGFUN ) {
1353 info1++; NEXTARG(info1)
1356 *term2++ = *info1++; COPY1ARG(term2,info1)
1360 else if ( *info1 == -INDEX ) {
1361 if ( info1[1] == WILDARGINDEX + AM.OffsetIndex ) {
1363 info1 += 2; NEXTARG(info1)
1366 *term2++ = *info1++; *term2++ = *info1++; COPY1ARG(term2,info1)
1370 else if ( *info1 == -SYMBOL ) {
1371 if ( info1[1] == WILDARGSYMBOL ) {
1373 info1 += 2; NEXTARG(info1)
1376 *term2++ = *info1++; *term2++ = *info1++; COPY1ARG(term2,info1)
1380 else if ( *info1 == -MINVECTOR || *info1 == -VECTOR ) {
1381 if ( info1[1] == WILDARGVECTOR + AM.OffsetVector ) {
1383 info1 += 2; NEXTARG(info1)
1386 *term2++ = *info1++; *term2++ = *info1++; COPY1ARG(term2,info1)
1391 MLOCK(ErrorMessageLock);
1392 MesPrint(
"&irregular code found in replace transformation (RunReplace)");
1393 MUNLOCK(ErrorMessageLock);
1397 AT.WorkPointer = term2;
1398 *term1 = term2 - term1;
1399 term1[2] = *term1 - 1;
1403 while ( t < tstop ) {
1405 if ( TestArgNum(n,totarg,args) == 0 ) {
1406 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1407 if ( *t <= -FUNCTION ) { *u++ = *t++; }
1408 else if ( *t < 0 ) { *u++ = *t++; *u++ = *t++; }
1409 else { i = *t; NCOPY(u,t,i) }
1425 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1426 if ( *t == -SNUMBER ) {
1427 info1 = info + FUNHEAD;
1428 while ( info1 < infoend ) {
1429 if ( *info1 == -SNUMBER ) {
1430 if ( info1[1] == t[1] ) {
1431 if ( info1[2] == -SNUMBER ) {
1432 *u++ = -SNUMBER; *u++ = info1[3];
1437 if ( info1[0] <= -FUNCTION ) i = 1;
1438 else if ( info1[0] < 0 ) i = 2;
1456 doanyway = 1; n2 = t[1];
1460 if ( *t < AM.OffsetIndex && *t >= 0 ) {
1461 info1 = info + FUNHEAD;
1462 while ( info1 < infoend ) {
1463 if ( ( *info1 == -SNUMBER ) && ( info1[1] == *t )
1464 && ( ( ( info1[2] == -SNUMBER ) && ( info1[3] >= 0 )
1465 && ( info1[3] < AM.OffsetIndex ) )
1466 || ( info1[2] == -INDEX || info1[2] == -VECTOR
1467 || info1[2] == -MINVECTOR ) ) ) {
1480 else if ( *t == -SNUMBER ) {
1481 doanyway = 1; n2 = t[1];
1489 if ( ngeneral > 0 ) {
1490 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1492 term3 = term1 + *term1;
1493 term4 = term1 + FUNHEAD;
1494 while ( term4 < term3 ) {
1495 if ( *term4 == *t && ( *t <= -FUNCTION ||
1496 ( t[1] == term4[1] ) ) )
break;
1499 if ( term4 < term3 )
goto dothisnow;
1503 term3 = term1 + *term1;
1504 term4 = term1 + FUNHEAD;
1505 while ( term4 < term3 ) {
1506 if ( ( term4[1] == *t ) &&
1507 ( ( *term4 == -INDEX || *term4 == -VECTOR ||
1508 ( *term4 == -SYMBOL && term4[1] < AM.OffsetIndex
1509 && term4[1] >= 0 ) ) ) )
break;
1512 if ( term4 < term3 )
goto dothisnow;
1529 info1 = info + FUNHEAD;
1530 while ( info1 < infoend ) {
1531 if ( *info1 == -SYMBOL && info1[1] == WILDARGSYMBOL
1532 && ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) ) {
1534 wild[2] = WILDARGSYMBOL;
1536 AN.WildValue = wild;
1537 AT.WildMask = &mask;
1540 if ( *t == -SYMBOL || ( *t > 0 && CheckWild(BHEAD WILDARGSYMBOL,SYMTOSUB,1,t) == 0 )
1546 n1 = SYMBOL; n2 = WILDARGSYMBOL;
1550 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1551 *term3++ = DUMFUN; term3++; FILLFUN(term3)
1552 COPY1ARG(term3,info1)
1555 *term3++ = fun[0]; term3++; FILLFUN(term3)
1558 term2[2] = term3 - term2 - 1;
1560 *term3++ = REPLACEMENT;
1561 term3++; FILLFUN(term3)
1563 if ( n1 < FUNCTION ) *term3++ = n2;
1564 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1566 COPY1ARG(term3,term4)
1572 *term3++ = 1; *term3++ = 1; *term3++ = 3;
1573 *term2 = term3 - term2;
1575 AT.WorkPointer = term3;
1577 if (
Generator(BHEAD term2,AR.Cnumlhs) ) {
1579 AT.WorkPointer = oldwork;
1580 AT.WildMask = oldmask;
1583 term4 = AT.WorkPointer;
1584 if (
EndSort(BHEAD term4,0) < 0 ) {}
1585 if ( ( *term4 && *(term4+*term4) != 0 ) || *term4 == 0 ) {
1586 MLOCK(ErrorMessageLock);
1587 MesPrint(
"&information in replace transformation does not evaluate into a single term");
1588 MUNLOCK(ErrorMessageLock);
1594 i = term4[2]-FUNHEAD;
1595 term3 = term4+FUNHEAD+1;
1597 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1601 AT.WorkPointer = term2;
1605 info1 += 2; NEXTARG(info1)
1607 else if ( ( *info1 == -INDEX )
1608 && ( info[1] == WILDARGINDEX + AM.OffsetIndex ) ) {
1610 wild[2] = WILDARGINDEX+AM.OffsetIndex;
1612 AN.WildValue = wild;
1613 AT.WildMask = &mask;
1616 if ( ( functions[fun[0]-FUNCTION].spec == TENSORFUNCTION )
1617 || ( *t == -INDEX || ( *t > 0 && CheckWild(BHEAD WILDARGINDEX,INDTOSUB,1,t) == 0 ) ) ) {
1622 n1 = INDEX; n2 = WILDARGINDEX+AM.OffsetIndex;
1626 info1 += 2; NEXTARG(info1)
1628 else if ( ( *info1 == -VECTOR )
1629 && ( info1[1] == WILDARGVECTOR + AM.OffsetVector ) ) {
1631 wild[2] = WILDARGVECTOR+AM.OffsetVector;
1633 AN.WildValue = wild;
1634 AT.WildMask = &mask;
1637 if ( functions[fun[0]-FUNCTION].spec == TENSORFUNCTION ) {
1638 if ( *t < MINSPEC ) {
1639 n1 = VECTOR; n2 = WILDARGVECTOR+AM.OffsetVector;
1644 else if ( *t == -VECTOR || *t == -MINVECTOR ||
1645 ( *t > 0 && CheckWild(BHEAD WILDARGVECTOR,VECTOSUB,1,t) == 0 ) ) {
1650 n1 = VECTOR; n2 = WILDARGVECTOR+AM.OffsetVector;
1654 info1 += 2; NEXTARG(info1)
1656 else if ( *info1 == -WILDARGFUN ) {
1658 wild[2] = WILDARGFUN;
1660 AN.WildValue = wild;
1661 AT.WildMask = &mask;
1664 if ( *t <= -FUNCTION || ( *t > 0 && CheckWild(BHEAD WILDARGFUN,FUNTOFUN,1,t) == 0 ) ) {
1669 n2 = n1 = -WILDARGFUN;
1673 info1++; NEXTARG(info1)
1676 NEXTARG(info1) NEXTARG(info1)
1680 if ( ngeneral > 0 ) {
1688 term3 = term2; term4 = term1; i = *term1;
1689 NCOPY(term3,term4,i)
1691 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1692 *term3++ = DUMFUN; term3++; FILLFUN(term3);
1697 *term3++ = fun[0]; term3++; FILLFUN(term3); *term3++ = *t;
1699 term4[1] = term3-term4;
1700 *term3++ = 1; *term3++ = 1; *term3++ = 3;
1701 *term2 = term3-term2;
1702 AT.WorkPointer = term3;
1704 if (
Generator(BHEAD term2,AR.Cnumlhs) ) {
1706 AT.WorkPointer = oldwork;
1707 AT.WildMask = oldmask;
1710 term4 = AT.WorkPointer;
1711 if (
EndSort(BHEAD term4,0) < 0 ) {}
1712 if ( ( *term4 && *(term4+*term4) != 0 ) || *term4 == 0 ) {
1713 MLOCK(ErrorMessageLock);
1714 MesPrint(
"&information in replace transformation does not evaluate into a single term");
1715 MUNLOCK(ErrorMessageLock);
1721 i = term4[2]-FUNHEAD;
1722 term3 = term4+FUNHEAD+1;
1725 AT.WorkPointer = term2;
1733 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
1734 if ( *t <= -FUNCTION ) { *u++ = *t++; }
1735 else if ( *t < 0 ) { *u++ = *t++; *u++ = *t++; }
1736 else { i = *t; NCOPY(u,t,i) }
1743 i = u - tstop; tstop[1] = i; tstop[2] = dirty;
1744 t = fun; u = tstop; NCOPY(t,u,i)
1745 AT.WorkPointer = oldwork;
1746 AT.WildMask = oldmask;
1757WORD RunImplode(WORD *fun, WORD *args)
1760 WORD *tt, *tstop, totarg, arg1, arg2, num1, num2, i, i1, n;
1761 WORD *f, *t, *ttt, *t4, *ff, *fff;
1762 WORD moveup, numzero, outspace;
1763 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
1764 if ( *args != ARGRANGE ) {
1765 MLOCK(ErrorMessageLock);
1766 MesPrint(
"Illegal range encountered in RunImplode");
1767 MUNLOCK(ErrorMessageLock);
1770 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
1771 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1772 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
1776 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; }
1777 else { num1 = arg1; num2 = arg2; }
1778 if ( num1 > totarg || num2 > totarg )
return(0);
1784 n = 1; f = fun+FUNHEAD;
1785 while ( n < num1 ) {
1786 if ( f >= tstop )
return(0);
1802 while ( n <= num2 ) {
1803 if ( f >= tstop )
return(0);
1804 if ( *f == -SNUMBER ) { *tt++ = -1; *tt++ = 0;
1805 if ( f[1] < 0 ) { *tt++ = -f[1]; *tt++ = -1; }
1806 else { *tt++ = f[1]; *tt++ = 1; }
1809 else if ( *f == -SYMBOL ) { *tt++ = f[1]; *tt++ = 1; *tt++ = 1; *tt++ = 1; f += 2; }
1810 else if ( *f < 0 )
return(0);
1812 if ( *f != ( f[ARGHEAD]+ARGHEAD ) )
return(0);
1815 if ( ( i1 > 3 ) || ( t[-1] != 1 ) )
return(0);
1816 if ( (UWORD)(t[-2]) > MAXPOSITIVE4 )
return(0);
1817 if ( f[ARGHEAD] == i1+1 ) {
1818 *tt++ = -1; *tt++ = 0; *tt++ = t[-2];
1819 if ( *t < 0 ) { *tt++ = -1; }
1822 else if ( ( f[ARGHEAD+1] != SYMBOL )
1823 || ( f[ARGHEAD+2] != 4 )
1824 || ( ( f+ARGHEAD+1+f[ARGHEAD+2] ) < ( t-i1 ) ) )
return(0);
1827 *tt++ = f[ARGHEAD+3];
1828 *tt++ = f[ARGHEAD+4];
1830 if ( *t < 0 ) { *tt++ = -1; }
1843 if ( arg1 > arg2 ) {
1847 t = tt - 4; numzero = 0;
1848 while ( t >= tstop ) {
1849 if ( t[2] == 0 ) numzero++;
1851 if ( numzero > 0 ) {
1854 ttt = t4 + 4*numzero;
1855 while ( ttt < tt ) *t4++ = *ttt++;
1865 numzero = 0; ttt = t;
1867 if ( t[2] == 0 ) numzero++;
1869 if ( numzero > 0 ) {
1872 while ( t4 < tt ) *ttt++ = *t4++;
1892 t = tstop; outspace = 0;
1895 if ( t[2] > MAXPOSITIVE4 ) {
return(0); }
1898 else if ( t[1] == 1 && t[2] == 1 && t[3] == 1 ) { outspace += 2; }
1899 else { outspace += 8 + ARGHEAD; }
1902 if ( outspace < (fff-ff) ) {
1905 if ( t[0] == -1 ) { *ff++ = -SNUMBER; *ff++ = t[2]*t[3]; }
1906 else if ( t[1] == 1 && t[2] == 1 && t[3] == 1 ) {
1907 *ff++ = -SYMBOL; *ff++ = t[0];
1910 *ff++ = 8+ARGHEAD; *ff++ = 0; FILLARG(ff);
1911 *ff++ = 8; *ff++ = SYMBOL; *ff++ = 4; *ff++ = t[0]; *ff++ = t[1];
1912 *ff++ = t[2]; *ff++ = 1; *ff++ = t[3] > 0 ? 3: -3;
1916 while ( fff < tstop ) *ff++ = *fff++;
1919 else if ( outspace > (fff-ff) ) {
1925 moveup = outspace-(fff-ff);
1928 while ( t > fff ) *--ttt = *--t;
1929 tt += moveup; tstop += moveup;
1938 if ( t[0] == -1 ) { *ff++ = -SNUMBER; *ff++ = t[2]*t[3]; }
1939 else if ( t[1] == 1 && t[2] == 1 && t[3] == 1 ) {
1940 *ff++ = -SYMBOL; *ff++ = t[0];
1943 *ff++ = 8+ARGHEAD; *ff++ = 0; FILLARG(ff);
1944 *ff++ = 8; *ff++ = SYMBOL; *ff++ = 4; *ff++ = t[0]; *ff++ = t[1];
1945 *ff++ = t[2]; *ff++ = 1; *ff++ = t[3] > 0 ? 3: -3;
1958WORD RunExplode(PHEAD WORD *fun, WORD *args)
1960 WORD arg1, arg2, num1, num2, *tt, *tstop, totarg, *tonew, *newfun;
1962 int reverse = 0, iarg, i, numzero;
1963 if ( functions[fun[0]-FUNCTION].spec != 0 )
return(0);
1964 if ( *args != ARGRANGE ) {
1965 MLOCK(ErrorMessageLock);
1966 MesPrint(
"Illegal range encountered in RunExplode");
1967 MUNLOCK(ErrorMessageLock);
1970 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
1971 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
1972 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
1976 if ( arg1 > arg2 ) { num1 = arg2; num2 = arg1; reverse = 1; }
1977 else { num1 = arg1; num2 = arg2; }
1978 if ( num1 > totarg || num2 > totarg )
return(0);
1979 if ( tstop + AM.MaxTer > AT.WorkTop )
goto OverWork;
1984 tonew = newfun = tstop;
1985 ff = fun + FUNHEAD; iarg = 0;
1986 while ( ff < tstop ) {
1988 if ( iarg == num1 ) {
1989 i = ff - fun; f = fun;
1998 while ( iarg <= num2 ) {
1999 if ( *ff == -SYMBOL || ( *ff == -SNUMBER && ff[1] == 0 ) )
2000 { *tonew++ = *ff++; *tonew++ = *ff++; }
2001 else if ( *ff == -SNUMBER ) {
2002 numzero = ABS(ff[1])-1;
2004 *tonew++ = -SNUMBER; *tonew++ = ff[1] < 0 ? -1: 1;
2005 while ( numzero > 0 ) {
2006 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
2010 while ( numzero > 0 ) {
2011 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
2013 *tonew++ = -SNUMBER; *tonew++ = ff[1] < 0 ? -1: 1;
2017 else if ( *ff < 0 ) {
return(0); }
2019 if ( *ff != ARGHEAD+8 || ff[ARGHEAD] != 8
2020 || ff[ARGHEAD+1] != SYMBOL || ABS(ff[ARGHEAD+7]) != 3
2021 || ff[ARGHEAD+6] != 1 )
return(0);
2022 numzero = ff[ARGHEAD+5];
2023 if ( numzero >= MAXPOSITIVE4 )
return(0);
2026 if ( ff[ARGHEAD+7] > 0 ) { *tonew++ = -SNUMBER; *tonew++ = 1; }
2028 *tonew++ = ARGHEAD+8; *tonew++ = 0; FILLARG(tonew)
2029 *tonew++ = 8; *tonew++ = SYMBOL; *tonew++ = ff[ARGHEAD+3];
2030 *tonew++ = ff[ARGHEAD+4]; *tonew++ = 1; *tonew++ = 1;
2033 while ( numzero > 0 ) {
2034 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
2038 while ( numzero > 0 ) {
2039 *tonew++ = -SNUMBER; *tonew++ = 0; numzero--;
2041 *tonew++ = ARGHEAD+8; *tonew++ = 0; FILLARG(tonew)
2042 *tonew++ = 8; *tonew++ = SYMBOL; *tonew++ = 4;
2043 *tonew++ = ff[ARGHEAD+3]; *tonew++ = ff[ARGHEAD+4];
2044 *tonew++ = 1; *tonew++ = 1;
2045 if ( ff[ARGHEAD+7] > 0 ) *tonew++ = 3;
2050 if ( tonew > AT.WorkTop )
goto OverWork;
2056 while ( ff < tstop ) *tonew++ = *ff++;
2057 i = newfun[1] = tonew-newfun;
2061 MLOCK(ErrorMessageLock);
2063 MUNLOCK(ErrorMessageLock);
2072WORD RunPermute(PHEAD WORD *fun, WORD *args, WORD *info)
2074 WORD *tt, totarg, *tstop, arg1, arg2, n, num, i, *f, *f1, *f2, *infostop;
2075 WORD *in, *iw, withdollar;
2077 if ( *args != ARGRANGE ) {
2078 MLOCK(ErrorMessageLock);
2079 MesPrint(
"Illegal range encountered in RunPermute");
2080 MUNLOCK(ErrorMessageLock);
2083 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
2084 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2085 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2086 arg1 = 1; arg2 = totarg;
2095 WantAddPointers(num);
2096 f = fun+FUNHEAD; n = 1; i = 0;
2097 while ( n < arg1 ) { n++; NEXTARG(f) }
2099 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2105 infostop = info + *info;
2107 if ( *info > totarg )
return(0);
2112 withdollar = 0; in = info;
2113 while ( in < infostop ) {
2115 d = Dollars - *in - 1;
2118 int nummodopt, dtype = -1, numdollar = -*in-1;
2119 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2120 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2121 if ( numdollar == ModOptdollars[nummodopt].number )
break;
2123 if ( nummodopt < NumModOptdollars ) {
2124 dtype = ModOptdollars[nummodopt].type;
2125 if ( dtype == MODLOCAL ) {
2126 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2129 LOCK(d->pthreadslockread);
2135 if ( ( d->type == DOLNUMBER || d->type == DOLTERMS )
2136 && d->where[0] == 4 && d->where[4] == 0 ) {
2137 if ( d->where[3] < 0 || d->where[2] != 1 || d->where[1] > totarg )
return(0);
2139 else if ( d->type == DOLWILDARGS ) {
2142 if ( *iw == -SNUMBER ) {
2143 if ( iw[1] <= 0 || iw[1] > totarg )
return(0);
2151 MLOCK(ErrorMessageLock);
2152 MesPrint(
"Illegal type of $-variable in RunPermute");
2153 MUNLOCK(ErrorMessageLock);
2158 else if ( *in > totarg )
return(0);
2162 WORD *incopy, *tocopy;
2163 incopy = TermMalloc(
"RunPermute");
2164 tocopy = incopy+1; in = info;
2165 while ( in < infostop ) {
2167 d = Dollars - *in - 1;
2170 int nummodopt, dtype = -1, numdollar = -*in-1;
2171 if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
2172 for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2173 if ( numdollar == ModOptdollars[nummodopt].number )
break;
2175 if ( nummodopt < NumModOptdollars ) {
2176 dtype = ModOptdollars[nummodopt].type;
2177 if ( dtype == MODLOCAL ) {
2178 d = ModOptdollars[nummodopt].dstruct+AT.identity;
2181 LOCK(d->pthreadslockread);
2187 if ( d->type == DOLNUMBER || d->type == DOLTERMS ) {
2188 *tocopy++ = d->where[1] - 1;
2190 else if ( d->type == DOLWILDARGS ) {
2193 *tocopy++ = iw[1] - 1;
2199 else *tocopy++ = *in++;
2202 *incopy = tocopy - incopy;
2204 tt = AT.pWorkSpace[AT.pWorkPointer+*in];
2206 while ( in < tocopy ) {
2207 if ( *in > totarg )
return(0);
2208 AT.pWorkSpace[AT.pWorkPointer+in[-1]] = AT.pWorkSpace[AT.pWorkPointer+*in];
2211 AT.pWorkSpace[AT.pWorkPointer+in[-1]] = tt;
2212 TermFree(incopy,
"RunPermute");
2216 tt = AT.pWorkSpace[AT.pWorkPointer+*info];
2218 while ( info < infostop ) {
2219 if ( *info > totarg )
return(0);
2220 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = AT.pWorkSpace[AT.pWorkPointer+*info];
2223 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = tt;
2245 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2247 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
2252 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop-tt;
2253 arg1 = 1; arg2 = totarg;
2255 WantAddPointers(num);
2256 f = fun+FUNHEAD; n = 1; i = 0;
2257 while ( n < arg1 ) { n++; f++; }
2259 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; f++; }
2265 infostop = info + *info;
2267 if ( *info > totarg )
return(0);
2268 tt = AT.pWorkSpace[AT.pWorkPointer+*info];
2270 while ( info < infostop ) {
2271 if ( *info > totarg )
return(0);
2272 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = AT.pWorkSpace[AT.pWorkPointer+*info];
2275 AT.pWorkSpace[AT.pWorkPointer+info[-1]] = tt;
2280 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2282 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; *f2++= *f++; }
2288 MLOCK(ErrorMessageLock);
2290 MUNLOCK(ErrorMessageLock);
2299WORD RunReverse(PHEAD WORD *fun, WORD *args)
2301 WORD *tt, totarg, *tstop, arg1, arg2, n, num, i, *f, *f1, *f2, i1, i2;
2302 if ( *args != ARGRANGE ) {
2303 MLOCK(ErrorMessageLock);
2304 MesPrint(
"Illegal range encountered in RunReverse");
2305 MUNLOCK(ErrorMessageLock);
2308 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
2309 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2310 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2311 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2319 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2320 if ( arg2 > totarg )
return(0);
2323 WantAddPointers(num);
2324 f = fun+FUNHEAD; n = 1; i = 0;
2325 while ( n < arg1 ) { n++; NEXTARG(f) }
2327 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2330 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2331 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2332 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2335 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2337 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
2342 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop - tt;
2343 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2351 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2352 if ( arg2 > totarg )
return(0);
2355 WantAddPointers(num);
2356 f = fun+FUNHEAD; n = 1; i = 0;
2357 while ( n < arg1 ) { n++; f++; }
2359 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; f++; }
2362 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2363 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2364 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2367 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2369 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; *f2++ = *f++; }
2375 MLOCK(ErrorMessageLock);
2377 MUNLOCK(ErrorMessageLock);
2386WORD RunDedup(PHEAD WORD *fun, WORD *args)
2388 WORD *tt, totarg, *tstop, arg1, arg2, n, i, j,k, *f, *f1, *f2, *fd, *fstart;
2389 if ( *args != ARGRANGE ) {
2390 MLOCK(ErrorMessageLock);
2391 MesPrint(
"Illegal range encountered in RunDedup");
2392 MUNLOCK(ErrorMessageLock);
2395 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
2396 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2397 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2398 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2400 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2401 if ( arg2 > totarg )
return(0);
2403 f = fun+FUNHEAD; n = 1;
2404 while ( n < arg1 ) { n++; NEXTARG(f) }
2409 for (; n <= arg2; n++ ) {
2411 for ( j = 0; j < i; j++ ) {
2414 for ( k = 0; k < fd-f2; k++ )
2415 if ( f2[k] != f[k] )
break;
2417 if ( k == fd-f2 )
break;
2431 for (j = n; j <= totarg; j++) {
2438 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop - tt;
2439 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2441 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2442 if ( arg2 > totarg )
return(0);
2448 for (; n <= arg2; n++ ) {
2449 for ( j = arg1; j < i; j++ ) {
2450 if ( f[n-1] == f[j-1] )
break;
2461 for (j = n; j <= totarg; j++, i++) {
2465 fun[1] = f + i - 1 - fun;
2475WORD RunCycle(PHEAD WORD *fun, WORD *args, WORD *info)
2477 WORD *tt, totarg, *tstop, arg1, arg2, n, num, i, j, *f, *f1, *f2, x, ncyc, cc;
2478 if ( *args != ARGRANGE ) {
2479 MLOCK(ErrorMessageLock);
2480 MesPrint(
"Illegal range encountered in RunCycle");
2481 MUNLOCK(ErrorMessageLock);
2485 if ( ncyc >= MAXPOSITIVE2 ) {
2486 ncyc -= MAXPOSITIVE2;
2487 if ( ncyc >= MAXPOSITIVE4 ) {
2488 ncyc -= MAXPOSITIVE4;
2492 ncyc = DolToNumber(BHEAD ncyc);
2493 if ( AN.ErrorInDollar ) {
2494 MesPrint(
" Error in Dollar variable in transform,cycle()=$");
2497 if ( ncyc >= MAXPOSITIVE4 || ncyc <= -MAXPOSITIVE4 ) {
2498 MesPrint(
" Illegal value from Dollar variable in transform,cycle()=$");
2503 if ( functions[fun[0]-FUNCTION].spec != TENSORFUNCTION ) {
2504 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2505 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2506 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2507 if ( arg1 > arg2 ) { n = arg1; arg1 = arg2; arg2 = n; }
2508 if ( arg2 > totarg )
return(0);
2517 WantAddPointers(num);
2518 f = fun+FUNHEAD; n = 1; i = 0;
2519 while ( n < arg1 ) { n++; NEXTARG(f) }
2521 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2528 if ( x > i/2 ) x -= i;
2530 else if ( x <= -i ) {
2532 if ( x <= -i/2 ) x += i;
2536 tt = AT.pWorkSpace[AT.pWorkPointer+i-1];
2537 for ( j = i-1; j > 0; j-- )
2538 AT.pWorkSpace[AT.pWorkPointer+j] = AT.pWorkSpace[AT.pWorkPointer+j-1];
2539 AT.pWorkSpace[AT.pWorkPointer] = tt;
2543 tt = AT.pWorkSpace[AT.pWorkPointer];
2544 for ( j = 1; j < i; j++ )
2545 AT.pWorkSpace[AT.pWorkPointer+j-1] = AT.pWorkSpace[AT.pWorkPointer+j];
2546 AT.pWorkSpace[AT.pWorkPointer+j-1] = tt;
2553 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2555 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
2560 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = tstop - tt;
2561 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2562 if ( arg1 > arg2 ) { n = arg1; arg1 = arg2; arg2 = n; }
2563 if ( arg2 > totarg )
return(0);
2572 WantAddPointers(num);
2573 f = fun+FUNHEAD; n = 1; i = 0;
2574 while ( n < arg1 ) { n++; f++; }
2576 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; f++; }
2583 if ( x > i/2 ) x -= i;
2585 else if ( x <= -i ) {
2587 if ( x <= -i/2 ) x += i;
2591 tt = AT.pWorkSpace[AT.pWorkPointer+i-1];
2592 for ( j = i-1; j > 0; j-- )
2593 AT.pWorkSpace[AT.pWorkPointer+j] = AT.pWorkSpace[AT.pWorkPointer+j-1];
2594 AT.pWorkSpace[AT.pWorkPointer] = tt;
2598 tt = AT.pWorkSpace[AT.pWorkPointer];
2599 for ( j = 1; j < i; j++ )
2600 AT.pWorkSpace[AT.pWorkPointer+j-1] = AT.pWorkSpace[AT.pWorkPointer+j];
2601 AT.pWorkSpace[AT.pWorkPointer+j-1] = tt;
2608 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
2610 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; *f2++ = *f++; }
2616 MLOCK(ErrorMessageLock);
2618 MUNLOCK(ErrorMessageLock);
2627WORD RunAddArg(PHEAD WORD *fun, WORD *args)
2629 WORD *tt, totarg, *tstop, arg1, arg2, n, num, *f, *f1, *f2;
2630 WORD scribble[10+ARGHEAD];
2632 if ( *args != ARGRANGE ) {
2633 MLOCK(ErrorMessageLock);
2634 MesPrint(
"Illegal range encountered in RunAddArg");
2635 MUNLOCK(ErrorMessageLock);
2638 if ( functions[fun[0]-FUNCTION].spec == TENSORFUNCTION ) {
2639 MLOCK(ErrorMessageLock);
2640 MesPrint(
"Illegal attempt to add arguments of a tensor in AddArg");
2641 MUNLOCK(ErrorMessageLock);
2644 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2645 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2646 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2657 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2658 if ( arg2 > totarg )
return(0);
2660 if ( num == 1 )
return(0);
2661 f = fun+FUNHEAD; n = 1;
2662 while ( n < arg1 ) { n++; NEXTARG(f) }
2665 while ( n <= arg2 ) {
2667 f2 = f + *f; f += ARGHEAD;
2668 while ( f < f2 ) {
StoreTerm(BHEAD f); f += *f; }
2670 else if ( *f == -SNUMBER && f[1] == 0 ) {
2674 ToGeneral(f,scribble,1);
2680 if (
EndSort(BHEAD tstop+ARGHEAD,0) )
return(-1);
2683 while ( *f2 ) { f2 += *f2; num++; }
2685 for ( n = 1; n < ARGHEAD; n++ ) tstop[n] = 0;
2686 if ( num == 1 && ToFast(tstop,tstop) == 1 ) {
2687 f2 = tstop; NEXTARG(f2);
2689 if ( *tstop == ARGHEAD ) {
2690 *tstop = -SNUMBER; tstop[1] = 0;
2696 while ( f < tstop ) *f2++ = *f++;
2697 while ( f < f2 ) *f1++ = *f++;
2699 if ( (space+8)*
sizeof(WORD) > (UWORD)AM.MaxTer ) {
2700 MLOCK(ErrorMessageLock);
2702 MUNLOCK(ErrorMessageLock);
2705 fun[1] = (WORD)space;
2714WORD RunMulArg(PHEAD WORD *fun, WORD *args)
2716 WORD *t, totarg, *tstop, arg1, arg2, n, *f, nb, *m, i, *w;
2717 WORD *scratch, argbuf[20], argsize, *where, *newterm;
2718 LONG oldcpointer_pos;
2719 CBUF *C = cbuf + AT.ebufnum;
2720 if ( *args != ARGRANGE ) {
2721 MLOCK(ErrorMessageLock);
2722 MesPrint(
"Illegal range encountered in RunMulArg");
2723 MUNLOCK(ErrorMessageLock);
2726 if ( functions[fun[0]-FUNCTION].spec == TENSORFUNCTION ) {
2727 MLOCK(ErrorMessageLock);
2728 MesPrint(
"Illegal attempt to multiply arguments of a tensor in MulArg");
2729 MUNLOCK(ErrorMessageLock);
2732 t = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2733 while ( t < tstop ) { totarg++; NEXTARG(t); }
2734 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2735 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
2736 if ( arg1 > totarg )
return(0);
2737 if ( arg2 < 1 )
return(0);
2738 if ( arg1 < 1 ) arg1 = 1;
2739 if ( arg2 > totarg ) arg2 = totarg;
2740 if ( arg1 == arg2 )
return(0);
2748 f = fun+FUNHEAD; n = 1;
2749 while ( n < arg1 ) { n++; NEXTARG(f) }
2751 if ( fun >= AT.WorkSpace && fun < AT.WorkTop ) {
2752 if ( AT.WorkPointer < fun+fun[1] ) AT.WorkPointer = fun+fun[1];
2754 scratch = AT.WorkPointer;
2758 while ( n <= arg2 ) {
2760 argsize = *t - ARGHEAD; where = t + ARGHEAD; t += *t;
2762 else if ( *t <= -FUNCTION ) {
2763 argbuf[0] = FUNHEAD+4; argbuf[1] = -*t++; argbuf[2] = FUNHEAD;
2764 for ( i = 2; i < FUNHEAD; i++ ) argbuf[i+1] = 0;
2765 argbuf[FUNHEAD+1] = 1;
2766 argbuf[FUNHEAD+2] = 1;
2767 argbuf[FUNHEAD+3] = 3;
2768 argsize = argbuf[0];
2771 else if ( *t == -SYMBOL ) {
2772 argbuf[0] = 8; argbuf[1] = SYMBOL; argbuf[2] = 4;
2773 argbuf[3] = t[1]; argbuf[4] = 1;
2774 argbuf[5] = 1; argbuf[6] = 1; argbuf[7] = 3;
2775 argsize = 8; t += 2;
2778 else if ( *t == -VECTOR || *t == -MINVECTOR ) {
2779 argbuf[0] = 7; argbuf[1] = INDEX; argbuf[2] = 3;
2781 argbuf[4] = 1; argbuf[5] = 1;
2782 if ( *t == -MINVECTOR ) argbuf[6] = -3;
2784 argsize = 7; t += 2;
2787 else if ( *t == -INDEX ) {
2788 argbuf[0] = 7; argbuf[1] = INDEX; argbuf[2] = 3;
2790 argbuf[4] = 1; argbuf[5] = 1; argbuf[6] = 3;
2791 argsize = 7; t += 2;
2794 else if ( *t == -SNUMBER ) {
2796 argbuf[0] = 4; argbuf[1] = -t[1]; argbuf[2] = 1; argbuf[3] = -3;
2799 argbuf[0] = 4; argbuf[1] = t[1]; argbuf[2] = 1; argbuf[3] = 3;
2801 argsize = 4; t += 2;
2811 m =
AddRHS(AT.ebufnum,1);
2813 for ( i = 0; i < argsize; i++ ) m[i] = where[i];
2817 *w++ = SUBEXPRESSION; *w++ = SUBEXPSIZE; *w++ = C->numrhs; *w++ = 1;
2818 *w++ = AT.ebufnum; FILLSUB(w);
2820 *w++ = 1; *w++ = 1; *w++ = 3;
2821 *scratch = w-scratch;
2825 newterm = AT.WorkPointer;
2826 EndSort(BHEAD newterm+ARGHEAD,0);
2829 w = newterm+ARGHEAD;
while ( *w ) w += *w;
2830 *newterm = w-newterm; newterm[1] = 0;
2831 if ( ToFast(newterm,newterm) ) {
2832 if ( *newterm <= -FUNCTION ) w = newterm+1;
2835 while ( t < tstop ) *w++ = *t++;
2837 t = newterm; NCOPY(f,t,i);
2839 AT.WorkPointer = scratch;
2840 if ( AT.WorkPointer > AT.WorkSpace && AT.WorkPointer < f ) AT.WorkPointer = f;
2853WORD RunIsLyndon(PHEAD WORD *fun, WORD *args,
int par)
2855 WORD *tt, totarg, *tstop, arg1, arg2, arg, num, *f, n, i;
2857 WORD sign, i1, i2, retval;
2858 if ( fun[0] <= GAMMASEVEN && fun[0] >= GAMMA )
return(0);
2859 if ( *args != ARGRANGE ) {
2860 MLOCK(ErrorMessageLock);
2861 MesPrint(
"Illegal range encountered in RunIsLyndon");
2862 MUNLOCK(ErrorMessageLock);
2865 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2866 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2867 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2868 if ( arg1 > totarg || arg2 > totarg )
return(-1);
2872 if ( arg1 == arg2 )
return(1);
2873 if ( arg2 < arg1 ) {
2874 arg = arg1; arg1 = arg2; arg2 = arg; sign = 1;
2879 WantAddPointers(num);
2880 f = fun+FUNHEAD; n = 1; i = 0;
2881 while ( n < arg1 ) { n++; NEXTARG(f) }
2883 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2890 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2891 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2892 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2900 for ( i1 = 1; i1 < num; i1++ ) {
2901 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+i1],
2902 AT.pWorkSpace[AT.pWorkPointer]);
2903 if ( retval > 0 )
continue;
2904 if ( retval < 0 )
return(0);
2905 for ( i2 = 1; i2 < num; i2++ ) {
2906 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+(i1+i2)%num],
2907 AT.pWorkSpace[AT.pWorkPointer+i2]);
2908 if ( retval < 0 )
return(0);
2909 if ( retval > 0 )
goto nexti1;
2931WORD RunToLyndon(PHEAD WORD *fun, WORD *args,
int par)
2933 WORD *tt, totarg, *tstop, arg1, arg2, arg, num, *f, *f1, *f2, n, i;
2934 WORD sign, i1, i2, retval, unique;
2935 if ( fun[0] <= GAMMASEVEN && fun[0] >= GAMMA )
return(0);
2936 if ( *args != ARGRANGE ) {
2937 MLOCK(ErrorMessageLock);
2938 MesPrint(
"Illegal range encountered in RunToLyndon");
2939 MUNLOCK(ErrorMessageLock);
2942 tt = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
2943 while ( tt < tstop ) { totarg++; NEXTARG(tt); }
2944 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
2945 if ( arg1 > totarg || arg2 > totarg )
return(-1);
2949 if ( arg1 == arg2 )
return(1);
2950 if ( arg2 < arg1 ) {
2951 arg = arg1; arg1 = arg2; arg2 = arg; sign = 1;
2956 WantAddPointers((2*num));
2957 f = fun+FUNHEAD; n = 1; i = 0;
2958 while ( n < arg1 ) { n++; NEXTARG(f) }
2960 while ( n <= arg2 ) { AT.pWorkSpace[AT.pWorkPointer+i++] = f; n++; NEXTARG(f) }
2967 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
2968 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
2969 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
2978 for ( i1 = 1; i1 < num; i1++ ) {
2979 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+i1],
2980 AT.pWorkSpace[AT.pWorkPointer]);
2981 if ( retval > 0 )
continue;
2987 for ( i2 = 0; i2 < num; i2++ ) {
2988 AT.pWorkSpace[AT.pWorkPointer+num+i2] =
2989 AT.pWorkSpace[AT.pWorkPointer+(i1+i2)%num];
2991 for ( i2 = 0; i2 < num; i2++ ) {
2992 AT.pWorkSpace[AT.pWorkPointer+i2] =
2993 AT.pWorkSpace[AT.pWorkPointer+i2+num];
2998 for ( i2 = 1; i2 < num; i2++ ) {
2999 retval = par * CompArg(AT.pWorkSpace[AT.pWorkPointer+(i1+i2)%num],
3000 AT.pWorkSpace[AT.pWorkPointer+i2]);
3001 if ( retval < 0 )
goto Rotate;
3002 if ( retval > 0 )
goto nexti1;
3013 tt = AT.pWorkSpace[AT.pWorkPointer+i1];
3014 AT.pWorkSpace[AT.pWorkPointer+i1] = AT.pWorkSpace[AT.pWorkPointer+i2];
3015 AT.pWorkSpace[AT.pWorkPointer+i2] = tt;
3022 if ( tstop+(f-f1) > AT.WorkTop )
goto OverWork;
3024 for ( i = 0; i < num; i++ ) { f = AT.pWorkSpace[AT.pWorkPointer+i]; COPY1ARG(f2,f) }
3032 MLOCK(ErrorMessageLock);
3034 MUNLOCK(ErrorMessageLock);
3043WORD RunDropArg(PHEAD WORD *fun, WORD *args)
3045 WORD *t, *tstop, *f, totarg, arg1, arg2, n;
3047 t = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
3048 while ( t < tstop ) { totarg++; NEXTARG(t); }
3049 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
3050 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
3051 if ( arg1 > totarg )
return(0);
3052 if ( arg2 < 1 )
return(0);
3053 if ( arg1 < 1 ) arg1 = 1;
3054 if ( arg2 > totarg ) arg2 = totarg;
3055 f = fun+FUNHEAD; n = 1;
3056 while ( n < arg1 ) { n++; NEXTARG(f) }
3058 while ( n <= arg2 ) { n++; NEXTARG(t) }
3059 while ( t < tstop ) *f++ = *t++;
3069WORD RunSelectArg(PHEAD WORD *fun, WORD *args)
3071 WORD *t, *tstop, *f, *tt, totarg, arg1, arg2, n;
3073 t = fun+FUNHEAD; tstop = fun+fun[1]; totarg = 0;
3074 while ( t < tstop ) { totarg++; NEXTARG(t); }
3075 if ( FindRange(BHEAD args,&arg1,&arg2,totarg) )
return(-1);
3076 if ( arg2 < arg1 ) { n = arg1; arg1 = arg2; arg2 = n; }
3077 if ( arg1 > totarg )
return(0);
3078 if ( arg2 < 1 )
return(0);
3079 if ( arg1 < 1 ) arg1 = 1;
3080 if ( arg2 > totarg ) arg2 = totarg;
3081 f = fun+FUNHEAD; n = 1; t = f;
3082 while ( n < arg1 ) { n++; NEXTARG(t) }
3083 while ( n <= arg2 ) {
3085 while ( t < tt ) *f++ = *t++;
3107int TestArgNum(
int n,
int totarg, WORD *args)
3116 if ( n == args[1] )
return(1);
3117 if ( args[1] >= MAXPOSITIVE4 ) {
3118 x1 = args[1]-MAXPOSITIVE4;
3119 if ( totarg-x1 == n )
return(1);
3124 if ( args[1] >= MAXPOSITIVE2 ) {
3125 x1 = args[1] - MAXPOSITIVE2;
3126 if ( x1 > MAXPOSITIVE4 ) {
3127 x1 = x1 - MAXPOSITIVE4;
3128 x1 = DolToNumber(BHEAD x1);
3132 x1 = DolToNumber(BHEAD x1);
3135 else if ( args[1] >= MAXPOSITIVE4 ) {
3136 x1 = totarg-(args[1]-MAXPOSITIVE4);
3139 if ( args[2] >= MAXPOSITIVE2 ) {
3140 x2 = args[2] - MAXPOSITIVE2;
3141 if ( x2 > MAXPOSITIVE4 ) {
3142 x2 = x2 - MAXPOSITIVE4;
3143 x2 = DolToNumber(BHEAD x2);
3147 x2 = DolToNumber(BHEAD x2);
3150 else if ( args[2] >= MAXPOSITIVE4 ) {
3151 x2 = totarg-(args[2]-MAXPOSITIVE4);
3155 if ( n >= x2 && n <= x1 )
return(1);
3158 if ( n >= x1 && n <= x2 )
return(1);
3176WORD PutArgInScratch(WORD *arg,UWORD *scrat)
3179 if ( *arg == -SNUMBER ) {
3180 scrat[0] = ABS(arg[1]);
3181 if ( arg[1] < 0 ) size = -1;
3186 if ( *t < 0 ) { i = ((-*t)-1)/2; size = -i; }
3187 else { i = ( *t -1)/2; size = i; }
3212UBYTE *ReadRange(UBYTE *s, WORD *out,
int par)
3214 UBYTE *in = s, *ss, c;
3218 if ( par == 0 && in[1] !=
'=' ) {
3219 MesPrint(
"&A range in this type of transform statement should be followed by an = sign");
3222 else if ( par == 1 && in[1] !=
',' && in[1] !=
'\0' ) {
3223 MesPrint(
"&A range in this type of transform statement should be followed by a comma or end-of-statement");
3226 else if ( par == 2 && in[1] !=
':' ) {
3227 MesPrint(
"&A range in this type of transform statement should be followed by a :");
3231 if ( FG.cTable[*s] == 0 ) {
3232 ss = s;
while ( FG.cTable[*s] == 0 ) s++;
3234 if ( StrICmp(ss,(UBYTE *)
"first") == 0 ) {
3238 else if ( StrICmp(ss,(UBYTE *)
"last") == 0 ) {
3244 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
3246 if ( ( x1 = GetDollar(ss) ) < 0 )
goto Error;
3252 while ( *s >=
'0' && *s <=
'9' ) {
3253 x1 = 10*x1 + *s++ -
'0';
3254 if ( x1 >= MAXPOSITIVE4 ) {
3255 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE4);
3262 else x1 = MAXPOSITIVE4;
3265 MesPrint(
"&Illegal keyword inside range specification");
3269 else if ( FG.cTable[*s] == 1 ) {
3271 while ( *s >=
'0' && *s <=
'9' ) {
3272 x1 = x1*10 + *s++ -
'0';
3273 if ( x1 >= MAXPOSITIVE4 ) {
3274 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE4);
3279 else if ( *s ==
'$' ) {
3281 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
3283 if ( ( x1 = GetDollar(ss) ) < 0 )
goto Error;
3288 MesPrint(
"&Illegal character in range specification");
3292 MesPrint(
"&A range is two indicators, separated by a comma or blank");
3296 if ( FG.cTable[*s] == 0 ) {
3297 ss = s;
while ( FG.cTable[*s] == 0 ) s++;
3299 if ( StrICmp(ss,(UBYTE *)
"first") == 0 ) {
3303 else if ( StrICmp(ss,(UBYTE *)
"last") == 0 ) {
3309 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
3311 if ( ( x2 = GetDollar(ss) ) < 0 )
goto Error;
3317 while ( *s >=
'0' && *s <=
'9' ) {
3318 x2 = 10*x2 + *s++ -
'0';
3319 if ( x2 >= MAXPOSITIVE4 ) {
3320 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE4);
3327 else x2 = MAXPOSITIVE4;
3330 MesPrint(
"&Illegal keyword inside range specification");
3334 else if ( FG.cTable[*s] == 1 ) {
3336 while ( *s >=
'0' && *s <=
'9' ) {
3337 x2 = x2*10 + *s++ -
'0';
3338 if ( x2 >= MAXPOSITIVE4 ) {
3339 MesPrint(
"&Fixed range indicator bigger than %l",(LONG)MAXPOSITIVE4);
3344 else if ( *s ==
'$' ) {
3346 while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
3348 if ( ( x2 = GetDollar(ss) ) < 0 )
goto Error;
3353 MesPrint(
"&Illegal character in range specification");
3357 MesPrint(
"&A range is two indicators, separated by a comma or blank between parentheses");
3360 out[0] = x1; out[1] = x2;
3363 MesPrint(
"&Undefined variable $%s in range",ss);
3372int FindRange(PHEAD WORD *args, WORD *arg1, WORD *arg2, WORD totarg)
3374 WORD n[2], fromlast, i;
3375 for ( i = 0; i < 2; i++ ) {
3378 if ( n[i] >= MAXPOSITIVE2 ) {
3379 n[i] -= MAXPOSITIVE2;
3380 if ( n[i] >= MAXPOSITIVE4 ) {
3382 n[i] -= MAXPOSITIVE4;
3384 n[i] = DolToNumber(BHEAD n[i]);
3385 if ( AN.ErrorInDollar )
goto Error;
3386 if ( fromlast ) n[i] = totarg-n[i];
3388 else if ( n[i] >= MAXPOSITIVE4 ) { n[i] = totarg-(n[i]-MAXPOSITIVE4); }
3389 if ( n[i] <= 0 )
goto Error;
3395 MLOCK(ErrorMessageLock);
3396 MesPrint(
"Illegal $ value in range while executing transform statement.");
3397 MUNLOCK(ErrorMessageLock);
LONG EndSort(PHEAD WORD *, int)
WORD Generator(PHEAD WORD *, WORD)
WORD StoreTerm(PHEAD WORD *)