54 static char *useprop =
55 "Only Symbols, DotProducts, User-defined Functions and vectors with indices\n\ 56 are allowed in optimized FORTRAN/C output";
66 static SCALAR *scabuffer = 0;
67 static LONG scasize = 0, scanumber = -1;
69 static LONG *objoffset = 0, objsize = 0;
70 static WORD *objbuffer = 0, *objpointer = 0, *objtop = 0;
71 static int numobjects = 0, numobjoffsets = 0;
72 static int iniobjects = 0;
74 static UBYTE scratchname[10];
75 static WORD **helppointers = 0, **sortpointers = 0;
76 static LONG sizepointers = 0;
78 static LONG *multiplicities = 0, multiplicitysize = 0;
85 int Optimize(WORD numexpr)
90 if ( FindScratchName() )
return(-1);
91 if ( LoadOpti(numexpr) < 0 )
return(-1);
92 iniobjects = numobjects;
97 HuntNumFactor(0L,0,0);
114 for ( j = 0; j < scanumber; j++ ) HuntBrackets(j);
119 retval = PrintOptima(numexpr);
129 int LoadOpti(WORD numexpr)
132 WORD *term, *t, *tstop, *m, *mstop, *oldwork = AT.WorkPointer, *tbuf, *w, nc;
137 AT.WorkPointer = (WORD *)(((UBYTE *)(tbuf)) + 2*AM.MaxTer);
138 term = AT.WorkPointer;
139 while ( GetTerm(BHEAD term) > 0 ) {
140 AT.WorkPointer = term + *term;
141 Normalize(BHEAD term);
142 AT.WorkPointer = term + *term;
150 t = term + 1; mstop = term + *term - 1;
152 *w++ = LNUMBER; *w++ = ABS(nc)+2; *w++ = nc; m = tstop;
153 while ( m < mstop ) *w++ = *m++;
154 while ( t < tstop ) {
156 if ( *t == SYMBOL ) {
158 while ( m < mstop ) {
159 objnum = PutObject(m,SYMBOL);
161 *w++ = objnum >> BITSINWORD;
162 *w++ = objnum & WORDMASK;
166 else if ( *t == DOTPRODUCT ) {
168 while ( m < mstop ) {
169 objnum = PutObject(m,DOTPRODUCT);
171 *w++ = objnum >> BITSINWORD;
172 *w++ = objnum & WORDMASK;
176 else if ( *t == VECTOR ) {
178 while ( m < mstop ) {
179 objnum = PutObject(m,VECTOR);
182 while ( m < mstop && m[0] == m[-2] && m[1] == m[-1] ) {
185 *w++ = objnum >> BITSINWORD;
186 *w++ = objnum & WORDMASK;
190 else if ( *t > MAXBUILTINFUNCTION ) {
191 objnum = PutObject(t,FUNCTION);
193 while ( mstop < tstop ) {
195 for ( i = 0; i < t[1]; i++ ) {
196 if ( m[i] != t[i] )
break;
198 if ( i < t[1] )
break;
200 t = mstop; mstop = t + t[1];
202 *w++ = objnum >> BITSINWORD;
203 *w++ = objnum & WORDMASK;
207 MLOCK(ErrorMessageLock);
208 MesPrint(
"Problems with expression %s:",EXPRNAME(numexpr));
210 MUNLOCK(ErrorMessageLock);
211 AT.WorkPointer = oldwork;
219 AT.WorkPointer = oldwork;
223 t = scabuffer->buffer;
224 while ( t < scabuffer->pointer ) {
236 void CleanOptiBuffer()
239 if ( scanumber > 0 ) {
240 for ( i = 0; i < scanumber; i++ ) {
241 if ( scabuffer[i].buffer ) M_free(scabuffer[i].buffer,
"scabuf2");
242 scabuffer[i].buffer = scabuffer[i].pointer = scabuffer[i].top = 0;
243 scabuffer[i].bufsize = scabuffer[i].numterms = 0;
245 if ( scabuffer ) M_free(scabuffer,
"scabuffer");
247 scasize = 0; scanumber = -1;
249 if ( objbuffer ) M_free(objbuffer,
"objbuffer");
250 objbuffer = objtop = 0;
252 if ( objoffset ) M_free(objoffset,
"objoffset");
255 if ( sortpointers ) M_free(sortpointers,
"optisort");
256 sortpointers = 0; helppointers = 0; sizepointers = 0;
257 if ( multiplicities ) M_free(multiplicities,
"multiplicities");
259 multiplicitysize = 0;
267 int PutObject(WORD *
object,
int type)
270 WORD *obj, *o, *oo, *t, *newobjbuffer;
271 LONG size = 2, j, newobjsize, *newoffsets;
273 case SYMBOL: size = 2;
break;
274 case DOTPRODUCT: size = 3;
break;
275 case VECTOR: size = 3;
break;
277 t = object;
while ( *t ) t += *t; size = t-
object+2;
break;
278 case FUNCTION: size =
object[1]+1;
break;
280 for ( i = 1; i <= numobjects; i++ ) {
281 obj = objbuffer + objoffset[i];
282 if ( *obj != type )
continue;
284 case SYMBOL:
if ( obj[1] == *
object )
return(i);
break;
287 if ( obj[1] == *
object && obj[2] ==
object[1] )
return(i);
290 k =
object[1]; o = obj+1; oo = object;
292 if ( *o != *oo )
break;
295 if ( k < 0 )
return(i);
298 if ( size == objoffset[i+1]-objoffset[i] ) {
299 o = obj + 1; oo = object; j = size-1;
301 if ( *o != *oo )
break;
304 if ( j < 0 )
return(i);
312 while ( objpointer + size >= objtop ) {
313 if ( objsize == 0 ) newobjsize = 2*size;
314 else newobjsize = 2*objsize;
315 if ( newobjsize < 200 ) newobjsize = 200;
316 newobjbuffer = (WORD *)Malloc1(newobjsize*
sizeof(WORD),
"objbuffer");
318 for ( j = 0; j < objsize; j++ ) newobjbuffer[j] = objbuffer[j];
319 objpointer = (objpointer-objbuffer) + newobjbuffer;
320 if ( objbuffer ) M_free(objbuffer,
"objbuffer");
321 objbuffer = newobjbuffer;
324 objpointer = objbuffer = newobjbuffer;
326 objsize = newobjsize;
327 objtop = objbuffer + objsize;
329 if ( numobjects + 3 >= numobjoffsets ) {
330 if ( numobjoffsets == 0 ) newobjsize = 50;
331 else newobjsize = 2*numobjoffsets;
332 newoffsets = (LONG *)Malloc1(newobjsize*
sizeof(LONG),
"newoffsets");
333 if ( numobjects > 0 ) {
334 for ( j = numobjects+1; j >= 0; j-- ) newoffsets[j] = objoffset[j];
335 if ( objoffset ) M_free(objoffset,
"objoffset");
338 newoffsets[0] = newoffsets[1] = newoffsets[2] = 0;
340 numobjoffsets = newobjsize; objoffset = newoffsets;
343 o = objbuffer + objoffset[numobjects]; *o++ = type;
345 case SYMBOL: *o++ = *object;
break;
347 case DOTPRODUCT: *o++ = *
object++; *o++ = *object;
break;
348 case FUNCTION: k =
object[1]; oo = object;
349 while ( --k >= 0 ) *o++ = *oo++;
352 oo = object; j = size;
353 while ( --j >= 0 ) *o++ = *oo++;
356 objoffset[numobjects+1] = o - objbuffer;
365 int AddToOpti(WORD *term,
int num)
371 if ( num >= scasize ) {
372 if ( scasize <= 0 ) newnumber = 100;
373 else newnumber = scasize * 2;
374 newsca = (
SCALAR *)Malloc1(newnumber *
sizeof(
SCALAR),
"scabuffer");
375 if ( scanumber > 0 ) {
376 for ( i = 0; i < scanumber; i++ ) newsca[i] = scabuffer[i];
377 for ( ; i < newnumber; i++ ) {
378 newsca[i].buffer = newsca[i].pointer = newsca[i].top = 0;
379 newsca[i].numterms = newsca[i].bufsize = 0;
381 if ( scabuffer ) M_free(scabuffer,
"scabuffer");
386 if ( num >= scanumber ) {
387 for ( i = scanumber+1; i <= num; i++ ) {
388 newsca = scabuffer + i;
389 if ( newsca->bufsize == 0 ) {
390 newsca->bufsize = 40;
391 newsca->buffer = (WORD *)Malloc1(newsca->bufsize*
sizeof(WORD),
"scabuf2");
392 newsca->pointer = newsca->buffer;
393 newsca->top = newsca->buffer + newsca->bufsize;
394 newsca->numterms = 0;
399 newsca = scabuffer + num;
400 while ( newsca->pointer + term[0]+1 >= newsca->top ) {
401 newnumber = newsca->bufsize * 2;
402 w = (WORD *)Malloc1(newnumber*
sizeof(WORD),
"newscabuffer");
403 i = newsca->pointer - newsca->buffer;
404 while ( --i >= 0 ) w[i] = newsca->buffer[i];
405 newsca->pointer = ( newsca->pointer - newsca->buffer ) + w;
406 newsca->bufsize = newnumber;
407 newsca->top = w + newsca->bufsize;
408 if ( newsca->buffer ) M_free(newsca->buffer,
"newscabuffer");
413 while ( --j >= 0 ) *newsca->pointer++ = *w++;
414 *(newsca->pointer) = 0;
424 int FindScratchName()
432 scratchname[0] =
'z'; scratchname[1] = 0;
433 sname[0] =
'Z'; sname[1] = 0;
434 for ( i = 25; i >= 0; i--, scratchname[0]--, sname[0]-- ) {
435 if ( ( GetName(AC.varnames,scratchname,&number,NOAUTO) == NAMENOTFOUND )
436 && ( GetName(AC.exprnames,scratchname,&number,NOAUTO) == NAMENOTFOUND )
437 && ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
438 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) )
441 scratchname[0] =
'z'; scratchname[2] = 0; sname[2] = 0;
442 for ( i = 25; i >= 0; i--, scratchname[0]-- ) {
443 scratchname[1] =
'z';
444 for ( j = 25; j >= 0; j--, scratchname[1]-- ) {
445 sname[0] = scratchname[0]; sname[1] = scratchname[1];
446 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
447 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
448 sname[0] = scratchname[0]; sname[1] = (UBYTE)(scratchname[1]-
'a'+
'A');
449 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
450 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
451 sname[0] = (UBYTE)(scratchname[0]-
'a'+
'A'); sname[1] = (UBYTE)(scratchname[1]-
'a'+
'A');
452 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
453 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
454 sname[0] = (UBYTE)(scratchname[0]-
'a'+
'A'); sname[1] = scratchname[1];
455 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
456 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) )
462 scratchname[1] =
'9';
463 for ( j = 9; j >= 0; j--, scratchname[1]-- ) {
464 sname[0] = scratchname[0]; sname[1] = scratchname[1];
465 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
466 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
467 sname[0] = (UBYTE)(scratchname[0]-
'a'+
'A');
468 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
469 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) )
474 scratchname[0] =
'z'; scratchname[3] = 0; sname[3] = 0;
475 for ( i = 25; i >= 0; i--, scratchname[0]-- ) {
476 scratchname[1] =
'9';
477 for ( j = 9; j >= 0; j--, scratchname[1]-- ) {
478 scratchname[2] =
'9';
479 for ( k = 9; k >= 0; k--, scratchname[2]-- ) {
480 sname[0] = scratchname[0]; sname[1] = scratchname[1];
481 sname[2] = scratchname[2];
482 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
483 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
484 sname[0] = (UBYTE)(scratchname[0]-
'a'+
'A');
485 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
486 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) )
492 scratchname[0] =
'z'; scratchname[4] = 0; sname[4] = 0;
493 for ( i = 25; i >= 0; i--, scratchname[0]-- ) {
494 scratchname[1] =
'9';
495 for ( j = 9; j >= 0; j--, scratchname[1]-- ) {
496 scratchname[2] =
'9';
497 for ( k = 9; k >= 0; k--, scratchname[2]-- ) {
498 scratchname[3] =
'9';
499 for ( l = 9; l >= 0; l--, scratchname[3]-- ) {
500 sname[0] = scratchname[0]; sname[1] = scratchname[1];
501 sname[2] = scratchname[2]; sname[3] = scratchname[3];
502 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
503 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
504 sname[0] = (UBYTE)(scratchname[0]-
'a'+
'A');
505 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
506 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) )
513 scratchname[0] =
'z'; scratchname[5] = 0; sname[5] = 0;
514 for ( i = 25; i >= 0; i--, scratchname[0]-- ) {
515 scratchname[1] =
'9';
516 for ( j = 9; j >= 0; j--, scratchname[1]-- ) {
517 scratchname[2] =
'9';
518 for ( k = 9; k >= 0; k--, scratchname[2]-- ) {
519 scratchname[3] =
'9';
520 for ( l = 9; l >= 0; l--, scratchname[3]-- ) {
521 scratchname[4] =
'9';
522 for ( m = 9; m >= 0; m--, scratchname[4]-- ) {
523 sname[0] = scratchname[0]; sname[1] = scratchname[1];
524 sname[2] = scratchname[2]; sname[3] = scratchname[3];
525 sname[4] = scratchname[4];
526 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
527 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) ) {
528 sname[0] = (UBYTE)(scratchname[0]-
'a'+
'A');
529 if ( ( GetName(AC.varnames,sname,&number,NOAUTO) == NAMENOTFOUND )
530 && ( GetName(AC.exprnames,sname,&number,NOAUTO) == NAMENOTFOUND ) )
538 MLOCK(ErrorMessageLock);
539 MesPrint(
"Could not find a decent name for the scratch variable in Optimize");
540 MUNLOCK(ErrorMessageLock);
549 int PrintOptima(WORD numexpr)
551 UBYTE obuffer[80], lbuf[24];
552 WORD *obj, stermbuf[10], *t, *m, n, oldskip = AO.OutSkip;
553 int i, first, fsym, *used;
555 LONG num, totnum = numobjects + scanumber, j;
556 AC.OutputMode = FORTRANMODE;
557 used = (
int *)Malloc1((totnum+1)*
sizeof(int),
"PrintOptima");
558 for ( j = 0; j < totnum; j++ ) used[j] = 0;
566 NumToStr(lbuf,numobjects+scanumber-1);
567 sprintf((
char *)obuffer,
"DOUBLE PRECISION %s(%s)",(
char *)scratchname,lbuf);
568 TokenToLine(obuffer);
570 for ( i = 1; i <= iniobjects; i++ ) {
571 obj = objbuffer + objoffset[i];
574 sprintf((
char *)obuffer,
"%s(%d)=",(
char *)scratchname,i);
575 TokenToLine(obuffer);
576 stermbuf[0] = SYMBOL;
578 stermbuf[2] = obj[1];
580 WriteSubTerm(stermbuf,1);
583 sprintf((
char *)obuffer,
"%s(%d)=",(
char *)scratchname,i);
584 TokenToLine(obuffer);
585 stermbuf[0] = DOTPRODUCT;
587 stermbuf[2] = obj[1];
588 stermbuf[3] = obj[2];
590 WriteSubTerm(stermbuf,1);
593 sprintf((
char *)obuffer,
"%s(%d)=",(
char *)scratchname,i);
594 TokenToLine(obuffer);
595 stermbuf[0] = VECTOR;
597 stermbuf[2] = obj[1];
598 stermbuf[3] = obj[2];
599 WriteSubTerm(stermbuf,1);
613 sprintf((
char *)obuffer,
"%s(%d)=",(
char *)scratchname,i);
614 TokenToLine(obuffer);
616 WriteSubTerm(obj+1,1);
617 AO.OutSkip = oldskip;
624 for ( i = scanumber-1; i >= 0; i-- ) {
625 if ( used[i+numobjects] && i != 0 )
continue;
628 while ( t < sca->pointer ) {
629 m = t + t[2] + 1; t += *t;
631 num = ( (LONG)(m[0]) << BITSINWORD ) + m[1];
632 if ( used[num] == 0 )
goto nexti;
638 sprintf((
char *)obuffer,
"%s=",(
char *)(EXPRNAME(numexpr)));
639 TokenToLine(obuffer);
642 sprintf((
char *)obuffer,
"%s(%d)=",(
char *)scratchname,i+numobjects);
643 TokenToLine(obuffer);
644 used[i+numobjects] = 1;
647 t = sca->buffer; first = 1;
649 while ( t < sca->pointer ) {
653 if ( n < 0 ) { n = -n; TokenToLine((UBYTE *)
"-"); }
654 else if ( !first ) TokenToLine((UBYTE *)
"+");
656 if ( n != 1 || m[3] != 1 || m[4] != 1 || t == m + m[1] ) {
657 fsym = 0; RatToLine((UWORD *)(m+3),n); }
661 if ( m[2] < 0 ) TokenToLine((UBYTE *)
"/");
662 else TokenToLine((UBYTE *)
"*");
664 else if ( m[2] < 0 ) TokenToLine((UBYTE *)
"1/");
666 num = ( (LONG)(m[0]) << BITSINWORD ) + m[1];
668 sprintf((
char *)obuffer,
"%s(%s)",(
char *)scratchname,lbuf);
669 TokenToLine(obuffer);
671 sprintf((
char *)obuffer,
"**%d",m[2]);
672 TokenToLine(obuffer);
674 else if ( m[2] < -1 ) {
675 sprintf((
char *)obuffer,
"**%d",-m[2]);
676 TokenToLine(obuffer);
681 AO.OutSkip = oldskip;
685 for ( j = 1; j < totnum; j++ ) {
686 if ( used[j] == 0 )
break;
688 if ( j >= totnum )
break;
690 AC.OutputMode = VORTRANMODE;
691 AO.OutSkip = oldskip;
692 M_free(used,
"PrintOptima");
701 WORD MaxPowerOpti(LONG number)
703 SCALAR *sca = scabuffer + number;
704 WORD pow = 0, *t, *m;
706 while ( t < sca->pointer ) {
710 if ( m[2] > pow ) pow = m[2];
711 else if ( -m[2] > pow ) pow = -m[2];
723 WORD HuntNumFactor(LONG number, WORD *coef,
int par)
726 SCALAR *sca = scabuffer + number, *ss;
727 WORD *t, *tt, *ttt, *m, *mm, *coef2, ncoef, n, nn, n1, n2, nt;
730 if ( par != 1 ) { coef = AT.WorkPointer + 4; }
732 m = t + 4; i = t[2]; mm = coef; ncoef = t[3];
734 if ( ncoef < 0 ) ncoef = -ncoef;
736 while ( t < sca->pointer ) {
737 if ( AccumGCD(BHEAD (UWORD *)coef,&ncoef,(UWORD *)(t+4),t[3]) )
goto ExitHunt;
738 if ( ncoef == 3 && coef[0] == 1 && coef[1] == 1 )
return(0);
744 if ( ncoef < 0 ) ncoef = -ncoef;
745 if ( ncoef == 3 && coef[0] == 1 && coef[1] == 1 )
return(0);
749 n = (ncoef-1)/2; t = coef; m = coef+n;
750 for ( i = 0; i < n; i++ ) { nn = *t; *t++ = *m; *m++ = nn; }
752 coef2 = coef + ncoef;
753 while ( t < sca->pointer ) {
754 nt = *t; ttt = t + t[2] + 1;
756 mm = m+1; *mm++ = LNUMBER;
757 if ( MulRat(BHEAD (UWORD *)(t+4),n1,(UWORD *)coef,n,(UWORD *)coef2,&n2) )
goto ExitHunt;
760 *mm++ = i;
if ( i < 0 ) i = -i; i--;
761 tt = coef2;
while ( --i >= 0 ) *mm++ = *tt++;
763 while ( ttt < t ) *mm++ = *ttt++;
773 n = (ncoef-1)/2; t = coef; m = coef+n;
774 for ( i = 0; i < n; i++ ) { nn = *t; *t++ = *m; *m++ = nn; }
775 if ( par == 1 )
return(ncoef);
777 numnewsca = scanumber;
778 AT.WorkPointer[1] = LNUMBER;
779 AT.WorkPointer[2] = ncoef+2;
780 AT.WorkPointer[3] = ncoef;
781 m = AT.WorkPointer + ncoef + 3;
782 *m++ = (numnewsca+numobjects) >> BITSINWORD;
783 *m++ = (numnewsca+numobjects) & WORDMASK;
785 AT.WorkPointer[0] = m - AT.WorkPointer;
786 AddToOpti(AT.WorkPointer,numnewsca);
790 ss = scabuffer + numnewsca;
791 sca = scabuffer + number;
792 m = sca->buffer; sca->buffer = ss->buffer; ss->buffer = m;
793 m = sca->pointer; sca->pointer = ss->pointer; ss->pointer = m;
794 m = sca->top; sca->top = ss->top; ss->top = m;
795 a = sca->numterms; sca->numterms = ss->numterms; ss->numterms = a;
796 a = sca->bufsize; sca->bufsize = ss->bufsize; ss->bufsize = a;
800 MLOCK(ErrorMessageLock);
801 MesCall(
"HuntNumFactor");
802 MUNLOCK(ErrorMessageLock);
824 WORD HuntFactor(LONG number, WORD *factor,
int par)
828 WORD *t, *m, *ft, *fm, *fr, *frr, *fact, *coef, ncoef, retval;
831 if ( factor == 0 && par != 0 ) {
832 MLOCK(ErrorMessageLock);
833 MesPrint(
"Internal error: wrong value (%d) of par in HuntFactor",
835 MUNLOCK(ErrorMessageLock);
839 if ( factor == 0 ) factor = AT.WorkPointer;
841 ncoef = HuntNumFactor(number,coef,1);
842 if ( ncoef == 0 || ( ncoef == 3 && coef[0] == 1
843 && coef[1] == 1 ) ) {
844 retval = 0; ncoef = 3; coef[0] = coef[1] = 1; }
845 else retval = ABS(ncoef)+3;
848 coef = factor + 4; ncoef = 3; coef[0] = coef[1] = 1;
851 factor[1] = LNUMBER; factor[2] = ABS(ncoef)+2; factor[3] = ncoef;
852 factor[0] = factor[2]+1;
853 fact = factor + factor[0];
854 sca = scabuffer+number;
856 m = t + t[2] + 1; t += *t;
858 while ( m < t ) *fm++ = *m++;
859 ft = fm; size = ft - fact;
863 while ( t < sca->pointer ) {
864 m = t + t[2] + 1; t += *t;
866 while ( fm < ft && m < t ) {
867 if ( fm[0] == m[0] && fm[1] == m[1] ) {
868 if ( fm[2] == m[2] ) { m += 3; fm += 3; }
869 else if ( ( fm[2] > 0 && m[2] < 0 )
870 || ( fm[2] < 0 && m[2] > 0 ) )
goto loosethis;
871 else if ( ( m[2] > 0 && fm[2] > m[2] )
872 || ( m[2] < 0 && fm[2] < m[2] ) ) {
873 fm[2] = m[2]; m += 3; fm += 3;
875 else { m += 3; fm += 3; }
877 else if ( fm[0] < m[0] || ( fm[0] == m[0] && fm[1] < m[1] ) ) {
878 loosethis: fr = fm + 3; frr = fm;
879 while ( fr < ft ) *frr++ = *fr++;
889 ft = fm; size = ft - fact;
900 if ( par > 1 || par < -1 )
return(size);
901 fr = t = sca->buffer;
902 while ( t < sca->pointer ) {
903 frr = fr; i = t[2]+1; m = t; t += *t;
904 while ( --i >= 0 ) *fr++ = *m++;
906 while ( fm < ft && m < t ) {
907 if ( fm[0] == m[0] && fm[1] == m[1] ) {
908 if ( fm[2] == m[2] ) { m += 3; fm += 3; }
910 *fr++ = *m++; *fr++ = *m++; *fr++ = *m++ - fm[2];
914 else { *fr++ = *m++; *fr++ = *m++; *fr++ = *m++; }
916 while ( m < t ) *fr++ = *m++;
921 if ( par == 1 || par == -1 )
return(size);
927 *t++ = size + 9; *t++ = LNUMBER; *t++ = 5; *t++ = 3; *t++ = 1; *t++ = 1;
929 *t++ = ( scanumber + numobjects ) >> BITSINWORD;
930 *t++ = ( scanumber + numobjects ) & WORDMASK;
933 AddToOpti(AT.WorkPointer,newnum);
934 sca = scabuffer + number;
935 scb = scabuffer + newnum;
936 t = sca->buffer; sca->buffer = scb->buffer; scb->buffer = t;
937 t = sca->pointer; sca->pointer = scb->pointer; scb->pointer = t;
938 t = sca->top; sca->top = scb->top; scb->top = t;
939 a = sca->numterms; sca->numterms = scb->numterms; scb->numterms = a;
940 a = sca->bufsize; sca->bufsize = scb->bufsize; scb->bufsize = a;
955 void HuntPairs(LONG number, WORD power)
958 SCALAR *sca = scabuffer + number;
959 WORD *t, *tt, *m, *mm, *w, *w1, *pattern, *p, *pp, *patstop,
960 *coef, ncoef, nf, nc2, nc, *newter;
961 int patsize, i, first, pushback = 0, nons, action = 0;
962 LONG numnewsca = 0, ns;
963 pattern = AT.WorkPointer;
965 while ( t < sca->pointer ) {
966 if ( *t < 0 ) { t -= *t;
continue; }
967 w1 = t; m = t + 1 + t[2]; t += *t;
969 if ( m[2] >= power || -m[2] >= power ) {
974 if ( power == m[2] ) { w += 3; }
975 else if ( power == -m[2] ) { w += 3; }
976 else { *p++ = *w++; *p++ = *w++;
977 if ( m[2] < 0 ) *p++ = *w++ + power;
978 else *p++ = *w++ - power;
981 else { *p++ = *w++; *p++ = *w++; *p++ = *w++; }
983 patsize = p - pattern;
984 if ( patsize == 0 ) { pushback++;
goto nextm; }
985 AT.WorkPointer = patstop = p;
993 while ( tt < sca->pointer ) {
994 if ( *tt < 0 ) { tt -= *tt;
continue; }
995 w = tt; mm = tt + tt[2] + 1; tt += *tt;
996 if ( w == w1 )
continue;
997 p = pattern; pp = AT.WorkPointer + w[2] + 1;
998 while ( p < patstop && mm < tt ) {
999 if ( mm[0] == p[0] && mm[1] == p[1] ) {
1000 if ( ( p[2] > 0 && mm[2] >= p[2] )
1001 || ( p[2] < 0 && mm[2] <= p[2] ) ) {
1002 if ( mm[2] == p[2] ) { mm += 3; p += 3; }
1004 *pp++ = *mm++; *pp++ = *mm++;
1005 *pp++ = *mm++ - p[2];
1011 else { *pp++ = *mm++; *pp++ = *mm++; *pp++ = *mm++; }
1013 if ( p >= patstop ) {
1014 while ( mm < tt ) *pp++ = *mm++;
1015 p = AT.WorkPointer; mm = w+1; i = mm[1];
1016 *p++ = pp - AT.WorkPointer;
1017 while ( --i >= 0 ) *p++ = *mm++;
1019 p = pp+1; mm = w1+1; i = mm[1];
1020 while ( --i >= 0 ) *p++ = *mm++;
1021 *p++ = m[0]; *p++ = m[1];
1022 if ( m[2] < 0 ) *p++ = -power;
1026 numnewsca = scanumber;
1027 AddToOpti(pp,numnewsca);
1028 sca = scabuffer + number;
1032 NormOpti(AT.WorkPointer);
1033 AddToOpti(AT.WorkPointer,numnewsca);
1046 nf = HuntFactor(numnewsca,AT.WorkPointer,1);
1047 SortOpti(numnewsca);
1052 coef = AT.WorkPointer + 4 + nf;
1053 ns = TestNewSca(numnewsca,coef,&ncoef);
1054 if ( ns != numnewsca ) {
1065 newter = coef + 2*ABS(ncoef) + 2;
1066 ncoef = REDLENG(ncoef);
1067 nc2 = REDLENG(AT.WorkPointer[3]);
1068 if ( MulRat(BHEAD (UWORD *)coef,ncoef,(UWORD *)(AT.WorkPointer+4)
1069 ,nc2,(UWORD *)(newter+4),&nc) ) {
1070 MLOCK(ErrorMessageLock);
1071 MesCall(
"HuntPairs");
1072 MUNLOCK(ErrorMessageLock);
1076 p = AT.WorkPointer + AT.WorkPointer[2] + 1;
1077 t = AT.WorkPointer + nf;
1078 newter[2] = ABS(nc) + 2;
1080 newter[1] = LNUMBER;
1081 m = newter + newter[2] + 1;
1082 while ( p < t ) *m++ = *p++;
1083 nf = i = newter[0] = m-newter;
1084 m = newter; t = AT.WorkPointer;
1085 while ( --i >= 0 ) *t++ = *m++;
1089 AT.WorkPointer[0] = nf + 3;
1090 AT.WorkPointer[1] = LNUMBER;
1091 AT.WorkPointer[2] = nf + 2;
1092 AT.WorkPointer[3] = ncoef;
1099 m = t = sca->buffer; p = AT.WorkPointer + 1;
1100 while ( t < sca->pointer ) {
1105 *p++ = LNUMBER; *p++ = 5; *p++ = 3; *p++ = 1;
1109 p = AT.WorkPointer + nf;
1112 while ( mm < patstop ) *p++ = *mm++;
1113 *p++ = (ns+numobjects) >> BITSINWORD;
1114 *p++ = (ns+numobjects) & WORDMASK;
1116 *(AT.WorkPointer) = p - AT.WorkPointer;
1117 NormOpti(AT.WorkPointer);
1122 i = *t;
while ( --i >= 0 ) *m++ = *t++;
1124 else { t += *t; m += *m; }
1126 i = *(AT.WorkPointer); p = AT.WorkPointer;
1127 while ( --i >= 0 ) *m++ = *p++;
1128 sca->pointer = m; *m = 0;
1137 if ( action ) SortOpti(number);
1153 AT.WorkPointer = pattern;
1165 void HuntBrackets(LONG number)
1168 SCALAR *sca = scabuffer + number;
1169 WORD *t, *m, *tt, *mm, *left = 0, mostpopular[2], *coef, nf, *newter;
1170 WORD ncoef, nc2, nc;
1171 LONG mostmultiple, n, i, num, newscanum, ns;
1174 if ( sca->numterms <= 2 )
return;
1175 n = scanumber + numobjects;
1176 while ( 2*n >= multiplicitysize ) {
1177 if ( multiplicitysize == 0 ) multiplicitysize = 500;
1178 else multiplicitysize *= 2;
1179 if ( multiplicities ) M_free(multiplicities,
"multiplicities");
1180 multiplicities = (LONG *)Malloc1(multiplicitysize*
sizeof(LONG),
"multiplicities");
1182 for ( i = 0; i <= n; i++ ) {
1183 multiplicities[i] = 0; multiplicities[i+n] = 0;
1186 while ( t < sca->pointer ) {
1187 m = t + t[2] + 1; t += *t;
1189 num = ( (LONG)(m[0]) << BITSINWORD ) + m[1];
1190 if ( m[2] > 0 ) multiplicities[num]++;
1191 else multiplicities[n+num]++;
1195 for ( i = 0, num = -1, mostmultiple = 0; i <= n; i++ ) {
1196 if ( multiplicities[i] > mostmultiple ) {
1197 mostmultiple = multiplicities[i]; num = i;
1199 if ( multiplicities[i+n] > mostmultiple ) {
1200 mostmultiple = multiplicities[i+n]; num = i+n;
1203 if ( mostmultiple <= 1 )
return;
1204 if ( num > n ) { neg = 1; num -= n; }
1206 mostpopular[0] = num >> BITSINWORD;
1207 mostpopular[1] = num & WORDMASK;
1213 t = sca->buffer; newscanum = scanumber;
1214 while ( t < sca->pointer ) {
1215 m = t + t[2] + 1; tt = t; t += *t;
1217 if ( m[0] == mostpopular[0] && m[1] == mostpopular[1] ) {
1218 if ( ( neg && m[2] > 0 ) || ( !neg && m[2] < 0 ) )
break;
1219 mm = AT.WorkPointer;
1221 while ( tt < m ) *mm++ = *tt++;
1224 *mm++ = *tt++; *mm++ = *tt++; *mm++ = 1 + *tt++;
1230 *mm++ = *tt++; *mm++ = *tt++; *mm++ = *tt++ - 1;
1234 while ( tt < t ) *mm++ = *tt++;
1235 AT.WorkPointer[0] = mm - AT.WorkPointer;
1237 AddToOpti(AT.WorkPointer,newscanum);
1244 sca = scabuffer+number;
1245 while ( t < sca->pointer ) {
1246 m = t + t[2] + 1; tt = t; t += *t;
1248 if ( m[0] == mostpopular[0] && m[1] == mostpopular[1] ) {
1249 if ( ( neg && m[2] > 0 ) || ( !neg && m[2] < 0 ) )
break;
1250 mm = AT.WorkPointer;
1251 while ( tt < m ) *mm++ = *tt++;
1254 *mm++ = *tt++; *mm++ = *tt++; *mm++ = 1 + *tt++;
1260 *mm++ = *tt++; *mm++ = *tt++; *mm++ = *tt++ - 1;
1264 while ( tt < t ) *mm++ = *tt++;
1265 AT.WorkPointer[0] = mm - AT.WorkPointer;
1267 AddToOpti(AT.WorkPointer,newscanum);
1272 while ( tt < t ) *left++ = *tt++;
1280 nf = HuntFactor(newscanum,AT.WorkPointer,1);
1281 SortOpti(newscanum);
1286 coef = AT.WorkPointer + 4 + nf;
1287 ns = TestNewSca(newscanum,coef,&ncoef);
1288 if ( ns != newscanum ) {
1299 newter = coef + 2*ABS(ncoef) + 2;
1300 ncoef = REDLENG(ncoef);
1301 nc2 = REDLENG(AT.WorkPointer[3]);
1302 if ( MulRat(BHEAD (UWORD *)coef,ncoef,(UWORD *)(AT.WorkPointer+4),nc2
1303 ,(UWORD *)(newter+4),&nc) ) {
1304 MLOCK(ErrorMessageLock);
1305 MesCall(
"HuntPairs");
1306 MUNLOCK(ErrorMessageLock);
1310 tt = AT.WorkPointer + AT.WorkPointer[2] + 1;
1311 t = AT.WorkPointer + nf;
1312 newter[1] = LNUMBER;
1313 newter[2] = ABS(nc) + 2;
1315 m = newter + newter[2] + 1;
1316 while ( tt < t ) *m++ = *tt++;
1317 nf = j = newter[0] = m-newter;
1318 m = newter; t = AT.WorkPointer;
1319 while ( --j >= 0 ) *t++ = *m++;
1323 AT.WorkPointer[0] = nf + 3;
1324 AT.WorkPointer[1] = LNUMBER;
1325 AT.WorkPointer[2] = nf + 2;
1326 AT.WorkPointer[3] = ncoef;
1331 m = AT.WorkPointer + 1;
1332 *m++ = LNUMBER; *m++ = 5; *m++ = 3; *m++ = 1; *m++ = 1;
1333 *m++ = mostpopular[0];
1334 *m++ = mostpopular[1];
1335 if ( neg ) *m++ = -1;
1339 t = AT.WorkPointer + nf;
1340 m = AT.WorkPointer + AT.WorkPointer[2] + 1;
1342 if ( m[0] == mostpopular[0] && m[1] == mostpopular[1] ) {
1350 *m++ = mostpopular[0];
1351 *m++ = mostpopular[1];
1352 if ( neg ) *m++ = -1;
1357 *m++ = (ns+numobjects) >> BITSINWORD;
1358 *m++ = (ns+numobjects) & WORDMASK;
1360 *(AT.WorkPointer) = m - AT.WorkPointer;
1361 NormOpti(AT.WorkPointer);
1362 j = *(AT.WorkPointer); m = AT.WorkPointer;
1363 while ( --j >= 0 ) *left++ = *m++;
1364 sca->pointer = left; *left = 0;
1378 void HuntNumBrackets(LONG number)
1394 void HuntPowers(LONG number, WORD power)
1397 SCALAR *sca = scabuffer + number;
1398 WORD *t1, *m1, *r1, *t2, *m2, *r2, *t3, *m3, *r3, *quotient, *extra
1399 , *q, n1, n2, n3, nq;
1401 quotient = AT.WorkPointer;
1403 while ( t1 < sca->pointer ) {
1404 m1 = t1 + t1[2] + 1; r1 = t1; t1 += *t1;
1406 if ( m1[2] >= power ) {
1411 n1 = REDLENG(r1[3]); t2 = t1; m1 = r1 + r1[2] + 1;
1412 while ( t2 < sca->pointer ) {
1413 m2 = t2 + t2[2] + 1; r2 = t2; t2 += *t2;
1414 n2 = REDLENG(r2[3]);
1415 if ( DivRat(BHEAD (UWORD *)(r2+4),n2,(UWORD *)(r1+4),n1,
1416 (UWORD *)(quotient+4),&nq) )
goto callHP;
1417 if ( TakeRatRoot((UWORD *)(quotient+4),&nq,power) )
continue;
1419 quotient[2] = ABS(n2)+2; quotient[3] = n2;
1420 quotient[1] = LNUMBER; q = quotient + quotient[2] + 1;
1421 while ( m2 < t2 && m1 < t1 ) {
1422 if ( *m1 == *m2 && m1[1] == m2[1] ) {
1423 if ( ((m2[2]-m1[2])%power) != 0 )
goto nextt2;
1424 *q++ = *m1++; *q++ = *m1++;
1425 *q++ = (m2[2]-*m1++)/power;
1428 else if ( *m1 < *m2 || ( *m1 == *m2 && m1[1] < m2[1] ) ) {
1429 if ( ( m1[2] % power ) != 0 )
goto nextt2;
1430 *q++ = *m1++; *q++ = *m1++; *q++ = -*m1++ / power;
1433 if ( ( m2[2] % power ) != 0 )
goto nextt2;
1434 *q++ = *m2++; *q++ = *m2++; *q++ = *m2++ / power;
1438 if ( ( m1[2] % power ) != 0 )
goto nextt2;
1439 *q++ = *m1++; *q++ = *m1++; *q++ = -*m1++ / power;
1442 if ( ( m2[2] % power ) != 0 )
goto nextt2;
1443 *q++ = *m2++; *q++ = *m2++; *q++ = *m2++ / power;
1445 quotient[0] = q - quotient;
1455 extra = quotient + quotient[0];
1456 if ( DivRat(BHEAD (UWORD *)(r1+4),n1,(UWORD *)(quotient+4),nq
1457 ,(UWORD *)(extra+4),&n3) )
goto callHP;
1458 if ( Mully(BHEAD (UWORD *)(extra+4),&n3,(UWORD *)(&power),1) )
goto callHP;
1460 extra[1] = LNUMBER; extra[2] = ABS(n2)+2; extra[3] = n2;
1461 m3 = extra + extra[2] + 1;
1462 m1 = r1 + r1[2] + 1;
1463 m2 = quotient + quotient[2] + 1;
1464 while ( m1 < t1 && m2 < q ) {
1465 if ( m1[0] == m2[0] && m1[1] == m2[1] ) {
1466 if ( m1[2] == m2[2] ) { m1+=3; }
1468 *m3++ = *m1++; *m3++ = *m1++; *m3++ = *m1++ - m2[2];
1472 else if ( m1[0] < m2[0] || ( m1[0] == m2[0]
1473 && m1[1] < m2[1] ) ) {
1474 *m3++ = *m1++; *m3++ = *m1++; *m3++ = *m1++;
1477 *m3++ = *m2++; *m3++ = *m2++; *m3++ = *m2++;
1481 *m3++ = *m1++; *m3++ = *m1++; *m3++ = *m1++;
1484 *m3++ = *m2++; *m3++ = *m2++; *m3++ = *m2++;
1486 extra[0] = m3 - extra;
1491 while ( t3 < sca->pointer ) {
1493 if ( *r3 != *extra )
continue;
1494 if ( r3[2] != extra[2] )
continue;
1495 for ( i = 4; i < *r3; i++ ) {
1496 if ( extra[i] != r3[i] )
break;
1498 if ( i < *r3 )
continue;
1503 if ( ( power & 1 ) != 0 && quotient[3] > 0 )
goto nextt2;
1504 if ( quotient[3] > 0 ) quotient[3] = -quotient[3];
1506 else if ( quotient[3] < 0 )
goto nextt2;
1520 MLOCK(ErrorMessageLock);
1521 MesCall(
"HuntPowers");
1522 MUNLOCK(ErrorMessageLock);
1538 WORD *t1, *m1, *tt1, *t2, *m2, *tt2, *fill;
1540 for ( i1 = 0; i1 < scanumber; i1++ ) {
1541 sca1 = scabuffer + i1;
1542 for ( i2 = 0; i2 < scanumber; i2++ ) {
1543 sca2 = scabuffer + i2;
1544 if ( sca2->numterms <= sca1->numterms )
continue;
1545 t1 = sca1->buffer; t2 = sca2->buffer;
1546 tt1 = t1; t1 += *t1;
1550 while ( t2 < sca2->pointer ) {
1551 if ( *tt1 != *t2 ) { t2 += *t2;
continue; }
1552 m1 = tt1 + tt1[2] + 1;
1553 m2 = t2 + t2[2] + 1; tt2 = t2; t2 += *t2;
1554 while ( m1 < t1 && m2 < t2 ) {
1555 if ( *m1 != *m2 || m1[1] != m2[1] || m1[2] != m2[2] )
break;
1558 if ( m1 >= t1 && m2 >= t2 ) {
1562 if ( tt1[2] != tt2[2] )
goto nexti2;
1564 if ( tt2[3] > 0 ) sign = 1;
1568 if ( tt2[3] < 0 ) sign = 1;
1571 m1 = tt1 + tt1[2] + 1;
1573 while ( tt1 < m1 ) {
1574 if ( *tt1 != *tt2 )
goto nexti2;
1580 if ( t2 >= sca2->pointer )
goto nexti2;
1581 while ( t1 < sca1->pointer && t2 < sca2->pointer ) {
1582 if ( *t1 != *t2 ) { t2 += *t2;
continue; }
1583 tt1 = t1 + *t1; m1 = t1 + t1[2] + 1;
1584 tt2 = t2 + *t2; m2 = t2 + t2[2] + 1;
1585 while ( m1 < tt1 && m2 < tt2 ) {
1586 if ( *m1 != *m2 || m1[1] != m2[1] || m1[2] != m2[2] )
break;
1589 if ( m1 >= tt1 && m2 >= tt2 ) {
1590 if ( t1[2] != t2[2] )
goto nexti2;
1591 if ( sign*t1[3] != t2[3] )
goto nexti2;
1592 m1 = t1 + t1[2] + 1; t1 += 4; t2 += 4;
1594 if ( *t1 != *t2 )
goto nexti2;
1601 if ( t1 < sca1->pointer )
goto nexti2;
1605 t1 = sca1->buffer; fill = t2 = sca2->buffer;
1607 while ( t1 < sca1->pointer && t2 < sca2->pointer ) {
1608 if ( *t1 != *t2 ) { t2 += *t2;
continue; }
1609 m1 = t1 + t1[2] + 1; tt1 = t1 + *t1;
1610 m2 = t2 + t2[2] + 1; tt2 = t2 + *t2;
1611 while ( m1 < tt1 && m2 < tt2 ) {
1612 if ( *m1 != *m2 || m1[1] != m2[1] || m1[2] != m2[2] )
break;
1615 if ( m1 >= tt1 && m2 >= tt2 ) {
1619 while ( t2 < tt2 ) *fill++ = *t2++;
1623 while ( t2 < sca2->pointer ) {
1624 j = *t2;
while ( --j >= 0 ) *fill++ = *t2++;
1627 *fill++ = 9; *fill++ = LNUMBER; *fill++ = 5;
1628 *fill++ = sign*3; *fill++ = 1; *fill++ = 1;
1629 *fill++ = ( i1+numobjects ) >> BITSINWORD;
1630 *fill++ = ( i1+numobjects ) & WORDMASK; *fill++ = 1;
1633 sca2->pointer = fill;
1645 LONG TestNewSca(LONG number, WORD *coef, WORD *ncoef)
1648 SCALAR *sca = scabuffer + number, *s;
1649 WORD *t1, *t2, *m1, *m2, *coef2, ncoef2, n1, n2;
1652 for ( i = 0, s = scabuffer; i < scanumber; i++, s++ ) {
1653 if ( i == number )
continue;
1654 if ( sca->numterms != s->numterms )
continue;
1661 while ( t1 < sca->pointer && t2 < s->pointer ) {
1662 m1 = t1 + t1[2] + 1; t1 += *t1;
1663 m2 = t2 + t2[2] + 1; t2 += *t2;
1664 while ( m1 < t1 && m2 < t2 ) {
1665 if ( *m1 != *m2 || m1[1] != m2[1] || m1[2] != m2[2] ) {
1669 if ( m1 < t1 || m2 < t2 ) { no = 1;
break; }
1677 n1 = REDLENG(t1[3]); n2 = REDLENG(t2[3]);
1678 DivRat(BHEAD (UWORD *)(t1+4),n1,(UWORD *)(t2+4),n2,(UWORD *)coef,ncoef);
1679 t1 += *t1; t2 += *t2;
1680 coef2 = coef + 2*ABS(*ncoef)+2;
1681 while ( t1 < sca->pointer && t2 < s->pointer ) {
1682 n1 = REDLENG(t1[3]); n2 = REDLENG(t2[3]);
1683 DivRat(BHEAD (UWORD *)(t1+4),n1,(UWORD *)(t2+4),n2,(UWORD *)coef2,&ncoef2);
1684 if ( *ncoef != ncoef2 )
break;
1686 while ( --ii >= 0 ) {
1687 if ( coef[ii] != coef2[ii] )
break;
1689 if ( ii >= 0 )
break;
1690 t1 += *t1; t2 += *t2;
1692 if ( t1 >= sca->pointer && t2 >= s->pointer ) {
1696 sca->pointer = sca->buffer;
1698 *ncoef = INCLENG(*ncoef);
1711 void NormOpti(WORD *term)
1713 WORD *t, *m, *w, *tt, a;
1714 tt = m = term + term[2] + 4; t = term + *term;
1717 while ( w >= tt && ( w[0] < w[-3]
1718 || ( w[0] == w[-3] && w[1] < w[-2] ) ) ) {
1719 a = w[0]; w[0] = w[-3]; w[-3] = a;
1720 a = w[1]; w[1] = w[-2]; w[-2] = a;
1721 a = w[2]; w[2] = w[-1]; w[-1] = a;
1733 void SortOpti(LONG number)
1735 SCALAR *sca = scabuffer + number;
1736 WORD *newbuffer, *t, *m, **p, j;
1737 LONG i, newsize, num = 0;
1738 if ( sca->numterms <= 1 )
return;
1739 if ( (sca->numterms+sca->numterms/2) > sizepointers ) {
1740 if ( sortpointers ) M_free(sortpointers,
"optisort");
1741 sizepointers = sca->numterms + sca->numterms/2 + 10;
1742 sortpointers = (WORD **)Malloc1(sizepointers*
sizeof(WORD *),
"optisort");
1746 while ( t < sca->pointer ) { *p++ = t; t += *t; num++; }
1747 if ( num != sca->numterms ) {
1748 MLOCK(ErrorMessageLock);
1749 MesPrint(
"Help! sca->numterms = %l, actual number = %l",
1750 sca->numterms, num);
1751 MUNLOCK(ErrorMessageLock);
1754 SplitOpti(sortpointers,num);
1755 newsize = ( sca->pointer - sca->buffer ) + 2;
1756 newbuffer = (WORD *)Malloc1(newsize*
sizeof(WORD),
"optisort2");
1758 for ( i = 0; i < num; i++ ) {
1759 t = sortpointers[i]; j = *t;
1760 while ( --j >= 0 ) *m++ = *t++;
1762 sca->numterms = num;
1764 M_free(sca->buffer,
"optisort2");
1765 sca->buffer = newbuffer; sca->pointer = m; sca->top = sca->buffer + newsize;
1766 sca->bufsize = newsize;
1776 void SplitOpti(WORD **pointers, LONG number)
1778 WORD *t1, *t2, *m1, *m2, **p;
1780 LONG left, right, i, j;
1781 if ( number <= 1 )
return;
1782 if ( number == 2 ) {
1783 t1 = pointers[0]; t2 = pointers[1];
1784 m1 = t1 + t1[2] + 1; m2 = t2 + t2[2] + 1;
1785 t1 += *t1; t2 += *t2;
1787 while ( m1 < t1 && m2 < t2 ) {
1788 if ( m1[0] > m2[0] ) { n = 1;
break; }
1789 else if ( m1[0] < m2[0] )
return;
1790 if ( m1[1] > m2[1] ) { n = 1;
break; }
1791 else if ( m1[1] < m2[1] )
return;
1792 if ( m1[2] < m2[2] ) { n = 1;
break; }
1793 else if ( m1[2] > m2[2] )
return;
1796 if ( n > 0 || m1 < t1 ) {
1797 t1 = pointers[0]; pointers[0] = pointers[1]; pointers[1] = t1;
1802 right = number - left;
1803 SplitOpti(pointers,left);
1804 SplitOpti(pointers+left,right);
1805 for ( i = 0; i < left; i++ ) helppointers[i] = pointers[i];
1806 i = 0; j = left; p = pointers;
1807 while ( i < left && j < number ) {
1808 t1 = helppointers[i]; t2 = pointers[j];
1809 m1 = t1 + t1[2] + 1; m2 = t2 + t2[2] + 1;
1810 t1 += *t1; t2 += *t2;
1812 while ( m1 < t1 && m2 < t2 ) {
1813 if ( m1[0] > m2[0] ) { n = 1;
break; }
1814 else if ( m1[0] < m2[0] ) { n = -1;
break; }
1815 if ( m1[1] > m2[1] ) { n = 1;
break; }
1816 else if ( m1[1] < m2[1] ) { n = -1;
break; }
1817 if ( m1[2] < m2[2] ) { n = 1;
break; }
1818 else if ( m1[2] > m2[2] ) { n = -1;
break; }
1821 if ( n > 0 || ( n == 0 && m1 < t1 ) ) { *p++ = pointers[j++]; }
1822 else *p++ = helppointers[i++];
1824 while ( i < left ) *p++ = helppointers[i++];