44static struct id_options {
49 {(UBYTE *)
"multi", SUBMULTI ,0}
50 ,{(UBYTE *)
"many", SUBMANY ,0}
51 ,{(UBYTE *)
"only", SUBONLY ,0}
52 ,{(UBYTE *)
"once", SUBONCE ,0}
53 ,{(UBYTE *)
"ifmatch", SUBAFTER ,0}
54 ,{(UBYTE *)
"ifnomatch", SUBAFTERNOT ,0}
55 ,{(UBYTE *)
"ifnotmatch", SUBAFTERNOT ,0}
56 ,{(UBYTE *)
"disorder", SUBDISORDER ,0}
57 ,{(UBYTE *)
"select", SUBSELECT ,0}
58 ,{(UBYTE *)
"all", SUBALL ,0}
66int CoLocal(UBYTE *inp) {
return(DoExpr(inp,LOCALEXPRESSION,0)); }
73int CoGlobal(UBYTE *inp) {
return(DoExpr(inp,GLOBALEXPRESSION,0)); }
80int CoLocalFactorized(UBYTE *inp) {
return(DoExpr(inp,LOCALEXPRESSION,1)); }
87int CoGlobalFactorized(UBYTE *inp) {
return(DoExpr(inp,GLOBALEXPRESSION,1)); }
96int DoExpr(UBYTE *inp,
int type,
int par)
101 WORD *w, i, j = 0, c1, c2, *OldWork = AT.WorkPointer, osize;
104 while ( *inp ==
',' ) inp++;
105 if ( par ) AC.ToBeInFactors = 1;
106 else AC.ToBeInFactors = 0;
108 while ( *p && *p !=
'=' ) {
109 if ( *p ==
'(' ) SKIPBRA4(p)
110 else if ( *p ==
'{' ) SKIPBRA5(p)
111 else if ( *p ==
'[' ) SKIPBRA1(p)
115 if ( ( q = SkipAName(inp) ) == 0 || q[-1] ==
'_' ) {
116 MesPrint(
"&Illegal name for expression");
118 if ( q[-1] ==
'_' ) {
119 while ( FG.cTable[*q] < 2 || *q ==
'_' ) q++;
124 if ( GetVar(inp,&c1,&c2,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
125 if ( c1 == CEXPRESSION ) {
126 if ( Expressions[c2].status == STOREDEXPRESSION ) {
127 MesPrint(
"&Illegal attempt to overwrite a stored expression");
131 HighWarning(
"Expression is replaced by new definition");
132 if ( AO.OptimizeResult.nameofexpr != NULL &&
133 StrCmp(inp,AO.OptimizeResult.nameofexpr) == 0 ) {
136 if ( Expressions[c2].status != DROPPEDEXPRESSION ) {
137 w = &(Expressions[c2].status);
138 if ( *w == LOCALEXPRESSION || *w == SKIPLEXPRESSION )
139 *w = DROPLEXPRESSION;
140 else if ( *w == GLOBALEXPRESSION || *w == SKIPGEXPRESSION )
141 *w = DROPGEXPRESSION;
142 else if ( *w == HIDDENLEXPRESSION )
143 *w = DROPHLEXPRESSION;
144 else if ( *w == HIDDENGEXPRESSION )
145 *w = DROPHGEXPRESSION;
147 AC.TransEname = Expressions[c2].name;
148 j = EntVar(CEXPRESSION,0,type,0,0,0);
149 Expressions[j].node = Expressions[c2].node;
150 Expressions[c2].replace = j;
154 MesPrint(
"&name of expression is also name of a variable");
156 j = EntVar(CEXPRESSION,inp,type,0,0,0);
166 j = EntVar(CEXPRESSION,inp,type,0,0,0);
170 OldWork = w = AT.WorkPointer;
171 *w++ = TYPEEXPRESSION;
176 *w++ = SUBEXPRESSION;
184 while ( *q ==
',' || *q ==
'(' ) {
186 if ( ( q = SkipAName(inp) ) == 0 ) {
187 MesPrint(
"&Illegal name for expression argument");
193 if ( GetVar(inp,&c1,&c2,ALLVARIABLES,WITHAUTO) < 0 ) c1 = -1;
196 *w++ = SYMTOSYM; *w++ = 4; *w++ = c2; *w++ = 0;
199 *w++ = INDTOIND; *w++ = 4;
200 *w++ = c2 + AM.OffsetIndex; *w++ = 0;
203 *w++ = VECTOVEC; *w++ = 4;
204 *w++ = c2 + AM.OffsetVector; *w++ = 0;
207 *w++ = FUNTOFUN; *w++ = 4; *w++ = c2 + FUNCTION; *w++ = 0;
210 MesPrint(
"&Illegal expression parameter: %s",inp);
216 if ( *q !=
')' || q+1 != p ) {
217 MesPrint(
"&Illegal use of arguments for expression");
220 AC.ProtoType[1] = w - AC.ProtoType;
222 else if ( c !=
'=' ) {
226 MesPrint(
"&Illegal LHS for expression definition");
233 SeekScratch(AR.outfile,&pos);
234 Expressions[j].counter = 1;
235 Expressions[j].onfile = pos;
236 Expressions[j].whichbuffer = 0;
238 Expressions[j].partodo = AC.inparallelflag;
240 OldWork[2] = w - OldWork - 3;
249 ClearWildcardNames();
250 osize = AC.ProtoType[1]; AC.ProtoType[1] = SUBEXPSIZE;
252 if ( ( i = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) {
253 AC.ProtoType[1] = osize;
256 else if ( error == 0 ) {
257 AC.ProtoType[1] = osize;
259 if (
PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0 ) {
260 MesPrint(
"&Cannot create expression");
264 Expressions[j].sizeprototype = OldWork[2];
265 OldWork[2] = 4+SUBEXPSIZE;
266 OldWork[4] = SUBEXPSIZE;
268 OldWork[SUBEXPSIZE+3] = 1;
269 OldWork[SUBEXPSIZE+4] = 1;
270 OldWork[SUBEXPSIZE+5] = 3;
271 OldWork[SUBEXPSIZE+6] = 0;
272 if (
PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0
274 MesPrint(
"&Cannot create expression");
277 AR.outfile->POfull = AR.outfile->POfill;
285 AT.WorkPointer = OldWork;
286 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
288 AC.ToBeInFactors = 0;
296 if ( ( q = SkipAName(inp) ) == 0 ) {
297 MesPrint(
"&Illegal name(s) for expression(s)");
301 if ( GetName(AC.exprnames,inp,&c2,NOAUTO) == NAMENOTFOUND ) {
302 MesPrint(
"&%s is not a valid expression",inp);
306 w = &(Expressions[c2].status);
307 if ( type == LOCALEXPRESSION ) {
309 case GLOBALEXPRESSION:
310 *w = LOCALEXPRESSION;
312 case SKIPGEXPRESSION:
313 *w = SKIPLEXPRESSION;
315 case DROPGEXPRESSION:
316 *w = DROPLEXPRESSION;
318 case HIDDENGEXPRESSION:
319 *w = HIDDENLEXPRESSION;
321 case HIDEGEXPRESSION:
322 *w = HIDELEXPRESSION;
324 case UNHIDEGEXPRESSION:
325 *w = UNHIDELEXPRESSION;
327 case INTOHIDEGEXPRESSION:
328 *w = INTOHIDELEXPRESSION;
330 case DROPHGEXPRESSION:
331 *w = DROPHLEXPRESSION;
335 else if ( type == GLOBALEXPRESSION ) {
337 case LOCALEXPRESSION:
338 *w = GLOBALEXPRESSION;
340 case SKIPLEXPRESSION:
341 *w = SKIPGEXPRESSION;
343 case DROPLEXPRESSION:
344 *w = DROPGEXPRESSION;
346 case HIDDENLEXPRESSION:
347 *w = HIDDENGEXPRESSION;
349 case HIDELEXPRESSION:
350 *w = HIDEGEXPRESSION;
352 case UNHIDELEXPRESSION:
353 *w = UNHIDEGEXPRESSION;
355 case INTOHIDELEXPRESSION:
356 *w = INTOHIDEGEXPRESSION;
358 case DROPHLEXPRESSION:
359 *w = DROPHGEXPRESSION;
370 }
while ( c ==
',' );
372 MesPrint(
"&Illegal object in local or global redefinition");
384int CoIdOld(UBYTE *inp)
387 return(CoIdExpression(inp,TYPEIDOLD));
398 return(CoIdExpression(inp,TYPEIDNEW));
406int CoIdNew(UBYTE *inp)
409 return(CoIdExpression(inp,TYPEIDNEW));
417int CoDisorder(UBYTE *inp)
419 AC.idoption = SUBDISORDER;
420 return(CoIdExpression(inp,TYPEIDNEW));
428int CoMany(UBYTE *inp)
430 AC.idoption = SUBMANY;
431 return(CoIdExpression(inp,TYPEIDNEW));
439int CoMulti(UBYTE *inp)
441 AC.idoption = SUBMULTI;
442 return(CoIdExpression(inp,TYPEIDNEW));
450int CoIfMatch(UBYTE *inp)
452 AC.idoption = SUBAFTER;
453 return(CoIdExpression(inp,TYPEIDNEW));
461int CoIfNoMatch(UBYTE *inp)
463 AC.idoption = SUBAFTERNOT;
464 return(CoIdExpression(inp,TYPEIDNEW));
472int CoOnce(UBYTE *inp)
474 AC.idoption = SUBONCE;
475 return(CoIdExpression(inp,TYPEIDNEW));
483int CoOnly(UBYTE *inp)
485 AC.idoption = SUBONLY;
486 return(CoIdExpression(inp,TYPEIDNEW));
494int CoSelect(UBYTE *inp)
496 AC.idoption = SUBSELECT;
497 return(CoIdExpression(inp,TYPEIDNEW));
507int CoIdExpression(UBYTE *inp,
int type)
510 int i, j, idhead, error = 0, MinusSign = 0, opt, retcode;
511 WORD *w, *s, *m, *mm, *ww, *FirstWork, *OldWork, c1, numsets = 0,
512 oldnumrhs, *ow, oldEside;
514 CBUF *C = cbuf+AC.cbufnum;
516 FirstWork = OldWork = AT.WorkPointer;
527 *w++ = idhead + SUBEXPSIZE;
529 if ( idhead >= IDHEAD ) *w++ = -1;
531 for ( i = 4; i < idhead; i++ ) *w++ = 0;
533 while ( *inp ==
',' ) inp++;
535 if ( AC.idoption == SUBSELECT ) {
539 else if ( ( AC.idoption == SUBAFTER ) || ( AC.idoption == SUBAFTERNOT ) ) {
540 while ( *p && *p !=
'=' && *p !=
',' ) {
541 if ( *p ==
'(' ) SKIPBRA4(p)
542 else if ( *p ==
'{' ) SKIPBRA5(p)
543 else if ( *p ==
'[' ) SKIPBRA1(p)
546 if ( *p ==
'=' || *inp !=
'-' || inp[1] !=
'>' ) {
547 MesPrint(
"&Illegal use if if[no]match in id statement");
548 error = 1;
goto AllDone;
551 MesPrint(
"&id-statement without = sign");
552 error = 1;
goto AllDone;
558 while ( *p && *p !=
'=' && *p !=
',' ) {
559 if ( *p ==
'(' ) SKIPBRA4(p)
560 else if ( *p ==
'{' ) SKIPBRA5(p)
561 else if ( *p ==
'[' ) SKIPBRA1(p)
564 if ( *p ==
'=' )
break;
566 MesPrint(
"&id-statement without = sign");
567 error = 1;
goto AllDone;
573 while ( FG.cTable[*pp] == 0 ) pp++;
575 i =
sizeof(IdOptions)/
sizeof(
struct id_options);
577 if ( StrICmp(inp,IdOptions[i].name) == 0 )
break;
580 MesPrint(
"&Illegal option %s in id-statement",inp);
581 *pp = c; error = 1; p++; inp = p;
continue;
583 opt = IdOptions[i].code;
588 if ( pp != p )
goto IllField;
589 AC.idoption |= SUBDISORDER;
593 if ( p != pp )
goto IllField;
594 if ( ( AC.idoption & SUBMASK ) != 0 ) {
595 if ( AC.idoption == SUBMULTI && type == TYPEIF ) {}
597 MesPrint(
"&Conflicting options in id-statement");
608 while ( *p && *p !=
'=' && *p !=
',' ) {
609 if ( *p ==
'(' ) SKIPBRA4(p)
610 else if ( *p ==
'{' ) SKIPBRA5(p)
611 else if ( *p ==
'[' ) SKIPBRA1(p)
614 if ( *p ==
'=' )
break;
616 MesPrint(
"&id-statement without = sign");
617 error = 1;
goto AllDone;
623 if ( p[-1] !=
'}' ) {
625 MesPrint(
"&Illegal temporary set: %s",inp);
630 c = p[-1]; p[-1] = 0;
631 c1 = DoTempSet(inp,p-1);
635 if ( w[-1] < 0 ) error = 1;
640 if ( GetName(AC.varnames,inp,&c1,NOAUTO) != CSET ) {
641 MesPrint(
"&%s is not a set",inp);
645 if ( c1 < AM.NumFixedSets ) {
646 MesPrint(
"&Built in sets are not allowed in the select option");
649 else if ( Sets[c1].type == CRANGE ) {
650 MesPrint(
"&Ranged sets are not allowed in the select option");
664 for ( i = 0; i < idhead; i++ ) *w++ = FirstWork[i];
665 AC.idoption = SUBSELECT;
669 if ( type == TYPEIF ) {
670 MesPrint(
"&The if[no]match->label option is not allowed in an if statement");
671 error = 1;
goto AllDone;
673 if ( pp[0] !=
'-' || pp[1] !=
'>' )
goto IllField;
678 while ( FG.cTable[*pp] <= 1 ) pp++;
681 MesPrint(
"&Illegal label %s in if[no]match option of id-statement",inp);
682 *p = c; error = 1; inp = p+1;
continue;
685 OldWork[3] = GetLabel(inp);
691 if ( FG.cTable[*inp] == 1 ) {
692 while ( *inp >=
'0' && *inp <=
'9' ) x = 10*x+*inp++ -
'0';
696 while ( FG.cTable[*inp] == 0 ) inp++;
698 if ( StrICont(pp,(UBYTE *)
"normalize") != 0 )
goto IllOpt;
700 OldWork[4] |= NORMALIZEFLAG;
702 if ( *inp !=
')' || inp+1 != p ) {
705 MesPrint(
"&Illegal ALL option in id-statement: ",pp);
716 if ( x > MAXPOSITIVE ) {
717 MesPrint(
"&Requested maximum number of matches %l in ALL option in id-statement is greater than %l ",x,MAXPOSITIVE);
721 if ( type != TYPEIDNEW ) {
722 if ( type == TYPEIDOLD ) {
723 MesPrint(
"&Requested ALL option not allowed in idold/also statement.");
726 else if ( type == TYPEIF ) {
727 MesPrint(
"&Requested ALL option not allowed in if(match())");
731 MesPrint(
"&ALL option only allowed in regular id-statement.");
740IllField: c = *p; *p = 0;
741 MesPrint(
"&Illegal optionfield %s in id-statement",inp);
742 *p = c; error = 1; inp = p+1;
continue;
744 i = AC.idoption & SUBMASK;
745 if ( i && i != opt ) {
746 MesPrint(
"&Conflicting options in id-statement");
749 else AC.idoption |= opt;
750 while ( *p ==
',' ) p++;
755 if ( ( AC.idoption & SUBMASK ) == 0 ) AC.idoption |= SUBMULTI;
756 OldWork[2] = AC.idoption;
762 *w++ = SUBEXPRESSION;
770 AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8;
774 ClearWildcardNames();
778 oldnumrhs = C->numrhs;
779 if ( ( retcode = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) { error = 1; }
780 else AC.ProtoType[2] = retcode;
783 if ( AC.NwildC &&
SortWild(w,AC.NwildC) ) error = 1;
787 OldWork[1] = AC.WildC-OldWork;
788 OldWork[idhead+1] = OldWork[1] - idhead;
791 s = C->
rhs[C->numrhs];
797 tw = AC.ProtoType; twstop = tw + tw[1]; tw += SUBEXPSIZE;
798 while ( tw < twstop ) {
799 if ( *tw == LOADDOLLAR ) {
813 if ( !error && *s == 0 ) {
814IllLeft:MesPrint(
"&Illegal LHS");
818 if ( !error && *(s+*s) != 0 ) {
819 MesPrint(
"&LHS should be one term only");
823 WORD oldpolyfun = AR.PolyFun;
825 if ( !error ) error = 1;
828 AN.RepPoint = AT.RepCount + 1;
829 ow = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
830 mm = s; ww = ow; i = *mm;
831 while ( --i >= 0 ) *ww++ = *mm++; AT.WorkPointer = ww;
832 AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
833 AR.Cnumlhs = C->numlhs;
842 AR.PolyFun = oldpolyfun;
843 if ( *w == 0 || *(w+*w) != 0 ) {
844 MesPrint(
"&LHS must be one term");
849 if ( AC.lhdollarflag ) MarkDirty(w,DIRTYFLAG);
851 AT.WorkPointer = w + *w;
860 C->numrhs = oldnumrhs;
864 AC.vectorlikeLHS = 0;
866 if ( m[2] != 3 || m[1] != 1 || *m != 1 ) {
867 if ( *m == 1 && m[1] == 1 && m[2] == -3 ) {
871 MesPrint(
"&Coefficient in LHS");
877 if ( *w == 7 && w[1] == INDEX && w[3] < 0 ) {
878 if ( ( AC.idoption & SUBMASK ) != 0 && ( AC.idoption & SUBMASK ) !=
880 MesPrint(
"&Illegal option for substitution of a vector");
883 AC.DumNum = AM.IndDum;
884 OldWork[2] = ( OldWork[2] - ( OldWork[2] & SUBMASK ) ) | SUBVECTOR;
889 *w++ = AC.DumNum + WILDOFFSET;
895 w[4] = AC.DumNum + WILDOFFSET;
896 OldWork[idhead+1] = w - OldWork - idhead;
897 AC.vectorlikeLHS = 1;
902 i = OldWork[2] & SUBMASK;
904 if ( i == 0 || i == SUBMULTI ) {
907 if ( *s == SYMBOL ) {
910 if ( ABS(s[1]) > 2*MAXPOWER ) {
911 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
918 else if ( *s == DOTPRODUCT ) {
921 if ( ABS(s[2]) > 2*MAXPOWER ) {
922 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
925 else if ( s[1] >= -(2*WILDOFFSET) || s[0] >= -(2*WILDOFFSET) ) {
926 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
934 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
939 if ( ( OldWork[2] & SUBMASK ) == 0 ) OldWork[2] |= SUBMULTI;
941 if ( ( OldWork[2] & SUBMASK ) == SUBSELECT ) {
951 s = FirstWork + idhead;
952 while ( --numsets >= 0 ) *m++ = *s++;
968 OldWork[1] = m - OldWork;
969 AC.ProtoType = OldWork+idhead;
971 if ( StudyPattern(OldWork) ) error = 1;
973 AT.WorkPointer = OldWork + OldWork[1];
974 if ( AC.lhdollarflag ) OldWork[4] |= DOLLARFLAG;
979 if ( type == TYPEIDOLD ) {
982 if ( C->
lhs[ci][0] == TYPEIDNEW ) {
983 if ( (C->
lhs[ci][2] & SUBMASK) == SUBALL ) {
984 MesPrint(
"&Idold/also cannot follow an id,all statement.");
989 else if ( C->
lhs[ci][0] == TYPEDETCURDUM ) { ci--;
continue; }
990 else if ( C->
lhs[ci][0] == TYPEIDOLD ) { ci--;
continue; }
994 MesPrint(
"&Idold/also should follow an id/idnew statement.");
1001 if ( type != TYPEIF ) {
1002 if ( ( retcode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
1004 AC.ProtoType[2] = retcode;
1007 w = C->
rhs[retcode];
1008 while ( *w ) { w += *w; w[-1] = -w[-1]; }
1010 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
1016 if ( !error ) {
AddNtoL(OldWork[1],OldWork); }
1018 AC.lhdollarflag = 0;
1019 AT.WorkPointer = FirstWork;
1028static WORD mularray[13] = { TYPEMULT, SUBEXPSIZE+3, 0, SUBEXPRESSION,
1029 SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
1031int CoMultiply(UBYTE *inp)
1034 int error = 0, RetCode;
1036 while ( *inp ==
',' ) inp++;
1038 p = SkipField(inp,0);
1041 if ( StrICont(inp,(UBYTE *)
"left") == 0 ) mularray[2] = 1;
1042 else if ( StrICont(inp,(UBYTE *)
"right") == 0 ) mularray[2] = 0;
1044 MesPrint(
"&Illegal option in multiply statement or ; forgotten.");
1050 ClearWildcardNames();
1051 while ( *inp ==
',' ) inp++;
1052 AC.ProtoType = mularray+3;
1053 mularray[7] = AC.cbufnum;
1054 if ( ( RetCode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
1056 mularray[5] = RetCode;
1057 AddNtoL(SUBEXPSIZE+3,mularray);
1058 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
1070int CoFill(UBYTE *inp)
1073 WORD error = 0, x, funnum, type, *oldwp = AT.WorkPointer;
1074 int i, oldcbufnum = AC.cbufnum, nofill = 0, numover, redef = 0;
1075 WORD *w, *wold, *Tprototype;
1076 UBYTE *p = inp, c, *inp1;
1078 LONG newreservation, sum = 0;
1079 UBYTE *p1, *p2, *p3, *p4, *fake = 0;
1081 if ( AC.exprfillwarning == 1 ) AC.exprfillwarning = 0;
1086 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1089 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,WITHAUTO) == NAMENOTFOUND )
1090 || ( T = functions[funnum].tabl ) == 0 || ( T->
numind > 0 && c !=
'(' ) ) {
1091 MesPrint(
"&%s should be a table with argument(s)",inp);
1100 MesPrint(
"&%s should be a table without arguments",inp);
1110 for ( sum = 0, i = 0, w = oldwp; i < T->
numind; i++ ) {
1111 ParseSignedNumber(x,p);
1112 if ( FG.cTable[p[-1]] != 1 || ( *p !=
',' && *p !=
')' ) ) {
1113 MesPrint(
"&Table arguments in fill statement should be numbers");
1116 if ( T->
sparse ) *w++ = x;
1117 else if ( x < T->mm[i].mini || x > T->
mm[i].
maxi ) {
1118 MesPrint(
"&Value %d for argument %d of table out of bounds",x,i+1);
1119 error = 1; nofill = 1;
1122 if ( *p ==
')' )
break;
1126 if ( *p !=
')' || i < ( T->
numind - 1 ) ) {
1127 MesPrint(
"&Incorrect number of table arguments in fill statement. Should be %d"
1129 error = 1; nofill = 1;
1132 if ( T->
sparse == 0 ) sum *= TABLEEXTENSION;
1136 i = FindTableTree(T,oldwp,1);
1139 if ( tablestub == 0 && ( ( T->
sparse & 2 ) == 2 ) && ( T->
mode != 0 )
1140 && ( AC.vetotablebasefill == 0 ) ) {
1144 functions[funnum].tabl = T = T->
spare;
1152 if ( T->
reserved == 0 ) newreservation = 20;
1160 while ( T->
totind >= newreservation && newreservation < MAXTABLECOMBUF )
1161 newreservation = 2*newreservation;
1162 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1163 if ( T->
totind >= newreservation ) {
1164 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1165 AC.cbufnum = oldcbufnum;
1168 wold = (WORD *)Malloc1(newreservation*
sizeof(WORD)*
1169 (T->
numind+TABLEEXTENSION),
"tablepointers");
1170 for ( i = T->
reserved*(T->
numind+TABLEEXTENSION)-1; i >= 0; i-- )
1177 for ( sum = T->
totind*(T->
numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1181#if TABLEEXTENSION == 2
1194 if ( AC.vetofilling ) nofill = 1;
1196 Warning(
"Table element was already defined. New definition will be used");
1199#if TABLEEXTENSION == 2
1209 if ( T->
numind ) { p++; }
1211 MesPrint(
"&Fill statement misses = sign after the table element");
1212 AC.cbufnum = oldcbufnum;
1213 AT.WorkPointer = oldwp;
1214 functions[funnum].tabl = oldT;
1217 if ( tablestub == 0 && T->
mode == 1 && AC.vetotablebasefill == 0 ) {
1225 numfake = (p4-T->
argtail)+(p3-p1)+10;
1227 fake = (UBYTE *)Malloc1(numfake*
sizeof(UBYTE),
"Fill fake rhs");
1229 *p++ =
't'; *p++ =
'b'; *p++ =
'l'; *p++ =
'_'; *p++ =
'(';
1230 p4 = p1;
while ( p4 < p2 ) *p++ = *p4++; *p++ =
',';
1231 p4 = p2+1;
while ( p4 < p3 ) *p++ = *p4++;
1234 while ( FG.cTable[*p4] == 1 ) p4++;
1236 if ( *p4 ==
'?' && p[-1] !=
',' ) {
1238 if ( FG.cTable[*p4] == 0 || *p4 ==
'$' || *p4 ==
'[' ) {
1244 else if ( *p4 ==
'{' ) {
1247 else if ( *p4 ) { *p++ = *p4++;
continue; }
1265 AC.tablefilling = funnum;
1267 p = SkipField(inp1,0);
1274 if ( ( i = CompileAlgebra(inp1,RHSIDE,Tprototype) ) < 0 ) { error = 1; i = 0; }
1281 if ( T->
sparse || c == 0 )
break;
1283#if ( TABLEEXTENSION == 2 )
1289#if ( TABLEEXTENSION == 2 )
1292 sum += TABLEEXTENSION-2;
1295 if ( AC.exprfillwarning == 1 ) {
1296 AC.exprfillwarning = 2;
1297 Warning(
"Use of expressions and/or $variables in Fill statements is potentially very dangerous.");
1299 AC.tablefilling = 0;
1300 if ( T->
sparse && c != 0 ) {
1301 MesPrint(
"&In sparse tables one can fill only one element at a time");
1304 else if ( numover ) {
1306 Warning(
"one element was overwritten. New definition will be used");
1307 else if ( AC.WarnFlag )
1308 MesPrint(
"&Warning: %d elements were overwritten. New definitions will be used",numover);
1311 if ( redef == 0 ) T->
totind++;
1319 M_free(fake,
"Fill fake rhs");
1321 functions[funnum].tabl = T = T->
spare;
1325 AC.cbufnum = oldcbufnum;
1326 AC.SymChangeFlag = 1;
1327 AT.WorkPointer = oldwp;
1328 functions[funnum].tabl = oldT;
1348int CoFillExpression(UBYTE *inp)
1352 WORD type, funnum, expnum, symnum, numsym = 0, *oldwork = AT.WorkPointer;
1353 WORD *brackets, *term, brasize, *b, *m, *w, *pw, *tstop, zero = 0;
1354 WORD oldcbuf = AC.cbufnum, curelement = 0;
1355 int weneedit, i, j, numzero, pow;
1357 LONG newreservation, numcommu, sum;
1358 POSITION oldposition;
1363 AN.IndDum = AM.IndDum;
1364 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1366 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1367 || ( T = functions[funnum].tabl ) == 0 ) {
1368 MesPrint(
"&%s should be a previously declared table",inp);
1375 MesPrint(
"&No = sign in FillExpression statement");
1379 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1381 if ( ( type = GetName(AC.exprnames,inp,&expnum,NOAUTO) ) == NAMENOTFOUND
1383 Expressions[expnum].status != LOCALEXPRESSION &&
1384 Expressions[expnum].status != SKIPLEXPRESSION &&
1385 Expressions[expnum].status != DROPLEXPRESSION &&
1386 Expressions[expnum].status != GLOBALEXPRESSION &&
1387 Expressions[expnum].status != SKIPGEXPRESSION &&
1388 Expressions[expnum].status != DROPGEXPRESSION ) ) {
1389 MesPrint(
"&%s should be an active expression with arguments",inp);
1392 if ( Expressions[expnum].inmem ) {
1393 MesPrint(
"&%s cannot be used in a FillExpression statement in the same %n\
1394 module that it has been redefined",inp);
1400 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1403 if ( GetVar(inp,&type,&symnum,-1,NOAUTO) == NAMENOTFOUND ) {
1404 MesPrint(
"&%s should be a previously declared symbol or function",inp);
1407 else if ( type == CSYMBOL ) {
1409 *AT.WorkPointer++ = symnum;
1412 else if ( type == CFUNCTION ) {
1416 MesPrint(
"&Argument should be a single function or a list of symbols");
1420 *AT.WorkPointer++ = symnum;
1423 MesPrint(
"&%s should be a previously declared symbol or function",inp);
1452 if ( c ==
')' )
break;
1454 MesPrint(
"&Illegal separator in FillExpression statement");
1459 MesPrint(
"&Illegal end of FillExpression statement");
1469 if ( ( numsym > 0 ) && ( T->
numind != numsym ) ) {
1470 MesPrint(
"&This table needs %d symbols for its array indices");
1480 if ( PF.me == MASTER ) {
1485 SetEndScratch(AR.infile, &pos);
1490 PUTZERO(oldposition);
1491 SeekFile(fi->
handle,&oldposition,SEEK_CUR);
1492 SetScratch(fi,&(Expressions[expnum].onfile));
1494 if ( ISNEGPOS(Expressions[expnum].onfile) ) {
1495 MesPrint(
"&File error in FillExpression");
1505 SETBASEPOSITION(oldposition,(UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer));
1506 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(Expressions[expnum].onfile));
1508 pw = AT.WorkPointer;
1509 if ( numsym < 0 ) { brackets = pw + 1; }
1510 else { brackets = pw + numsym; }
1511 brasize = -1; weneedit = 0;
1512 term = (WORD *)(((UBYTE *)(brackets)) + AM.MaxTer);
1513 AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
1515 AC.tablefilling = funnum;
1516 if ( GetTerm(BHEAD term) > 0 ) {
1517 while ( GetTerm(BHEAD term) > 0 ) {
1518 GETSTOP(term,tstop);
1520 while ( m < tstop && *m != HAAKJE ) m += m[1];
1521 if ( *m != HAAKJE ) {
1522 MesPrint(
"&Illegal attempt to put an expression without brackets in a table");
1526 if ( brasize == m - w ) {
1528 while ( *b == *w && w < m ) { b++; w++; }
1532 *m = *term - (m-term);
1534 numdummies = DetCurDum(BHEAD term) - AM.IndDum;
1535 if ( numdummies > T->numdummies ) T->numdummies = numdummies;
1541 AddNtoC(AC.cbufnum,1,&zero,4);
1542 numcommu = numcommute(C->
rhs[curelement],&(C->
NumTerms[curelement]));
1543 C->
CanCommu[curelement] = numcommu;
1545 b = brackets; w = term + 1;
1546 if ( numsym < 0 ) pw = oldwork + 1;
1547 else pw = oldwork + numsym;
1548 while ( w < m ) *b++ = *w++;
1549 brasize = b - brackets;
1555 if ( *brackets != symnum || brasize != brackets[1] ) {
1556 weneedit = 0;
continue;
1561 b = brackets + FUNHEAD;
1562 bb = brackets+brackets[1];
1565 if ( *b != -SNUMBER )
break;
1569 if ( b < bb || i != T->numind ) {
1570 weneedit = 0;
continue;
1573 else if ( brasize > 0 && ( *brackets != SYMBOL
1574 || brackets[1] < brasize || (brackets[1]-2) > numsym*2 ) ) {
1575 weneedit = 0;
continue;
1577 numzero = 0; sum = 0;
1579 for ( i = 0; i < numsym; i++ ) {
1580 if ( brasize > 0 ) {
1581 b = brackets + 2; j = brackets[1]-2;
1583 if ( *b == oldwork[i] )
break;
1588 if ( 2*numzero+brackets[1]-2 > numsym*2 ) {
1589 weneedit = 0;
goto nextterm;
1595 if ( T->
sparse ) *pw++ = pow;
1596 else if ( pow < T->mm[i].mini || pow > T->
mm[i].
maxi ) {
1597 weneedit = 0;
goto nextterm;
1603 b = brackets + FUNHEAD;
1605 for ( i = 0; i < T->
numind; i++ ) {
1608 if ( T->
sparse ) { *pw++ = pow; }
1609 else if ( pow < T->mm[i].mini || pow > T->
mm[i].
maxi ) {
1610 weneedit = 0;
goto nextterm;
1617 if ( numsym < 0 ) pw = oldwork + 1;
1618 else pw = oldwork + T->
numind;
1619 i = FindTableTree(T,pw,1);
1629 if ( T->
reserved == 0 ) newreservation = 20;
1639 while ( T->
totind >= newreservation && newreservation < MAXTABLECOMBUF )
1640 newreservation = 2*newreservation;
1641 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1642 if ( T->
totind >= newreservation ) {
1643 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1644 AC.cbufnum = oldcbuf;
1645 AT.WorkPointer = oldwork;
1649 if ( T->
totind >= newreservation ) {
1650 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1651 AC.cbufnum = oldcbuf;
1652 AT.WorkPointer = oldwork;
1655 w = (WORD *)Malloc1(newreservation*
sizeof(WORD)*
1656 (T->
numind+TABLEEXTENSION),
"tablepointers");
1657 for ( i = T->
reserved*(T->
numind+TABLEEXTENSION)-1; i >= 0; i-- )
1663 if ( numsym < 0 ) pw = oldwork + 1;
1664 else pw = oldwork + numsym;
1665 for ( sum = T->
totind*(T->
numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1671#if ( TABLEEXTENSION != 2 )
1673 sum *= TABLEEXTENSION;
1681#if ( TABLEEXTENSION == 2 )
1690newentry:
if ( *m == HAAKJE ) { m += m[1] - 1; }
1692 *m = *term - (m-term);
1698 AddNtoC(AC.cbufnum,1,&zero,6);
1699 numcommu = numcommute(C->
rhs[curelement],&(C->
NumTerms[curelement]));
1700 C->
CanCommu[curelement] = numcommu;
1704 SetScratch(fi,&(oldposition));
1707 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(oldposition));
1710 AC.cbufnum = oldcbuf;
1711 AC.tablefilling = 0;
1712 AT.WorkPointer = oldwork;
1716 AC.cbufnum = oldcbuf;
1717 AC.tablefilling = 0;
1718 AT.WorkPointer = oldwork;
1734int CoPrintTable(UBYTE *inp)
1737 int fflag = 0, sflag = 0, addflag = 0, error = 0, sum, i, j;
1738 UBYTE *filename, *p, c, buffer[100], *s, *oldoutputline = AO.OutputLine;
1739 WORD type, funnum, *expr, *m, num;
1741 WORD oldSkip = AO.OutSkip, oldMode = AC.OutputMode, oldHandle = AC.LogHandle;
1742 WORD oldType = AO.PrintType, *oldwork = AT.WorkPointer;
1743 UBYTE *oldFill = AO.OutFill, *oldLine = AO.OutputLine;
1745 if ( PF.me != MASTER )
return 0;
1750 while ( *inp ==
'+' ) {
1752 if ( *inp ==
'f' || *inp ==
'F' ) { fflag = 1; inp++; }
1753 else if ( *inp ==
's' || *inp ==
'S' ) { sflag = PRINTONETERM; inp++; }
1755 MesPrint(
"&Illegal + option in PrintTable statement");
1758 while ( *inp !=
',' && *inp && *inp !=
'+' ) {
1761 MesPrint(
"&Illegal + option in PrintTable statement");
1765 MesPrint(
"&Unfinished PrintTable statement");
1772 if ( *inp ==
',' ) inp++;
1777 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1779 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1780 || ( T = functions[funnum].tabl ) == 0 ) {
1781 MesPrint(
"&%s should be a previously declared table",inp);
1791 if ( *p ==
'>' ) { addflag = 1; p++; }
1797 if ( addflag ) AC.LogHandle = OpenAddFile((
char *)filename);
1798 else AC.LogHandle = CreateFile((
char *)filename);
1799 if ( AC.LogHandle < 0 ) {
1800 MesPrint(
"&Cannot open file '%s' properly",filename);
1801 error = 1;
goto finally;
1803 AO.PrintType = PRINTLFILE;
1805 else if ( fflag && AC.LogHandle >= 0 ) {
1806 AO.PrintType = PRINTLFILE;
1808 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
1809 AT.WorkPointer += 2*AC.LineLength;
1811 AO.PrintType |= sflag;
1817 if ( AC.LogHandle == oldHandle ) FiniLine();
1818 AO.OutputLine = AO.OutFill = (UBYTE *)Malloc1(AC.LineLength+20,
"PrintTable");
1819 AO.OutStop = AO.OutFill + AC.LineLength;
1820 for ( i = 0; i < T->
totind; i++ ) {
1822 TokenToLine((UBYTE *)
"Fill ");
1823 TokenToLine((UBYTE *)(VARNAME(functions,funnum)));
1824 TokenToLine((UBYTE *)
"(");
1827 sum = i * ( T->
numind + TABLEEXTENSION );
1828 for ( j = 0; j < T->
numind; j++, sum++ ) {
1829 if ( j > 0 ) TokenToLine((UBYTE *)
",");
1831 s = buffer; s = NumCopy(num,s);
1832 TokenToLine(buffer);
1837 for ( j = 0; j < T->
numind; j++ ) {
1839 TokenToLine((UBYTE *)
",");
1845 s = buffer; s = NumCopy(num,s);
1846 TokenToLine(buffer);
1850 TOKENTOLINE(
") =",
")=");
1853 if ( AC.OutputSpaces != NOSPACEFORMAT ) TokenToLine((UBYTE *)
" ");
1871 while ( *m ) m += *m;
1873 if ( WriteExpression(expr,(LONG)(m-expr)) ) { error = 1;
goto finally; }
1877 TokenToLine((UBYTE *)
"0");
1879 TokenToLine((UBYTE *)
";");
1882 M_free(AO.OutputLine,
"PrintTable");
1883 AO.OutputLine = AO.OutFill = oldoutputline;
1888 AO.OutSkip = oldSkip;
1889 AC.OutputMode = oldMode;
1890 AC.LogHandle = oldHandle;
1891 AO.PrintType = oldType;
1892 AO.OutFill = oldFill;
1893 AO.OutputLine = oldLine;
1894 AT.WorkPointer = oldwork;
1907static WORD AssignLHS[14] = { TYPEASSIGN, 3+SUBEXPSIZE, 0,
1908 SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0,0,0,0,0 };
1910int CoAssign(UBYTE *inp)
1912 int error = 0, retcode;
1915 if ( *inp !=
'$' ) {
1916nolhs: MesPrint(
"&assign statement should have a dollar variable in the LHS");
1920 if ( FG.cTable[*inp] != 0 )
goto nolhs;
1921 while ( FG.cTable[*inp] < 2 ) inp++;
1922 if ( AP.PreAssignFlag == 2 ) {
1923 if ( *inp ==
'_' ) inp++;
1925 if ( ( *inp ==
',' && inp[1] !=
'=' ) && ( *inp !=
'=' ) ) {
1926 MesPrint(
"&assign statement should have only a dollar variable in the LHS");
1931 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
1932 number = AddDollar(name,DOLUNDEFINED,0,0);
1935 if ( c ==
',' ) inp++;
1937 if ( *inp ==
',' ) inp++;
1941 AssignLHS[7] = AC.cbufnum;
1942 retcode = CompileAlgebra(inp,RHSIDE,(AssignLHS+3));
1943 if ( retcode < 0 ) error = 1;
1948 AssignLHS[2] = number;
1949 AssignLHS[5] = retcode;
1950 AddNtoL(AssignLHS[1],AssignLHS);
1968int CoDeallocateTable(UBYTE *inp)
1972 WORD type, funnum, i;
1975 while ( *inp ==
',' ) inp++;
1976 if ( *inp == 0 )
break;
1977 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1979 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1980 || ( T = functions[funnum].tabl ) == 0 ) {
1981 MesPrint(
"&%s should be a previously declared table",inp);
1985 MesPrint(
"&%s should be a sparse table",inp);
void AddPotModdollar(WORD)
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
LONG EndSort(PHEAD WORD *, int)
WORD Generator(PHEAD WORD *, WORD)
WORD FlushOut(POSITION *, FILEHANDLE *, int)
WORD SortWild(WORD *, WORD)
int PF_BroadcastExpr(EXPRESSIONS e, FILEHANDLE *file)