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)
114 if ( *p ) { /* Variety with the = sign */
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);
162 Here we have to worry about reuse of the expression in the
163 same module. That will need AS.Oldvflags but that may not
164 be defined or have the proper value.
166 j = EntVar(CEXPRESSION,inp,type,0,0,0);
170 OldWork = w = AT.WorkPointer;
171 *w++ = TYPEEXPRESSION;
175 AR.CurExpr = j; /* Block expression j */
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 != '=
' ) {
224 The dummy accepted L F := RHS;
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;
243 Writing the expression prototype to disk and to the compiler
244 buffer is done only after the RHS has been compiled because
245 we don't know the number of the main level RHS yet.
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");
384 int CoIdOld(UBYTE *inp)
387 return(CoIdExpression(inp,TYPEIDOLD));
398 return(CoIdExpression(inp,TYPEIDNEW));
406 int CoIdNew(UBYTE *inp)
409 return(CoIdExpression(inp,TYPEIDNEW));
417 int CoDisorder(UBYTE *inp)
419 AC.idoption = SUBDISORDER;
420 return(CoIdExpression(inp,TYPEIDNEW));
428 int CoMany(UBYTE *inp)
430 AC.idoption = SUBMANY;
431 return(CoIdExpression(inp,TYPEIDNEW));
439 int CoMulti(UBYTE *inp)
441 AC.idoption = SUBMULTI;
442 return(CoIdExpression(inp,TYPEIDNEW));
450 int CoIfMatch(UBYTE *inp)
452 AC.idoption = SUBAFTER;
453 return(CoIdExpression(inp,TYPEIDNEW));
461 int CoIfNoMatch(UBYTE *inp)
463 AC.idoption = SUBAFTERNOT;
464 return(CoIdExpression(inp,TYPEIDNEW));
472 int CoOnce(UBYTE *inp)
474 AC.idoption = SUBONCE;
475 return(CoIdExpression(inp,TYPEIDNEW));
483 int CoOnly(UBYTE *inp)
485 AC.idoption = SUBONLY;
486 return(CoIdExpression(inp,TYPEIDNEW));
494 int CoSelect(UBYTE *inp)
496 AC.idoption = SUBSELECT;
497 return(CoIdExpression(inp,TYPEIDNEW));
507 int 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;
570 We have either a secondary option or a syntax error
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;
620 We have a set at inp.
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");
660 Now exchange the positions a bit.
661 Regular stuff at OldWork, numsets sets at FirstWork[idhead]
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;
674 pp += 2; /* points now at the label */
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);
714 Note that the following statement limits x to
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.");
740 IllField: 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;
758 Now we have a field till the = sign
759 Now the subexpression prototype
762 *w++ = SUBEXPRESSION;
770 AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8;
774 ClearWildcardNames();
775 oldcpointer = AddLHS(AC.cbufnum) - C->Buffer;
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;
785 /* Make the LHS pointers ready */
787 OldWork[1] = AC.WildC-OldWork;
788 OldWork[idhead+1] = OldWork[1] - idhead;
791 s = C->rhs[C->numrhs];
793 Now check whether wildcards get converted to dollars (for PARALLEL)
797 tw = AC.ProtoType; twstop = tw + tw[1]; tw += SUBEXPSIZE;
798 while ( tw < twstop ) {
799 if ( *tw == LOADDOLLAR ) {
800 AddPotModdollar(tw[2]);
806 We have the expression in the compiler buffers.
807 The main level is at lhs[numlhs]
808 The partial lhs (including ProtoType) is in OldWork (in WorkSpace)
809 We need to load the result at w after the prototype
810 Because these sort routines don't use the WorkSpace
811 there should not be a conflict
813 if ( !error && *s == 0 ) {
814 IllLeft: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;
1028 static WORD mularray[13] = { TYPEMULT, SUBEXPSIZE+3, 0, SUBEXPRESSION,
1029 SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
1031 int 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)
1070 int 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;
1348 int 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;
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 )
1690 newentry:
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;
1734 int 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;
1907 static WORD AssignLHS[14] = { TYPEASSIGN, 3+SUBEXPSIZE, 0,
1908 SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0,0,0,0,0 };
1910 int CoAssign(UBYTE *inp)
1912 int error = 0, retcode;
1915 if ( *inp !=
'$' ) {
1916 nolhs: 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);
1968 int 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)
int PF_BroadcastExpr(EXPRESSIONS e, FILEHANDLE *file)
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
WORD Generator(PHEAD WORD *, WORD)
WORD FlushOut(POSITION *, FILEHANDLE *, int)
LONG EndSort(PHEAD WORD *, int)