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}
65 int CoLocal(UBYTE *inp) {
return(DoExpr(inp,LOCALEXPRESSION,0)); }
72 int CoGlobal(UBYTE *inp) {
return(DoExpr(inp,GLOBALEXPRESSION,0)); }
79 int CoLocalFactorized(UBYTE *inp) {
return(DoExpr(inp,LOCALEXPRESSION,1)); }
86 int CoGlobalFactorized(UBYTE *inp) {
return(DoExpr(inp,GLOBALEXPRESSION,1)); }
95 int DoExpr(UBYTE *inp,
int type,
int par)
100 WORD *w, i, j = 0, c1, c2, *OldWork = AT.WorkPointer, osize;
103 while ( *inp ==
',' ) inp++;
104 if ( par ) AC.ToBeInFactors = 1;
105 else AC.ToBeInFactors = 0;
107 while ( *p && *p !=
'=' ) {
108 if ( *p ==
'(' ) SKIPBRA4(p)
109 else if ( *p == '{
' ) SKIPBRA5(p) 110 else if ( *p == '[
' ) SKIPBRA1(p) 113 if ( *p ) { /* Variety with the = sign */ 114 if ( ( q = SkipAName(inp) ) == 0 || q[-1] == '_
' ) { 115 MesPrint("&Illegal name for expression"); 117 if ( q[-1] == '_
' ) { 118 while ( FG.cTable[*q] < 2 || *q == '_
' ) q++; 123 if ( GetVar(inp,&c1,&c2,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) { 124 if ( c1 == CEXPRESSION ) { 125 if ( Expressions[c2].status == STOREDEXPRESSION ) { 126 MesPrint("&Illegal attempt to overwrite a stored expression"); 130 HighWarning("Expression is replaced by new definition"); 131 if ( AO.OptimizeResult.nameofexpr != NULL && 132 StrCmp(inp,AO.OptimizeResult.nameofexpr) == 0 ) { 135 if ( Expressions[c2].status != DROPPEDEXPRESSION ) { 136 w = &(Expressions[c2].status); 137 if ( *w == LOCALEXPRESSION || *w == SKIPLEXPRESSION ) 138 *w = DROPLEXPRESSION; 139 else if ( *w == GLOBALEXPRESSION || *w == SKIPGEXPRESSION ) 140 *w = DROPGEXPRESSION; 142 AC.TransEname = Expressions[c2].name; 143 j = EntVar(CEXPRESSION,0,type,0,0,0); 144 Expressions[j].node = Expressions[c2].node; 145 Expressions[c2].replace = j; 149 MesPrint("&name of expression is also name of a variable"); 151 j = EntVar(CEXPRESSION,inp,type,0,0,0); 157 Here we have to worry about reuse of the expression in the 158 same module. That will need AS.Oldvflags but that may not 159 be defined or have the proper value. 161 j = EntVar(CEXPRESSION,inp,type,0,0,0); 165 OldWork = w = AT.WorkPointer; 166 *w++ = TYPEEXPRESSION; 170 AR.CurExpr = j; /* Block expression j */ 171 *w++ = SUBEXPRESSION; 179 while ( *q == ',
' || *q == '(
' ) { 181 if ( ( q = SkipAName(inp) ) == 0 ) { 182 MesPrint("&Illegal name for expression argument"); 188 if ( GetVar(inp,&c1,&c2,ALLVARIABLES,WITHAUTO) < 0 ) c1 = -1; 191 *w++ = SYMTOSYM; *w++ = 4; *w++ = c2; *w++ = 0; 194 *w++ = INDTOIND; *w++ = 4; 195 *w++ = c2 + AM.OffsetIndex; *w++ = 0; 198 *w++ = VECTOVEC; *w++ = 4; 199 *w++ = c2 + AM.OffsetVector; *w++ = 0; 202 *w++ = FUNTOFUN; *w++ = 4; *w++ = c2 + FUNCTION; *w++ = 0; 205 MesPrint("&Illegal expression parameter: %s",inp); 211 if ( *q != ')
' || q+1 != p ) { 212 MesPrint("&Illegal use of arguments for expression"); 215 AC.ProtoType[1] = w - AC.ProtoType; 221 SeekScratch(AR.outfile,&pos); 222 Expressions[j].counter = 1; 223 Expressions[j].onfile = pos; 224 Expressions[j].whichbuffer = 0; 226 Expressions[j].partodo = AC.inparallelflag; 228 OldWork[2] = w - OldWork - 3; 231 Writing the expression prototype to disk and to the compiler 232 buffer is done only after the RHS has been compiled because 233 we don't know the number of the main level RHS yet.
237 ClearWildcardNames();
238 osize = AC.ProtoType[1]; AC.ProtoType[1] = SUBEXPSIZE;
239 if ( ( i = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) {
240 AC.ProtoType[1] = osize;
243 else if ( error == 0 ) {
244 AC.ProtoType[1] = osize;
247 if (
PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0 ) {
248 MesPrint(
"&Cannot create expression");
252 OldWork[2] = 4+SUBEXPSIZE;
253 OldWork[4] = SUBEXPSIZE;
255 OldWork[SUBEXPSIZE+3] = 1;
256 OldWork[SUBEXPSIZE+4] = 1;
257 OldWork[SUBEXPSIZE+5] = 3;
258 OldWork[SUBEXPSIZE+6] = 0;
259 if (
PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0
261 MesPrint(
"&Cannot create expression");
272 AR.outfile->POfull = AR.outfile->POfill;
275 AddNtoL(OldWork[1],OldWork);
276 AT.WorkPointer = OldWork;
277 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
280 AC.ToBeInFactors = 0;
288 if ( ( q = SkipAName(inp) ) == 0 ) {
289 MesPrint(
"&Illegal name(s) for expression(s)");
293 if ( GetName(AC.exprnames,inp,&c2,NOAUTO) == NAMENOTFOUND ) {
294 MesPrint(
"&%s is not a valid expression",inp);
298 w = &(Expressions[c2].status);
299 if ( type == LOCALEXPRESSION ) {
301 case GLOBALEXPRESSION:
302 *w = LOCALEXPRESSION;
304 case SKIPGEXPRESSION:
305 *w = SKIPLEXPRESSION;
307 case DROPGEXPRESSION:
308 *w = DROPLEXPRESSION;
310 case HIDDENGEXPRESSION:
311 *w = HIDDENLEXPRESSION;
313 case HIDEGEXPRESSION:
314 *w = HIDELEXPRESSION;
316 case UNHIDEGEXPRESSION:
317 *w = UNHIDELEXPRESSION;
319 case INTOHIDEGEXPRESSION:
320 *w = INTOHIDELEXPRESSION;
324 else if ( type == GLOBALEXPRESSION ) {
326 case LOCALEXPRESSION:
327 *w = GLOBALEXPRESSION;
329 case SKIPLEXPRESSION:
330 *w = SKIPGEXPRESSION;
332 case DROPLEXPRESSION:
333 *w = DROPGEXPRESSION;
335 case HIDDENLEXPRESSION:
336 *w = HIDDENGEXPRESSION;
338 case HIDELEXPRESSION:
339 *w = HIDEGEXPRESSION;
341 case UNHIDELEXPRESSION:
342 *w = UNHIDEGEXPRESSION;
344 case INTOHIDELEXPRESSION:
345 *w = INTOHIDEGEXPRESSION;
356 }
while ( c ==
',' );
358 MesPrint(
"&Illegal object in local or global redefinition");
370 int CoIdOld(UBYTE *inp)
373 return(CoIdExpression(inp,TYPEIDOLD));
384 return(CoIdExpression(inp,TYPEIDNEW));
392 int CoIdNew(UBYTE *inp)
395 return(CoIdExpression(inp,TYPEIDNEW));
403 int CoDisorder(UBYTE *inp)
405 AC.idoption = SUBDISORDER;
406 return(CoIdExpression(inp,TYPEIDNEW));
414 int CoMany(UBYTE *inp)
416 AC.idoption = SUBMANY;
417 return(CoIdExpression(inp,TYPEIDNEW));
425 int CoMulti(UBYTE *inp)
427 AC.idoption = SUBMULTI;
428 return(CoIdExpression(inp,TYPEIDNEW));
436 int CoIfMatch(UBYTE *inp)
438 AC.idoption = SUBAFTER;
439 return(CoIdExpression(inp,TYPEIDNEW));
447 int CoIfNoMatch(UBYTE *inp)
449 AC.idoption = SUBAFTERNOT;
450 return(CoIdExpression(inp,TYPEIDNEW));
458 int CoOnce(UBYTE *inp)
460 AC.idoption = SUBONCE;
461 return(CoIdExpression(inp,TYPEIDNEW));
469 int CoOnly(UBYTE *inp)
471 AC.idoption = SUBONLY;
472 return(CoIdExpression(inp,TYPEIDNEW));
480 int CoSelect(UBYTE *inp)
482 AC.idoption = SUBSELECT;
483 return(CoIdExpression(inp,TYPEIDNEW));
493 int CoIdExpression(UBYTE *inp,
int type)
496 int i, j, idhead, error = 0, MinusSign = 0, opt, retcode;
497 WORD *w, *s, *m, *mm, *ww, *FirstWork, *OldWork, c1, numsets = 0,
498 oldnumrhs, *ow, oldEside;
500 CBUF *C = cbuf+AC.cbufnum;
502 FirstWork = OldWork = AT.WorkPointer;
513 *w++ = idhead + SUBEXPSIZE;
515 if ( idhead >= IDHEAD ) *w++ = -1;
517 for ( i = 4; i < idhead; i++ ) *w++ = 0;
519 while ( *inp ==
',' ) inp++;
521 if ( AC.idoption == SUBSELECT ) {
525 else if ( ( AC.idoption == SUBAFTER ) || ( AC.idoption == SUBAFTERNOT ) ) {
526 while ( *p && *p !=
'=' && *p !=
',' ) {
527 if ( *p ==
'(' ) SKIPBRA4(p)
528 else if ( *p == '{
' ) SKIPBRA5(p) 529 else if ( *p == '[
' ) SKIPBRA1(p) 532 if ( *p == '=
' || *inp != '-
' || inp[1] != '>
' ) { 533 MesPrint("&Illegal use if if[no]match in id statement"); 534 error = 1; goto AllDone; 537 MesPrint("&id-statement without = sign"); 538 error = 1; goto AllDone; 544 while ( *p && *p != '=
' && *p != ',
' ) { 545 if ( *p == '(
' ) SKIPBRA4(p) 546 else if ( *p == '{
' ) SKIPBRA5(p) 547 else if ( *p == '[
' ) SKIPBRA1(p) 550 if ( *p == '=
' ) break; 552 MesPrint("&id-statement without = sign"); 553 error = 1; goto AllDone; 556 We have either a secondary option or a syntax error 559 while ( FG.cTable[*pp] == 0 ) pp++; 561 i = sizeof(IdOptions)/sizeof(struct id_options); 563 if ( StrICmp(inp,IdOptions[i].name) == 0 ) break; 566 MesPrint("&Illegal option %s in id-statement",inp); 567 *pp = c; error = 1; p++; inp = p; continue; 569 opt = IdOptions[i].code; 574 if ( pp != p ) goto IllField; 575 AC.idoption |= SUBDISORDER; 579 if ( p != pp ) goto IllField; 580 if ( ( AC.idoption & SUBMASK ) != 0 ) { 581 if ( AC.idoption == SUBMULTI && type == TYPEIF ) {} 583 MesPrint("&Conflicting options in id-statement"); 594 while ( *p && *p != '=
' && *p != ',
' ) { 595 if ( *p == '(
' ) SKIPBRA4(p) 596 else if ( *p == '{
' ) SKIPBRA5(p) 597 else if ( *p == '[
' ) SKIPBRA1(p) 600 if ( *p == '=
' ) break; 602 MesPrint("&id-statement without = sign"); 603 error = 1; goto AllDone; 606 We have a set at inp. 609 if ( p[-1] != '}
' ) { 611 MesPrint("&Illegal temporary set: %s",inp); 616 c = p[-1]; p[-1] = 0; 617 c1 = DoTempSet(inp,p-1); 621 if ( w[-1] < 0 ) error = 1; 626 if ( GetName(AC.varnames,inp,&c1,NOAUTO) != CSET ) { 627 MesPrint("&%s is not a set",inp); 631 if ( c1 < AM.NumFixedSets ) { 632 MesPrint("&Built in sets are not allowed in the select option"); 635 else if ( Sets[c1].type == CRANGE ) { 636 MesPrint("&Ranged sets are not allowed in the select option"); 646 Now exchange the positions a bit. 647 Regular stuff at OldWork, numsets sets at FirstWork[idhead] 650 for ( i = 0; i < idhead; i++ ) *w++ = FirstWork[i]; 651 AC.idoption = SUBSELECT; 655 if ( type == TYPEIF ) { 656 MesPrint("&The if[no]match->label option is not allowed in an if statement"); 657 error = 1; goto AllDone; 659 if ( pp[0] != '-
' || pp[1] != '>
' ) goto IllField; 660 pp += 2; /* points now at the label */ 664 while ( FG.cTable[*pp] <= 1 ) pp++; 667 MesPrint("&Illegal label %s in if[no]match option of id-statement",inp); 668 *p = c; error = 1; inp = p+1; continue; 671 OldWork[3] = GetLabel(inp); 676 IllField: c = *p; *p = 0; 677 MesPrint("&Illegal optionfield %s in id-statement",inp); 678 *p = c; error = 1; inp = p+1; continue; 680 i = AC.idoption & SUBMASK; 681 if ( i && i != opt ) { 682 MesPrint("&Conflicting options in id-statement"); 685 else AC.idoption |= opt; 686 while ( *p == ',
' ) p++; 691 if ( ( AC.idoption & SUBMASK ) == 0 ) AC.idoption |= SUBMULTI; 692 OldWork[2] = AC.idoption; 694 Now we have a field till the = sign 695 Now the subexpression prototype 698 *w++ = SUBEXPRESSION; 706 AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8; 710 oldcpointer = AddLHS(AC.cbufnum) - C->Buffer; 713 oldnumrhs = C->numrhs; 714 if ( ( retcode = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) { error = 1; } 715 else AC.ProtoType[2] = retcode; 718 if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1; 720 /* Make the LHS pointers ready */ 722 OldWork[1] = AC.WildC-OldWork; 723 OldWork[idhead+1] = OldWork[1] - idhead; 726 s = C->rhs[C->numrhs]; 728 Now check whether wildcards get converted to dollars (for PARALLEL) 732 tw = AC.ProtoType; twstop = tw + tw[1]; tw += SUBEXPSIZE; 733 while ( tw < twstop ) { 734 if ( *tw == LOADDOLLAR ) { 735 AddPotModdollar(tw[2]); 741 We have the expression in the compiler buffers. 742 The main level is at lhs[numlhs] 743 The partial lhs (including ProtoType) is in OldWork (in WorkSpace) 744 We need to load the result at w after the prototype 745 Because these sort routines don't use the WorkSpace
746 there should not be a conflict
748 if ( !error && *s == 0 ) {
749 IllLeft:MesPrint(
"&Illegal LHS");
753 if ( !error && *(s+*s) != 0 ) {
754 MesPrint(
"&LHS should be one term only");
759 if ( !error ) error = 1;
762 AN.RepPoint = AT.RepCount + 1;
763 ow = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
764 mm = s; ww = ow; i = *mm;
765 while ( --i >= 0 ) *ww++ = *mm++; AT.WorkPointer = ww;
766 AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
767 AR.Cnumlhs = C->numlhs;
775 if ( *w == 0 || *(w+*w) != 0 ) {
776 MesPrint(
"&LHS must be one term");
781 if ( AC.lhdollarflag ) MarkDirty(w,DIRTYFLAG);
783 AT.WorkPointer = w + *w;
792 C->numrhs = oldnumrhs;
797 if ( m[2] != 3 || m[1] != 1 || *m != 1 ) {
798 if ( *m == 1 && m[1] == 1 && m[2] == -3 ) {
802 MesPrint(
"&Coefficient in LHS");
808 if ( *w == 7 && w[1] == INDEX && w[3] < 0 ) {
809 if ( ( AC.idoption & SUBMASK ) != 0 && ( AC.idoption & SUBMASK ) !=
811 MesPrint(
"&Illegal option for substitution of a vector");
814 AC.DumNum = AM.IndDum;
815 OldWork[2] = ( OldWork[2] - ( OldWork[2] & SUBMASK ) ) | SUBALL;
820 *w++ = AC.DumNum + WILDOFFSET;
826 w[4] = AC.DumNum + WILDOFFSET;
827 OldWork[idhead+1] = w - OldWork - idhead;
832 i = OldWork[2] & SUBMASK;
834 if ( i == 0 || i == SUBMULTI ) {
837 if ( *s == SYMBOL ) {
840 if ( ABS(s[1]) > 2*MAXPOWER ) {
841 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
848 else if ( *s == DOTPRODUCT ) {
851 if ( ABS(s[2]) > 2*MAXPOWER ) {
852 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
855 else if ( s[1] >= -(2*WILDOFFSET) || s[0] >= -(2*WILDOFFSET) ) {
856 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
864 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
869 if ( ( OldWork[2] & SUBMASK ) == 0 ) OldWork[2] |= SUBMULTI;
871 if ( ( OldWork[2] & SUBMASK ) == SUBSELECT ) {
881 s = FirstWork + idhead;
882 while ( --numsets >= 0 ) *m++ = *s++;
898 OldWork[1] = m - OldWork;
899 AC.ProtoType = OldWork+idhead;
901 if ( StudyPattern(OldWork) ) error = 1;
903 AT.WorkPointer = OldWork + OldWork[1];
904 OldWork[4] = AC.lhdollarflag;
909 if ( type != TYPEIF ) {
910 if ( ( retcode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
912 AC.ProtoType[2] = retcode;
916 while ( *w ) { w += *w; w[-1] = -w[-1]; }
918 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
924 { AddNtoL(OldWork[1],OldWork); }
927 AT.WorkPointer = FirstWork;
936 static WORD mularray[13] = { TYPEMULT, SUBEXPSIZE+3, 0, SUBEXPRESSION,
937 SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
939 int CoMultiply(UBYTE *inp)
942 int error = 0, RetCode;
944 while ( *inp ==
',' ) inp++;
946 p = SkipField(inp,0);
949 if ( StrICont(inp,(UBYTE *)
"left") == 0 ) mularray[2] = 1;
950 else if ( StrICont(inp,(UBYTE *)
"right") == 0 ) mularray[2] = 0;
952 MesPrint(
"&Illegal option in multiply statement or ; forgotten.");
958 while ( *inp ==
',' ) inp++;
959 AC.ProtoType = mularray+3;
960 mularray[7] = AC.cbufnum;
961 if ( ( RetCode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
963 mularray[5] = RetCode;
964 AddNtoL(SUBEXPSIZE+3,mularray);
965 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
977 int CoFill(UBYTE *inp)
980 WORD error = 0, x, funnum, type, *oldwp = AT.WorkPointer;
981 int i, oldcbufnum = AC.cbufnum, nofill = 0, numover, redef = 0;
982 WORD *w, *wold, *Tprototype;
983 UBYTE *p = inp, c, *inp1;
985 LONG newreservation, sum = 0;
986 UBYTE *p1, *p2, *p3, *p4, *fake = 0;
988 if ( AC.exprfillwarning == 1 ) AC.exprfillwarning = 0;
993 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
996 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,WITHAUTO) == NAMENOTFOUND )
997 || ( T = functions[funnum].tabl ) == 0 || c !=
'(' ) {
998 MesPrint(
"&%s should be a table with argument(s)",inp);
1003 for ( sum = 0, i = 0, w = oldwp; i < T->
numind; i++ ) {
1004 ParseSignedNumber(x,p);
1005 if ( FG.cTable[p[-1]] != 1 || ( *p !=
',' && *p !=
')' ) ) {
1006 MesPrint(
"&Table arguments in fill statement should be numbers");
1009 if ( T->
sparse ) *w++ = x;
1010 else if ( x < T->mm[i].mini || x > T->
mm[i].
maxi ) {
1011 MesPrint(
"&Value %d for argument %d of table out of bounds",x,i+1);
1012 error = 1; nofill = 1;
1015 if ( *p ==
')' )
break;
1019 if ( *p !=
')' || i < ( T->
numind - 1 ) ) {
1020 MesPrint(
"&Incorrect number of table arguments in fill statement. Should be %d" 1022 error = 1; nofill = 1;
1025 if ( T->
sparse == 0 ) sum *= TABLEEXTENSION;
1029 i = FindTableTree(T,oldwp,1);
1032 if ( tablestub == 0 && ( ( T->
sparse & 2 ) == 2 ) && ( T->
mode != 0 )
1033 && ( AC.vetotablebasefill == 0 ) ) {
1037 functions[funnum].tabl = T = T->
spare;
1045 if ( T->
reserved == 0 ) newreservation = 20;
1053 while ( T->
totind >= newreservation && newreservation < MAXTABLECOMBUF )
1054 newreservation = 2*newreservation;
1055 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1056 if ( T->
totind >= newreservation ) {
1057 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1058 AC.cbufnum = oldcbufnum;
1061 wold = (WORD *)Malloc1(newreservation*
sizeof(WORD)*
1062 (T->
numind+TABLEEXTENSION),
"tablepointers");
1063 for ( i = T->
reserved*(T->
numind+TABLEEXTENSION)-1; i >= 0; i-- )
1070 for ( sum = T->
totind*(T->
numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1074 #if TABLEEXTENSION == 2 1087 if ( AC.vetofilling ) nofill = 1;
1089 Warning(
"Table element was already defined. New definition will be used");
1092 #if TABLEEXTENSION == 2 1102 p++;
if ( *p !=
'=' ) {
1103 MesPrint(
"&Fill statement misses = sign after the table element");
1104 AC.cbufnum = oldcbufnum;
1105 AT.WorkPointer = oldwp;
1106 functions[funnum].tabl = oldT;
1109 if ( tablestub == 0 && T->
mode == 1 && AC.vetotablebasefill == 0 ) {
1117 numfake = (p4-T->
argtail)+(p3-p1)+10;
1119 fake = (UBYTE *)Malloc1(numfake*
sizeof(UBYTE),
"Fill fake rhs");
1121 *p++ =
't'; *p++ =
'b'; *p++ =
'l'; *p++ =
'_'; *p++ =
'(';
1122 p4 = p1;
while ( p4 < p2 ) *p++ = *p4++; *p++ =
',';
1123 p4 = p2+1;
while ( p4 < p3 ) *p++ = *p4++;
1126 while ( FG.cTable[*p4] == 1 ) p4++;
1128 if ( *p4 ==
'?' && p[-1] !=
',' ) {
1130 if ( FG.cTable[*p4] == 0 || *p4 ==
'$' || *p4 ==
'[' ) {
1136 else if ( *p4 ==
'{' ) {
1139 else if ( *p4 ) { *p++ = *p4++;
continue; }
1155 AC.tablefilling = funnum;
1157 p = SkipField(inp1,0);
1164 if ( ( i = CompileAlgebra(inp1,RHSIDE,Tprototype) ) < 0 ) { error = 1; i = 0; }
1171 if ( T->
sparse || c == 0 )
break;
1173 #if ( TABLEEXTENSION == 2 ) 1179 #if ( TABLEEXTENSION == 2 ) 1182 sum += TABLEEXTENSION-2;
1185 if ( AC.exprfillwarning == 1 ) {
1186 AC.exprfillwarning = 2;
1187 Warning(
"Use of expressions and/or $variables in Fill statements is potentially very dangerous.");
1189 AC.tablefilling = 0;
1190 if ( T->
sparse && c != 0 ) {
1191 MesPrint(
"&In sparse tables one can fill only one element at a time");
1194 else if ( numover ) {
1196 Warning(
"one element was overwritten. New definition will be used");
1197 else if ( AC.WarnFlag )
1198 MesPrint(
"&Warning: %d elements were overwritten. New definitions will be used",numover);
1201 if ( redef == 0 ) T->
totind++;
1209 M_free(fake,
"Fill fake rhs");
1211 functions[funnum].tabl = T = T->
spare;
1215 AC.cbufnum = oldcbufnum;
1216 AC.SymChangeFlag = 1;
1217 AT.WorkPointer = oldwp;
1218 functions[funnum].tabl = oldT;
1238 int CoFillExpression(UBYTE *inp)
1242 WORD type, funnum, expnum, symnum, numsym = 0, *oldwork = AT.WorkPointer;
1243 WORD *brackets, *term, brasize, *b, *m, *w, *pw, *tstop, zero = 0;
1244 WORD oldcbuf = AC.cbufnum, curelement = 0;
1245 int weneedit, i, j, numzero, pow;
1247 LONG newreservation, numcommu, sum;
1253 AN.IndDum = AM.IndDum;
1254 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1256 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1257 || ( T = functions[funnum].tabl ) == 0 ) {
1258 MesPrint(
"&%s should be a previously declared table",inp);
1265 MesPrint(
"&No = sign in FillExpression statement");
1269 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1271 if ( ( type = GetName(AC.exprnames,inp,&expnum,NOAUTO) ) == NAMENOTFOUND
1273 Expressions[expnum].status != LOCALEXPRESSION &&
1274 Expressions[expnum].status != SKIPLEXPRESSION &&
1275 Expressions[expnum].status != DROPLEXPRESSION &&
1276 Expressions[expnum].status != GLOBALEXPRESSION &&
1277 Expressions[expnum].status != SKIPGEXPRESSION &&
1278 Expressions[expnum].status != DROPGEXPRESSION ) ) {
1279 MesPrint(
"&%s should be an active expression with arguments",inp);
1282 if ( Expressions[expnum].inmem ) {
1283 MesPrint(
"&%s cannot be used in a FillExpression statement in the same %n\ 1284 module that it has been redefined",inp);
1290 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1293 if ( GetVar(inp,&type,&symnum,-1,NOAUTO) == NAMENOTFOUND ) {
1294 MesPrint(
"&%s should be a previously declared symbol or function",inp);
1297 else if ( type == CSYMBOL ) {
1299 *AT.WorkPointer++ = symnum;
1302 else if ( type == CFUNCTION ) {
1306 MesPrint(
"&Argument should be a single function or a list of symbols");
1310 *AT.WorkPointer++ = symnum;
1313 MesPrint(
"&%s should be a previously declared symbol or function",inp);
1342 if ( c ==
')' )
break;
1344 MesPrint(
"&Illegal separator in FillExpression statement");
1349 MesPrint(
"&Illegal end of FillExpression statement");
1359 if ( ( numsym > 0 ) && ( T->
numind != numsym ) ) {
1360 MesPrint(
"&This table needs %d symbols for its array indices");
1365 if ( fi->handle >= 0 ) {
1366 PUTZERO(oldposition);
1367 SeekFile(fi->handle,&oldposition,SEEK_CUR);
1368 SetScratch(fi,&(Expressions[expnum].onfile));
1370 if ( ISNEGPOS(Expressions[expnum].onfile) ) {
1371 MesPrint(
"&File error in FillExpression");
1381 SETBASEPOSITION(oldposition,(UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer));
1382 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(Expressions[expnum].onfile));
1384 pw = AT.WorkPointer;
1385 if ( numsym < 0 ) { brackets = pw + 1; }
1386 else { brackets = pw + numsym; }
1387 brasize = -1; weneedit = 0;
1388 term = (WORD *)(((UBYTE *)(brackets)) + AM.MaxTer);
1389 AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
1391 AC.tablefilling = funnum;
1392 if ( GetTerm(BHEAD term) > 0 ) {
1393 while ( GetTerm(BHEAD term) > 0 ) {
1394 GETSTOP(term,tstop);
1396 while ( m < tstop && *m != HAAKJE ) m += m[1];
1397 if ( *m != HAAKJE ) {
1398 MesPrint(
"&Illegal attempt to put an expression without brackets in a table");
1402 if ( brasize == m - w ) {
1404 while ( *b == *w && w < m ) { b++; w++; }
1408 *m = *term - (m-term);
1409 AddNtoC(AC.cbufnum,*m,m);
1410 numdummies = DetCurDum(BHEAD term) - AM.IndDum;
1411 if ( numdummies > T->numdummies ) T->numdummies = numdummies;
1417 AddNtoC(AC.cbufnum,1,&zero);
1418 numcommu = numcommute(C->
rhs[curelement],&(C->
NumTerms[curelement]));
1419 C->
CanCommu[curelement] = numcommu;
1421 b = brackets; w = term + 1;
1422 if ( numsym < 0 ) pw = oldwork + 1;
1423 else pw = oldwork + numsym;
1424 while ( w < m ) *b++ = *w++;
1425 brasize = b - brackets;
1431 if ( *brackets != symnum || brasize != brackets[1] ) {
1432 weneedit = 0;
continue;
1437 b = brackets + FUNHEAD;
1438 bb = brackets+brackets[1];
1441 if ( *b != -SNUMBER )
break;
1445 if ( b < bb || i != T->numind ) {
1446 weneedit = 0;
continue;
1449 else if ( brasize > 0 && ( *brackets != SYMBOL
1450 || brackets[1] < brasize || (brackets[1]-2) > numsym*2 ) ) {
1451 weneedit = 0;
continue;
1453 numzero = 0; sum = 0;
1455 for ( i = 0; i < numsym; i++ ) {
1456 if ( brasize > 0 ) {
1457 b = brackets + 2; j = brackets[1]-2;
1459 if ( *b == oldwork[i] )
break;
1464 if ( 2*numzero+brackets[1]-2 > numsym*2 ) {
1465 weneedit = 0;
goto nextterm;
1471 if ( T->
sparse ) *pw++ = pow;
1472 else if ( pow < T->mm[i].mini || pow > T->
mm[i].
maxi ) {
1473 weneedit = 0;
goto nextterm;
1479 b = brackets + FUNHEAD;
1481 for ( i = 0; i < T->
numind; i++ ) {
1484 if ( T->
sparse ) { *pw++ = pow; }
1485 else if ( pow < T->mm[i].mini || pow > T->
mm[i].
maxi ) {
1486 weneedit = 0;
goto nextterm;
1493 if ( numsym < 0 ) pw = oldwork + 1;
1494 else pw = oldwork + T->
numind;
1495 i = FindTableTree(T,pw,1);
1505 if ( T->
reserved == 0 ) newreservation = 20;
1515 while ( T->
totind >= newreservation && newreservation < MAXTABLECOMBUF )
1516 newreservation = 2*newreservation;
1517 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1518 if ( T->
totind >= newreservation ) {
1519 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1520 AC.cbufnum = oldcbuf;
1521 AT.WorkPointer = oldwork;
1525 if ( T->
totind >= newreservation ) {
1526 MesPrint(
"@More than %ld elements in sparse table",MAXTABLECOMBUF);
1527 AC.cbufnum = oldcbuf;
1528 AT.WorkPointer = oldwork;
1531 w = (WORD *)Malloc1(newreservation*
sizeof(WORD)*
1532 (T->
numind+TABLEEXTENSION),
"tablepointers");
1533 for ( i = T->
reserved*(T->
numind+TABLEEXTENSION)-1; i >= 0; i-- )
1539 if ( numsym < 0 ) pw = oldwork + 1;
1540 else pw = oldwork + numsym;
1541 for ( sum = T->
totind*(T->
numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1547 #if ( TABLEEXTENSION != 2 ) 1549 sum *= TABLEEXTENSION;
1557 #if ( TABLEEXTENSION == 2 ) 1566 newentry:
if ( *m == HAAKJE ) { m += m[1] - 1; }
1568 *m = *term - (m-term);
1569 AddNtoC(AC.cbufnum,*m,m);
1574 AddNtoC(AC.cbufnum,1,&zero);
1575 numcommu = numcommute(C->
rhs[curelement],&(C->
NumTerms[curelement]));
1576 C->
CanCommu[curelement] = numcommu;
1579 if ( fi->handle >= 0 ) {
1580 SetScratch(fi,&(oldposition));
1583 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(oldposition));
1586 AC.cbufnum = oldcbuf;
1587 AC.tablefilling = 0;
1588 AT.WorkPointer = oldwork;
1592 AC.cbufnum = oldcbuf;
1593 AC.tablefilling = 0;
1594 AT.WorkPointer = oldwork;
1610 int CoPrintTable(UBYTE *inp)
1613 int fflag = 0, sflag = 0, addflag = 0, error = 0, sum, i, j;
1614 UBYTE *filename, *p, c, buffer[100], *s, *oldoutputline = AO.OutputLine;
1615 WORD type, funnum, *expr, *m, num;
1617 WORD oldSkip = AO.OutSkip, oldMode = AC.OutputMode, oldHandle = AC.LogHandle;
1618 WORD oldType = AO.PrintType, *oldwork = AT.WorkPointer;
1619 UBYTE *oldFill = AO.OutFill, *oldLine = AO.OutputLine;
1621 if ( PF.me != MASTER )
return 0;
1626 while ( *inp ==
'+' ) {
1628 if ( *inp ==
'f' || *inp ==
'F' ) { fflag = 1; inp++; }
1629 else if ( *inp ==
's' || *inp ==
'S' ) { sflag = PRINTONETERM; inp++; }
1631 MesPrint(
"&Illegal + option in PrintTable statement");
1634 while ( *inp !=
',' && *inp && *inp !=
'+' ) {
1637 MesPrint(
"&Illegal + option in PrintTable statement");
1641 MesPrint(
"&Unfinished PrintTable statement");
1648 if ( *inp ==
',' ) inp++;
1653 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1655 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1656 || ( T = functions[funnum].tabl ) == 0 ) {
1657 MesPrint(
"&%s should be a previously declared table",inp);
1667 if ( *p ==
'>' ) { addflag = 1; p++; }
1673 if ( addflag ) AC.LogHandle = OpenAddFile((
char *)filename);
1674 else AC.LogHandle = CreateFile((
char *)filename);
1675 if ( AC.LogHandle < 0 ) {
1676 MesPrint(
"&Cannot open file '%s' properly",filename);
1677 error = 1;
goto finally;
1679 AO.PrintType = PRINTLFILE;
1681 else if ( fflag && AC.LogHandle >= 0 ) {
1682 AO.PrintType = PRINTLFILE;
1684 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
1685 AT.WorkPointer += 2*AC.LineLength;
1687 AO.PrintType |= sflag;
1693 if ( AC.LogHandle == oldHandle ) FiniLine();
1694 AO.OutputLine = AO.OutFill = (UBYTE *)Malloc1(AC.LineLength+20,
"PrintTable");
1695 AO.OutStop = AO.OutFill + AC.LineLength;
1696 for ( i = 0; i < T->
totind; i++ ) {
1698 TokenToLine((UBYTE *)
"Fill ");
1699 TokenToLine((UBYTE *)(VARNAME(functions,funnum)));
1700 TokenToLine((UBYTE *)
"(");
1703 sum = i * ( T->
numind + TABLEEXTENSION );
1704 for ( j = 0; j < T->
numind; j++, sum++ ) {
1705 if ( j > 0 ) TokenToLine((UBYTE *)
",");
1707 s = buffer; s = NumCopy(num,s);
1708 TokenToLine(buffer);
1713 for ( j = 0; j < T->
numind; j++ ) {
1715 TokenToLine((UBYTE *)
",");
1721 s = buffer; s = NumCopy(num,s);
1722 TokenToLine(buffer);
1726 TOKENTOLINE(
") =",
")=");
1729 if ( AC.OutputSpaces != NOSPACEFORMAT ) TokenToLine((UBYTE *)
" ");
1747 while ( *m ) m += *m;
1749 if ( WriteExpression(expr,(LONG)(m-expr)) ) { error = 1;
goto finally; }
1753 TokenToLine((UBYTE *)
"0");
1755 TokenToLine((UBYTE *)
";");
1758 M_free(AO.OutputLine,
"PrintTable");
1759 AO.OutputLine = AO.OutFill = oldoutputline;
1764 AO.OutSkip = oldSkip;
1765 AC.OutputMode = oldMode;
1766 AC.LogHandle = oldHandle;
1767 AO.PrintType = oldType;
1768 AO.OutFill = oldFill;
1769 AO.OutputLine = oldLine;
1770 AT.WorkPointer = oldwork;
1783 static WORD AssignLHS[14] = { TYPEASSIGN, 3+SUBEXPSIZE, 0,
1784 SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0,0,0,0,0 };
1786 int CoAssign(UBYTE *inp)
1788 int error = 0, retcode;
1791 if ( *inp !=
'$' ) {
1792 nolhs: MesPrint(
"&assign statement should have a dollar variable in the LHS");
1796 if ( FG.cTable[*inp] != 0 )
goto nolhs;
1797 while ( FG.cTable[*inp] < 2 ) inp++;
1798 if ( AP.PreAssignFlag == 2 ) {
1799 if ( *inp ==
'_' ) inp++;
1801 if ( ( *inp ==
',' && inp[1] !=
'=' ) && ( *inp !=
'=' ) ) {
1802 MesPrint(
"&assign statement should have only a dollar variable in the LHS");
1807 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
1808 number = AddDollar(name,DOLUNDEFINED,0,0);
1811 if ( c ==
',' ) inp++;
1813 if ( *inp ==
',' ) inp++;
1817 AssignLHS[7] = AC.cbufnum;
1818 retcode = CompileAlgebra(inp,RHSIDE,(AssignLHS+3));
1819 if ( retcode < 0 ) error = 1;
1824 AssignLHS[2] = number;
1825 AssignLHS[5] = retcode;
1826 AddNtoL(AssignLHS[1],AssignLHS);
1844 int CoDeallocateTable(UBYTE *inp)
1848 WORD type, funnum, i;
1851 while ( *inp ==
',' ) inp++;
1852 if ( *inp == 0 )
break;
1853 if ( ( p = SkipAName(inp) ) == 0 )
return(1);
1855 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1856 || ( T = functions[funnum].tabl ) == 0 ) {
1857 MesPrint(
"&%s should be a previously declared table",inp);
1861 MesPrint(
"&%s should be a sparse table",inp);
void AddPotModdollar(WORD)
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
WORD Generator(PHEAD WORD *, WORD)
WORD FlushOut(POSITION *, FILEHANDLE *, int)
LONG EndSort(PHEAD WORD *, int)