44 static 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}
66 int CoLocal(UBYTE *inp) {
return(DoExpr(inp,LOCALEXPRESSION,0)); }
73 int CoGlobal(UBYTE *inp) {
return(DoExpr(inp,GLOBALEXPRESSION,0)); }
80 int CoLocalFactorized(UBYTE *inp) {
return(DoExpr(inp,LOCALEXPRESSION,1)); }
87 int CoGlobalFactorized(UBYTE *inp) {
return(DoExpr(inp,GLOBALEXPRESSION,1)); }
96 int 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;
281 AT.WorkPointer = OldWork;
282 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
284 AC.ToBeInFactors = 0;
292 if ( ( q = SkipAName(inp) ) == 0 ) {
293 MesPrint(
"&Illegal name(s) for expression(s)");
297 if ( GetName(AC.exprnames,inp,&c2,NOAUTO) == NAMENOTFOUND ) {
298 MesPrint(
"&%s is not a valid expression",inp);
302 w = &(Expressions[c2].status);
303 if ( type == LOCALEXPRESSION ) {
305 case GLOBALEXPRESSION:
306 *w = LOCALEXPRESSION;
308 case SKIPGEXPRESSION:
309 *w = SKIPLEXPRESSION;
311 case DROPGEXPRESSION:
312 *w = DROPLEXPRESSION;
314 case HIDDENGEXPRESSION:
315 *w = HIDDENLEXPRESSION;
317 case HIDEGEXPRESSION:
318 *w = HIDELEXPRESSION;
320 case UNHIDEGEXPRESSION:
321 *w = UNHIDELEXPRESSION;
323 case INTOHIDEGEXPRESSION:
324 *w = INTOHIDELEXPRESSION;
326 case DROPHGEXPRESSION:
327 *w = DROPHLEXPRESSION;
331 else if ( type == GLOBALEXPRESSION ) {
333 case LOCALEXPRESSION:
334 *w = GLOBALEXPRESSION;
336 case SKIPLEXPRESSION:
337 *w = SKIPGEXPRESSION;
339 case DROPLEXPRESSION:
340 *w = DROPGEXPRESSION;
342 case HIDDENLEXPRESSION:
343 *w = HIDDENGEXPRESSION;
345 case HIDELEXPRESSION:
346 *w = HIDEGEXPRESSION;
348 case UNHIDELEXPRESSION:
349 *w = UNHIDEGEXPRESSION;
351 case INTOHIDELEXPRESSION:
352 *w = INTOHIDEGEXPRESSION;
354 case DROPHLEXPRESSION:
355 *w = DROPHGEXPRESSION;
366 }
while ( c ==
',' );
368 MesPrint(
"&Illegal object in local or global redefinition");
380 int CoIdOld(UBYTE *inp)
383 return(CoIdExpression(inp,TYPEIDOLD));
394 return(CoIdExpression(inp,TYPEIDNEW));
402 int CoIdNew(UBYTE *inp)
405 return(CoIdExpression(inp,TYPEIDNEW));
413 int CoDisorder(UBYTE *inp)
415 AC.idoption = SUBDISORDER;
416 return(CoIdExpression(inp,TYPEIDNEW));
424 int CoMany(UBYTE *inp)
426 AC.idoption = SUBMANY;
427 return(CoIdExpression(inp,TYPEIDNEW));
435 int CoMulti(UBYTE *inp)
437 AC.idoption = SUBMULTI;
438 return(CoIdExpression(inp,TYPEIDNEW));
446 int CoIfMatch(UBYTE *inp)
448 AC.idoption = SUBAFTER;
449 return(CoIdExpression(inp,TYPEIDNEW));
457 int CoIfNoMatch(UBYTE *inp)
459 AC.idoption = SUBAFTERNOT;
460 return(CoIdExpression(inp,TYPEIDNEW));
468 int CoOnce(UBYTE *inp)
470 AC.idoption = SUBONCE;
471 return(CoIdExpression(inp,TYPEIDNEW));
479 int CoOnly(UBYTE *inp)
481 AC.idoption = SUBONLY;
482 return(CoIdExpression(inp,TYPEIDNEW));
490 int CoSelect(UBYTE *inp)
492 AC.idoption = SUBSELECT;
493 return(CoIdExpression(inp,TYPEIDNEW));
503 int CoIdExpression(UBYTE *inp,
int type)
506 int i, j, idhead, error = 0, MinusSign = 0, opt, retcode;
507 WORD *w, *s, *m, *mm, *ww, *FirstWork, *OldWork, c1, numsets = 0,
508 oldnumrhs, *ow, oldEside;
510 CBUF *C = cbuf+AC.cbufnum;
512 FirstWork = OldWork = AT.WorkPointer;
523 *w++ = idhead + SUBEXPSIZE;
525 if ( idhead >= IDHEAD ) *w++ = -1;
527 for ( i = 4; i < idhead; i++ ) *w++ = 0;
529 while ( *inp ==
',' ) inp++;
531 if ( AC.idoption == SUBSELECT ) {
535 else if ( ( AC.idoption == SUBAFTER ) || ( AC.idoption == SUBAFTERNOT ) ) {
536 while ( *p && *p !=
'=' && *p !=
',' ) {
537 if ( *p ==
'(' ) SKIPBRA4(p)
538 else if ( *p ==
'{' ) SKIPBRA5(p)
539 else if ( *p ==
'[' ) SKIPBRA1(p)
542 if ( *p ==
'=' || *inp !=
'-' || inp[1] !=
'>' ) {
543 MesPrint(
"&Illegal use if if[no]match in id statement");
544 error = 1;
goto AllDone;
547 MesPrint(
"&id-statement without = sign");
548 error = 1;
goto AllDone;
554 while ( *p && *p !=
'=' && *p !=
',' ) {
555 if ( *p ==
'(' ) SKIPBRA4(p)
556 else if ( *p ==
'{' ) SKIPBRA5(p)
557 else if ( *p ==
'[' ) SKIPBRA1(p)
560 if ( *p ==
'=' )
break;
562 MesPrint(
"&id-statement without = sign");
563 error = 1;
goto AllDone;
569 while ( FG.cTable[*pp] == 0 ) pp++;
571 i =
sizeof(IdOptions)/
sizeof(
struct id_options);
573 if ( StrICmp(inp,IdOptions[i].name) == 0 )
break;
576 MesPrint(
"&Illegal option %s in id-statement",inp);
577 *pp = c; error = 1; p++; inp = p;
continue;
579 opt = IdOptions[i].code;
584 if ( pp != p )
goto IllField;
585 AC.idoption |= SUBDISORDER;
589 if ( p != pp )
goto IllField;
590 if ( ( AC.idoption & SUBMASK ) != 0 ) {
591 if ( AC.idoption == SUBMULTI && type == TYPEIF ) {}
593 MesPrint(
"&Conflicting options in id-statement");
604 while ( *p && *p !=
'=' && *p !=
',' ) {
605 if ( *p ==
'(' ) SKIPBRA4(p)
606 else if ( *p ==
'{' ) SKIPBRA5(p)
607 else if ( *p ==
'[' ) SKIPBRA1(p)
610 if ( *p ==
'=' )
break;
612 MesPrint(
"&id-statement without = sign");
613 error = 1;
goto AllDone;
619 if ( p[-1] !=
'}' ) {
621 MesPrint(
"&Illegal temporary set: %s",inp);
626 c = p[-1]; p[-1] = 0;
627 c1 = DoTempSet(inp,p-1);
631 if ( w[-1] < 0 ) error = 1;
636 if ( GetName(AC.varnames,inp,&c1,NOAUTO) != CSET ) {
637 MesPrint(
"&%s is not a set",inp);
641 if ( c1 < AM.NumFixedSets ) {
642 MesPrint(
"&Built in sets are not allowed in the select option");
645 else if ( Sets[c1].type == CRANGE ) {
646 MesPrint(
"&Ranged sets are not allowed in the select option");
660 for ( i = 0; i < idhead; i++ ) *w++ = FirstWork[i];
661 AC.idoption = SUBSELECT;
665 if ( type == TYPEIF ) {
666 MesPrint(
"&The if[no]match->label option is not allowed in an if statement");
667 error = 1;
goto AllDone;
669 if ( pp[0] !=
'-' || pp[1] !=
'>' )
goto IllField;
674 while ( FG.cTable[*pp] <= 1 ) pp++;
677 MesPrint(
"&Illegal label %s in if[no]match option of id-statement",inp);
678 *p = c; error = 1; inp = p+1;
continue;
681 OldWork[3] = GetLabel(inp);
687 if ( FG.cTable[*inp] == 1 ) {
688 while ( *inp >=
'0' && *inp <=
'9' ) x = 10*x+*inp++ -
'0';
692 while ( FG.cTable[*inp] == 0 ) inp++;
694 if ( StrICont(pp,(UBYTE *)
"normalize") != 0 )
goto IllOpt;
696 OldWork[4] |= NORMALIZEFLAG;
698 if ( *inp !=
')' || inp+1 != p ) {
701 MesPrint(
"&Illegal ALL option in id-statement: ",pp);
712 if ( x > MAXPOSITIVE ) {
713 MesPrint(
"&Requested maximum number of matches %l in ALL option in id-statement is greater than %l ",x,MAXPOSITIVE);
717 if ( type != TYPEIDNEW ) {
718 if ( type == TYPEIDOLD ) {
719 MesPrint(
"&Requested ALL option not allowed in idold/also statement.");
722 else if ( type == TYPEIF ) {
723 MesPrint(
"&Requested ALL option not allowed in if(match())");
727 MesPrint(
"&ALL option only allowed in regular id-statement.");
736 IllField: c = *p; *p = 0;
737 MesPrint(
"&Illegal optionfield %s in id-statement",inp);
738 *p = c; error = 1; inp = p+1;
continue;
740 i = AC.idoption & SUBMASK;
741 if ( i && i != opt ) {
742 MesPrint(
"&Conflicting options in id-statement");
745 else AC.idoption |= opt;
746 while ( *p ==
',' ) p++;
751 if ( ( AC.idoption & SUBMASK ) == 0 ) AC.idoption |= SUBMULTI;
752 OldWork[2] = AC.idoption;
758 *w++ = SUBEXPRESSION;
766 AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8;
770 ClearWildcardNames();
774 oldnumrhs = C->numrhs;
775 if ( ( retcode = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) { error = 1; }
776 else AC.ProtoType[2] = retcode;
779 if ( AC.NwildC &&
SortWild(w,AC.NwildC) ) error = 1;
783 OldWork[1] = AC.WildC-OldWork;
784 OldWork[idhead+1] = OldWork[1] - idhead;
787 s = C->
rhs[C->numrhs];
793 tw = AC.ProtoType; twstop = tw + tw[1]; tw += SUBEXPSIZE;
794 while ( tw < twstop ) {
795 if ( *tw == LOADDOLLAR ) {
809 if ( !error && *s == 0 ) {
810 IllLeft:MesPrint(
"&Illegal LHS");
814 if ( !error && *(s+*s) != 0 ) {
815 MesPrint(
"&LHS should be one term only");
820 if ( !error ) error = 1;
823 AN.RepPoint = AT.RepCount + 1;
824 ow = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
825 mm = s; ww = ow; i = *mm;
826 while ( --i >= 0 ) *ww++ = *mm++; AT.WorkPointer = ww;
827 AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
828 AR.Cnumlhs = C->numlhs;
836 if ( *w == 0 || *(w+*w) != 0 ) {
837 MesPrint(
"&LHS must be one term");
842 if ( AC.lhdollarflag ) MarkDirty(w,DIRTYFLAG);
844 AT.WorkPointer = w + *w;
853 C->numrhs = oldnumrhs;
857 AC.vectorlikeLHS = 0;
859 if ( m[2] != 3 || m[1] != 1 || *m != 1 ) {
860 if ( *m == 1 && m[1] == 1 && m[2] == -3 ) {
864 MesPrint(
"&Coefficient in LHS");
870 if ( *w == 7 && w[1] == INDEX && w[3] < 0 ) {
871 if ( ( AC.idoption & SUBMASK ) != 0 && ( AC.idoption & SUBMASK ) !=
873 MesPrint(
"&Illegal option for substitution of a vector");
876 AC.DumNum = AM.IndDum;
877 OldWork[2] = ( OldWork[2] - ( OldWork[2] & SUBMASK ) ) | SUBVECTOR;
882 *w++ = AC.DumNum + WILDOFFSET;
888 w[4] = AC.DumNum + WILDOFFSET;
889 OldWork[idhead+1] = w - OldWork - idhead;
890 AC.vectorlikeLHS = 1;
895 i = OldWork[2] & SUBMASK;
897 if ( i == 0 || i == SUBMULTI ) {
900 if ( *s == SYMBOL ) {
903 if ( ABS(s[1]) > 2*MAXPOWER ) {
904 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
911 else if ( *s == DOTPRODUCT ) {
914 if ( ABS(s[2]) > 2*MAXPOWER ) {
915 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
918 else if ( s[1] >= -(2*WILDOFFSET) || s[0] >= -(2*WILDOFFSET) ) {
919 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
927 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
932 if ( ( OldWork[2] & SUBMASK ) == 0 ) OldWork[2] |= SUBMULTI;
934 if ( ( OldWork[2] & SUBMASK ) == SUBSELECT ) {
944 s = FirstWork + idhead;
945 while ( --numsets >= 0 ) *m++ = *s++;
961 OldWork[1] = m - OldWork;
962 AC.ProtoType = OldWork+idhead;
964 if ( StudyPattern(OldWork) ) error = 1;
966 AT.WorkPointer = OldWork + OldWork[1];
967 if ( AC.lhdollarflag ) OldWork[4] |= DOLLARFLAG;
972 if ( type == TYPEIDOLD ) {
975 if ( C->
lhs[ci][0] == TYPEIDNEW ) {
976 if ( (C->
lhs[ci][2] & SUBMASK) == SUBALL ) {
977 MesPrint(
"&Idold/also cannot follow an id,all statement.");
982 else if ( C->
lhs[ci][0] == TYPEDETCURDUM ) { ci--;
continue; }
983 else if ( C->
lhs[ci][0] == TYPEIDOLD ) { ci--;
continue; }
987 MesPrint(
"&Idold/also should follow an id/idnew statement.");
994 if ( type != TYPEIF ) {
995 if ( ( retcode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
997 AC.ProtoType[2] = retcode;
1000 w = C->
rhs[retcode];
1001 while ( *w ) { w += *w; w[-1] = -w[-1]; }
1003 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
1009 if ( !error ) {
AddNtoL(OldWork[1],OldWork); }
1011 AC.lhdollarflag = 0;
1012 AT.WorkPointer = FirstWork;
1021 static WORD mularray[13] = { TYPEMULT, SUBEXPSIZE+3, 0, SUBEXPRESSION,
1022 SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
1024 int CoMultiply(UBYTE *inp)
1027 int error = 0, RetCode;
1029 while ( *inp ==
',' ) inp++;
1031 p = SkipField(inp,0);
1034 if ( StrICont(inp,(UBYTE *)
"left") == 0 ) mularray[2] = 1;
1035 else if ( StrICont(inp,(UBYTE *)
"right") == 0 ) mularray[2] = 0;
1037 MesPrint(
"&Illegal option in multiply statement or ; forgotten.");
1043 ClearWildcardNames();
1044 while ( *inp ==
',' ) inp++;
1045 AC.ProtoType = mularray+3;
1046 mularray[7] = AC.cbufnum;
1047 if ( ( RetCode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
1049 mularray[5] = RetCode;
1050 AddNtoL(SUBEXPSIZE+3,mularray);
1051 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
1063 int CoFill(UBYTE *inp)
1066 WORD error = 0, x, funnum, type, *oldwp = AT.WorkPointer;
1067 int i, oldcbufnum = AC.cbufnum, nofill = 0, numover, redef = 0;
1068 WORD *w, *wold, *Tprototype;
1069 UBYTE *p = inp, c, *inp1;
1071 LONG newreservation, sum = 0;
1072 UBYTE *p1, *p2, *p3, *p4, *fake = 0;
1074 if ( AC.exprfillwarning == 1 ) AC.exprfillwarning = 0;
1079 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1082 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,WITHAUTO) == NAMENOTFOUND )
1083 || ( T = functions[funnum].tabl ) == 0 || ( T->
numind > 0 && c !=
'(' ) ) {
1084 MesPrint(
"&%s should be a table with argument(s)",inp);
1093 MesPrint(
"&%s should be a table without arguments",inp);
1103 for ( sum = 0, i = 0, w = oldwp; i < T->
numind; i++ ) {
1104 ParseSignedNumber(x,p);
1105 if ( FG.cTable[p[-1]] != 1 || ( *p !=
',' && *p !=
')' ) ) {
1106 MesPrint(
"&Table arguments in fill statement should be numbers");
1109 if ( T->
sparse ) *w++ = x;
1110 else if ( x < T->mm[i].mini || x > T->
mm[i].
maxi ) {
1111 MesPrint(
"&Value %d for argument %d of table out of bounds",x,i+1);
1112 error = 1; nofill = 1;
1115 if ( *p ==
')' )
break;
1119 if ( *p !=
')' || i < ( T->
numind - 1 ) ) {
1120 MesPrint(
"&Incorrect number of table arguments in fill statement. Should be %d" 1122 error = 1; nofill = 1;
1125 if ( T->
sparse == 0 ) sum *= TABLEEXTENSION;
1129 i = FindTableTree(T,oldwp,1);
1132 if ( tablestub == 0 && ( ( T->
sparse & 2 ) == 2 ) && ( T->
mode != 0 )
1133 && ( AC.vetotablebasefill == 0 ) ) {
1137 functions[funnum].tabl = T = T->
spare;
1145 if ( T->
reserved == 0 ) newreservation = 20;
1153 while ( T->
totind >= newreservation && newreservation < MAXTABLECOMBUF )
1154 newreservation = 2*newreservation;
1155 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1156 if ( T->
totind >= newreservation ) {
1157 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1158 AC.cbufnum = oldcbufnum;
1161 wold = (WORD *)Malloc1(newreservation*
sizeof(WORD)*
1162 (T->
numind+TABLEEXTENSION),
"tablepointers");
1163 for ( i = T->
reserved*(T->
numind+TABLEEXTENSION)-1; i >= 0; i-- )
1170 for ( sum = T->
totind*(T->
numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1174 #if TABLEEXTENSION == 2 1187 if ( AC.vetofilling ) nofill = 1;
1189 Warning(
"Table element was already defined. New definition will be used");
1192 #if TABLEEXTENSION == 2 1202 if ( T->
numind ) { p++; }
1204 MesPrint(
"&Fill statement misses = sign after the table element");
1205 AC.cbufnum = oldcbufnum;
1206 AT.WorkPointer = oldwp;
1207 functions[funnum].tabl = oldT;
1210 if ( tablestub == 0 && T->
mode == 1 && AC.vetotablebasefill == 0 ) {
1218 numfake = (p4-T->
argtail)+(p3-p1)+10;
1220 fake = (UBYTE *)Malloc1(numfake*
sizeof(UBYTE),
"Fill fake rhs");
1222 *p++ =
't'; *p++ =
'b'; *p++ =
'l'; *p++ =
'_'; *p++ =
'(';
1223 p4 = p1;
while ( p4 < p2 ) *p++ = *p4++; *p++ =
',';
1224 p4 = p2+1;
while ( p4 < p3 ) *p++ = *p4++;
1227 while ( FG.cTable[*p4] == 1 ) p4++;
1229 if ( *p4 ==
'?' && p[-1] !=
',' ) {
1231 if ( FG.cTable[*p4] == 0 || *p4 ==
'$' || *p4 ==
'[' ) {
1237 else if ( *p4 ==
'{' ) {
1240 else if ( *p4 ) { *p++ = *p4++;
continue; }
1256 AC.tablefilling = funnum;
1258 p = SkipField(inp1,0);
1265 if ( ( i = CompileAlgebra(inp1,RHSIDE,Tprototype) ) < 0 ) { error = 1; i = 0; }
1272 if ( T->
sparse || c == 0 )
break;
1274 #if ( TABLEEXTENSION == 2 ) 1280 #if ( TABLEEXTENSION == 2 ) 1283 sum += TABLEEXTENSION-2;
1286 if ( AC.exprfillwarning == 1 ) {
1287 AC.exprfillwarning = 2;
1288 Warning(
"Use of expressions and/or $variables in Fill statements is potentially very dangerous.");
1290 AC.tablefilling = 0;
1291 if ( T->
sparse && c != 0 ) {
1292 MesPrint(
"&In sparse tables one can fill only one element at a time");
1295 else if ( numover ) {
1297 Warning(
"one element was overwritten. New definition will be used");
1298 else if ( AC.WarnFlag )
1299 MesPrint(
"&Warning: %d elements were overwritten. New definitions will be used",numover);
1302 if ( redef == 0 ) T->
totind++;
1310 M_free(fake,
"Fill fake rhs");
1312 functions[funnum].tabl = T = T->
spare;
1316 AC.cbufnum = oldcbufnum;
1317 AC.SymChangeFlag = 1;
1318 AT.WorkPointer = oldwp;
1319 functions[funnum].tabl = oldT;
1339 int CoFillExpression(UBYTE *inp)
1343 WORD type, funnum, expnum, symnum, numsym = 0, *oldwork = AT.WorkPointer;
1344 WORD *brackets, *term, brasize, *b, *m, *w, *pw, *tstop, zero = 0;
1345 WORD oldcbuf = AC.cbufnum, curelement = 0;
1346 int weneedit, i, j, numzero, pow;
1348 LONG newreservation, numcommu, sum;
1354 AN.IndDum = AM.IndDum;
1355 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1357 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1358 || ( T = functions[funnum].tabl ) == 0 ) {
1359 MesPrint(
"&%s should be a previously declared table",inp);
1366 MesPrint(
"&No = sign in FillExpression statement");
1370 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1372 if ( ( type = GetName(AC.exprnames,inp,&expnum,NOAUTO) ) == NAMENOTFOUND
1374 Expressions[expnum].status != LOCALEXPRESSION &&
1375 Expressions[expnum].status != SKIPLEXPRESSION &&
1376 Expressions[expnum].status != DROPLEXPRESSION &&
1377 Expressions[expnum].status != GLOBALEXPRESSION &&
1378 Expressions[expnum].status != SKIPGEXPRESSION &&
1379 Expressions[expnum].status != DROPGEXPRESSION ) ) {
1380 MesPrint(
"&%s should be an active expression with arguments",inp);
1383 if ( Expressions[expnum].inmem ) {
1384 MesPrint(
"&%s cannot be used in a FillExpression statement in the same %n\ 1385 module that it has been redefined",inp);
1391 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1394 if ( GetVar(inp,&type,&symnum,-1,NOAUTO) == NAMENOTFOUND ) {
1395 MesPrint(
"&%s should be a previously declared symbol or function",inp);
1398 else if ( type == CSYMBOL ) {
1400 *AT.WorkPointer++ = symnum;
1403 else if ( type == CFUNCTION ) {
1407 MesPrint(
"&Argument should be a single function or a list of symbols");
1411 *AT.WorkPointer++ = symnum;
1414 MesPrint(
"&%s should be a previously declared symbol or function",inp);
1443 if ( c ==
')' )
break;
1445 MesPrint(
"&Illegal separator in FillExpression statement");
1450 MesPrint(
"&Illegal end of FillExpression statement");
1460 if ( ( numsym > 0 ) && ( T->
numind != numsym ) ) {
1461 MesPrint(
"&This table needs %d symbols for its array indices");
1471 if ( PF.me == MASTER ) {
1476 SetEndScratch(AR.infile, &pos);
1481 PUTZERO(oldposition);
1482 SeekFile(fi->
handle,&oldposition,SEEK_CUR);
1483 SetScratch(fi,&(Expressions[expnum].onfile));
1485 if ( ISNEGPOS(Expressions[expnum].onfile) ) {
1486 MesPrint(
"&File error in FillExpression");
1496 SETBASEPOSITION(oldposition,(UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer));
1497 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(Expressions[expnum].onfile));
1499 pw = AT.WorkPointer;
1500 if ( numsym < 0 ) { brackets = pw + 1; }
1501 else { brackets = pw + numsym; }
1502 brasize = -1; weneedit = 0;
1503 term = (WORD *)(((UBYTE *)(brackets)) + AM.MaxTer);
1504 AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
1506 AC.tablefilling = funnum;
1507 if ( GetTerm(BHEAD term) > 0 ) {
1508 while ( GetTerm(BHEAD term) > 0 ) {
1509 GETSTOP(term,tstop);
1511 while ( m < tstop && *m != HAAKJE ) m += m[1];
1512 if ( *m != HAAKJE ) {
1513 MesPrint(
"&Illegal attempt to put an expression without brackets in a table");
1517 if ( brasize == m - w ) {
1519 while ( *b == *w && w < m ) { b++; w++; }
1523 *m = *term - (m-term);
1525 numdummies = DetCurDum(BHEAD term) - AM.IndDum;
1526 if ( numdummies > T->numdummies ) T->numdummies = numdummies;
1532 AddNtoC(AC.cbufnum,1,&zero,4);
1533 numcommu = numcommute(C->
rhs[curelement],&(C->
NumTerms[curelement]));
1534 C->
CanCommu[curelement] = numcommu;
1536 b = brackets; w = term + 1;
1537 if ( numsym < 0 ) pw = oldwork + 1;
1538 else pw = oldwork + numsym;
1539 while ( w < m ) *b++ = *w++;
1540 brasize = b - brackets;
1546 if ( *brackets != symnum || brasize != brackets[1] ) {
1547 weneedit = 0;
continue;
1552 b = brackets + FUNHEAD;
1553 bb = brackets+brackets[1];
1556 if ( *b != -SNUMBER )
break;
1560 if ( b < bb || i != T->numind ) {
1561 weneedit = 0;
continue;
1564 else if ( brasize > 0 && ( *brackets != SYMBOL
1565 || brackets[1] < brasize || (brackets[1]-2) > numsym*2 ) ) {
1566 weneedit = 0;
continue;
1568 numzero = 0; sum = 0;
1570 for ( i = 0; i < numsym; i++ ) {
1571 if ( brasize > 0 ) {
1572 b = brackets + 2; j = brackets[1]-2;
1574 if ( *b == oldwork[i] )
break;
1579 if ( 2*numzero+brackets[1]-2 > numsym*2 ) {
1580 weneedit = 0;
goto nextterm;
1586 if ( T->
sparse ) *pw++ = pow;
1587 else if ( pow < T->mm[i].mini || pow > T->
mm[i].
maxi ) {
1588 weneedit = 0;
goto nextterm;
1594 b = brackets + FUNHEAD;
1596 for ( i = 0; i < T->
numind; i++ ) {
1599 if ( T->
sparse ) { *pw++ = pow; }
1600 else if ( pow < T->mm[i].mini || pow > T->
mm[i].
maxi ) {
1601 weneedit = 0;
goto nextterm;
1608 if ( numsym < 0 ) pw = oldwork + 1;
1609 else pw = oldwork + T->
numind;
1610 i = FindTableTree(T,pw,1);
1620 if ( T->
reserved == 0 ) newreservation = 20;
1630 while ( T->
totind >= newreservation && newreservation < MAXTABLECOMBUF )
1631 newreservation = 2*newreservation;
1632 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1633 if ( T->
totind >= newreservation ) {
1634 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1635 AC.cbufnum = oldcbuf;
1636 AT.WorkPointer = oldwork;
1640 if ( T->
totind >= newreservation ) {
1641 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1642 AC.cbufnum = oldcbuf;
1643 AT.WorkPointer = oldwork;
1646 w = (WORD *)Malloc1(newreservation*
sizeof(WORD)*
1647 (T->
numind+TABLEEXTENSION),
"tablepointers");
1648 for ( i = T->
reserved*(T->
numind+TABLEEXTENSION)-1; i >= 0; i-- )
1654 if ( numsym < 0 ) pw = oldwork + 1;
1655 else pw = oldwork + numsym;
1656 for ( sum = T->
totind*(T->
numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1662 #if ( TABLEEXTENSION != 2 ) 1664 sum *= TABLEEXTENSION;
1672 #if ( TABLEEXTENSION == 2 ) 1681 newentry:
if ( *m == HAAKJE ) { m += m[1] - 1; }
1683 *m = *term - (m-term);
1689 AddNtoC(AC.cbufnum,1,&zero,6);
1690 numcommu = numcommute(C->
rhs[curelement],&(C->
NumTerms[curelement]));
1691 C->
CanCommu[curelement] = numcommu;
1695 SetScratch(fi,&(oldposition));
1698 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(oldposition));
1701 AC.cbufnum = oldcbuf;
1702 AC.tablefilling = 0;
1703 AT.WorkPointer = oldwork;
1707 AC.cbufnum = oldcbuf;
1708 AC.tablefilling = 0;
1709 AT.WorkPointer = oldwork;
1725 int CoPrintTable(UBYTE *inp)
1728 int fflag = 0, sflag = 0, addflag = 0, error = 0, sum, i, j;
1729 UBYTE *filename, *p, c, buffer[100], *s, *oldoutputline = AO.OutputLine;
1730 WORD type, funnum, *expr, *m, num;
1732 WORD oldSkip = AO.OutSkip, oldMode = AC.OutputMode, oldHandle = AC.LogHandle;
1733 WORD oldType = AO.PrintType, *oldwork = AT.WorkPointer;
1734 UBYTE *oldFill = AO.OutFill, *oldLine = AO.OutputLine;
1736 if ( PF.me != MASTER )
return 0;
1741 while ( *inp ==
'+' ) {
1743 if ( *inp ==
'f' || *inp ==
'F' ) { fflag = 1; inp++; }
1744 else if ( *inp ==
's' || *inp ==
'S' ) { sflag = PRINTONETERM; inp++; }
1746 MesPrint(
"&Illegal + option in PrintTable statement");
1749 while ( *inp !=
',' && *inp && *inp !=
'+' ) {
1752 MesPrint(
"&Illegal + option in PrintTable statement");
1756 MesPrint(
"&Unfinished PrintTable statement");
1763 if ( *inp ==
',' ) inp++;
1768 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1770 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1771 || ( T = functions[funnum].tabl ) == 0 ) {
1772 MesPrint(
"&%s should be a previously declared table",inp);
1782 if ( *p ==
'>' ) { addflag = 1; p++; }
1788 if ( addflag ) AC.LogHandle = OpenAddFile((
char *)filename);
1789 else AC.LogHandle = CreateFile((
char *)filename);
1790 if ( AC.LogHandle < 0 ) {
1791 MesPrint(
"&Cannot open file '%s' properly",filename);
1792 error = 1;
goto finally;
1794 AO.PrintType = PRINTLFILE;
1796 else if ( fflag && AC.LogHandle >= 0 ) {
1797 AO.PrintType = PRINTLFILE;
1799 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
1800 AT.WorkPointer += 2*AC.LineLength;
1802 AO.PrintType |= sflag;
1808 if ( AC.LogHandle == oldHandle ) FiniLine();
1809 AO.OutputLine = AO.OutFill = (UBYTE *)Malloc1(AC.LineLength+20,
"PrintTable");
1810 AO.OutStop = AO.OutFill + AC.LineLength;
1811 for ( i = 0; i < T->
totind; i++ ) {
1813 TokenToLine((UBYTE *)
"Fill ");
1814 TokenToLine((UBYTE *)(VARNAME(functions,funnum)));
1815 TokenToLine((UBYTE *)
"(");
1818 sum = i * ( T->
numind + TABLEEXTENSION );
1819 for ( j = 0; j < T->
numind; j++, sum++ ) {
1820 if ( j > 0 ) TokenToLine((UBYTE *)
",");
1822 s = buffer; s = NumCopy(num,s);
1823 TokenToLine(buffer);
1828 for ( j = 0; j < T->
numind; j++ ) {
1830 TokenToLine((UBYTE *)
",");
1836 s = buffer; s = NumCopy(num,s);
1837 TokenToLine(buffer);
1841 TOKENTOLINE(
") =",
")=");
1844 if ( AC.OutputSpaces != NOSPACEFORMAT ) TokenToLine((UBYTE *)
" ");
1862 while ( *m ) m += *m;
1864 if ( WriteExpression(expr,(LONG)(m-expr)) ) { error = 1;
goto finally; }
1868 TokenToLine((UBYTE *)
"0");
1870 TokenToLine((UBYTE *)
";");
1873 M_free(AO.OutputLine,
"PrintTable");
1874 AO.OutputLine = AO.OutFill = oldoutputline;
1879 AO.OutSkip = oldSkip;
1880 AC.OutputMode = oldMode;
1881 AC.LogHandle = oldHandle;
1882 AO.PrintType = oldType;
1883 AO.OutFill = oldFill;
1884 AO.OutputLine = oldLine;
1885 AT.WorkPointer = oldwork;
1898 static WORD AssignLHS[14] = { TYPEASSIGN, 3+SUBEXPSIZE, 0,
1899 SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0,0,0,0,0 };
1901 int CoAssign(UBYTE *inp)
1903 int error = 0, retcode;
1906 if ( *inp !=
'$' ) {
1907 nolhs: MesPrint(
"&assign statement should have a dollar variable in the LHS");
1911 if ( FG.cTable[*inp] != 0 )
goto nolhs;
1912 while ( FG.cTable[*inp] < 2 ) inp++;
1913 if ( AP.PreAssignFlag == 2 ) {
1914 if ( *inp ==
'_' ) inp++;
1916 if ( ( *inp ==
',' && inp[1] !=
'=' ) && ( *inp !=
'=' ) ) {
1917 MesPrint(
"&assign statement should have only a dollar variable in the LHS");
1922 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
1923 number = AddDollar(name,DOLUNDEFINED,0,0);
1926 if ( c ==
',' ) inp++;
1928 if ( *inp ==
',' ) inp++;
1932 AssignLHS[7] = AC.cbufnum;
1933 retcode = CompileAlgebra(inp,RHSIDE,(AssignLHS+3));
1934 if ( retcode < 0 ) error = 1;
1939 AssignLHS[2] = number;
1940 AssignLHS[5] = retcode;
1941 AddNtoL(AssignLHS[1],AssignLHS);
1959 int CoDeallocateTable(UBYTE *inp)
1963 WORD type, funnum, i;
1966 while ( *inp ==
',' ) inp++;
1967 if ( *inp == 0 )
break;
1968 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1970 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1971 || ( T = functions[funnum].tabl ) == 0 ) {
1972 MesPrint(
"&%s should be a previously declared table",inp);
1976 MesPrint(
"&%s should be a sparse table",inp);
void AddPotModdollar(WORD)
int PF_BroadcastExpr(EXPRESSIONS e, FILEHANDLE *file)
WORD SortWild(WORD *, WORD)
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
WORD Generator(PHEAD WORD *, WORD)
WORD FlushOut(POSITION *, FILEHANDLE *, int)
LONG EndSort(PHEAD WORD *, int)