FORM v5.0.1-23-g7a8f756
sort.c
Go to the documentation of this file.
1
17/* #[ License : */
18/*
19 * Copyright (C) 1984-2026 J.A.M. Vermaseren
20 * When using this file you are requested to refer to the publication
21 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
22 * This is considered a matter of courtesy as the development was paid
23 * for by FOM the Dutch physics granting agency and we would like to
24 * be able to track its scientific use to convince FOM of its value
25 * for the community.
26 *
27 * This file is part of FORM.
28 *
29 * FORM is free software: you can redistribute it and/or modify it under the
30 * terms of the GNU General Public License as published by the Free Software
31 * Foundation, either version 3 of the License, or (at your option) any later
32 * version.
33 *
34 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
35 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
36 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
37 * details.
38 *
39 * You should have received a copy of the GNU General Public License along
40 * with FORM. If not, see <http://www.gnu.org/licenses/>.
41 */
42/* #] License : */
43/*
44 #[ Includes : sort.c
45
46 Sort routines according to new conventions (25-jun-1997).
47 This is more object oriented.
48 The active sort is indicated by AT.SS which should agree with
49 AN.FunSorts[AR.sLevel];
50
51#define GZIPDEBUG
52*/
53#define NEWSPLITMERGE
54/* Comment to turn off Timsort in SplitMerge for debugging: */
55#define NEWSPLITMERGETIMSORT
56/* During SplitMerge, print pointer array state on entry. Very spammy, for debugging. */
57/* #define SPLITMERGEDEBUG */
58/* Debug printing for GarbHand */
59/* #define TESTGARB */
60
61#include "form3.h"
62#include <math.h>
63
64#ifdef WITHPTHREADS
65UBYTE THRbuf[100];
66#endif
67
68#ifdef WITHSTATS
69extern LONG numwrites;
70extern LONG numreads;
71extern LONG numseeks;
72extern LONG nummallocs;
73extern LONG numfrees;
74#endif
75
76/*
77 #] Includes :
78 #[ SortUtilities :
79 #[ WriteStats : void WriteStats(lspace,par,checkLogType)
80*/
81
82char *toterms[] = { " ", " >>", "-->" };
83
84#define HUMANSTRLEN 12
85#define HUMANSUFFLEN 4
86#define HUMANSUFFSTRLEN 4
87const char humanTermsSuffix[HUMANSUFFLEN][HUMANSUFFSTRLEN] = {"K ","M ","B ","T "};
88const char humanBytesSuffix[HUMANSUFFLEN][HUMANSUFFSTRLEN] = {"KiB","MiB","GiB","TiB"};
89void HumanString(char* string, float input, const char suffix[HUMANSUFFLEN][HUMANSUFFSTRLEN]) {
90 int ind = -1;
91 while (ind < 0 || (input >= 1000.0f && ind+1 < HUMANSUFFLEN) ) {
92 input /= 1000.0f;
93 ind++;
94 }
95 if ( input <= 0.5f ) {
96 snprintf(string, HUMANSTRLEN,
97 " ( <1 %s)", suffix[ind]);
98 }
99 else {
100 snprintf(string, HUMANSTRLEN,
101 " (%3ld %s)", lroundf(input), suffix[ind]);
102 }
103}
104
105#define COL_EXP 16
106#define COL_SPA 8
107#define COL_EQU 42
108#define COL_VAL 53
109
110WORD DigitsIn(LONG x) {
111 if ( x < 0 ) x = -x;
112 WORD dig = 1;
113 while ( x > 9 ) {
114 dig++;
115 x /= 10;
116 }
117 return dig;
118}
119
136void WriteStats(POSITION *plspace, WORD par, WORD checkLogType)
137{
138 GETIDENTITY
139 char buf[120];
140 LONG millitime;
141 UWORD timepart;
142 SORTING *S;
143 int use_wtime;
144
145 if ( AT.SS == AT.S0 && AC.StatsFlag ) {
146#ifdef WITHPTHREADS
147 if ( AC.ThreadStats == 0 && identity > 0 ) return;
148#elif defined(WITHMPI)
149 if ( AC.OldParallelStats ) return;
150 if ( ! AC.ProcessStats && PF.me != MASTER ) return;
151#endif
152 if ( Expressions == 0 ) return;
153
154 if ( par == STATSSPLITMERGE ) {
155 if ( AC.ShortStatsMax == 0 ) return;
156 AR.ShortSortCount++;
157 if ( AR.ShortSortCount < AC.ShortStatsMax ) return;
158 }
159 AR.ShortSortCount = 0;
160
161 S = AT.SS;
162
163 char humanGenTermsText[HUMANSTRLEN] = "";
164 char humanTermsLeftText[HUMANSTRLEN] = "";
165 char humanBytesText[HUMANSTRLEN] = "";
166 char humanUnsortedBytesText[HUMANSTRLEN] = "";
167 char humanComparisonsText[HUMANSTRLEN] = "";
168 char humanMaxTermSizeText[HUMANSTRLEN] = "";
169 if ( AC.HumanStatsFlag ) {
170 HumanString(humanGenTermsText, (float)(S->GenTerms), humanTermsSuffix);
171 HumanString(humanTermsLeftText, (float)(S->TermsLeft), humanTermsSuffix);
172 HumanString(humanBytesText, (float)(BASEPOSITION(*plspace)), humanBytesSuffix);
173 HumanString(humanUnsortedBytesText, (float)(S->verbUnsortedSize), humanBytesSuffix);
174 HumanString(humanComparisonsText, (float)(S->verbComparisons), humanTermsSuffix);
175 HumanString(humanMaxTermSizeText, (float)(S->verbMaxTermSize), humanTermsSuffix);
176 }
177
178 MLOCK(ErrorMessageLock);
179
180 /* If the statistics should not go to the log file, temporarily hide the
181 * LogHandle. This must be done within the ErrorMessageLock region to
182 * avoid a data race between threads. */
183 const WORD oldLogHandle = AC.LogHandle;
184 if ( checkLogType && AM.LogType ) {
185 AC.LogHandle = -1;
186 }
187
188 if ( AC.ShortStats ) {}
189 else {
190#ifdef WITHPTHREADS
191 if ( identity > 0 ) {
192 MesPrint(" Thread %d reporting",identity);
193 }
194 else {
195 MesPrint("");
196 }
197#elif defined(WITHMPI)
198 if ( PF.me != MASTER ) {
199 MesPrint(" Process %d reporting",PF.me);
200 }
201 else {
202 MesPrint("");
203 }
204#else
205 MesPrint("");
206#endif
207 }
208 /*
209 * We define WTimeStatsFlag as a flag to print the wall-clock time on
210 * the *master*, not in workers. This can be confusing in thread
211 * statistics when short statistics is used. Technically,
212 * TimeWallClock() is not thread-safe in TFORM.
213 */
214 use_wtime = AC.WTimeStatsFlag;
215#if defined(WITHPTHREADS)
216 if ( use_wtime && identity > 0 ) use_wtime = 0;
217#elif defined(WITHMPI)
218 if ( use_wtime && PF.me != MASTER ) use_wtime = 0;
219#endif
220 char *wpref = use_wtime ? "W" : "";
221 char *wspac = use_wtime ? "" : " ";
222 millitime = use_wtime ? TimeWallClock(1) * 10 : TimeCPU(1);
223 timepart = (UWORD)(millitime%1000);
224 millitime /= 1000;
225 timepart /= 10;
226
227 if ( AC.ShortStats ) {
228#if defined(WITHPTHREADS) || defined(WITHMPI)
229#ifdef WITHPTHREADS
230 if ( identity > 0 ) {
231#else
232 if ( PF.me != MASTER ) {
233 const int identity = PF.me;
234#endif
235 if ( par == STATSSPLITMERGE || par == STATSPOSTSORT ) {
236 snprintf(buf, sizeof(buf),
237 "%d: %7ld.%02us %8ld>%10ld%3s%10ld:%10ld %s %s",identity,
238 millitime,timepart,AN.ninterms,S->GenTerms,toterms[par],
239 S->TermsLeft,BASEPOSITION(*plspace),EXPRNAME(AR.CurExpr),
240 AC.Commercial);
241 MesPrint("%s", buf);
242 }
243 else if ( par == STATSMERGETOFILE ) {
244 snprintf(buf, sizeof(buf),
245 "%d: %7ld.%02us %10ld:%10ld",identity,millitime,timepart,
246 S->TermsLeft,BASEPOSITION(*plspace));
247 MesPrint("%s", buf);
248 }
249 }
250 else
251#endif
252 {
253 if ( par == STATSSPLITMERGE || par == STATSPOSTSORT ) {
254 snprintf(buf, sizeof(buf),
255 "%7ld.%02us %8ld>%10ld%3s%10ld:%10ld %s %s",
256 millitime,timepart,AN.ninterms,S->GenTerms,toterms[par],
257 S->TermsLeft,BASEPOSITION(*plspace),EXPRNAME(AR.CurExpr),
258 AC.Commercial);
259 MesPrint("%s", buf);
260 }
261 else if ( par == STATSMERGETOFILE ) {
262 snprintf(buf, sizeof(buf),
263 "%7ld.%02us %10ld:%10ld",millitime,timepart,
264 S->TermsLeft,BASEPOSITION(*plspace));
265 MesPrint("%s", buf);
266 }
267 }
268 }
269 else {
270 if ( par == STATSMERGETOFILE ) {
271 snprintf(buf, sizeof(buf),
272 "%sTime = %7ld.%02u sec",wpref,millitime,timepart);
273 MesPrint("%s", buf);
274 }
275 else {
276 snprintf(buf, sizeof(buf),
277 "%sTime = %7ld.%02u sec %sGenerated terms =%11ld%s",
278 wpref, millitime, timepart, wspac, S->GenTerms, humanGenTermsText);
279 MesPrint("%s", buf);
280 }
281
282 const int exprlen = strlen((char*)EXPRNAME(AR.CurExpr));
283 const int overflow = MaX(0, exprlen - COL_EXP);
284 if ( par == STATSSPLITMERGE ) {
285 int width = snprintf(buf, sizeof(buf),
286 "%*s %*ld Terms %s",
287 COL_EXP, EXPRNAME(AR.CurExpr),
288 MaX(0,COL_SPA-1-overflow), AN.ninterms, FG.swmes[par]);
289 width += snprintf(buf+width, sizeof(buf)-width,
290 "%*s=",
291 MaX(0,COL_EQU-1-width), "");
292 snprintf(buf+width, sizeof(buf)-width,
293 "%*ld%s",
294 MaX(0,COL_VAL-width), S->TermsLeft, humanTermsLeftText);
295 MesPrint("%s", buf);
296 }
297 else {
298#ifdef WITHPTHREADS
299 if ( identity > 0 && par == STATSPOSTSORT ) {
300 int width = snprintf(buf, sizeof(buf),
301 "%*s%*s Terms in thread",
302 COL_EXP, EXPRNAME(AR.CurExpr), MaX(0,COL_SPA-overflow), "");
303 width += snprintf(buf+width, sizeof(buf)-width,
304 "%*s=",
305 MaX(0,COL_EQU-1-width), "");
306 snprintf(buf+width, sizeof(buf)-width,
307 "%*ld%s",
308 MaX(0,COL_VAL-width), S->TermsLeft, humanTermsLeftText);
309 MesPrint("%s", buf);
310 }
311 else
312#elif defined(WITHMPI)
313 if ( PF.me != MASTER && par == STATSPOSTSORT ) {
314 int width = snprintf(buf, sizeof(buf),
315 "%*s%*s Terms in process=",
316 COL_EXP, EXPRNAME(AR.CurExpr), MaX(0,COL_SPA-overflow), "");
317 snprintf(buf+width, sizeof(buf)-width,
318 "%*ld%s",
319 MaX(0,COL_VAL-width), S->TermsLeft, humanTermsLeftText);
320 MesPrint("%s", buf);
321 }
322 else
323#endif
324 {
325 int width = snprintf(buf, sizeof(buf),
326 "%*s%*s Terms %s",
327 COL_EXP, EXPRNAME(AR.CurExpr), MaX(0,COL_SPA-overflow), "",
328 FG.swmes[par]);
329 width += snprintf(buf+width, sizeof(buf)-width,
330 "%*s=",
331 MaX(0,COL_EQU-1-width), "");
332 snprintf(buf+width, sizeof(buf)-width,
333 "%*ld%s",
334 MaX(0,COL_VAL-width), S->TermsLeft, humanTermsLeftText);
335 MesPrint("%s", buf);
336 }
337 }
338
339 const WORD dig = DigitsIn(BASEPOSITION(*plspace));
340 snprintf(buf, sizeof(buf),
341 "%*s Bytes used%*s=%11ld%s",
342 COL_EXP+COL_SPA, AC.Commercial, MiN(6,17-dig), "",
343 BASEPOSITION(*plspace), humanBytesText);
344 MesPrint("%s", buf);
345 }
346
347 if ( par == STATSPOSTSORT ) {
348 if ( AC.SortVerbose ) {
349 snprintf(buf, sizeof(buf), "%*s Unsorted bytes =%11ld%s",
350 COL_EXP+COL_SPA, "", S->verbUnsortedSize, humanUnsortedBytesText);
351 MesPrint("%s", buf);
352 snprintf(buf, sizeof(buf), "%*s Small Buffer =%5ld,%5ld",
353 COL_EXP+COL_SPA, "", S->verbSBsortTerms, S->verbSBsortCap);
354 MesPrint("%s", buf);
355 snprintf(buf, sizeof(buf), "%*s Large Buffer =%5ld,%5ld",
356 COL_EXP+COL_SPA, "", S->verbLBsortPatches, S->verbLBsortCap);
357 MesPrint("%s", buf);
358 snprintf(buf, sizeof(buf), "%*s Comparisons =%11ld%s",
359 COL_EXP+COL_SPA, "", S->verbComparisons, humanComparisonsText);
360 MesPrint("%s", buf);
361 snprintf(buf, sizeof(buf), "%24s Largest Term =%11ld%s",
362 "",S->verbMaxTermSize,humanMaxTermSizeText);
363 MesPrint("%s", buf);
364 }
365 }
366
367#ifdef WITHSTATS
368 MesPrint("Total number of writes: %l, reads: %l, seeks, %l"
369 ,numwrites,numreads,numseeks);
370 MesPrint("Total number of mallocs: %l, frees: %l"
371 ,nummallocs,numfrees);
372#endif
373 /* Put back the original LogHandle, it was changed if the statistics were
374 * not printed in the log file. */
375 AC.LogHandle = oldLogHandle;
376
377 MUNLOCK(ErrorMessageLock);
378 }
379}
380
381/*
382 #] WriteStats :
383 #[ NewSort : WORD NewSort()
384*/
395int NewSort(PHEAD0)
396{
397 GETBIDENTITY
398 SORTING *S, **newFS;
399 int i, newsize;
400 if ( AN.SoScratC == 0 )
401 AN.SoScratC = (UWORD *)Malloc1(2*(AM.MaxTal+2)*sizeof(UWORD),"NewSort");
402 AR.sLevel++;
403 if ( AR.sLevel >= AN.NumFunSorts ) {
404 if ( AN.NumFunSorts == 0 ) newsize = 100;
405 else newsize = 2*AN.NumFunSorts;
406 newFS = (SORTING **)Malloc1((newsize+1)*sizeof(SORTING *),"FunSort pointers");
407 for ( i = 0; i < AN.NumFunSorts; i++ ) newFS[i] = AN.FunSorts[i];
408 for ( ; i <= newsize; i++ ) newFS[i] = 0;
409 if ( AN.FunSorts ) M_free(AN.FunSorts,"FunSort pointers");
410 AN.FunSorts = newFS; AN.NumFunSorts = newsize;
411 }
412 if ( AR.sLevel == 0 ) {
413
414 AN.FunSorts[0] = AT.S0;
415 if ( AR.PolyFun == 0 ) { AT.S0->PolyFlag = 0; }
416 else if ( AR.PolyFunType == 1 ) { AT.S0->PolyFlag = 1; }
417 else if ( AR.PolyFunType == 2 ) {
418 if ( AR.PolyFunExp == 2
419 || AR.PolyFunExp == 3 ) AT.S0->PolyFlag = 1;
420 else AT.S0->PolyFlag = 2;
421 }
422 AR.ShortSortCount = 0;
423 }
424 else {
425 if ( AN.FunSorts[AR.sLevel] == 0 ) {
426 AN.FunSorts[AR.sLevel] = AllocSort(
427 AM.SLargeSize,AM.SSmallSize,AM.SSmallEsize,AM.STermsInSmall
428 ,AM.SMaxPatches,AM.SMaxFpatches,AM.SIOsize,1);
429 }
430 AN.FunSorts[AR.sLevel]->PolyFlag = 0;
431 }
432 AT.SS = S = AN.FunSorts[AR.sLevel];
433 S->sFill = S->sBuffer;
434 S->lFill = S->lBuffer;
435 S->lPatch = 0;
436 S->fPatchN = 0;
437 S->GenTerms = S->TermsLeft = S->GenSpace = S->SpaceLeft = 0;
438 S->PoinFill = S->sPointer;
439 *S->PoinFill = S->sFill;
440 if ( AR.sLevel > 0 ) { S->PolyWise = 0; }
441 PUTZERO(S->SizeInFile[0]); PUTZERO(S->SizeInFile[1]); PUTZERO(S->SizeInFile[2]);
442 S->sTerms = 0;
443 PUTZERO(S->file.POposition);
444 S->stage4 = 0;
445 if ( AR.sLevel > AN.MaxFunSorts ) AN.MaxFunSorts = AR.sLevel;
446
447 // Zero the SortVerbose counters:
448 S->verbComparisons = 0;
449 S->verbMaxTermSize = 0;
450 S->verbSBsortTerms = 0;
451 S->verbSBsortCap = 0;
452 S->verbLBsortPatches = 0;
453 S->verbLBsortCap = 0;
454 S->verbUnsortedSize = 0;
455 return(0);
456}
457
458/*
459 #] NewSort :
460 #[ EndSort : WORD EndSort(PHEAD buffer,par)
461*/
486LONG EndSort(PHEAD WORD *buffer, int par)
487{
488 GETBIDENTITY
489 SORTING *S = AT.SS;
490 WORD j, **ss, *to, *t;
491 LONG sSpace, over, tover, spare, retval = 0;
492 POSITION position, pp;
493 off_t lSpace;
494 FILEHANDLE *fout = 0, *oldoutfile = 0, *newout = 0;
495
496 if ( AM.exitflag && AR.sLevel == 0 ) return(0);
497#ifdef WITHMPI
498 if( (retval = PF_EndSort()) > 0){
499 oldoutfile = AR.outfile;
500 retval = 0;
501 goto RetRetval;
502 }
503 else if(retval < 0){
504 retval = -1;
505 goto RetRetval;
506 }
507 /* PF_EndSort returned 0: for S != AM.S0 and slaves still do the regular sort */
508#endif /* WITHMPI */
509 oldoutfile = AR.outfile;
510/* PolyFlag repair action
511 if ( S == AT.S0 ) {
512 if ( AR.PolyFun == 0 ) { S->PolyFlag = 0; }
513 else if ( AR.PolyFunType == 1 ) { S->PolyFlag = 1; }
514 else if ( AR.PolyFunType == 2 ) {
515 if ( AR.PolyFunExp == 2
516 || AR.PolyFunExp == 3 ) S->PolyFlag = 1;
517 else S->PolyFlag = 2;
518 }
519 S->PolyWise = 0;
520 }
521 else {
522 S->PolyFlag = S->PolyWise = 0;
523 }
524*/
525 S->PolyWise = 0;
526 *(S->PoinFill) = 0;
527#ifdef SPLITTIME
528 PrintTime((UBYTE *)"EndSort, before SplitMerge");
529#endif
530 S->sPointer[SplitMerge(BHEAD S->sPointer,S->sTerms)] = 0;
531#ifdef SPLITTIME
532 PrintTime((UBYTE *)"Endsort, after SplitMerge");
533#endif
534 sSpace = 0;
535 tover = over = S->sTerms;
536 ss = S->sPointer;
537 if ( over >= 0 ) {
538 if ( S->lPatch > 0 || S->file.handle >= 0 ) {
539 ss[over] = 0;
540 sSpace = ComPress(ss,&spare);
541 S->TermsLeft -= over - spare;
542 if ( par == 1 ) { AR.outfile = newout = AllocFileHandle(0,(char *)0); }
543 }
544 else if ( S != AT.S0 ) {
545 ss[over] = 0;
546 if ( par == 2 ) {
547 sSpace = 3;
548 while ( ( t = *ss++ ) != 0 ) { sSpace += *t; }
549 if ( AN.tryterm > 0 && ( (sSpace+1)*sizeof(WORD) < (size_t)(AM.MaxTer) ) ) {
550 to = TermMalloc("$-sort space");
551 }
552 else {
553 LONG allocsp = sSpace+1;
554 if ( allocsp < MINALLOC ) allocsp = MINALLOC;
555 allocsp = ((allocsp+7)/8)*8;
556 to = (WORD *)Malloc1(allocsp*sizeof(WORD),"$-sort space");
557 if ( AN.tryterm > 0 ) AN.tryterm = 0;
558 }
559 *((WORD **)buffer) = to;
560 ss = S->sPointer;
561 while ( ( t = *ss++ ) != 0 ) {
562 j = *t; while ( --j >= 0 ) *to++ = *t++;
563 }
564 *to = 0;
565 retval = sSpace + 1;
566 }
567 else {
568 to = buffer;
569 sSpace = 0;
570 while ( ( t = *ss++ ) != 0 ) {
571 j = *t;
572 if ( ( sSpace += j ) > AM.MaxTer/((LONG)sizeof(WORD)) ) {
573 /* Too big! Get the total size for useful error message */
574 while ( ( t = *ss++ ) != 0 ) {
575 sSpace += *t;
576 }
577 MLOCK(ErrorMessageLock);
578 MesPrint("Sorted function argument too long (%d words). Increase MaxTermSize (%l words).", sSpace, AM.MaxTer/((LONG)sizeof(WORD)));
579 MUNLOCK(ErrorMessageLock);
580 retval = -1; goto RetRetval;
581 }
582 while ( --j >= 0 ) *to++ = *t++;
583 }
584 *to = 0;
585 retval = to - buffer;
586 }
587 goto RetRetval;
588 }
589 else {
590 POSITION oldpos;
591 if ( S == AT.S0 ) {
592 fout = AR.outfile;
593 *AR.CompressPointer = 0;
594 SeekScratch(AR.outfile,&position);
595 }
596 else {
597 fout = &(S->file);
598 PUTZERO(position);
599 }
600 oldpos = position;
601 S->TermsLeft = 0;
602/*
603 Here we can go directly to the output.
604*/
605#ifdef WITHZLIB
606 { int oldgzipCompress = AR.gzipCompress;
607 AR.gzipCompress = 0;
608#endif
609 if ( tover > 0 ) {
610 ss = S->sPointer;
611 while ( ( t = *ss++ ) != 0 ) {
612 if ( *t ) S->TermsLeft++;
613#ifdef WITHPTHREADS
614 if ( AS.MasterSort && ( fout == AR.outfile ) ) { PutToMaster(BHEAD t); }
615 else
616#endif
617 if ( PutOut(BHEAD t,&position,fout,1) < 0 ) {
618 retval = -1; goto RetRetval;
619 }
620 }
621 }
622#ifdef WITHPTHREADS
623 if ( AS.MasterSort && ( fout == AR.outfile ) ) { PutToMaster(BHEAD 0); }
624 else
625#endif
626 if ( FlushOut(&position,fout,1) ) {
627 retval = -1; goto RetRetval;
628 }
629#ifdef WITHZLIB
630 AR.gzipCompress = oldgzipCompress;
631 }
632#endif
633#ifdef WITHPTHREADS
634 if ( AS.MasterSort && ( fout == AR.outfile ) ) goto RetRetval;
635#endif
636#ifdef WITHMPI
637 if ( PF.me != MASTER && PF.exprtodo < 0 ) goto RetRetval;
638#endif
639 DIFPOS(oldpos,position,oldpos);
640 S->SpaceLeft = BASEPOSITION(oldpos);
641 WriteStats(&oldpos,STATSPOSTSORT,NOCHECKLOGTYPE);
642 pp = oldpos;
643 goto RetRetval;
644 }
645 }
646 else if ( par == 1 && newout == 0 ) { AR.outfile = newout = AllocFileHandle(0,(char *)0); }
647 sSpace++;
648 lSpace = sSpace + (S->lFill - S->lBuffer) - (LONG)S->lPatch*(AM.MaxTer/sizeof(WORD));
649/* Note wrt MaxTer and lPatch: each patch starts with space for decompression */
650/* Not needed if only large buffer, but needed when using files (?) */
651 SETBASEPOSITION(pp,lSpace);
652 MULPOS(pp,sizeof(WORD));
653 if ( S->file.handle >= 0 ) {
654 ADD2POS(pp,S->fPatches[S->fPatchN]);
655 }
656 if ( S == AT.S0 ) {
657 if ( S->lPatch > 0 || S->file.handle >= 0 ) {
658 WriteStats(&pp,STATSSPLITMERGE,CHECKLOGTYPE);
659 }
660 }
661 if ( par == 2 ) { AR.outfile = newout = AllocFileHandle(0,(char *)0); }
662 if ( S->lPatch > 0 ) {
663 if ( ( S->lPatch >= S->MaxPatches ) ||
664 ( ( (WORD *)(((UBYTE *)(S->lFill + sSpace)) + 2*AM.MaxTer) ) >= S->lTop ) ) {
665/*
666 The large buffer is too full. Merge and write it
667*/
668 // Update SortVerbose counters
669 if ( S->lPatch >= S->MaxPatches ) S->verbLBsortPatches++;
670 else S->verbLBsortCap++;
671
672#ifdef GZIPDEBUG
673 MLOCK(ErrorMessageLock);
674 MesPrint("%w EndSort: lPatch = %d, MaxPatches = %d,lFill = %x, sSpace = %ld, MaxTer = %d, lTop = %x"
675 ,S->lPatch,S->MaxPatches,S->lFill,sSpace,AM.MaxTer/sizeof(WORD),S->lTop);
676 MUNLOCK(ErrorMessageLock);
677#endif
678
679 if ( MergePatches(1) ) {
680 MLOCK(ErrorMessageLock);
681 MesCall("EndSort");
682 MUNLOCK(ErrorMessageLock);
683 retval = -1; goto RetRetval;
684 }
685 S->lPatch = 0;
686 pp = S->SizeInFile[1];
687 MULPOS(pp,sizeof(WORD));
688#ifndef WITHPTHREADS
689 if ( S == AT.S0 )
690#endif
691 {
692 POSITION pppp;
693 SETBASEPOSITION(pppp,0);
694 SeekFile(S->file.handle,&pppp,SEEK_CUR);
695 SeekFile(S->file.handle,&pp,SEEK_END);
696 SeekFile(S->file.handle,&pppp,SEEK_SET);
697 WriteStats(&pp,STATSMERGETOFILE,CHECKLOGTYPE);
698 UpdateMaxSize();
699 }
700 }
701 else {
702 S->Patches[S->lPatch++] = S->lFill;
703 to = (WORD *)(((UBYTE *)(S->lFill)) + AM.MaxTer);
704 if ( tover > 0 ) {
705 ss = S->sPointer;
706 while ( ( t = *ss++ ) != 0 ) {
707 j = *t;
708 if ( j < 0 ) j = t[1] + 2;
709 while ( --j >= 0 ) *to++ = *t++;
710 }
711 }
712 *to++ = 0;
713 S->lFill = to;
714 if ( S->file.handle < 0 ) {
715 if ( MergePatches(2) ) {
716 MLOCK(ErrorMessageLock);
717 MesCall("EndSort");
718 MUNLOCK(ErrorMessageLock);
719 retval = -1; goto RetRetval;
720 }
721 if ( S == AT.S0 ) {
722 pp = S->SizeInFile[2];
723 MULPOS(pp,sizeof(WORD));
724#ifdef WITHPTHREADS
725 if ( AS.MasterSort && ( fout == AR.outfile ) ) goto RetRetval;
726#endif
727 WriteStats(&pp,STATSPOSTSORT,NOCHECKLOGTYPE);
728 UpdateMaxSize();
729 }
730 else {
731 if ( par == 2 && newout->handle >= 0 ) {
732 POSITION zeropos;
733 PUTZERO(zeropos);
734#ifdef ALLLOCK
735 LOCK(newout->pthreadslock);
736#endif
737 SeekFile(newout->handle,&zeropos,SEEK_SET);
738 to = (WORD *)Malloc1(BASEPOSITION(newout->filesize)+sizeof(WORD)*2
739 ,"$-buffer reading");
740 if ( AN.tryterm > 0 ) AN.tryterm = 0;
741 if ( ( retval = ReadFile(newout->handle,(UBYTE *)to,BASEPOSITION(newout->filesize)) ) !=
742 BASEPOSITION(newout->filesize) ) {
743 MLOCK(ErrorMessageLock);
744 MesPrint("Error reading information for $ variable");
745 MUNLOCK(ErrorMessageLock);
746 M_free(to,"$-buffer reading");
747 retval = -1;
748 }
749 else {
750 *((WORD **)buffer) = to;
751 retval /= sizeof(WORD);
752 }
753#ifdef ALLLOCK
754 UNLOCK(newout->pthreadslock);
755#endif
756 }
757 else if ( newout->handle >= 0 ) {
758/*
759 We land here if par == 1 (function arg sort) and PutOut has created a file.
760 This means that the term is larger than SIOsize, which we ensure is at least
761 as large as MaxTermSize in setfile.c. Thus we know already that the term won't fit.
762*/
763TooLarge:
764 MLOCK(ErrorMessageLock);
765 MesPrint("(1)Output should fit inside a single term. Increase MaxTermSize?");
766 MesCall("EndSort");
767 MUNLOCK(ErrorMessageLock);
768 retval = -1; goto RetRetval;
769 }
770 else {
771 t = newout->PObuffer;
772 // We deal with the par == 2 case after RetRetval.
773 if ( par != 2 ) {
774 j = newout->POfill - t;
775 to = buffer;
776 if ( to >= AT.WorkSpace && to < AT.WorkTop && to+j > AT.WorkTop )
777 goto WorkSpaceError;
778 if ( j > AM.MaxTer ) {
779 MLOCK(ErrorMessageLock);
780 MesPrint("Encountered term of size: %d words.", j/(LONG)sizeof(WORD) );
781 MUNLOCK(ErrorMessageLock);
782 goto TooLarge;
783 }
784 NCOPY(to,t,j);
785 retval = to - buffer - 1;
786 }
787 }
788 }
789 goto RetRetval;
790 }
791 if ( MergePatches(1) ) { /* --> SortFile */
792 MLOCK(ErrorMessageLock);
793 MesCall("EndSort");
794 MUNLOCK(ErrorMessageLock);
795 retval = -1; goto RetRetval;
796 }
797 UpdateMaxSize();
798 pp = S->SizeInFile[1];
799 MULPOS(pp,sizeof(WORD));
800#ifndef WITHPTHREADS
801 if ( S == AT.S0 )
802#endif
803 {
804 POSITION pppp;
805 SETBASEPOSITION(pppp,0);
806 SeekFile(S->file.handle,&pppp,SEEK_CUR);
807 SeekFile(S->file.handle,&pp,SEEK_END);
808 SeekFile(S->file.handle,&pppp,SEEK_SET);
809 WriteStats(&pp,STATSMERGETOFILE,CHECKLOGTYPE);
810 }
811#ifdef WITHERRORXXX
812 if ( S != AT.S0 ) {
813/*
814 This is wrong! We have sorted to the sort file.
815 Things are not sitting in the output yet.
816*/
817 if ( newout->handle >= 0 ) goto TooLarge;
818 t = newout->PObuffer;
819 j = newout->POfill - t;
820 to = buffer;
821 if ( to >= AT.WorkSpace && to < AT.WorkTop && to+j > AT.WorkTop )
822 goto WorkSpaceError;
823 if ( j > AM.MaxTer ) goto TooLarge;
824 NCOPY(to,t,j);
825 goto RetRetval;
826 }
827#endif
828 }
829 }
830 if ( S->file.handle >= 0 ) {
831#ifdef GZIPDEBUG
832 MLOCK(ErrorMessageLock);
833 MesPrint("%w EndSort: fPatchN = %d, lPatch = %d, position = %12p"
834 ,S->fPatchN,S->lPatch,&(S->fPatches[S->fPatchN]));
835 MUNLOCK(ErrorMessageLock);
836#endif
837 if ( S->lPatch <= 0 ) {
838 StageSort(&(S->file));
839 position = S->fPatches[S->fPatchN];
840 ss = S->sPointer;
841 if ( *ss ) {
842 *AR.CompressPointer = 0;
843#ifdef WITHZLIB
844 if ( S == AT.S0 && AR.NoCompress == 0 && AR.gzipCompress > 0 )
845 S->fpcompressed[S->fPatchN] = 1;
846 else
847 S->fpcompressed[S->fPatchN] = 0;
848 SetupOutputGZIP(&(S->file));
849#endif
850 while ( ( t = *ss++ ) != 0 ) {
851 if ( PutOut(BHEAD t,&position,&(S->file),1) < 0 ) {
852 retval = -1; goto RetRetval;
853 }
854 }
855 if ( FlushOut(&position,&(S->file),1) ) {
856 retval = -1; goto RetRetval;
857 }
858 ++(S->fPatchN);
859 S->fPatches[S->fPatchN] = position;
860 UpdateMaxSize();
861#ifdef GZIPDEBUG
862 MLOCK(ErrorMessageLock);
863 MesPrint("%w EndSort+: fPatchN = %d, lPatch = %d, position = %12p"
864 ,S->fPatchN,S->lPatch,&(S->fPatches[S->fPatchN]));
865 MUNLOCK(ErrorMessageLock);
866#endif
867 }
868 }
869 AR.Stage4Name = 0;
870#ifdef WITHPTHREADS
871 if ( AS.MasterSort && AC.ThreadSortFileSynch ) {
872 if ( S->file.handle >= 0 ) {
873 SynchFile(S->file.handle);
874 }
875 }
876#endif
877 UpdateMaxSize();
878 if ( MergePatches(0) ) {
879 MLOCK(ErrorMessageLock);
880 MesCall("EndSort");
881 MUNLOCK(ErrorMessageLock);
882 retval = -1; goto RetRetval;
883 }
884 S->stage4 = 0;
885#ifdef WITHPTHREADS
886 if ( AS.MasterSort && ( fout == AR.outfile ) ) goto RetRetval;
887#endif
888 pp = S->SizeInFile[0];
889 MULPOS(pp,sizeof(WORD));
890 WriteStats(&pp,STATSPOSTSORT,NOCHECKLOGTYPE);
891 UpdateMaxSize();
892 }
893RetRetval:
894
895#ifdef WITHMPI
896 /* NOTE: PF_EndSort has been changed such that it sets S->TermsLeft. (TU 30 Jun 2011) */
897 if ( AR.sLevel == 0 && (PF.me == MASTER || PF.exprtodo >= 0) ) {
898 Expressions[AR.CurExpr].counter = S->TermsLeft;
899 Expressions[AR.CurExpr].size = pp;
900 }
901#else
902 if ( AR.sLevel == 0 ) {
903 Expressions[AR.CurExpr].counter = S->TermsLeft;
904 Expressions[AR.CurExpr].size = pp;
905 }/*if ( AR.sLevel == 0 )*/
906#endif
907/*:[25nov2003 mt]*/
908 if ( S->file.handle >= 0 && ( par != 1 ) && ( par != 2 ) ) {
909 /* sortfile is still open */
910 UpdateMaxSize();
911#ifdef WITHZLIB
912 ClearSortGZIP(&(S->file));
913#endif
914 CloseFile(S->file.handle);
915 S->file.handle = -1;
916 remove(S->file.name);
917#ifdef GZIPDEBUG
918 MLOCK(ErrorMessageLock);
919 MesPrint("%wEndSort: sortfile %s removed",S->file.name);
920 MUNLOCK(ErrorMessageLock);
921#endif
922 }
923 AR.outfile = oldoutfile;
924 AR.sLevel--;
925 if ( AR.sLevel >= 0 ) AT.SS = AN.FunSorts[AR.sLevel];
926 if ( par == 1 ) {
927 if ( retval < 0 ) {
928 UpdateMaxSize();
929 if ( newout ) {
930 DeAllocFileHandle(newout);
931 newout = 0;
932 }
933 }
934 else if ( newout ) {
935 if ( newout->handle >= 0 ) {
936 MLOCK(ErrorMessageLock);
937 MesPrint("(2)Output should fit inside a single term. Increase MaxTermSize?");
938 MesCall("EndSort");
939 MUNLOCK(ErrorMessageLock);
940 Terminate(-1);
941 }
942 else if ( newout->POfill > newout->PObuffer ) {
943/*
944 Here we have to copy the contents of the 'file' into
945 the buffer. We assume that this buffer lies in the WorkSpace.
946 Hence
947*/
948 j = newout->POfill-newout->PObuffer;
949 if ( buffer >= AT.WorkSpace && buffer < AT.WorkTop && buffer+j > AT.WorkTop )
950 goto WorkSpaceError;
951 else {
952 to = buffer; t = newout->PObuffer;
953 while ( j-- > 0 ) *to++ = *t++;
954 }
955 UpdateMaxSize();
956 }
957 DeAllocFileHandle(newout);
958 newout = 0;
959 }
960 }
961 else if ( par == 2 ) {
962 if ( newout ) {
963 if ( retval == 0 ) {
964 if ( newout->handle >= 0 ) {
965/*
966 output resides at the moment in a file
967 Find the size, make a buffer, copy into the buffer and clean up.
968*/
969 POSITION zeropos;
970 PUTZERO(position);
971#ifdef ALLLOCK
972 LOCK(newout->pthreadslock);
973#endif
974 SeekFile(newout->handle,&position,SEEK_END);
975 PUTZERO(zeropos);
976 SeekFile(newout->handle,&zeropos,SEEK_SET);
977 to = (WORD *)Malloc1(BASEPOSITION(position)+sizeof(WORD)*3
978 ,"$-buffer reading");
979 if ( AN.tryterm > 0 ) AN.tryterm = 0;
980 if ( ( retval = ReadFile(newout->handle,(UBYTE *)to,BASEPOSITION(position)) ) !=
981 BASEPOSITION(position) ) {
982 MLOCK(ErrorMessageLock);
983 MesPrint("Error reading information for $ variable");
984 MUNLOCK(ErrorMessageLock);
985 M_free(to,"$-buffer reading");
986 retval = -1;
987 }
988 else {
989 *((WORD **)buffer) = to;
990 retval /= sizeof(WORD);
991 }
992#ifdef ALLLOCK
993 UNLOCK(newout->pthreadslock);
994#endif
995 }
996 else {
997/*
998 output resides in the cache buffer and the file was never opened
999*/
1000 LONG wsiz = newout->POfill - newout->PObuffer;
1001 if ( AN.tryterm > 0 && ( (wsiz+2)*sizeof(WORD) < (size_t)(AM.MaxTer) ) ) {
1002 to = TermMalloc("$-sort space");
1003 }
1004 else {
1005 LONG allocsp = wsiz+2;
1006 if ( allocsp < MINALLOC ) allocsp = MINALLOC;
1007 allocsp = ((allocsp+7)/8)*8;
1008 to = (WORD *)Malloc1(allocsp*sizeof(WORD),"$-buffer reading");
1009 if ( AN.tryterm > 0 ) AN.tryterm = 0;
1010 }
1011 *((WORD **)buffer) = to; t = newout->PObuffer;
1012 retval = wsiz;
1013 NCOPY(to,t,wsiz);
1014 }
1015 }
1016 UpdateMaxSize();
1017 DeAllocFileHandle(newout);
1018 newout = 0;
1019 }
1020 }
1021 else {
1022 if ( newout ) {
1023 DeAllocFileHandle(newout);
1024 newout = 0;
1025 }
1026 }
1027
1028 return(retval);
1029WorkSpaceError:
1030 MLOCK(ErrorMessageLock);
1031 MesWork();
1032 MesCall("EndSort");
1033 MUNLOCK(ErrorMessageLock);
1034 Terminate(-1);
1035 return(-1);
1036}
1037
1038/*
1039 #] EndSort :
1040 #[ PutIn : LONG PutIn(handle,position,buffer,take,npat)
1041*/
1057LONG PutIn(FILEHANDLE *file, POSITION *position, WORD *buffer, WORD **take, int npat)
1058{
1059 LONG i, RetCode;
1060 WORD *from, *to;
1061#ifndef WITHZLIB
1062 DUMMYUSE(npat);
1063#endif
1064 from = buffer + ( file->POsize * sizeof(UBYTE) )/sizeof(WORD);
1065 i = from - *take;
1066 if ( i*((LONG)(sizeof(WORD))) > AM.MaxTer ) {
1067 MLOCK(ErrorMessageLock);
1068 MesPrint("Problems in PutIn");
1069 MUNLOCK(ErrorMessageLock);
1070 Terminate(-1);
1071 }
1072 to = buffer;
1073 while ( --i >= 0 ) *--to = *--from;
1074 *take = to;
1075#ifdef WITHZLIB
1076 if ( ( RetCode = FillInputGZIP(file,position,(UBYTE *)buffer
1077 ,file->POsize,npat) ) < 0 ) {
1078 MLOCK(ErrorMessageLock);
1079 MesPrint("PutIn: We have RetCode = %x while reading %x bytes",
1080 RetCode,file->POsize);
1081 MUNLOCK(ErrorMessageLock);
1082 Terminate(-1);
1083 }
1084#else
1085#ifdef ALLLOCK
1086 LOCK(file->pthreadslock);
1087#endif
1088 SeekFile(file->handle,position,SEEK_SET);
1089 if ( ( RetCode = ReadFile(file->handle,(UBYTE *)buffer,file->POsize) ) < 0 ) {
1090#ifdef ALLLOCK
1091 UNLOCK(file->pthreadslock);
1092#endif
1093 MLOCK(ErrorMessageLock);
1094 MesPrint("PutIn: We have RetCode = %x while reading %x bytes",
1095 RetCode,file->POsize);
1096 MUNLOCK(ErrorMessageLock);
1097 Terminate(-1);
1098 }
1099#ifdef ALLLOCK
1100 UNLOCK(file->pthreadslock);
1101#endif
1102#endif
1103 return(RetCode);
1104}
1105
1106/*
1107 #] PutIn :
1108 #[ Sflush : WORD Sflush(file)
1109*/
1117int Sflush(FILEHANDLE *fi)
1118{
1119 LONG size, RetCode;
1120#ifdef WITHZLIB
1121 GETIDENTITY
1122 int dobracketindex = 0;
1123 if ( AR.sLevel <= 0 && Expressions[AR.CurExpr].newbracketinfo
1124 && ( fi == AR.outfile || fi == AR.hidefile ) ) dobracketindex = 1;
1125#endif
1126 if ( fi->handle < 0 ) {
1127 if ( ( RetCode = CreateFile(fi->name) ) >= 0 ) {
1128#ifdef GZIPDEBUG
1129 MLOCK(ErrorMessageLock);
1130 MesPrint("%w Sflush created scratch file %s",fi->name);
1131 MUNLOCK(ErrorMessageLock);
1132#endif
1133 fi->handle = (WORD)RetCode;
1134 PUTZERO(fi->filesize);
1135 PUTZERO(fi->POposition);
1136 }
1137 else {
1138 MLOCK(ErrorMessageLock);
1139 MesPrint("Cannot create scratch file %s",fi->name);
1140 MUNLOCK(ErrorMessageLock);
1141 return(-1);
1142 }
1143 }
1144#ifdef WITHZLIB
1145 if ( AT.SS == AT.S0 && !AR.NoCompress && AR.gzipCompress > 0
1146 && dobracketindex == 0 ) {
1147 if ( FlushOutputGZIP(fi) ) return(-1);
1148 fi->POfill = fi->PObuffer;
1149 }
1150 else
1151#endif
1152 {
1153#ifdef ALLLOCK
1154 LOCK(fi->pthreadslock);
1155#endif
1156 size = (fi->POfill-fi->PObuffer)*sizeof(WORD);
1157 SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1158 if ( WriteFile(fi->handle,(UBYTE *)(fi->PObuffer),size) != size ) {
1159#ifdef ALLLOCK
1160 UNLOCK(fi->pthreadslock);
1161#endif
1162 MLOCK(ErrorMessageLock);
1163 MesPrint("Write error while finishing sort. Disk full?");
1164 MUNLOCK(ErrorMessageLock);
1165 return(-1);
1166 }
1167 ADDPOS(fi->filesize,size);
1168 ADDPOS(fi->POposition,size);
1169 fi->POfill = fi->PObuffer;
1170#ifdef ALLLOCK
1171 UNLOCK(fi->pthreadslock);
1172#endif
1173 }
1174 return(0);
1175}
1176
1177/*
1178 #] Sflush :
1179 #[ PutOut : WORD PutOut(term,position,file,ncomp)
1180*/
1203WORD PutOut(PHEAD WORD *term, POSITION *position, FILEHANDLE *fi, WORD ncomp)
1204{
1205 GETBIDENTITY
1206 WORD i, *p, ret, *r, *rr, j, k, first;
1207 int dobracketindex = 0;
1208 LONG RetCode;
1209
1210 if ( AT.SS != AT.S0 ) {
1211/*
1212 For this case no compression should be used
1213*/
1214 if ( ( i = *term ) <= 0 ) return(0);
1215 ret = i;
1216 ADDPOS(*position,i*sizeof(WORD));
1217 p = fi->POfill;
1218 do {
1219 if ( p >= fi->POstop ) {
1220 if ( fi->handle < 0 ) {
1221 if ( ( RetCode = CreateFile(fi->name) ) >= 0 ) {
1222#ifdef GZIPDEBUG
1223 MLOCK(ErrorMessageLock);
1224 MesPrint("%w PutOut created sortfile %s",fi->name);
1225 MUNLOCK(ErrorMessageLock);
1226#endif
1227 fi->handle = (WORD)RetCode;
1228 PUTZERO(fi->filesize);
1229 PUTZERO(fi->POposition);
1230/*
1231 Should not be here anymore?
1232#ifdef WITHZLIB
1233 fi->ziobuffer = 0;
1234#endif
1235*/
1236 }
1237 else {
1238 MLOCK(ErrorMessageLock);
1239 MesPrint("Cannot create scratch file %s",fi->name);
1240 MUNLOCK(ErrorMessageLock);
1241 return(-1);
1242 }
1243 }
1244#ifdef ALLLOCK
1245 LOCK(fi->pthreadslock);
1246#endif
1247 if ( fi == AR.hidefile ) {
1248 LOCK(AS.inputslock);
1249 }
1250 SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1251 if ( ( RetCode = WriteFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize) ) != fi->POsize ) {
1252 if ( fi == AR.hidefile ) {
1253 UNLOCK(AS.inputslock);
1254 }
1255#ifdef ALLLOCK
1256 UNLOCK(fi->pthreadslock);
1257#endif
1258 MLOCK(ErrorMessageLock);
1259 MesPrint("Write error during sort. Disk full?");
1260 MesPrint("Attempt to write %l bytes on file %d at position %15p",
1261 fi->POsize,fi->handle,&(fi->POposition));
1262 MesPrint("RetCode = %l, Buffer address = %l",RetCode,(LONG)(fi->PObuffer));
1263 MUNLOCK(ErrorMessageLock);
1264 return(-1);
1265 }
1266 ADDPOS(fi->filesize,fi->POsize);
1267 p = fi->PObuffer;
1268 ADDPOS(fi->POposition,fi->POsize);
1269 if ( fi == AR.hidefile ) {
1270 UNLOCK(AS.inputslock);
1271 }
1272#ifdef ALLLOCK
1273 UNLOCK(fi->pthreadslock);
1274#endif
1275#ifdef WITHPTHREADS
1276 if ( AS.MasterSort && AC.ThreadSortFileSynch ) {
1277 if ( fi->handle >= 0 ) SynchFile(fi->handle);
1278 }
1279#endif
1280 }
1281 *p++ = *term++;
1282 } while ( --i > 0 );
1283 fi->POfull = fi->POfill = p;
1284 return(ret);
1285 }
1286 if ( ( AP.PreDebug & DUMPOUTTERMS ) == DUMPOUTTERMS ) {
1287 MLOCK(ErrorMessageLock);
1288#ifdef WITHPTHREADS
1289 snprintf((char *)(THRbuf),100,"PutOut(%d)",AT.identity);
1290 PrintTerm(term,(char *)(THRbuf));
1291#else
1292 PrintTerm(term,"PutOut");
1293#endif
1294 MesPrint("ncomp = %d, AR.NoCompress = %d, AR.sLevel = %d",ncomp,AR.NoCompress,AR.sLevel);
1295 MesPrint("File %s, position %p",fi->name,position);
1296 MUNLOCK(ErrorMessageLock);
1297 }
1298
1299 if ( AR.sLevel <= 0 && Expressions[AR.CurExpr].newbracketinfo
1300 && ( fi == AR.outfile || fi == AR.hidefile ) ) dobracketindex = 1;
1301 r = rr = AR.CompressPointer;
1302 first = j = k = ret = 0;
1303 if ( ( i = *term ) != 0 ) {
1304 if ( i < 0 ) { /* Compressed term */
1305 i = term[1] + 2;
1306 if ( fi == AR.outfile || fi == AR.hidefile ) {
1307 MLOCK(ErrorMessageLock);
1308 MesPrint("Ran into precompressed term");
1309 MUNLOCK(ErrorMessageLock);
1310 Terminate(-1);
1311 return(-1);
1312 }
1313 }
1314 else if ( !AR.NoCompress && ( ncomp > 0 ) && AR.sLevel <= 0 ) { /* Must compress */
1315 if ( dobracketindex ) {
1316 PutBracketInIndex(BHEAD term,position);
1317 }
1318 j = *r++ - 1;
1319 p = term + 1;
1320 i--;
1321 if ( AR.PolyFun ) {
1322 WORD *polystop, *sa;
1323 sa = p + i;
1324 sa -= ABS(sa[-1]);
1325 polystop = p;
1326 while ( polystop < sa && *polystop != AR.PolyFun ) {
1327 polystop += polystop[1];
1328 }
1329 if ( polystop < sa ) {
1330 if ( AR.PolyFunType == 2 ) polystop[2] &= ~MUSTCLEANPRF;
1331 while ( i > 0 && j > 0 && *p == *r && p < polystop ) {
1332 i--; j--; k--; p++; r++;
1333 }
1334 }
1335 else {
1336 while ( i > 0 && j > 0 && *p == *r && p < sa ) { i--; j--; k--; p++; r++; }
1337 }
1338 }
1339#ifdef WITHFLOAT
1340 else if ( AT.aux_ != 0 ) {
1341 WORD *floatstop, *sa;
1342 sa = p + i;
1343 sa -= ABS(sa[-1]);
1344 floatstop = p;
1345 while ( floatstop < sa && *floatstop != FLOATFUN ) {
1346 floatstop += floatstop[1];
1347 }
1348 if ( floatstop < sa ) {
1349 while ( i > 0 && j > 0 && *p == *r && p < floatstop ) {
1350 i--; j--; k--; p++; r++;
1351 }
1352 }
1353 else {
1354 while ( i > 0 && j > 0 && *p == *r && p < sa ) { i--; j--; k--; p++; r++; }
1355 }
1356 }
1357#endif
1358 else {
1359 WORD *sa;
1360 sa = p + i;
1361 sa -= ABS(sa[-1]);
1362 while ( i > 0 && j > 0 && *p == *r && p < sa ) { i--; j--; k--; p++; r++; }
1363 }
1364 if ( k > -2 ) {
1365nocompress:
1366 j = i = *term;
1367 k = 0;
1368 p = term;
1369 r = rr;
1370 NCOPY(r,p,j);
1371 }
1372 else {
1373 *rr = *term;
1374 term = p;
1375 j = i;
1376 NCOPY(r,p,j);
1377 j = i;
1378 i += 2;
1379 first = 2;
1380 }
1381/* Sabotage getting into the coefficient next time */
1382 r[-(ABS(r[-1]))] = 0;
1383 if ( r >= AR.ComprTop ) {
1384 MLOCK(ErrorMessageLock);
1385 MesPrint("CompressSize of %10l is insufficient",AM.CompressSize);
1386 MUNLOCK(ErrorMessageLock);
1387 Terminate(-1);
1388 return(-1);
1389 }
1390 }
1391 else if ( !AR.NoCompress && ( ncomp < 0 ) && AR.sLevel <= 0 ) {
1392 /* No compress but put in compress buffer anyway */
1393 if ( dobracketindex ) {
1394 PutBracketInIndex(BHEAD term,position);
1395 }
1396 j = *r++ - 1;
1397 p = term + 1;
1398 i--;
1399 if ( AR.PolyFun ) {
1400 WORD *polystop, *sa;
1401 sa = p + i;
1402 sa -= ABS(sa[-1]);
1403 polystop = p;
1404 while ( polystop < sa && *polystop != AR.PolyFun ) {
1405 polystop += polystop[1];
1406 }
1407 if ( polystop < sa ) {
1408 if ( AR.PolyFunType == 2 ) polystop[2] &= ~MUSTCLEANPRF;
1409 while ( i > 0 && j > 0 && *p == *r && p < polystop ) {
1410 i--; j--; k--; p++; r++;
1411 }
1412 }
1413 else {
1414 while ( i > 0 && j > 0 && *p == *r ) { i--; j--; k--; p++; r++; }
1415 }
1416 }
1417 else {
1418 while ( i > 0 && j > 0 && *p == *r ) { i--; j--; k--; p++; r++; }
1419 }
1420 goto nocompress;
1421 }
1422 else {
1423 if ( AR.PolyFunType == 2 ) {
1424 WORD *t, *tstop;
1425 tstop = term + *term;
1426 tstop -= ABS(tstop[-1]);
1427 t = term+1;
1428 while ( t < tstop ) {
1429 if ( *t == AR.PolyFun ) {
1430 t[2] &= ~MUSTCLEANPRF;
1431 }
1432 t += t[1];
1433 }
1434 }
1435 if ( dobracketindex ) {
1436 PutBracketInIndex(BHEAD term,position);
1437 }
1438 }
1439 ret = i;
1440 ADDPOS(*position,i*sizeof(WORD));
1441 p = fi->POfill;
1442 do {
1443 if ( p >= fi->POstop ) {
1444#ifdef WITHMPI /* [16mar1998 ar] */
1445 if ( PF.me != MASTER && AR.sLevel <= 0 && (fi == AR.outfile || fi == AR.hidefile) && PF.parallel && PF.exprtodo < 0 ) {
1446 PF_BUFFER *sbuf = PF.sbuf;
1447 sbuf->fill[sbuf->active] = fi->POstop;
1448 PF_ISendSbuf(MASTER,PF_BUFFER_MSGTAG);
1449 p = fi->PObuffer = fi->POfill = fi->POfull =
1450 sbuf->buff[sbuf->active];
1451 fi->POstop = sbuf->stop[sbuf->active];
1452 }
1453 else
1454#endif /* WITHMPI [16mar1998 ar] */
1455 {
1456 if ( fi->handle < 0 ) {
1457 if ( ( RetCode = CreateFile(fi->name) ) >= 0 ) {
1458#ifdef GZIPDEBUG
1459 MLOCK(ErrorMessageLock);
1460 MesPrint("%w PutOut created sortfile %s",fi->name);
1461 MUNLOCK(ErrorMessageLock);
1462#endif
1463 fi->handle = (WORD)RetCode;
1464 PUTZERO(fi->filesize);
1465 PUTZERO(fi->POposition);
1466/*
1467 Should not be here?
1468#ifdef WITHZLIB
1469 fi->ziobuffer = 0;
1470#endif
1471*/
1472 }
1473 else {
1474 MLOCK(ErrorMessageLock);
1475 MesPrint("Cannot create scratch file %s",fi->name);
1476 MUNLOCK(ErrorMessageLock);
1477 return(-1);
1478 }
1479 }
1480#ifdef WITHZLIB
1481 if ( !AR.NoCompress && ncomp > 0 && AR.gzipCompress > 0
1482 && dobracketindex == 0 && fi->zsp != 0 ) {
1483 fi->POfill = p;
1484 if ( PutOutputGZIP(fi) ) return(-1);
1485 p = fi->PObuffer;
1486 }
1487 else
1488#endif
1489 {
1490#ifdef ALLLOCK
1491 LOCK(fi->pthreadslock);
1492#endif
1493 if ( fi == AR.hidefile ) {
1494 LOCK(AS.inputslock);
1495 }
1496 SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1497 if ( ( RetCode = WriteFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize) ) != fi->POsize ) {
1498 if ( fi == AR.hidefile ) {
1499 UNLOCK(AS.inputslock);
1500 }
1501#ifdef ALLLOCK
1502 UNLOCK(fi->pthreadslock);
1503#endif
1504 MLOCK(ErrorMessageLock);
1505 MesPrint("Write error during sort. Disk full?");
1506 MesPrint("Attempt to write %l bytes on file %d at position %15p",
1507 fi->POsize,fi->handle,&(fi->POposition));
1508 MesPrint("RetCode = %l, Buffer address = %l",RetCode,(LONG)(fi->PObuffer));
1509 MUNLOCK(ErrorMessageLock);
1510 return(-1);
1511 }
1512 ADDPOS(fi->filesize,fi->POsize);
1513 p = fi->PObuffer;
1514 ADDPOS(fi->POposition,fi->POsize);
1515 if ( fi == AR.hidefile ) {
1516 UNLOCK(AS.inputslock);
1517 }
1518#ifdef ALLLOCK
1519 UNLOCK(fi->pthreadslock);
1520#endif
1521#ifdef WITHPTHREADS
1522 if ( AS.MasterSort && AC.ThreadSortFileSynch ) {
1523 if ( fi->handle >= 0 ) SynchFile(fi->handle);
1524 }
1525#endif
1526 }
1527 }
1528 }
1529 if ( first ) {
1530 if ( first == 2 ) *p++ = k;
1531 else *p++ = j;
1532 first--;
1533 }
1534 else *p++ = *term++;
1535/*
1536 if ( AP.DebugFlag ) {
1537 TalToLine((UWORD)(p[-1])); TokenToLine((UBYTE *)" ");
1538 }
1539*/
1540 } while ( --i > 0 );
1541 fi->POfull = fi->POfill = p;
1542 }
1543/*
1544 if ( AP.DebugFlag ) {
1545 AO.OutSkip = 0;
1546 FiniLine();
1547 }
1548*/
1549 return(ret);
1550}
1551
1552/*
1553 #] PutOut :
1554 #[ FlushOut : WORD FlushOut(position,file,compr)
1555*/
1565int FlushOut(POSITION *position, FILEHANDLE *fi, int compr)
1566{
1567 GETIDENTITY
1568 LONG size, RetCode;
1569 int dobracketindex = 0;
1570#ifndef WITHZLIB
1571 DUMMYUSE(compr);
1572#endif
1573 if ( AR.sLevel <= 0 && Expressions[AR.CurExpr].newbracketinfo
1574 && ( fi == AR.outfile || fi == AR.hidefile ) ) dobracketindex = 1;
1575#ifdef WITHMPI /* [16mar1998 ar] */
1576 if ( PF.me != MASTER && AR.sLevel <= 0 && (fi == AR.outfile || fi == AR.hidefile) && PF.parallel && PF.exprtodo < 0 ) {
1577 PF_BUFFER *sbuf = PF.sbuf;
1578 if ( fi->POfill >= fi->POstop ){
1579 sbuf->fill[sbuf->active] = fi->POstop;
1580 PF_ISendSbuf(MASTER,PF_BUFFER_MSGTAG);
1581 fi->POfull = fi->POfill = fi->PObuffer = sbuf->buff[sbuf->active];
1582 fi->POstop = sbuf->stop[sbuf->active];
1583 }
1584 *(fi->POfill)++ = 0;
1585 sbuf->fill[sbuf->active] = fi->POfill;
1586 PF_ISendSbuf(MASTER,PF_ENDBUFFER_MSGTAG);
1587 fi->PObuffer = fi->POfill = fi->POfull = sbuf->buff[sbuf->active];
1588 fi->POstop = sbuf->stop[sbuf->active];
1589 return(0);
1590 }
1591#endif /* WITHMPI [16mar1998 ar] */
1592 if ( fi->POfill >= fi->POstop ) {
1593 if ( fi->handle < 0 ) {
1594 if ( ( RetCode = CreateFile(fi->name) ) >= 0 ) {
1595#ifdef GZIPDEBUG
1596 MLOCK(ErrorMessageLock);
1597 MesPrint("%w FlushOut created scratch file %s",fi->name);
1598 MUNLOCK(ErrorMessageLock);
1599#endif
1600 PUTZERO(fi->filesize);
1601 PUTZERO(fi->POposition);
1602 fi->handle = (WORD)RetCode;
1603/*
1604 Should not be here?
1605#ifdef WITHZLIB
1606 fi->ziobuffer = 0;
1607#endif
1608*/
1609 }
1610 else {
1611 MLOCK(ErrorMessageLock);
1612 MesPrint("Cannot create scratch file %s",fi->name);
1613 MUNLOCK(ErrorMessageLock);
1614 return(-1);
1615 }
1616 }
1617#ifdef WITHZLIB
1618 if ( AT.SS == AT.S0 && !AR.NoCompress && AR.gzipCompress > 0
1619 && dobracketindex == 0 && ( compr > 0 ) && fi->zsp != 0 ) {
1620 if ( PutOutputGZIP(fi) ) return(-1);
1621 fi->POfill = fi->PObuffer;
1622 }
1623 else
1624#endif
1625 {
1626#ifdef ALLLOCK
1627 LOCK(fi->pthreadslock);
1628#endif
1629 if ( fi == AR.hidefile ) {
1630 LOCK(AS.inputslock);
1631 }
1632 SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1633 if ( ( RetCode = WriteFile(fi->handle,(UBYTE *)(fi->PObuffer),fi->POsize) ) != fi->POsize ) {
1634#ifdef ALLLOCK
1635 UNLOCK(fi->pthreadslock);
1636#endif
1637 if ( fi == AR.hidefile ) {
1638 UNLOCK(AS.inputslock);
1639 }
1640 MLOCK(ErrorMessageLock);
1641 MesPrint("Write error while sorting. Disk full?");
1642 MesPrint("Attempt to write %l bytes on file %d at position %15p",
1643 fi->POsize,fi->handle,&(fi->POposition));
1644 MesPrint("RetCode = %l, Buffer address = %l",RetCode,(LONG)(fi->PObuffer));
1645 MUNLOCK(ErrorMessageLock);
1646 return(-1);
1647 }
1648 ADDPOS(fi->filesize,fi->POsize);
1649 fi->POfill = fi->PObuffer;
1650 ADDPOS(fi->POposition,fi->POsize);
1651 if ( fi == AR.hidefile ) {
1652 UNLOCK(AS.inputslock);
1653 }
1654#ifdef ALLLOCK
1655 UNLOCK(fi->pthreadslock);
1656#endif
1657#ifdef WITHPTHREADS
1658 if ( AS.MasterSort && AC.ThreadSortFileSynch && fi != AR.hidefile ) {
1659 if ( fi->handle >= 0 ) SynchFile(fi->handle);
1660 }
1661#endif
1662 }
1663 }
1664 *(fi->POfill)++ = 0;
1665 fi->POfull = fi->POfill;
1666/*
1667 {
1668 UBYTE OutBuf[140];
1669 if ( AP.DebugFlag ) {
1670 AO.OutFill = AO.OutputLine = OutBuf;
1671 AO.OutSkip = 3;
1672 FiniLine();
1673 TokenToLine((UBYTE *)"End of expression written");
1674 FiniLine();
1675 }
1676 }
1677*/
1678 size = (fi->POfill-fi->PObuffer)*sizeof(WORD);
1679 if ( fi->handle >= 0 ) {
1680#ifdef WITHZLIB
1681 if ( AT.SS == AT.S0 && !AR.NoCompress && AR.gzipCompress > 0
1682 && dobracketindex == 0 && ( compr > 0 ) && fi->zsp != 0 ) {
1683 if ( FlushOutputGZIP(fi) ) return(-1);
1684 fi->POfill = fi->PObuffer;
1685 }
1686 else
1687#endif
1688 {
1689#ifdef ALLLOCK
1690 LOCK(fi->pthreadslock);
1691#endif
1692 if ( fi == AR.hidefile ) {
1693 LOCK(AS.inputslock);
1694 }
1695 SeekFile(fi->handle,&(fi->POposition),SEEK_SET);
1696/*
1697 MesPrint("FlushOut: writing %l bytes to position %12p",size,&(fi->POposition));
1698*/
1699 if ( ( RetCode = WriteFile(fi->handle,(UBYTE *)(fi->PObuffer),size) ) != size ) {
1700#ifdef ALLLOCK
1701 UNLOCK(fi->pthreadslock);
1702#endif
1703 if ( fi == AR.hidefile ) {
1704 UNLOCK(AS.inputslock);
1705 }
1706 MLOCK(ErrorMessageLock);
1707 MesPrint("Write error while finishing sorting. Disk full?");
1708 MesPrint("Attempt to write %l bytes on file %d at position %15p",
1709 size,fi->handle,&(fi->POposition));
1710 MesPrint("RetCode = %l, Buffer address = %l",RetCode,(LONG)(fi->PObuffer));
1711 MUNLOCK(ErrorMessageLock);
1712 return(-1);
1713 }
1714 ADDPOS(fi->filesize,size);
1715 ADDPOS(fi->POposition,size);
1716 fi->POfill = fi->PObuffer;
1717 if ( fi == AR.hidefile ) {
1718 UNLOCK(AS.inputslock);
1719 }
1720#ifdef ALLLOCK
1721 UNLOCK(fi->pthreadslock);
1722#endif
1723#ifdef WITHPTHREADS
1724 if ( AS.MasterSort && AC.ThreadSortFileSynch ) {
1725 if ( fi->handle >= 0 ) SynchFile(fi->handle);
1726 }
1727#endif
1728 }
1729 }
1730 if ( dobracketindex ) {
1731 BRACKETINFO *b = Expressions[AR.CurExpr].newbracketinfo;
1732 if ( b->indexfill > 0 ) {
1733 DIFPOS(b->indexbuffer[b->indexfill-1].next,*position,Expressions[AR.CurExpr].onfile);
1734 }
1735 }
1736#ifdef WITHZLIB
1737 if ( AT.SS == AT.S0 && !AR.NoCompress && AR.gzipCompress > 0
1738 && dobracketindex == 0 && ( compr > 0 ) && fi->zsp != 0 ) {
1739 PUTZERO(*position);
1740 if ( fi->handle >= 0 ) {
1741#ifdef ALLLOCK
1742 LOCK(fi->pthreadslock);
1743#endif
1744 SeekFile(fi->handle,position,SEEK_END);
1745#ifdef ALLLOCK
1746 UNLOCK(fi->pthreadslock);
1747#endif
1748 }
1749 else {
1750 ADDPOS(*position,((UBYTE *)fi->POfill-(UBYTE *)fi->PObuffer));
1751 }
1752 }
1753 else
1754#endif
1755 {
1756 ADDPOS(*position,sizeof(WORD));
1757 }
1758 return(0);
1759}
1760
1761/*
1762 #] FlushOut :
1763 #[ AddCoef : WORD AddCoef(pterm1,pterm2)
1764*/
1779int AddCoef(PHEAD WORD **ps1, WORD **ps2)
1780{
1781 GETBIDENTITY
1782 SORTING *S = AT.SS;
1783 WORD *s1, *s2;
1784 WORD l1, l2, i;
1785 WORD OutLen, *t, j;
1786 UWORD *OutCoef;
1787#ifdef WITHFLOAT
1788 if ( AT.SortFloatMode ) return(AddWithFloat(BHEAD ps1,ps2));
1789#endif
1790 OutCoef = AN.SoScratC;
1791 s1 = *ps1; s2 = *ps2;
1792 GETCOEF(s1,l1);
1793 GETCOEF(s2,l2);
1794 if ( AddRat(BHEAD (UWORD *)s1,l1,(UWORD *)s2,l2,OutCoef,&OutLen) ) {
1795 MLOCK(ErrorMessageLock);
1796 MesCall("AddCoef");
1797 MUNLOCK(ErrorMessageLock);
1798 Terminate(-1);
1799 }
1800 if ( AN.ncmod != 0 ) {
1801 if ( ( AC.modmode & POSNEG ) != 0 ) {
1802 NormalModulus(OutCoef,&OutLen);
1803/*
1804 We had forgotten that this can also become smaller but the
1805 denominator isn't there. Correct in the other case
1806 17-may-2009 [JV]
1807*/
1808 j = ABS(OutLen); OutCoef[j] = 1;
1809 for ( i = 1; i < j; i++ ) OutCoef[j+i] = 0;
1810 }
1811 else if ( BigLong(OutCoef,OutLen,(UWORD *)AC.cmod,ABS(AN.ncmod)) >= 0 ) {
1812 SubPLon(OutCoef,OutLen,(UWORD *)AC.cmod,ABS(AN.ncmod),OutCoef,&OutLen);
1813 OutCoef[OutLen] = 1;
1814 for ( i = 1; i < OutLen; i++ ) OutCoef[OutLen+i] = 0;
1815 }
1816 }
1817 if ( !OutLen ) { *ps1 = *ps2 = 0; return(0); }
1818 OutLen *= 2;
1819 if ( OutLen < 0 ) i = - ( --OutLen );
1820 else i = ++OutLen;
1821 if ( l1 < 0 ) l1 = -l1;
1822 l1 *= 2; l1++;
1823 if ( i <= l1 ) { /* Fits in 1 */
1824 l1 -= i;
1825 **ps1 -= l1;
1826 s2 = (WORD *)OutCoef;
1827 while ( --i > 0 ) *s1++ = *s2++;
1828 *s1++ = OutLen;
1829 while ( --l1 >= 0 ) *s1++ = 0;
1830 goto RegEnd;
1831 }
1832 if ( l2 < 0 ) l2 = -l2;
1833 l2 *= 2; l2++;
1834 if ( i <= l2 ) { /* Fits in 2 */
1835 l2 -= i;
1836 **ps2 -= l2;
1837 s1 = (WORD *)OutCoef;
1838 while ( --i > 0 ) *s2++ = *s1++;
1839 *s2++ = OutLen;
1840 while ( --l2 >= 0 ) *s2++ = 0;
1841 *ps1 = *ps2;
1842 goto RegEnd;
1843 }
1844
1845 /* Doesn't fit. Make a new term. */
1846
1847 t = s1;
1848 s1 = *ps1;
1849 j = *s1++ + i - l1; /* Space needed */
1850 if ( (S->sFill + j) >= S->sTop2 ) {
1851 GarbHand();
1852 s1 = *ps1;
1853 t = s1 + *s1 - 1;
1854 j = *s1++ + i - l1; /* Space needed */
1855 l1 = *t;
1856 if ( l1 < 0 ) l1 = - l1;
1857 t -= l1-1;
1858 }
1859 s2 = S->sFill;
1860 *s2++ = j;
1861 while ( s1 < t ) *s2++ = *s1++;
1862 s1 = (WORD *)OutCoef;
1863 while ( --i > 0 ) *s2++ = *s1++;
1864 *s2++ = OutLen;
1865 *ps1 = S->sFill;
1866 S->sFill = s2;
1867RegEnd:
1868 *ps2 = 0;
1869 if ( **ps1 > AM.MaxTer/((LONG)(sizeof(WORD))) ) {
1870 MLOCK(ErrorMessageLock);
1871 MesPrint("Term too complex after addition in sort. MaxTermSize = %10l",
1872 AM.MaxTer/sizeof(WORD));
1873 MUNLOCK(ErrorMessageLock);
1874 Terminate(-1);
1875 }
1876 if ( **ps1 > S->verbMaxTermSize ) S->verbMaxTermSize = **ps1;
1877 return(1);
1878}
1879
1880/*
1881 #] AddCoef :
1882 #[ AddPoly : WORD AddPoly(pterm1,pterm2)
1883*/
1909int AddPoly(PHEAD WORD **ps1, WORD **ps2)
1910{
1911 GETBIDENTITY
1912 SORTING *S = AT.SS;
1913 WORD i;
1914 WORD *s1, *s2, *m, *w, *t, oldpw = S->PolyWise;
1915 s1 = *ps1 + S->PolyWise;
1916 s2 = *ps2 + S->PolyWise;
1917 w = AT.WorkPointer;
1918/*
1919 Add here the two arguments. Is a straight merge.
1920*/
1921 if ( S->PolyFlag == 2 && AR.PolyFunExp != 2 && AR.PolyFunExp != 3 ) {
1922 WORD **oldSplitScratch = AN.SplitScratch;
1923 LONG oldSplitScratchSize = AN.SplitScratchSize;
1924 LONG oldInScratch = AN.InScratch;
1925 WORD oldtype = AR.SortType;
1926 if ( (WORD *)((UBYTE *)w + AM.MaxTer) >= AT.WorkTop ) {
1927 MLOCK(ErrorMessageLock);
1928 MesPrint("Program was adding polyratfun arguments");
1929 MesWork();
1930 MUNLOCK(ErrorMessageLock);
1931 }
1932 AR.SortType = SORTHIGHFIRST;
1933 S->PolyWise = 0;
1934 AN.SplitScratch = AN.SplitScratch1;
1935 AN.SplitScratchSize = AN.SplitScratchSize1;
1936 AN.InScratch = AN.InScratch1;
1937 poly_ratfun_add(BHEAD s1,s2);
1938 S->PolyWise = oldpw;
1939 AN.SplitScratch1 = AN.SplitScratch;
1940 AN.SplitScratchSize1 = AN.SplitScratchSize;
1941 AN.InScratch1 = AN.InScratch;
1942 AN.SplitScratch = oldSplitScratch;
1943 AN.SplitScratchSize = oldSplitScratchSize;
1944 AN.InScratch = oldInScratch;
1945 AT.WorkPointer = w;
1946 AR.SortType = oldtype;
1947 if ( w[1] <= FUNHEAD ||
1948 ( w[FUNHEAD] == -SNUMBER && w[FUNHEAD+1] == 0 ) ) {
1949 *ps1 = *ps2 = 0; return(0);
1950 }
1951 }
1952 else {
1953 if ( w + s1[1] + s2[1] + 12 + ARGHEAD >= AT.WorkTop ) {
1954 MLOCK(ErrorMessageLock);
1955 MesPrint("Program was adding polyfun arguments");
1956 MesWork();
1957 MUNLOCK(ErrorMessageLock);
1958 }
1959 AddArgs(BHEAD s1,s2,w);
1960 }
1961/*
1962 Now we need to store the result in a convenient place.
1963*/
1964 if ( w[1] <= FUNHEAD ) { *ps1 = *ps2 = 0; return(0); }
1965 if ( w[1] <= s1[1] || w[1] <= s2[1] ) { /* Fits in place. */
1966 if ( w[1] > s1[1] ) {
1967 *ps1 = *ps2;
1968 s1 = s2;
1969 }
1970 t = s1 + s1[1];
1971 m = *ps1 + **ps1;
1972 i = w[1];
1973 NCOPY(s1,w,i);
1974 if ( s1 != t ) {
1975 while ( t < m ) *s1++ = *t++;
1976 **ps1 = WORDDIF(s1,(*ps1));
1977 }
1978 *ps2 = 0;
1979 }
1980 else { /* Make new term */
1981#ifdef TESTGARB
1982 s2 = *ps2;
1983#endif
1984 *ps2 = 0;
1985 if ( (S->sFill + (**ps1 + w[1] - s1[1])) >= S->sTop2 ) {
1986#ifdef TESTGARB
1987 MesPrint("------Garbage collection-------");
1988#endif
1989 AT.WorkPointer += w[1];
1990 GarbHand();
1991 AT.WorkPointer = w;
1992 s1 = *ps1;
1993 if ( (S->sFill + (**ps1 + w[1] - s1[1])) >= S->sTop2 ) {
1994#ifdef TESTGARB
1995 UBYTE OutBuf[140];
1996 MLOCK(ErrorMessageLock);
1997 AO.OutFill = AO.OutputLine = OutBuf;
1998 AO.OutSkip = 3;
1999 FiniLine();
2000 i = *s2;
2001 while ( --i >= 0 ) {
2002 TalToLine((UWORD)(*s2++)); TokenToLine((UBYTE *)" ");
2003 }
2004 FiniLine();
2005 AO.OutFill = AO.OutputLine = OutBuf;
2006 AO.OutSkip = 3;
2007 FiniLine();
2008 s2 = *ps1;
2009 i = *s2;
2010 while ( --i >= 0 ) {
2011 TalToLine((UWORD)(*s2++)); TokenToLine((UBYTE *)" ");
2012 }
2013 FiniLine();
2014 AO.OutFill = AO.OutputLine = OutBuf;
2015 AO.OutSkip = 3;
2016 FiniLine();
2017 s2 = w;
2018 i = w[1];
2019 while ( --i >= 0 ) {
2020 TalToLine((UWORD)(*s2++)); TokenToLine((UBYTE *)" ");
2021 }
2022 FiniLine();
2023 if ( AR.sLevel > 0 ) {
2024 MesPrint("Please increase SubSmallExtension setup parameter.");
2025 }
2026 else {
2027 MesPrint("Please increase SmallExtension setup parameter.");
2028 }
2029 MUNLOCK(ErrorMessageLock);
2030#else
2031 MLOCK(ErrorMessageLock);
2032 if ( AR.sLevel > 0 ) {
2033 MesPrint("Please increase SubSmallExtension setup parameter.");
2034 }
2035 else {
2036 MesPrint("Please increase SmallExtension setup parameter.");
2037 }
2038 MUNLOCK(ErrorMessageLock);
2039#endif
2040 Terminate(-1);
2041 }
2042 }
2043 t = *ps1;
2044 s2 = S->sFill;
2045 m = s2;
2046 i = S->PolyWise;
2047 NCOPY(s2,t,i);
2048 i = w[1];
2049 NCOPY(s2,w,i);
2050 t = t + t[1];
2051 w = *ps1 + **ps1;
2052 while ( t < w ) *s2++ = *t++;
2053 *m = WORDDIF(s2,m);
2054 *ps1 = m;
2055 S->sFill = s2;
2056 if ( *m > AM.MaxTer/((LONG)sizeof(WORD)) ) {
2057 MLOCK(ErrorMessageLock);
2058 MesPrint("Term too complex after polynomial addition. MaxTermSize = %10l",
2059 AM.MaxTer/sizeof(WORD));
2060 MUNLOCK(ErrorMessageLock);
2061 Terminate(-1);
2062 }
2063 if ( *m > S->verbMaxTermSize ) S->verbMaxTermSize = *m;
2064 }
2065 return(1);
2066}
2067
2068/*
2069 #] AddPoly :
2070 #[ AddArgs : void AddArgs(arg1,arg2,to)
2071*/
2072
2073#define INSLENGTH(x) w[1] = FUNHEAD+ARGHEAD+x; w[FUNHEAD] = ARGHEAD+x;
2074
2082void AddArgs(PHEAD WORD *s1, WORD *s2, WORD *m)
2083{
2084 GETBIDENTITY
2085 WORD i1, i2;
2086 WORD *w = m, *mm, *t, *t1, *t2, *tstop1, *tstop2;
2087 WORD tempterm[8+FUNHEAD];
2088
2089 *m++ = AR.PolyFun; *m++ = 0; FILLFUN(m)
2090 *m++ = 0; *m++ = 0; FILLARG(m)
2091 if ( s1[FUNHEAD] < 0 || s2[FUNHEAD] < 0 ) {
2092 if ( s1[FUNHEAD] < 0 ) {
2093 if ( s2[FUNHEAD] < 0 ) { /* Both are special */
2094 if ( s1[FUNHEAD] <= -FUNCTION ) {
2095 if ( s2[FUNHEAD] == s1[FUNHEAD] ) {
2096 *m++ = 4+FUNHEAD; *m++ = -s1[FUNHEAD]; *m++ = FUNHEAD;
2097 FILLFUN(m)
2098 *m++ = 2; *m++ = 1; *m++ = 3;
2099 INSLENGTH(4+FUNHEAD)
2100 }
2101 else if ( s2[FUNHEAD] <= -FUNCTION ) {
2102 i1 = functions[-FUNCTION-s1[FUNHEAD]].commute != 0;
2103 i2 = functions[-FUNCTION-s2[FUNHEAD]].commute != 0;
2104 if ( ( !i1 && i2 ) || ( i1 == i2 && i1 > i2 ) ) {
2105 i1 = s2[FUNHEAD];
2106 s2[FUNHEAD] = s1[FUNHEAD];
2107 s1[FUNHEAD] = i1;
2108 }
2109 *m++ = 4+FUNHEAD; *m++ = -s1[FUNHEAD]; *m++ = FUNHEAD;
2110 FILLFUN(m)
2111 *m++ = 1; *m++ = 1; *m++ = 3;
2112 *m++ = 4+FUNHEAD; *m++ = -s2[FUNHEAD]; *m++ = FUNHEAD;
2113 FILLFUN(m)
2114 *m++ = 1; *m++ = 1; *m++ = 3;
2115 INSLENGTH(8+2*FUNHEAD)
2116 }
2117 else if ( s2[FUNHEAD] == -SYMBOL ) {
2118 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = s2[FUNHEAD+1]; *m++ = 1;
2119 *m++ = 1; *m++ = 1; *m++ = 3;
2120 *m++ = 4+FUNHEAD; *m++ = -s1[FUNHEAD]; *m++ = FUNHEAD;
2121 FILLFUN(m)
2122 *m++ = 1; *m++ = 1; *m++ = 3;
2123 INSLENGTH(12+FUNHEAD)
2124 }
2125 else { /* number */
2126 *m++ = 4;
2127 *m++ = ABS(s2[FUNHEAD+1]); *m++ = 1; *m++ = s2[FUNHEAD+1] < 0 ? -3: 3;
2128 *m++ = 4+FUNHEAD; *m++ = -s1[FUNHEAD]; *m++ = FUNHEAD;
2129 FILLFUN(m)
2130 *m++ = 1; *m++ = 1; *m++ = 3;
2131 INSLENGTH(8+FUNHEAD)
2132 }
2133 }
2134 else if ( s1[FUNHEAD] == -SYMBOL ) {
2135 if ( s2[FUNHEAD] == s1[FUNHEAD] ) {
2136 if ( s1[FUNHEAD+1] == s2[FUNHEAD+1] ) {
2137 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = s1[FUNHEAD+1];
2138 *m++ = 1; *m++ = 2; *m++ = 1; *m++ = 3;
2139 INSLENGTH(8)
2140 }
2141 else {
2142 if ( s1[FUNHEAD+1] > s2[FUNHEAD+1] )
2143 { i1 = s2[FUNHEAD+1]; i2 = s1[FUNHEAD+1]; }
2144 else { i1 = s1[FUNHEAD+1]; i2 = s2[FUNHEAD+1]; }
2145 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = i1;
2146 *m++ = 1; *m++ = 1; *m++ = 1; *m++ = 3;
2147 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = i2;
2148 *m++ = 1; *m++ = 1; *m++ = 1; *m++ = 3;
2149 INSLENGTH(16)
2150 }
2151 }
2152 else if ( s2[FUNHEAD] <= -FUNCTION ) {
2153 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = s1[FUNHEAD+1]; *m++ = 1;
2154 *m++ = 1; *m++ = 1; *m++ = 3;
2155 *m++ = 4+FUNHEAD; *m++ = -s2[FUNHEAD]; *m++ = FUNHEAD;
2156 FILLFUN(m)
2157 *m++ = 1; *m++ = 1; *m++ = 3;
2158 INSLENGTH(12+FUNHEAD)
2159 }
2160 else {
2161 *m++ = 4;
2162 *m++ = ABS(s2[FUNHEAD+1]); *m++ = 1; *m++ = s2[FUNHEAD+1] < 0 ? -3: 3;
2163 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = s1[FUNHEAD+1]; *m++ = 1;
2164 *m++ = 1; *m++ = 1; *m++ = 3;
2165 INSLENGTH(12)
2166 }
2167 }
2168 else { /* Must be -SNUMBER! */
2169 if ( s2[FUNHEAD] <= -FUNCTION ) {
2170 *m++ = 4;
2171 *m++ = ABS(s1[FUNHEAD+1]); *m++ = 1; *m++ = s1[FUNHEAD+1] < 0 ? -3: 3;
2172 *m++ = 4+FUNHEAD; *m++ = -s2[FUNHEAD]; *m++ = FUNHEAD;
2173 FILLFUN(m)
2174 *m++ = 1; *m++ = 1; *m++ = 3;
2175 INSLENGTH(8+FUNHEAD)
2176 }
2177 else if ( s2[FUNHEAD] == -SYMBOL ) {
2178 *m++ = 4;
2179 *m++ = ABS(s1[FUNHEAD+1]); *m++ = 1; *m++ = s1[FUNHEAD+1] < 0 ? -3: 3;
2180 *m++ = 8; *m++ = SYMBOL; *m++ = 4; *m++ = s2[FUNHEAD+1]; *m++ = 1;
2181 *m++ = 1; *m++ = 1; *m++ = 3;
2182 INSLENGTH(12)
2183 }
2184 else { /* Both are numbers. add. */
2185 LONG x1;
2186 x1 = (LONG)s1[FUNHEAD+1] + (LONG)s2[FUNHEAD+1];
2187 if ( x1 < 0 ) { i1 = (WORD)(-x1); i2 = -3; }
2188 else { i1 = (WORD)x1; i2 = 3; }
2189 if ( x1 && AN.ncmod != 0 ) {
2190 m[0] = 4;
2191 m[1] = i1;
2192 m[2] = 1;
2193 m[3] = i2;
2194 if ( Modulus(m) ) Terminate(-1);
2195 if ( *m == 0 ) w[1] = 0;
2196 else {
2197 if ( *m == 4 && ( m[1] & MAXPOSITIVE ) == m[1]
2198 && m[3] == 3 ) {
2199 i1 = m[1];
2200 m -= ARGHEAD;
2201 *m++ = -SNUMBER;
2202 *m++ = i1;
2203 INSLENGTH(4)
2204 }
2205 else {
2206 INSLENGTH(*m)
2207 m += *m;
2208 }
2209 }
2210 }
2211 else {
2212 if ( x1 == 0 ) {
2213 w[1] = FUNHEAD;
2214 }
2215 else if ( ( i1 & MAXPOSITIVE ) == i1 ) {
2216 m -= ARGHEAD;
2217 *m++ = -SNUMBER;
2218 *m++ = (WORD)x1;
2219 w[1] = FUNHEAD+2;
2220 }
2221 else {
2222 *m++ = 4; *m++ = i1; *m++ = 1; *m++ = i2;
2223 INSLENGTH(4)
2224 }
2225 }
2226 }
2227 }
2228 }
2229 else { /* Only s1 is special */
2230s1only:
2231/*
2232 Compose a term in `tempterm'
2233*/
2234 t = tempterm;
2235 if ( s1[FUNHEAD] <= -FUNCTION ) {
2236 *t++ = 4+FUNHEAD; *t++ = -s1[FUNHEAD]; *t++ = FUNHEAD;
2237 FILLFUN(t)
2238 *t++ = 1; *t++ = 1; *t++ = 3;
2239 }
2240 else if ( s1[FUNHEAD] == -SYMBOL ) {
2241 *t++ = 8; *t++ = SYMBOL; *t++ = 4;
2242 *t++ = s1[FUNHEAD+1]; *t++ = 1;
2243 *t++ = 1; *t++ = 1; *t++ = 3;
2244 }
2245 else {
2246 *t++ = 4; *t++ = ABS(s1[FUNHEAD+1]);
2247 *t++ = 1; *t++ = s1[FUNHEAD+1] < 0 ? -3: 3;
2248 }
2249 tstop1 = t;
2250 s1 = tempterm;
2251 goto twogen;
2252 }
2253 }
2254 else { /* Only s2 is special */
2255 t = s1;
2256 s1 = s2;
2257 s2 = t;
2258 goto s1only;
2259 }
2260 }
2261 else {
2262 int oldPolyFlag;
2263 tstop1 = s1 + s1[1];
2264 s1 += FUNHEAD+ARGHEAD;
2265twogen:
2266 tstop2 = s2 + s2[1];
2267 s2 += FUNHEAD+ARGHEAD;
2268/*
2269 Now we should merge the expressions in s1 and s2 into m.
2270*/
2271 oldPolyFlag = AT.SS->PolyFlag;
2272 AT.SS->PolyFlag = 0;
2273 while ( s1 < tstop1 && s2 < tstop2 ) {
2274 i1 = CompareTerms(BHEAD s1,s2,(WORD)(-1));
2275 if ( i1 > 0 ) {
2276 i2 = *s1;
2277 NCOPY(m,s1,i2);
2278 }
2279 else if ( i1 < 0 ) {
2280 i2 = *s2;
2281 NCOPY(m,s2,i2);
2282 }
2283 else { /* Coefficients should be added. */
2284 WORD i;
2285 t = s1+*s1;
2286 i1 = t[-1];
2287 i2 = *s1 - ABS(i1);
2288 t2 = s2 + i2;
2289 s2 += *s2;
2290 mm = m;
2291 NCOPY(m,s1,i2);
2292 t1 = s1;
2293 s1 = t;
2294 i2 = s2[-1];
2295/*
2296 t1,i1 is the first coefficient
2297 t2,i2 is the second coefficient
2298 It should be placed at m,i1
2299*/
2300 i1 = REDLENG(i1);
2301 i2 = REDLENG(i2);
2302 if ( AddRat(BHEAD (UWORD *)t1,i1,(UWORD *)t2,i2,(UWORD *)m,&i) ) {
2303 MLOCK(ErrorMessageLock);
2304 MesPrint("Addition of coefficients of PolyFun");
2305 MUNLOCK(ErrorMessageLock);
2306 Terminate(-1);
2307 }
2308 if ( i == 0 ) {
2309 m = mm;
2310 }
2311 else {
2312 i1 = INCLENG(i);
2313 m += ABS(i1);
2314 m[-1] = i1;
2315 *mm = WORDDIF(m,mm);
2316 if ( AN.ncmod != 0 ) {
2317 if ( Modulus(mm) ) Terminate(-1);
2318 if ( !*mm ) m = mm;
2319 else m = mm + *mm;
2320 }
2321 }
2322 }
2323 }
2324 while ( s1 < tstop1 ) *m++ = *s1++;
2325 while ( s2 < tstop2 ) *m++ = *s2++;
2326 w[1] = WORDDIF(m,w);
2327 w[FUNHEAD] = w[1] - FUNHEAD;
2328 if ( ToFast(w+FUNHEAD,w+FUNHEAD) ) {
2329 if ( w[FUNHEAD] <= -FUNCTION ) w[1] = FUNHEAD+1;
2330 else w[1] = FUNHEAD+2;
2331 if ( w[FUNHEAD] == -SNUMBER && w[FUNHEAD+1] == 0 ) w[1] = FUNHEAD;
2332 }
2333/* AT.SS->PolyFlag = AR.PolyFunType;*/
2334 AT.SS->PolyFlag = oldPolyFlag;
2335 }
2336}
2337
2338/*
2339 #] AddArgs :
2340 #[ Compare1 : WORD Compare1(term1,term2,level)
2341*/
2375WORD Compare1(PHEAD WORD *term1, WORD *term2, WORD level)
2376{
2377 SORTING *S = AT.SS;
2378 WORD *stopper1, *stopper2, *t2;
2379 WORD *s1, *s2, *t1;
2380 WORD *stopex1, *stopex2;
2381 WORD c1, c2;
2382 WORD prevorder;
2383 WORD count = -1, localPoly, polyhit = -1;
2384
2385 // Update SortVerbose counter
2386 S->verbComparisons++;
2387
2388 if ( S->PolyFlag ) {
2389/*
2390 if ( S->PolyWise != 0 ) {
2391 MLOCK(ErrorMessageLock);
2392 MesPrint("S->PolyWise is not zero!!!!!");
2393 MUNLOCK(ErrorMessageLock);
2394 }
2395*/
2396 count = 0; localPoly = 1; S->PolyWise = polyhit = 0;
2397 S->PolyFlag = AR.PolyFunType;
2398 if ( AR.PolyFunType == 2 &&
2399 ( AR.PolyFunExp == 2 || AR.PolyFunExp == 3 ) ) S->PolyFlag = 1;
2400 }
2401 else { localPoly = 0; }
2402#ifdef WITHFLOAT
2403 AT.SortFloatMode = 0;
2404#endif
2405 prevorder = 0;
2406 GETSTOP(term1,s1);
2407 stopper1 = s1;
2408 GETSTOP(term2,stopper2);
2409 t1 = term1 + 1;
2410 t2 = term2 + 1;
2411 while ( t1 < stopper1 && t2 < stopper2 ) {
2412 if ( *t1 != *t2 ) {
2413 if ( *t1 == HAAKJE ) return(PREV(-1));
2414 if ( *t2 == HAAKJE ) return(PREV(1));
2415 if ( *t1 >= (FUNCTION-1) ) {
2416 if ( *t2 < (FUNCTION-1) ) return(PREV(-1));
2417 if ( *t1 < FUNCTION && *t2 < FUNCTION ) return(PREV(*t2-*t1));
2418 if ( *t1 < FUNCTION ) return(PREV(1));
2419 if ( *t2 < FUNCTION ) return(PREV(-1));
2420 c1 = functions[*t1-FUNCTION].commute;
2421 c2 = functions[*t2-FUNCTION].commute;
2422 if ( !c1 ) {
2423 if ( c2 ) return(PREV(1));
2424 else return(PREV(*t2-*t1));
2425 }
2426 else {
2427 if ( !c2 ) return(PREV(-1));
2428 else return(PREV(*t2-*t1));
2429 }
2430 }
2431 else return(PREV(*t2-*t1));
2432 }
2433 s1 = t1 + 2;
2434 s2 = t2 + 2;
2435 c1 = *t1;
2436 t1 += t1[1];
2437 t2 += t2[1];
2438 if ( localPoly && c1 < FUNCTION ) {
2439 polyhit = 1;
2440 }
2441 if ( c1 <= (FUNCTION-1)
2442 || ( c1 >= FUNCTION && functions[c1-FUNCTION].spec > 0 ) ) {
2443 if ( c1 == SYMBOL ) {
2444 if ( *s1 == FACTORSYMBOL && *s2 == FACTORSYMBOL
2445 && s1[-1] == 4 && s2[-1] == 4
2446 && ( ( t1 < stopper1 && *t1 == HAAKJE )
2447 || ( t1 == stopper1 && AT.fromindex ) ) ) {
2448/*
2449 We have to be very careful with the criteria here, because
2450 Compare1 is called both in the regular sorting and by the
2451 routine that makes the bracket index. In the last case
2452 there is no HAAKJE subterm.
2453*/
2454 if ( s1[1] != s2[1] ) return(s2[1]-s1[1]);
2455 s1 += 2; s2 += 2;
2456 }
2457 else if ( AR.SortType >= SORTPOWERFIRST ) {
2458 WORD i1 = 0, *r1;
2459 r1 = s1;
2460 while ( s1 < t1 ) { i1 += s1[1]; s1 += 2; }
2461 s1 = r1; r1 = s2;
2462 while ( s2 < t2 ) { i1 -= s2[1]; s2 += 2; }
2463 s2 = r1;
2464 if ( i1 ) {
2465 if ( AR.SortType >= SORTANTIPOWER ) i1 = -i1;
2466 return(PREV(i1));
2467 }
2468 }
2469 while ( s1 < t1 ) {
2470 if ( s2 >= t2 ) {
2471/* return(PREV(1)); */
2472 if ( AR.SortType==SORTLOWFIRST ) {
2473 return(PREV((s1[1]>0?-1:1)));
2474 }
2475 else {
2476 return(PREV((s1[1]<0?-1:1)));
2477 }
2478 }
2479 if ( *s1 != *s2 ) {
2480/* return(PREV(*s2-*s1)); */
2481 if ( AR.SortType==SORTLOWFIRST ) {
2482 if ( *s1 < *s2 ) {
2483 return(PREV((s1[1]<0?1:-1)));
2484 }
2485 else {
2486 return(PREV((s2[1]<0?-1:1)));
2487 }
2488 }
2489 else {
2490 if ( *s1 < *s2 ) {
2491 return(PREV((s1[1]<0?-1:1)));
2492 }
2493 else {
2494 return(PREV((s2[1]<0?1:-1)));
2495 }
2496 }
2497 }
2498 s1++; s2++;
2499 if ( *s1 != *s2 ) return(
2500 PREV((AR.SortType==SORTLOWFIRST?*s2-*s1:*s1-*s2)));
2501 s1++; s2++;
2502 }
2503 if ( s2 < t2 ) {
2504/* return(PREV(-1)); */
2505 if ( AR.SortType==SORTLOWFIRST ) {
2506 return(PREV((s2[1]<0?-1:1)));
2507 }
2508 else {
2509 return(PREV((s2[1]<0?1:-1)));
2510 }
2511 }
2512 }
2513 else if ( c1 == DOTPRODUCT ) {
2514 if ( AR.SortType >= SORTPOWERFIRST ) {
2515 WORD i1 = 0, *r1;
2516 r1 = s1;
2517 while ( s1 < t1 ) { i1 += s1[2]; s1 += 3; }
2518 s1 = r1; r1 = s2;
2519 while ( s2 < t2 ) { i1 -= s2[2]; s2 += 3; }
2520 s2 = r1;
2521 if ( i1 ) {
2522 if ( AR.SortType >= SORTANTIPOWER ) i1 = -i1;
2523 return(PREV(i1));
2524 }
2525 }
2526 while ( s1 < t1 ) {
2527 if ( s2 >= t2 ) return(PREV(1));
2528 if ( *s1 != *s2 ) return(PREV(*s2-*s1));
2529 s1++; s2++;
2530 if ( *s1 != *s2 ) return(PREV(*s2-*s1));
2531 s1++; s2++;
2532 if ( *s1 != *s2 ) return(
2533 PREV((AR.SortType==SORTLOWFIRST?*s2-*s1:*s1-*s2)));
2534 s1++; s2++;
2535 }
2536 if ( s2 < t2 ) return(PREV(-1));
2537 }
2538 else {
2539 while ( s1 < t1 ) {
2540 if ( s2 >= t2 ) return(PREV(1));
2541 if ( *s1 != *s2 ) return(PREV(*s2-*s1));
2542 s1++; s2++;
2543 }
2544 if ( s2 < t2 ) return(PREV(-1));
2545 }
2546 }
2547 else {
2548#if FUNHEAD != 2
2549 s1 += FUNHEAD-2;
2550 s2 += FUNHEAD-2;
2551#endif
2552 if ( localPoly && c1 == AR.PolyFun ) {
2553 if ( count == 0 ) {
2554 if ( S->PolyFlag == 1 ) {
2555 WORD i1, i2;
2556 if ( *s1 > 0 ) i1 = *s1;
2557 else if ( *s1 <= -FUNCTION ) i1 = 1;
2558 else i1 = 2;
2559 if ( *s2 > 0 ) i2 = *s2;
2560 else if ( *s2 <= -FUNCTION ) i2 = 1;
2561 else i2 = 2;
2562 if ( s1+i1 == t1 && s2+i2 == t2 ) { /* This is the stuff */
2563/*
2564 Test for scalar nature
2565*/
2566 if ( !polyhit ) {
2567 WORD *u1, *u2, *ustop;
2568 if ( *s1 < 0 ) {
2569 if ( *s1 != -SNUMBER && *s1 != -SYMBOL && *s1 > -FUNCTION )
2570 goto NoPoly;
2571 }
2572 else {
2573 u1 = s1 + ARGHEAD;
2574 while ( u1 < t1 ) {
2575 u2 = u1 + *u1;
2576 ustop = u2 - ABS(u2[-1]);
2577 u1++;
2578 while ( u1 < ustop ) {
2579 if ( *u1 == INDEX ) goto NoPoly;
2580 u1 += u1[1];
2581 }
2582 u1 = u2;
2583 }
2584 }
2585 if ( *s2 < 0 ) {
2586 if ( *s2 != -SNUMBER && *s2 != -SYMBOL && *s2 > -FUNCTION )
2587 goto NoPoly;
2588 }
2589 else {
2590 u1 = s2 + ARGHEAD;
2591 while ( u1 < t2 ) {
2592 u2 = u1 + *u1;
2593 ustop = u2 - ABS(u2[-1]);
2594 u1++;
2595 while ( u1 < ustop ) {
2596 if ( *u1 == INDEX ) goto NoPoly;
2597 u1 += u1[1];
2598 }
2599 u1 = u2;
2600 }
2601 }
2602 }
2603 S->PolyWise = WORDDIF(s1,term1);
2604 S->PolyWise -= FUNHEAD;
2605 count = 1;
2606 continue;
2607 }
2608 else {
2609NoPoly:
2610 S->PolyWise = localPoly = 0;
2611 }
2612 }
2613 else if ( AR.PolyFunType == 2 ) {
2614 WORD i1, i2, i1a, i2a;
2615 if ( *s1 > 0 ) i1 = *s1;
2616 else if ( *s1 <= -FUNCTION ) i1 = 1;
2617 else i1 = 2;
2618 if ( *s2 > 0 ) i2 = *s2;
2619 else if ( *s2 <= -FUNCTION ) i2 = 1;
2620 else i2 = 2;
2621 if ( s1[i1] > 0 ) i1a = s1[i1];
2622 else if ( s1[i1] <= -FUNCTION ) i1a = 1;
2623 else i1a = 2;
2624 if ( s2[i2] > 0 ) i2a = s2[i2];
2625 else if ( s2[i2] <= -FUNCTION ) i2a = 1;
2626 else i2a = 2;
2627 if ( s1+i1+i1a == t1 && s2+i2+i2a == t2 ) { /* This is the stuff */
2628/*
2629 Test for scalar nature
2630*/
2631 if ( !polyhit ) {
2632 WORD *u1, *u2, *ustop;
2633 if ( *s1 < 0 ) {
2634 if ( *s1 != -SNUMBER && *s1 != -SYMBOL && *s1 > -FUNCTION )
2635 goto NoPoly;
2636 }
2637 else {
2638 u1 = s1 + ARGHEAD;
2639 while ( u1 < s1+i1 ) {
2640 u2 = u1 + *u1;
2641 ustop = u2 - ABS(u2[-1]);
2642 u1++;
2643 while ( u1 < ustop ) {
2644 if ( *u1 == INDEX ) goto NoPoly;
2645 u1 += u1[1];
2646 }
2647 u1 = u2;
2648 }
2649 }
2650 if ( s1[i1] < 0 ) {
2651 if ( s1[i1] != -SNUMBER && s1[i1] != -SYMBOL && s1[i1] > -FUNCTION )
2652 goto NoPoly;
2653 }
2654 else {
2655 u1 = s1 +i1 + ARGHEAD;
2656 while ( u1 < t1 ) {
2657 u2 = u1 + *u1;
2658 ustop = u2 - ABS(u2[-1]);
2659 u1++;
2660 while ( u1 < ustop ) {
2661 if ( *u1 == INDEX ) goto NoPoly;
2662 u1 += u1[1];
2663 }
2664 u1 = u2;
2665 }
2666 }
2667 if ( *s2 < 0 ) {
2668 if ( *s2 != -SNUMBER && *s2 != -SYMBOL && *s2 > -FUNCTION )
2669 goto NoPoly;
2670 }
2671 else {
2672 u1 = s2 + ARGHEAD;
2673 while ( u1 < s2+i2 ) {
2674 u2 = u1 + *u1;
2675 ustop = u2 - ABS(u2[-1]);
2676 u1++;
2677 while ( u1 < ustop ) {
2678 if ( *u1 == INDEX ) goto NoPoly;
2679 u1 += u1[1];
2680 }
2681 u1 = u2;
2682 }
2683 }
2684 if ( s2[i2] < 0 ) {
2685 if ( s2[i2] != -SNUMBER && s2[i2] != -SYMBOL && s2[i2] > -FUNCTION )
2686 goto NoPoly;
2687 }
2688 else {
2689 u1 = s2 + i2 + ARGHEAD;
2690 while ( u1 < t2 ) {
2691 u2 = u1 + *u1;
2692 ustop = u2 - ABS(u2[-1]);
2693 u1++;
2694 while ( u1 < ustop ) {
2695 if ( *u1 == INDEX ) goto NoPoly;
2696 u1 += u1[1];
2697 }
2698 u1 = u2;
2699 }
2700 }
2701 }
2702 S->PolyWise = WORDDIF(s1,term1);
2703 S->PolyWise -= FUNHEAD;
2704 count = 1;
2705 continue;
2706 }
2707 else {
2708 S->PolyWise = localPoly = 0;
2709 }
2710 }
2711 else {
2712 S->PolyWise = localPoly = 0;
2713 }
2714 }
2715 else {
2716 t1 = term1 + S->PolyWise;
2717 t2 = term2 + S->PolyWise;
2718 S->PolyWise = 0;
2719 localPoly = 0;
2720 continue;
2721 }
2722 }
2723#ifdef WITHFLOAT
2724 if ( level == 0 && c1 == FLOATFUN && t1 == stopper1 && t2 == stopper2 && AT.aux_ != 0 ) {
2725/*
2726 We have two FLOATFUN's. Test whether they are 'legal'
2727*/
2728 if ( TestFloat(s1-FUNHEAD) ) {
2729 if ( TestFloat(s2-FUNHEAD) ) { AT.SortFloatMode = 3; return(0); }
2730 else { return(1); }
2731 }
2732 else if ( TestFloat(s2-FUNHEAD) ) { return(-1); }
2733 }
2734#endif
2735 while ( s1 < t1 ) {
2736/*
2737 The next statement was added 9-nov-2001. It repaired a bad error
2738*/
2739 if ( s2 >= t2 ) return(PREV(-1));
2740/*
2741 There is a little problem here with fast arguments
2742 We don't want to sacrifice speed, but we like to
2743 keep a rational ordering. This last one suffers in
2744 the solution that has been chosen here.
2745*/
2746 if ( AC.properorderflag ) {
2747 WORD oldpolyflag;
2748 oldpolyflag = S->PolyFlag;
2749 S->PolyFlag = 0;
2750 if ( ( c2 = -CompArg(s1,s2) ) != 0 ) {
2751 S->PolyFlag = oldpolyflag; return(PREV(c2));
2752 }
2753 S->PolyFlag = oldpolyflag;
2754 NEXTARG(s1)
2755 NEXTARG(s2)
2756 }
2757 else {
2758 if ( *s1 > 0 ) {
2759 if ( *s2 > 0 ) {
2760 WORD oldpolyflag;
2761 stopex1 = s1 + *s1;
2762 if ( s2 >= t2 ) return(PREV(-1));
2763 stopex2 = s2 + *s2;
2764 s1 += ARGHEAD; s2 += ARGHEAD;
2765 oldpolyflag = S->PolyFlag;
2766 S->PolyFlag = 0;
2767 while ( s1 < stopex1 ) {
2768 if ( s2 >= stopex2 ) {
2769 S->PolyFlag = oldpolyflag; return(PREV(-1));
2770 }
2771 if ( ( c2 = CompareTerms(BHEAD s1,s2,(WORD)1) ) != 0 ) {
2772 S->PolyFlag = oldpolyflag; return(PREV(c2));
2773 }
2774 s1 += *s1;
2775 s2 += *s2;
2776 }
2777 S->PolyFlag = oldpolyflag;
2778 if ( s2 < stopex2 ) return(PREV(1));
2779 }
2780 else return(PREV(1));
2781 }
2782 else {
2783 if ( *s2 > 0 ) return(PREV(-1));
2784 if ( *s1 != *s2 ) { return(PREV(*s1-*s2)); }
2785 if ( *s1 > -FUNCTION ) {
2786 if ( *++s1 != *++s2 ) { return(PREV(*s2-*s1)); }
2787 }
2788 s1++; s2++;
2789 }
2790 }
2791 }
2792 if ( s2 < t2 ) return(PREV(1));
2793 }
2794 }
2795#ifdef WITHFLOAT
2796 if ( level == 0 && t1 < stopper1 && *t1 == FLOATFUN && t1+t1[1] == stopper1
2797 && TestFloat(t1) && AT.aux_ != 0 ) {
2798 AT.SortFloatMode = 1; return(0);
2799 }
2800 else if ( level == 0 && t2 < stopper2 && *t2 == FLOATFUN && t2+t2[1] == stopper2
2801 && TestFloat(t2) && AT.aux_ != 0 ) {
2802 AT.SortFloatMode = 2; return(0);
2803 }
2804#endif
2805 {
2806 if ( AR.SortType != SORTLOWFIRST ) {
2807 if ( t1 < stopper1 ) return(PREV(1));
2808 if ( t2 < stopper2 ) return(PREV(-1));
2809 }
2810 else {
2811 if ( t1 < stopper1 ) return(PREV(-1));
2812 if ( t2 < stopper2 ) return(PREV(1));
2813 }
2814 }
2815 if ( level == 3 ) return(CompCoef(term1,term2));
2816 if ( level >= 1 )
2817 return(CompCoef(term2,term1));
2818 return(0);
2819}
2820
2821/*
2822 #] Compare1 :
2823 #[ CompareSymbols : WORD CompareSymbols(term1,term2,par)
2824*/
2838WORD CompareSymbols(PHEAD WORD *term1, WORD *term2, WORD par)
2839{
2840 WORD *t1, *t2, *tt1, *tt2;
2841 DUMMYUSE(par);
2842 const int low = AR.SortType == SORTLOWFIRST ? 1 : -1;
2843 const int high = - low;
2844
2845 t1 = term1 + 3; tt1 = term1+*term1; tt1 -= ABS(tt1[-1]);
2846 t2 = term2 + 3; tt2 = term2+*term2; tt2 -= ABS(tt2[-1]);
2847
2848// Currently, FORM never sets polysortflag != 0, so disable this code.
2849// if ( AN.polysortflag > 0 ) {
2850// WORD sum1, sum2;
2851// sum1 = 0; sum2 = 0;
2852// while ( t1 < tt1 ) { sum1 += t1[1]; t1 += 2; }
2853// while ( t2 < tt2 ) { sum2 += t2[1]; t2 += 2; }
2854// if ( sum1 < sum2 ) return(low);
2855// if ( sum1 > sum2 ) return(high);
2856// t1 = term1+3; t2 = term2 + 3;
2857// }
2858
2859 while ( t1 < tt1 && t2 < tt2 ) {
2860 const WORD s1 = *t1;
2861 const WORD s2 = *t2;
2862 if ( s1 != s2 ) { return ( s1 > s2 ) ? low : high ; }
2863 const WORD p1 = t1[1];
2864 const WORD p2 = t2[1];
2865 if ( p1 != p2 ) { return ( p1 < p2 ) ? low : high ; }
2866 t1 += 2; t2 += 2;
2867 }
2868
2869 if ( t1 < tt1 ) return(high);
2870 if ( t2 < tt2 ) return(low);
2871
2872 return(0);
2873}
2874
2875/*
2876 #] CompareSymbols :
2877 #[ CompareHSymbols : WORD CompareHSymbols(term1,term2,par)
2878*/
2888WORD CompareHSymbols(PHEAD WORD *term1, WORD *term2, WORD par)
2889{
2890 WORD *t1, *t2, *tt1, *tt2, *ttt1, *ttt2;
2891 DUMMYUSE(par);
2892 DUMMYUSE(AT.WorkPointer);
2893 t1 = term1 + 1; tt1 = term1+*term1; tt1 -= ABS(tt1[-1]); t1 += 2;
2894 t2 = term2 + 1; tt2 = term2+*term2; tt2 -= ABS(tt2[-1]); t2 += 2;
2895 while ( t1 < tt1 && t2 < tt2 ) {
2896 if ( *t1 != *t2 ) {
2897 if ( t1[0] < t2[0] ) return(-1);
2898 return(1);
2899 }
2900 else if ( *t1 == HAAKJE ) {
2901 t1 += 3; t2 += 3; continue;
2902 }
2903 ttt1 = t1+t1[1]; ttt2 = t2+t2[1];
2904 while ( t1 < ttt1 && t2 < ttt2 ) {
2905 if ( *t1 > *t2 ) return(-1);
2906 if ( *t1 < *t2 ) return(1);
2907 if ( t1[1] < t2[1] ) return(-1);
2908 if ( t1[1] > t2[1] ) return(1);
2909 t1 += 2; t2 += 2;
2910 }
2911 if ( t1 < ttt1 ) return(1);
2912 if ( t2 < ttt2 ) return(-1);
2913 }
2914 if ( t1 < tt1 ) return(1);
2915 if ( t2 < tt2 ) return(-1);
2916 return(0);
2917}
2918
2919/*
2920 #] CompareHSymbols :
2921 #[ ComPress : LONG ComPress(ss,n)
2922*/
2941LONG ComPress(WORD **ss, LONG *n)
2942{
2943 GETIDENTITY
2944 WORD *t, *s, j, k;
2945 LONG size = 0;
2946 int newsize, i;
2947/*
2948 #[ debug :
2949
2950 WORD **sss = ss;
2951
2952 if ( AP.DebugFlag ) {
2953 UBYTE OutBuf[140];
2954 MLOCK(ErrorMessageLock);
2955 MesPrint("ComPress:");
2956 AO.OutFill = AO.OutputLine = OutBuf;
2957 AO.OutSkip = 3;
2958 FiniLine();
2959 ss = sss;
2960 while ( *ss ) {
2961 s = *ss++;
2962 j = *s;
2963 if ( j < 0 ) {
2964 j = s[1] + 2;
2965 }
2966 while ( --j >= 0 ) {
2967 TalToLine((UWORD)(*s++)); TokenToLine((UBYTE *)" ");
2968 }
2969 FiniLine();
2970 }
2971 AO.OutSkip = 0;
2972 FiniLine();
2973 MUNLOCK(ErrorMessageLock);
2974 ss = sss;
2975 }
2976
2977 #] debug :
2978*/
2979 *n = 0;
2980 if ( AT.SS == AT.S0 && !AR.NoCompress ) {
2981 if ( AN.compressSize == 0 ) {
2982 if ( *ss ) { AN.compressSize = **ss + 64; }
2983 else { AN.compressSize = AM.MaxTer/sizeof(WORD) + 2; }
2984 AN.compressSpace = (WORD *)Malloc1(AN.compressSize*sizeof(WORD),"Compression");
2985 }
2986 AN.compressSpace[0] = 0;
2987 while ( *ss ) {
2988 k = 0;
2989 s = *ss;
2990 j = *s++;
2991 if ( j > AN.compressSize ) {
2992 newsize = j + 64;
2993 t = (WORD *)Malloc1(newsize*sizeof(WORD),"Compression");
2994 t[0] = 0;
2995 if ( AN.compressSpace ) {
2996 for ( i = 0; i < *AN.compressSpace; i++ ) t[i] = AN.compressSpace[i];
2997 M_free(AN.compressSpace,"Compression");
2998 }
2999 AN.compressSpace = t;
3000 AN.compressSize = newsize;
3001 }
3002 t = AN.compressSpace;
3003 i = *t - 1;
3004 *t++ = j; j--;
3005 if ( AR.PolyFun ) {
3006 WORD *polystop, *sa;
3007 sa = s + j;
3008 sa -= ABS(sa[-1]);
3009 polystop = s;
3010 while ( polystop < sa && *polystop != AR.PolyFun ) {
3011 polystop += polystop[1];
3012 }
3013 while ( i > 0 && j > 0 && *s == *t && s < polystop ) {
3014 i--; j--; s++; t++; k--;
3015 }
3016 }
3017 else {
3018 WORD *sa;
3019 sa = s + j;
3020 sa -= ABS(sa[-1]);
3021 while ( i > 0 && j > 0 && *s == *t && s < sa ) { i--; j--; s++; t++; k--; }
3022 }
3023 if ( k < -1 ) {
3024 s[-1] = j;
3025 s[-2] = k;
3026 *ss = s-2;
3027 size += j + 2;
3028 }
3029 else {
3030 size += *AN.compressSpace;
3031 if ( k == -1 ) { t--; s--; j++; }
3032 }
3033 while ( --j >= 0 ) *t++ = *s++;
3034/* Sabotage getting into the coefficient next time */
3035 t = AN.compressSpace + *AN.compressSpace;
3036 t[-(ABS(t[-1]))] = 0;
3037 ss++;
3038 (*n)++;
3039 }
3040 }
3041 else {
3042 while ( *ss ) {
3043 size += *(*ss++);
3044 (*n)++;
3045 }
3046 }
3047/*
3048 #[ debug :
3049
3050 if ( AP.DebugFlag ) {
3051 UBYTE OutBuf[140];
3052 AO.OutFill = AO.OutputLine = OutBuf;
3053 AO.OutSkip = 3;
3054 FiniLine();
3055 ss = sss;
3056 while ( *ss ) {
3057 s = *ss++;
3058 j = *s;
3059 if ( j < 0 ) {
3060 j = s[1] + 2;
3061 }
3062 while ( --j >= 0 ) {
3063 TalToLine((UWORD)(*s++)); TokenToLine((UBYTE *)" ");
3064 }
3065 FiniLine();
3066 }
3067 AO.OutSkip = 0;
3068 FiniLine();
3069 }
3070
3071 #] debug :
3072*/
3073 return(size);
3074}
3075
3076/*
3077 #] ComPress :
3078 #[ SplitMerge : void SplitMerge(Point,number)
3079*/
3105#ifdef NEWSPLITMERGE
3106
3107LONG SplitMerge(PHEAD WORD **Pointer, LONG number)
3108{
3109 GETBIDENTITY
3110 SORTING *S = AT.SS;
3111 WORD **pp3, **pp1, **pp2, **pptop;
3112 LONG i, newleft, newright, split;
3113
3114#ifdef SPLITMERGEDEBUG
3115 /* Print current array state on entry. */
3116 printf("%4ld: ", number);
3117 for (int ii = 0; ii < S->sTerms; ii++) {
3118 if ( (S->sPointer)[ii] ) {
3119 printf("%4d ", (unsigned)(S->sPointer[ii]-S->sBuffer));
3120 }
3121 else {
3122 printf(".... ");
3123 }
3124 }
3125 printf("\n");
3126 fflush(stdout);
3127#endif
3128
3129 if ( number < 2 ) return(number);
3130 if ( number == 2 ) {
3131 pp1 = Pointer; pp2 = pp1 + 1;
3132 if ( ( i = CompareTerms(BHEAD *pp1,*pp2,(WORD)0) ) < 0 ) {
3133 pp3 = (WORD **)(*pp1); *pp1 = *pp2; *pp2 = (WORD *)pp3;
3134 }
3135 else if ( i == 0 ) {
3136 number--;
3137 if ( S->PolyWise ) { if ( AddPoly(BHEAD pp1,pp2) == 0 ) number = 0; }
3138 else { if ( AddCoef(BHEAD pp1,pp2) == 0 ) number = 0; }
3139 }
3140 return(number);
3141 }
3142 pptop = Pointer + number;
3143 split = number/2;
3144 newleft = SplitMerge(BHEAD Pointer,split);
3145 newright = SplitMerge(BHEAD Pointer+split,number-split);
3146 if ( newright == 0 ) return(newleft);
3147/*
3148 We compare the last of the left with the first of the right
3149 If they are already in order, we will be done quickly.
3150 We may have to compactify the buffer because the recursion may
3151 have created holes. Also this compare may result in equal terms.
3152 Addition of 23-jul-1999. It makes things a bit faster.
3153*/
3154 if ( newleft > 0 && newright > 0 &&
3155 ( i = CompareTerms(BHEAD Pointer[newleft-1],Pointer[split],(WORD)0) ) >= 0 ) {
3156 pp2 = Pointer+split; pp1 = Pointer+newleft-1;
3157 if ( i == 0 ) {
3158 if ( S->PolyWise ) {
3159 if ( AddPoly(BHEAD pp1,pp2) > 0 ) pp1++;
3160 else newleft--;
3161 }
3162 else {
3163 if ( AddCoef(BHEAD pp1,pp2) > 0 ) pp1++;
3164 else newleft--;
3165 }
3166 *pp2++ = 0; newright--;
3167 }
3168 else pp1++;
3169 newleft += newright;
3170 if ( pp1 < pp2 ) {
3171 while ( --newright >= 0 ) *pp1++ = *pp2++;
3172 while ( pp1 < pptop ) *pp1++ = 0;
3173 }
3174 return(newleft);
3175 }
3176
3177 if ( split >= AN.SplitScratchSize ) {
3178 AN.SplitScratchSize = (split*3)/2+100;
3179 if ( AN.SplitScratchSize > S->Terms2InSmall/2 )
3180 AN.SplitScratchSize = S->Terms2InSmall/2;
3181 if ( AN.SplitScratch ) M_free(AN.SplitScratch,"AN.SplitScratch");
3182 AN.SplitScratch = (WORD **)Malloc1(AN.SplitScratchSize*sizeof(WORD *),"AN.SplitScratch");
3183 }
3184
3185 pp3 = AN.SplitScratch; pp1 = Pointer;
3186 /* Move rather than copy, so GarbHand can't double-count. */
3187 for ( i = 0; i < newleft; i++ ) { *pp3++ = *pp1; *pp1++ = 0; }
3188 AN.InScratch = newleft;
3189 pp1 = AN.SplitScratch; pp2 = Pointer + split; pp3 = Pointer;
3190
3191#ifdef NEWSPLITMERGETIMSORT
3192/*
3193 An improvement in the style of Timsort
3194*/
3195 while ( newleft > 8 ) {
3196 /* Check the middle of the LHS terms */
3197 LONG nnleft = newleft/2;
3198 if ( ( i = CompareTerms(BHEAD pp1[nnleft],*pp2,(WORD)0) ) < 0 ) {
3199 /* The terms are not in order. Break out and continue as normal. */
3200 break;
3201 }
3202 /* The terms merge or are in order. Copy pointers up to this point. */
3203 /* In the copy, zero the skipped pointers so GarbHand can't double-count. */
3204 for (int iii = 0; iii < nnleft; iii++) {
3205 *pp3++ = *pp1;
3206 *pp1++ = 0;
3207 }
3208 newleft -= nnleft;
3209 if ( i == 0 ) {
3210 if ( S->PolyWise ) { i = AddPoly(BHEAD pp1,pp2); }
3211 else { i = AddCoef(BHEAD pp1,pp2); }
3212 if ( i == 0 ) {
3213 /* The terms cancelled. The next term goes in *pp3. Don't move. */
3214 }
3215 else {
3216 /* The terms added. Advance pp3. */
3217 *pp3++ = *pp1;
3218 }
3219 /* We have taken a LHS (copy) and RHS term. */
3220 *pp2++ = 0;
3221 newright--;
3222 *pp1++ = 0;
3223 newleft--;
3224 break;
3225 }
3226 }
3227#endif
3228
3229 while ( newleft > 0 && newright > 0 ) {
3230 if ( ( i = CompareTerms(BHEAD *pp1,*pp2,(WORD)0) ) < 0 ) {
3231 *pp3++ = *pp2;
3232 *pp2++ = 0;
3233 newright--;
3234 }
3235 else if ( i > 0 ) {
3236 *pp3++ = *pp1;
3237 *pp1++ = 0;
3238 newleft--;
3239 }
3240 else {
3241 if ( S->PolyWise ) { if ( AddPoly(BHEAD pp1,pp2) > 0 ) *pp3++ = *pp1; }
3242 else { if ( AddCoef(BHEAD pp1,pp2) > 0 ) *pp3++ = *pp1; }
3243 *pp1++ = 0; *pp2++ = 0; newleft--; newright--;
3244 }
3245 }
3246 for ( i = 0; i < newleft; i++ ) { *pp3++ = *pp1; *pp1++ = 0; }
3247 if ( pp3 == pp2 ) {
3248 pp3 += newright;
3249 } else {
3250 for ( i = 0; i < newright; i++ ) { *pp3++ = *pp2++; }
3251 }
3252 newleft = pp3 - Pointer;
3253 while ( pp3 < pptop ) *pp3++ = 0;
3254 AN.InScratch = 0;
3255 return(newleft);
3256}
3257
3258#else
3259
3260LONG SplitMerge(PHEAD WORD **Pointer, LONG number)
3261{
3262 GETBIDENTITY
3263 SORTING *S = AT.SS;
3264 WORD **pp3, **pp1, **pp2;
3265 LONG nleft, nright, i, newleft, newright;
3266 WORD **pptop;
3267
3268#ifdef SPLITMERGEDEBUG
3269 /* Print current array state on entry. */
3270 printf("%4ld: ", number);
3271 for (int ii = 0; ii < S->sTerms; ii++) {
3272 if ( (S->sPointer)[ii] ) {
3273 printf("%4d ", (unsigned)(S->sPointer[ii]-S->sBuffer));
3274 }
3275 else {
3276 printf(".... ");
3277 }
3278 }
3279 printf("\n");
3280 fflush(stdout);
3281#endif
3282
3283 if ( number < 2 ) return(number);
3284 if ( number == 2 ) {
3285 pp1 = Pointer; pp2 = pp1 + 1;
3286 if ( ( i = CompareTerms(BHEAD *pp1,*pp2,(WORD)0) ) < 0 ) {
3287 pp3 = (WORD **)(*pp1); *pp1 = *pp2; *pp2 = (WORD *)pp3;
3288 }
3289 else if ( i == 0 ) {
3290 number--;
3291 if ( S->PolyWise ) { if ( AddPoly(BHEAD pp1,pp2) == 0 ) { number = 0; } }
3292 else { if ( AddCoef(BHEAD pp1,pp2) == 0 ) { number = 0; } }
3293 }
3294 return(number);
3295 }
3296 pptop = Pointer + number;
3297 nleft = number >> 1; nright = number - nleft;
3298 newleft = SplitMerge(BHEAD Pointer,nleft);
3299 newright = SplitMerge(BHEAD Pointer+nleft,nright);
3300/*
3301 We compare the last of the left with the first of the right
3302 If they are already in order, we will be done quickly.
3303 We may have to compactify the buffer because the recursion may
3304 have created holes. Also this compare may result in equal terms.
3305 Addition of 23-jul-1999. It makes things a bit faster.
3306*/
3307 if ( newleft > 0 && newright > 0 &&
3308 ( i = CompareTerms(BHEAD Pointer[newleft-1],Pointer[nleft],(WORD)0) ) >= 0 ) {
3309 pp2 = Pointer+nleft; pp1 = Pointer+newleft-1;
3310 if ( i == 0 ) {
3311 if ( S->PolyWise ) {
3312 if ( AddPoly(BHEAD pp1,pp2) > 0 ) pp1++;
3313 else newleft--;
3314 }
3315 else {
3316 if ( AddCoef(BHEAD pp1,pp2) > 0 ) pp1++;
3317 else newleft--;
3318 }
3319 *pp2++ = 0; newright--;
3320 }
3321 else pp1++;
3322 newleft += newright;
3323 if ( pp1 < pp2 ) {
3324 while ( --newright >= 0 ) *pp1++ = *pp2++;
3325 while ( pp1 < pptop ) *pp1++ = 0;
3326 }
3327 return(newleft);
3328 }
3329 if ( nleft > AN.SplitScratchSize ) {
3330 AN.SplitScratchSize = (nleft*3)/2+100;
3331 if ( AN.SplitScratchSize > S->Terms2InSmall/2 )
3332 AN.SplitScratchSize = S->Terms2InSmall/2;
3333 if ( AN.SplitScratch ) M_free(AN.SplitScratch,"AN.SplitScratch");
3334 AN.SplitScratch = (WORD **)Malloc1(AN.SplitScratchSize*sizeof(WORD *),"AN.SplitScratch");
3335 }
3336 pp3 = AN.SplitScratch; pp1 = Pointer; i = nleft;
3337 do { *pp3++ = *pp1; *pp1++ = 0; } while ( *pp1 && --i > 0 );
3338 if ( i > 0 ) { *pp3 = 0; i--; }
3339 AN.InScratch = nleft - i;
3340 pp1 = AN.SplitScratch; pp2 = Pointer + nleft; pp3 = Pointer;
3341 while ( nleft > 0 && nright > 0 && *pp1 && *pp2 ) {
3342 if ( ( i = CompareTerms(BHEAD *pp1,*pp2,(WORD)0) ) < 0 ) {
3343 *pp3++ = *pp2;
3344 *pp2++ = 0;
3345 nright--;
3346 }
3347 else if ( i > 0 ) {
3348 *pp3++ = *pp1;
3349 *pp1++ = 0;
3350 nleft--;
3351 }
3352 else {
3353 if ( S->PolyWise ) { if ( AddPoly(BHEAD pp1,pp2) > 0 ) *pp3++ = *pp1; }
3354 else { if ( AddCoef(BHEAD pp1,pp2) > 0 ) *pp3++ = *pp1; }
3355 *pp1++ = 0; *pp2++ = 0; nleft--; nright--;
3356 }
3357 }
3358 while ( --nleft >= 0 && *pp1 ) { *pp3++ = *pp1; *pp1++ = 0; }
3359 while ( --nright >= 0 && *pp2 ) { *pp3++ = *pp2++; }
3360 nleft = pp3 - Pointer;
3361 while ( pp3 < pptop ) *pp3++ = 0;
3362 AN.InScratch = 0;
3363 return(nleft);
3364}
3365
3366#endif
3367
3368/*
3369 #] SplitMerge :
3370 #[ GarbHand : void GarbHand()
3371*/
3387void GarbHand(void)
3388{
3389 GETIDENTITY
3390 SORTING *S = AT.SS;
3391 WORD **Point, *s2, *t, *garbuf, i;
3392 LONG k, total = 0;
3393 int tobereturned = 0;
3394/*
3395 Compute the size needed. Put it in total.
3396*/
3397#ifdef TESTGARB
3398 MLOCK(ErrorMessageLock);
3399 MesPrint("in: S->sFill = %l, S->sTop2 = %l",S->sFill-S->sBuffer,S->sTop2-S->sBuffer);
3400#endif
3401 Point = S->sPointer;
3402 k = S->sTerms;
3403 while ( --k >= 0 ) {
3404 if ( ( s2 = *Point++ ) != 0 ) { total += *s2; }
3405 }
3406 Point = AN.SplitScratch;
3407 k = AN.InScratch;
3408 while ( --k >= 0 ) {
3409 if ( ( s2 = *Point++ ) != 0 ) { total += *s2; }
3410 }
3411#ifdef TESTGARB
3412 MesPrint("total = %l, nterms = %l",total,AN.InScratch);
3413 MUNLOCK(ErrorMessageLock);
3414#endif
3415/*
3416 Test now whether it fits. If so deal with the problem inside
3417 the memory at the tail of the large buffer.
3418*/
3419 if ( S->lBuffer != 0 && S->lFill + total <= S->lTop ) {
3420 garbuf = S->lFill;
3421 }
3422 else {
3423 garbuf = (WORD *)Malloc1(total*sizeof(WORD),"Garbage buffer");
3424 tobereturned = 1;
3425 }
3426 t = garbuf;
3427 Point = S->sPointer;
3428 k = S->sTerms;
3429 while ( --k >= 0 ) {
3430 if ( *Point ) {
3431 s2 = *Point++;
3432 i = *s2;
3433 NCOPY(t,s2,i);
3434 }
3435 else { Point++; }
3436 }
3437 Point = AN.SplitScratch;
3438 k = AN.InScratch;
3439 while ( --k >= 0 ) {
3440 if ( *Point ) {
3441 s2 = *Point++;
3442 i = *s2;
3443 NCOPY(t,s2,i);
3444 }
3445 else Point++;
3446 }
3447 s2 = S->sBuffer;
3448 t = garbuf;
3449 Point = S->sPointer;
3450 k = S->sTerms;
3451 while ( --k >= 0 ) {
3452 if ( *Point ) {
3453 *Point++ = s2;
3454 i = *t;
3455 NCOPY(s2,t,i);
3456 }
3457 else { Point++; }
3458 }
3459 Point = AN.SplitScratch;
3460 k = AN.InScratch;
3461 while ( --k >= 0 ) {
3462 if ( *Point ) {
3463 *Point++ = s2;
3464 i = *t;
3465 NCOPY(s2,t,i);
3466 }
3467 else Point++;
3468 }
3469 S->sFill = s2;
3470#ifdef TESTGARB
3471 MLOCK(ErrorMessageLock);
3472 MesPrint("out: S->sFill = %l, S->sTop2 = %l",S->sFill-S->sBuffer,S->sTop2-S->sBuffer);
3473 if ( S->sFill >= S->sTop2 ) {
3474 MesPrint("We are in deep trouble");
3475 }
3476 MUNLOCK(ErrorMessageLock);
3477#endif
3478 if ( tobereturned ) M_free(garbuf,"Garbage buffer");
3479 return;
3480}
3481
3482/*
3483 #] GarbHand :
3484 #[ MergePatches : WORD MergePatches(par)
3485*/
3502int MergePatches(WORD par)
3503{
3504 GETIDENTITY
3505 SORTING *S = AT.SS;
3506 WORD **poin, **poin2, ul, k, i, im, *m1;
3507 WORD *p, lpat, mpat, level, l1, l2, r1, r2, r3, c;
3508 WORD *m2, *m3, r31, r33, ki, *rr;
3509 UWORD *coef;
3510 POSITION position;
3511 FILEHANDLE *fin, *fout;
3512 int fhandle;
3513/*
3514 UBYTE *s;
3515*/
3516#ifdef WITHZLIB
3517 POSITION position2;
3518 int oldgzipCompress = AR.gzipCompress;
3519 if ( par == 2 ) {
3520 AR.gzipCompress = 0;
3521 }
3522#endif
3523 fin = &S->file;
3524 fout = &(AR.FoStage4[0]);
3525NewMerge:
3526 coef = AN.SoScratC;
3527 poin = S->poina; poin2 = S->poin2a;
3528 rr = AR.CompressPointer;
3529 *rr = 0;
3530/*
3531 #[ Setup :
3532*/
3533 if ( par == 1 ) {
3534 fout = &(S->file);
3535 if ( fout->handle < 0 ) {
3536FileMake:
3537 PUTZERO(S->OldPosOut);
3538 if ( ( fhandle = CreateFile(fout->name) ) < 0 ) {
3539 MLOCK(ErrorMessageLock);
3540 MesPrint("Cannot create file %s",fout->name);
3541 MUNLOCK(ErrorMessageLock);
3542 goto ReturnError;
3543 }
3544#ifdef GZIPDEBUG
3545 MLOCK(ErrorMessageLock);
3546 MesPrint("%w MergePatches created output file %s",fout->name);
3547 MUNLOCK(ErrorMessageLock);
3548#endif
3549 fout->handle = fhandle;
3550 PUTZERO(fout->filesize);
3551 PUTZERO(fout->POposition);
3552/*
3553 Should not be here?
3554#ifdef WITHZLIB
3555 fout->ziobuffer = 0;
3556#endif
3557*/
3558#ifdef ALLLOCK
3559 LOCK(fout->pthreadslock);
3560#endif
3561 SeekFile(fout->handle,&(fout->filesize),SEEK_SET);
3562#ifdef ALLLOCK
3563 UNLOCK(fout->pthreadslock);
3564#endif
3565 S->fPatchN = 0;
3566 PUTZERO(S->fPatches[0]);
3567 fout->POfill = fout->PObuffer;
3568 PUTZERO(fout->POposition);
3569 }
3570ConMer:
3571 StageSort(fout);
3572#ifdef WITHZLIB
3573 if ( S == AT.S0 && AR.NoCompress == 0 && AR.gzipCompress > 0 )
3574 S->fpcompressed[S->fPatchN] = 1;
3575 else
3576 S->fpcompressed[S->fPatchN] = 0;
3577 SetupOutputGZIP(fout);
3578#endif
3579 }
3580 else if ( par == 0 && S->stage4 > 0 ) {
3581/*
3582 We will have to do our job more than once.
3583 Input is from S->file and output will go to AR.FoStage4.
3584 The file corresponding to this last one must be made now.
3585*/
3586 AR.Stage4Name ^= 1;
3587/*
3588 s = (UBYTE *)(fout->name); while ( *s ) s++;
3589 if ( AR.Stage4Name ) s[-1] += 1;
3590 else s[-1] -= 1;
3591*/
3592 S->iPatches = S->fPatches;
3593 S->fPatches = S->inPatches;
3594 S->inPatches = S->iPatches;
3595 (S->inNum) = S->fPatchN;
3596 S->OldPosIn = S->OldPosOut;
3597#ifdef WITHZLIB
3598 m1 = S->fpincompressed;
3599 S->fpincompressed = S->fpcompressed;
3600 S->fpcompressed = m1;
3601 for ( i = 0; i < S->inNum; i++ ) {
3602 S->fPatchesStop[i] = S->iPatches[i+1];
3603#ifdef GZIPDEBUG
3604 MLOCK(ErrorMessageLock);
3605 MesPrint("%w fPatchesStop[%d] = %10p",i,&(S->fPatchesStop[i]));
3606 MUNLOCK(ErrorMessageLock);
3607#endif
3608 }
3609#endif
3610 S->stage4 = 0;
3611 goto FileMake;
3612 }
3613 else {
3614#ifdef WITHZLIB
3615/*
3616 The next statement is just for now
3617*/
3618 AR.gzipCompress = 0;
3619#endif
3620 if ( par == 0 ) {
3621 S->iPatches = S->fPatches;
3622 S->inNum = S->fPatchN;
3623#ifdef WITHZLIB
3624 m1 = S->fpincompressed;
3625 S->fpincompressed = S->fpcompressed;
3626 S->fpcompressed = m1;
3627 for ( i = 0; i < S->inNum; i++ ) {
3628 S->fPatchesStop[i] = S->fPatches[i+1];
3629#ifdef GZIPDEBUG
3630 MLOCK(ErrorMessageLock);
3631 MesPrint("%w fPatchesStop[%d] = %10p",i,&(S->fPatchesStop[i]));
3632 MUNLOCK(ErrorMessageLock);
3633#endif
3634 }
3635#endif
3636 }
3637 fout = AR.outfile;
3638 }
3639 if ( par ) { /* Mark end of patches */
3640 S->Patches[S->lPatch] = S->lFill;
3641 for ( i = 0; i < S->lPatch; i++ ) {
3642 S->pStop[i] = S->Patches[i+1]-1;
3643 S->Patches[i] = (WORD *)(((UBYTE *)(S->Patches[i])) + AM.MaxTer);
3644 }
3645 }
3646 else { /* Load the patches */
3647 S->lPatch = (S->inNum);
3648#ifdef WITHMPI
3649 if ( S->lPatch > 1 || ( (PF.exprtodo <0) && (fout == AR.outfile || fout == AR.hidefile ) ) ) {
3650#else
3651 if ( S->lPatch > 1 ) {
3652#endif
3653#ifdef WITHZLIB
3654 SetupAllInputGZIP(S);
3655#endif
3656 p = S->lBuffer;
3657 for ( i = 0; i < S->lPatch; i++ ) {
3658 p = (WORD *)(((UBYTE *)p)+2*AM.MaxTer+COMPINC*sizeof(WORD));
3659 S->Patches[i] = p;
3660 p = (WORD *)(((UBYTE *)p) + fin->POsize);
3661 S->pStop[i] = m2 = p;
3662#ifdef WITHZLIB
3663 PutIn(fin,&(S->iPatches[i]),S->Patches[i],&m2,i);
3664#else
3665 ADDPOS(S->iPatches[i],PutIn(fin,&(S->iPatches[i]),S->Patches[i],&m2,i));
3666#endif
3667 }
3668 }
3669 }
3670 if ( fout->handle >= 0 ) {
3671 PUTZERO(position);
3672#ifdef ALLLOCK
3673 LOCK(fout->pthreadslock);
3674#endif
3675 SeekFile(fout->handle,&position,SEEK_END);
3676 ADDPOS(position,((fout->POfill-fout->PObuffer)*sizeof(WORD)));
3677#ifdef ALLLOCK
3678 UNLOCK(fout->pthreadslock);
3679#endif
3680 }
3681 else {
3682 SETBASEPOSITION(position,(fout->POfill-fout->PObuffer)*sizeof(WORD));
3683 }
3684/*
3685 #] Setup :
3686
3687 The old code had to be replaced because all output needs to go
3688 through PutOut. For this we have to go term by term and keep
3689 track of the compression.
3690*/
3691 if ( S->lPatch == 1 ) { /* Single patch --> direct copy. Very rare. */
3692 LONG length;
3693
3694 if ( fout->handle < 0 ) if ( Sflush(fout) ) goto PatCall;
3695 if ( par ) { /* Memory to file */
3696#ifdef WITHZLIB
3697/*
3698 We fix here the problem that the thing needs to go through PutOut
3699*/
3700 m2 = m1 = *S->Patches; /* The m2 is to keep the compiler from complaining */
3701 while ( *m1 ) {
3702 if ( *m1 < 0 ) { /* Need to uncompress */
3703 i = -(*m1++); m2 += i; im = *m1+i+1;
3704 while ( i > 0 ) { *m1-- = *m2--; i--; }
3705 *m1 = im;
3706 }
3707#ifdef WITHPTHREADS
3708 /* Check here (and in the following) that we are at ground level
3709 (so S == AT.S0) to use PutToMaster. Control can reach here,
3710 with AS.MasterSort, but with S != AT.S0, when the SortBots are
3711 adding PolyRatFun and the sorting of their arguments requires
3712 large buffer patches to be merged. In this case, terms escape
3713 the PolyRatFun argument and end up at ground level, if we use
3714 PutToMaster. */
3715 if ( AS.MasterSort && ( fout == AR.outfile ) && S == AT.S0 ) {
3716 im = PutToMaster(BHEAD m1);
3717 }
3718 else
3719#endif
3720 if ( ( im = PutOut(BHEAD m1,&position,fout,1) ) < 0 ) goto ReturnError;
3721 ADDPOS(S->SizeInFile[par],im);
3722 m2 = m1;
3723 m1 += *m1;
3724 }
3725#ifdef WITHPTHREADS
3726 if ( AS.MasterSort && ( fout == AR.outfile ) && S == AT.S0 ) {
3727 PutToMaster(BHEAD 0);
3728 }
3729 else
3730#endif
3731 if ( FlushOut(&position,fout,1) ) goto ReturnError;
3732 ADDPOS(S->SizeInFile[par],1);
3733#else
3734/* old code */
3735 length = (LONG)(*S->pStop)-(LONG)(*S->Patches)+sizeof(WORD);
3736 if ( WriteFile(fout->handle,(UBYTE *)(*S->Patches),length) != length )
3737 goto PatwCall;
3738 ADDPOS(position,length);
3739 ADDPOS(fout->POposition,length);
3740 ADDPOS(fout->filesize,length);
3741 ADDPOS(S->SizeInFile[par],length/sizeof(WORD));
3742#endif
3743 }
3744 else { /* File to file */
3745#ifdef WITHZLIB
3746/*
3747 Note: if we change FRONTSIZE we need to make the minimum value
3748 of SmallEsize in AllocSort correspondingly larger or smaller.
3749 Theoretically we could get close to 2*AM.MaxTer!
3750*/
3751 #define FRONTSIZE (2*AM.MaxTer)
3752 WORD *copybuf = (WORD *)(((UBYTE *)(S->sBuffer)) + FRONTSIZE);
3753 WORD *copytop;
3754 SetupAllInputGZIP(S);
3755 m1 = m2 = copybuf;
3756 position2 = S->iPatches[0];
3757 while ( ( length = FillInputGZIP(fin,&position2,
3758 (UBYTE *)copybuf,
3759 (S->SmallEsize*sizeof(WORD)-FRONTSIZE),0) ) > 0 ) {
3760 copytop = (WORD *)(((UBYTE *)copybuf)+length);
3761 while ( *m1 && ( ( *m1 > 0 && m1+*m1 < copytop ) ||
3762 ( *m1 < 0 && ( m1+1 < copytop ) && ( m1+m1[1]+1 < copytop ) ) ) )
3763/*
3764 22-jun-2013 JV Extremely nasty bug that has been around for a while.
3765 What if the end is in the remaining part? We will loose terms!
3766 while ( *m1 && ( (WORD *)(((UBYTE *)(m1)) + AM.MaxTer ) < S->sTop2 ) )
3767*/
3768 {
3769 if ( *m1 < 0 ) { /* Need to uncompress */
3770 i = -(*m1++); m2 += i; im = *m1+i+1;
3771 while ( i > 0 ) { *m1-- = *m2--; i--; }
3772 *m1 = im;
3773 }
3774#ifdef WITHPTHREADS
3775 if ( AS.MasterSort && ( fout == AR.outfile ) && S == AT.S0 ) {
3776 im = PutToMaster(BHEAD m1);
3777 }
3778 else
3779#endif
3780 if ( ( im = PutOut(BHEAD m1,&position,fout,1) ) < 0 ) goto ReturnError;
3781 ADDPOS(S->SizeInFile[par],im);
3782 m2 = m1;
3783 m1 += *m1;
3784 }
3785 if ( m1 < copytop && *m1 == 0 ) break;
3786/*
3787 Now move the remaining part 'back'
3788*/
3789 m3 = copybuf;
3790 m1 = copytop;
3791 while ( m1 > m2 ) *--m3 = *--m1;
3792 m2 = m3;
3793 m1 = m2 + *m2;
3794 }
3795 if ( length < 0 ) {
3796 MLOCK(ErrorMessageLock);
3797 MesPrint("Readerror");
3798 goto PatCall2;
3799 }
3800#ifdef WITHPTHREADS
3801 if ( AS.MasterSort && ( fout == AR.outfile ) && S == AT.S0 ) {
3802 PutToMaster(BHEAD 0);
3803 }
3804 else
3805#endif
3806 if ( FlushOut(&position,fout,1) ) goto ReturnError;
3807 ADDPOS(S->SizeInFile[par],1);
3808#else
3809/* old code */
3810 SeekFile(fin->handle,&(S->iPatches[0]),SEEK_SET); /* needed for stage4 */
3811 while ( ( length = ReadFile(fin->handle,
3812 (UBYTE *)(S->sBuffer),S->SmallEsize*sizeof(WORD)) ) > 0 ) {
3813 if ( WriteFile(fout->handle,(UBYTE *)(S->sBuffer),length) != length )
3814 goto PatwCall;
3815 ADDPOS(position,length);
3816 ADDPOS(fout->POposition,length);
3817 ADDPOS(fout->filesize,length);
3818 ADDPOS(S->SizeInFile[par],length/sizeof(WORD));
3819 }
3820 if ( length < 0 ) {
3821 MLOCK(ErrorMessageLock);
3822 MesPrint("Readerror");
3823 goto PatCall2;
3824 }
3825#endif
3826 }
3827 goto EndOfAll;
3828 }
3829 else if ( S->lPatch > 0 ) {
3830
3831 /* More than one patch. Construct the tree. */
3832
3833 lpat = 1;
3834 do { lpat *= 2; } while ( lpat < S->lPatch );
3835 mpat = ( lpat >> 1 ) - 1;
3836 k = lpat - S->lPatch;
3837
3838 /* k is the number of empty places in the tree. they will
3839 be at the even positions from 2 to 2*k */
3840
3841 for ( i = 1; i < lpat; i++ ) {
3842 S->tree[i] = -1;
3843 }
3844 for ( i = 1; i <= k; i++ ) {
3845 im = ( i * 2 ) - 1;
3846 poin[im] = S->Patches[i-1];
3847 poin2[im] = poin[im] + *(poin[im]);
3848 S->used[i] = im;
3849 S->ktoi[im] = i-1;
3850 S->tree[mpat+i] = 0;
3851 poin[im-1] = poin2[im-1] = 0;
3852 }
3853 for ( i = (k*2)+1; i <= lpat; i++ ) {
3854 S->used[i-k] = i;
3855 S->ktoi[i] = i-k-1;
3856 poin[i] = S->Patches[i-k-1];
3857 poin2[i] = poin[i] + *(poin[i]);
3858 }
3859/*
3860 the array poin tells the position of the i-th element of the S->tree
3861 'S->used' is a stack with the S->tree elements that need to be entered
3862 into the S->tree. at the beginning this is S->lPatch. during the
3863 sort there will be only very few elements.
3864 poin2 is the next value of poin. it has to be determined
3865 before the comparisons as the position or the size of the
3866 term indicated by poin may change.
3867 S->ktoi translates a S->tree element back to its stream number.
3868
3869 start the sort
3870*/
3871 level = S->lPatch;
3872
3873 /* introduce one term */
3874OneTerm:
3875 k = S->used[level];
3876 i = k + lpat - 1;
3877 if ( !*(poin[k]) ) {
3878 do { if ( !( i >>= 1 ) ) goto EndOfMerge; } while ( !S->tree[i] );
3879 if ( S->tree[i] == -1 ) {
3880 S->tree[i] = 0;
3881 level--;
3882 goto OneTerm;
3883 }
3884 k = S->tree[i];
3885 S->used[level] = k;
3886 S->tree[i] = 0;
3887 }
3888/*
3889 move terms down the tree
3890*/
3891 while ( i >>= 1 ) {
3892 if ( S->tree[i] > 0 ) {
3893 if ( ( c = CompareTerms(BHEAD poin[S->tree[i]],poin[k],(WORD)0) ) > 0 ) {
3894/*
3895 S->tree[i] is the smaller. Exchange and go on.
3896*/
3897 S->used[level] = S->tree[i];
3898 S->tree[i] = k;
3899 k = S->used[level];
3900 }
3901 else if ( !c ) { /* Terms are equal */
3902 S->TermsLeft--;
3903/*
3904 Here the terms are equal and their coefficients
3905 have to be added.
3906*/
3907 l1 = *( m1 = poin[S->tree[i]] );
3908 l2 = *( m2 = poin[k] );
3909 if ( S->PolyWise ) { /* Here we work with PolyFun */
3910 WORD *tt1, *w;
3911 tt1 = m1;
3912 m1 += S->PolyWise;
3913 m2 += S->PolyWise;
3914 if ( S->PolyFlag == 2 ) {
3915 w = poly_ratfun_add(BHEAD m1,m2);
3916 if ( *tt1 + w[1] - m1[1] > AM.MaxTer/((LONG)sizeof(WORD)) ) {
3917 MLOCK(ErrorMessageLock);
3918 MesPrint("Term too complex in PolyRatFun addition. MaxTermSize of %10l is too small",AM.MaxTer);
3919 MUNLOCK(ErrorMessageLock);
3920 Terminate(-1);
3921 }
3922 AT.WorkPointer = w;
3923 }
3924 else {
3925 w = AT.WorkPointer;
3926 if ( w + m1[1] + m2[1] > AT.WorkTop ) {
3927 MLOCK(ErrorMessageLock);
3928 MesPrint("A WorkSpace of %10l is too small",AM.WorkSize);
3929 MUNLOCK(ErrorMessageLock);
3930 Terminate(-1);
3931 }
3932 AddArgs(BHEAD m1,m2,w);
3933 }
3934 r1 = w[1];
3935 if ( r1 <= FUNHEAD
3936 || ( w[FUNHEAD] == -SNUMBER && w[FUNHEAD+1] == 0 ) )
3937 { goto cancelled; }
3938 if ( r1 == m1[1] ) {
3939 NCOPY(m1,w,r1);
3940 }
3941 else if ( r1 < m1[1] ) {
3942 r2 = m1[1] - r1;
3943 m2 = w + r1;
3944 m1 += m1[1];
3945 while ( --r1 >= 0 ) *--m1 = *--m2;
3946 m2 = m1 - r2;
3947 r1 = S->PolyWise;
3948 while ( --r1 >= 0 ) *--m1 = *--m2;
3949 *m1 -= r2;
3950 poin[S->tree[i]] = m1;
3951 }
3952 else {
3953 r2 = r1 - m1[1];
3954 m2 = tt1 - r2;
3955 r1 = S->PolyWise;
3956 m1 = tt1;
3957 *m1 += r2;
3958 poin[S->tree[i]] = m2;
3959 NCOPY(m2,m1,r1);
3960 r1 = w[1];
3961 NCOPY(m2,w,r1);
3962 }
3963 }
3964#ifdef WITHFLOAT
3965 else if ( AT.SortFloatMode ) {
3966 WORD *term1, *term2;
3967 term1 = poin[S->tree[i]];
3968 term2 = poin[k];
3969 if ( MergeWithFloat(BHEAD &term1,&term2) == 0 )
3970 goto cancelled;
3971 poin[S->tree[i]] = term1;
3972 }
3973#endif
3974 else {
3975 r1 = *( m1 += l1 - 1 );
3976 m1 -= ABS(r1) - 1;
3977 r1 = ( ( r1 > 0 ) ? (r1-1) : (r1+1) ) >> 1;
3978 r2 = *( m2 += l2 - 1 );
3979 m2 -= ABS(r2) - 1;
3980 r2 = ( ( r2 > 0 ) ? (r2-1) : (r2+1) ) >> 1;
3981
3982 if ( AddRat(BHEAD (UWORD *)m1,r1,(UWORD *)m2,r2,coef,&r3) ) {
3983 MLOCK(ErrorMessageLock);
3984 MesCall("MergePatches");
3985 MUNLOCK(ErrorMessageLock);
3986 SETERROR(-1)
3987 }
3988
3989 if ( AN.ncmod != 0 ) {
3990 if ( ( AC.modmode & POSNEG ) != 0 ) {
3991 NormalModulus(coef,&r3);
3992 }
3993 else if ( BigLong(coef,r3,(UWORD *)AC.cmod,ABS(AN.ncmod)) >= 0 ) {
3994 WORD ii;
3995 SubPLon(coef,r3,(UWORD *)AC.cmod,ABS(AN.ncmod),coef,&r3);
3996 coef[r3] = 1;
3997 for ( ii = 1; ii < r3; ii++ ) coef[r3+ii] = 0;
3998 }
3999 }
4000 r3 *= 2;
4001 r33 = ( r3 > 0 ) ? ( r3 + 1 ) : ( r3 - 1 );
4002 if ( r3 < 0 ) r3 = -r3;
4003 if ( r1 < 0 ) r1 = -r1;
4004 r1 *= 2;
4005 r31 = r3 - r1;
4006 if ( !r3 ) { /* Terms cancel */
4007cancelled:
4008 ul = S->used[level] = S->tree[i];
4009 S->tree[i] = -1;
4010/*
4011 We skip to the next term in stream ul
4012*/
4013 im = *poin2[ul];
4014 if ( im < 0 ) {
4015 r1 = poin2[ul][1] - im + 1;
4016 m1 = poin2[ul] + 2;
4017 m2 = poin[ul] - im + 1;
4018 while ( ++im <= 0 ) *--m1 = *--m2;
4019 *--m1 = r1;
4020 poin2[ul] = m1;
4021 im = r1;
4022 }
4023 poin[ul] = poin2[ul];
4024 ki = S->ktoi[ul];
4025 if ( !par && (poin[ul] + im + COMPINC) >= S->pStop[ki]
4026 && im > 0 ) {
4027#ifdef WITHZLIB
4028 PutIn(fin,&(S->iPatches[ki]),S->Patches[ki],&(poin[ul]),ki);
4029#else
4030 ADDPOS(S->iPatches[ki],PutIn(fin,&(S->iPatches[ki]),
4031 S->Patches[ki],&(poin[ul]),ki));
4032#endif
4033 poin2[ul] = poin[ul] + im;
4034 }
4035 else {
4036 poin2[ul] += im;
4037 }
4038 S->used[++level] = k;
4039 S->TermsLeft--;
4040 }
4041 else if ( !r31 ) { /* copy coef into term1 */
4042 goto CopCof2;
4043 }
4044 else if ( r31 < 0 ) { /* copy coef into term1
4045 and adjust the length of term1 */
4046 goto CopCoef;
4047 }
4048 else {
4049/*
4050 this is the dreaded calamity.
4051 is there enough space?
4052*/
4053 if( (poin[S->tree[i]]+l1+r31) >= poin2[S->tree[i]] ) {
4054/*
4055 no space! now the special trick for which
4056 we left 2*maxlng spaces open at the beginning
4057 of each patch.
4058*/
4059 if ( (l1 + r31) > AM.MaxTer/((LONG)sizeof(WORD)) ) {
4060 MLOCK(ErrorMessageLock);
4061 MesPrint("Coefficient overflow during sort");
4062 MUNLOCK(ErrorMessageLock);
4063 goto ReturnError;
4064 }
4065 m2 = poin[S->tree[i]];
4066 m3 = ( poin[S->tree[i]] -= r31 );
4067 do { *m3++ = *m2++; } while ( m2 < m1 );
4068 m1 = m3;
4069 }
4070CopCoef:
4071 *(poin[S->tree[i]]) += r31;
4072CopCof2:
4073 m2 = (WORD *)coef; im = r3;
4074 NCOPY(m1,m2,im);
4075 *m1 = r33;
4076 }
4077 }
4078/*
4079 Now skip to the next term in stream k.
4080*/
4081NextTerm:
4082 im = poin2[k][0];
4083 if ( im < 0 ) {
4084 r1 = poin2[k][1] - im + 1;
4085 m1 = poin2[k] + 2;
4086 m2 = poin[k] - im + 1;
4087 while ( ++im <= 0 ) *--m1 = *--m2;
4088 *--m1 = r1;
4089 poin2[k] = m1;
4090 im = r1;
4091 }
4092 poin[k] = poin2[k];
4093 ki = S->ktoi[k];
4094 if ( !par && ( (poin[k] + im + COMPINC) >= S->pStop[ki] )
4095 && im > 0 ) {
4096#ifdef WITHZLIB
4097 PutIn(fin,&(S->iPatches[ki]),S->Patches[ki],&(poin[k]),ki);
4098#else
4099 ADDPOS(S->iPatches[ki],PutIn(fin,&(S->iPatches[ki]),
4100 S->Patches[ki],&(poin[k]),ki));
4101#endif
4102 poin2[k] = poin[k] + im;
4103 }
4104 else {
4105 poin2[k] += im;
4106 }
4107 goto OneTerm;
4108 }
4109 }
4110 else if ( S->tree[i] < 0 ) {
4111 S->tree[i] = k;
4112 level--;
4113 goto OneTerm;
4114 }
4115 }
4116/*
4117 found the smallest in the set. indicated by k.
4118 write to its destination.
4119*/
4120#ifdef WITHPTHREADS
4121 if ( AS.MasterSort && ( fout == AR.outfile ) && S == AT.S0 ) {
4122 im = PutToMaster(BHEAD poin[k]);
4123 }
4124 else
4125#endif
4126 if ( ( im = PutOut(BHEAD poin[k],&position,fout,1) ) < 0 ) {
4127 MLOCK(ErrorMessageLock);
4128 MesPrint("Called from MergePatches with k = %d (stream %d)",k,S->ktoi[k]);
4129 MUNLOCK(ErrorMessageLock);
4130 goto ReturnError;
4131 }
4132 ADDPOS(S->SizeInFile[par],im);
4133 goto NextTerm;
4134 }
4135 else {
4136 goto NormalReturn;
4137 }
4138EndOfMerge:
4139#ifdef WITHPTHREADS
4140 if ( AS.MasterSort && ( fout == AR.outfile ) && S == AT.S0 ) {
4141 PutToMaster(BHEAD 0);
4142 }
4143 else
4144#endif
4145 if ( FlushOut(&position,fout,1) ) goto ReturnError;
4146 ADDPOS(S->SizeInFile[par],1);
4147EndOfAll:
4148 if ( par == 1 ) { /* Set the fpatch pointers */
4149#ifdef WITHZLIB
4150 SeekFile(fout->handle,&position,SEEK_CUR);
4151#endif
4152 (S->fPatchN)++;
4153 S->fPatches[S->fPatchN] = position;
4154 }
4155 if ( par == 0 && fout != AR.outfile ) {
4156/*
4157 Output went to sortfile. We have two possibilities:
4158 1: We are not finished with the current in-out cycle
4159 In that case we should pop to the next set of patches
4160 2: We finished a cycle and should clean up the in file
4161 Then we restart the sort.
4162*/
4163 (S->fPatchN)++;
4164 S->fPatches[S->fPatchN] = position;
4165 if ( ISNOTZEROPOS(S->OldPosIn) ) { /* We are not done */
4166
4167 SeekFile(fin->handle,&(S->OldPosIn),SEEK_SET);
4168/*
4169 We don't need extra provisions for the zlib compression here.
4170 If part of an expression has been sorted, the whole has been so.
4171 This means that S->fpincompressed[] will remain the same
4172*/
4173 if ( (ULONG)ReadFile(fin->handle,(UBYTE *)(&(S->inNum)),(LONG)sizeof(WORD)) !=
4174 sizeof(WORD)
4175 || (ULONG)ReadFile(fin->handle,(UBYTE *)(&(S->OldPosIn)),(LONG)sizeof(POSITION)) !=
4176 sizeof(POSITION)
4177 || (ULONG)ReadFile(fin->handle,(UBYTE *)S->iPatches,(LONG)((S->inNum)+1)
4178 *sizeof(POSITION)) != ((S->inNum)+1)*sizeof(POSITION) ) {
4179 MLOCK(ErrorMessageLock);
4180 MesPrint("Read error fourth stage sorting");
4181 MUNLOCK(ErrorMessageLock);
4182 goto ReturnError;
4183 }
4184 *rr = 0;
4185#ifdef WITHZLIB
4186 for ( i = 0; i < S->inNum; i++ ) {
4187 S->fPatchesStop[i] = S->iPatches[i+1];
4188#ifdef GZIPDEBUG
4189 MLOCK(ErrorMessageLock);
4190 MesPrint("%w fPatchesStop[%d] = %10p",i,&(S->fPatchesStop[i]));
4191 MUNLOCK(ErrorMessageLock);
4192#endif
4193 }
4194#endif
4195 goto ConMer;
4196 }
4197 else {
4198/*
4199 if ( fin == &(AR.FoStage4[0]) ) {
4200 s = (UBYTE *)(fin->name); while ( *s ) s++;
4201 if ( AR.Stage4Name == 1 ) s[-1] -= 1;
4202 else s[-1] += 1;
4203 }
4204*/
4205/* TruncateFile(fin->handle); */
4206 UpdateMaxSize();
4207#ifdef WITHZLIB
4208 ClearSortGZIP(fin);
4209#endif
4210 CloseFile(fin->handle);
4211 remove(fin->name); /* Gives diskspace free again. */
4212#ifdef GZIPDEBUG
4213 MLOCK(ErrorMessageLock);
4214 MesPrint("%w MergePatches removed in file %s",fin->name);
4215 MUNLOCK(ErrorMessageLock);
4216#endif
4217/*
4218 if ( fin == &(AR.FoStage4[0]) ) {
4219 s = (UBYTE *)(fin->name); while ( *s ) s++;
4220 if ( AR.Stage4Name == 1 ) s[-1] += 1;
4221 else s[-1] -= 1;
4222 }
4223*/
4224 fin->handle = -1;
4225 { FILEHANDLE *ff = fin; fin = fout; fout = ff; }
4226 PUTZERO(S->SizeInFile[0]);
4227 goto NewMerge;
4228 }
4229 }
4230 if ( par == 0 ) {
4231/* TruncateFile(fin->handle); */
4232 UpdateMaxSize();
4233#ifdef WITHZLIB
4234 ClearSortGZIP(fin);
4235#endif
4236 CloseFile(fin->handle);
4237 remove(fin->name);
4238 fin->handle = -1;
4239#ifdef GZIPDEBUG
4240 MLOCK(ErrorMessageLock);
4241 MesPrint("%w MergePatches removed in file %s",fin->name);
4242 MUNLOCK(ErrorMessageLock);
4243#endif
4244 }
4245NormalReturn:
4246#ifdef WITHZLIB
4247 AR.gzipCompress = oldgzipCompress;
4248#endif
4249 return(0);
4250ReturnError:
4251#ifdef WITHZLIB
4252 AR.gzipCompress = oldgzipCompress;
4253#endif
4254 return(-1);
4255#ifndef WITHZLIB
4256PatwCall:
4257 MLOCK(ErrorMessageLock);
4258 MesPrint("Error while writing to file.");
4259 goto PatCall2;
4260#endif
4261PatCall:;
4262 MLOCK(ErrorMessageLock);
4263PatCall2:;
4264 MesCall("MergePatches");
4265 MUNLOCK(ErrorMessageLock);
4266#ifdef WITHZLIB
4267 AR.gzipCompress = oldgzipCompress;
4268#endif
4269 SETERROR(-1)
4270}
4271
4272/*
4273 #] MergePatches :
4274 #[ StoreTerm : WORD StoreTerm(term)
4275*/
4285int StoreTerm(PHEAD WORD *term)
4286{
4287 GETBIDENTITY
4288 SORTING *S = AT.SS;
4289 WORD **ss, *lfill, j, *t;
4290 POSITION pp;
4291 LONG lSpace, sSpace, RetCode, over, tover;
4292
4293 // Update SortVerbose counters
4294 S->verbUnsortedSize += *term * sizeof(*term);
4295 if ( S->verbMaxTermSize < *term ) S->verbMaxTermSize = *term;
4296
4297 if ( ( ( AP.PreDebug & DUMPTOSORT ) == DUMPTOSORT ) && AR.sLevel == 0 ) {
4298#ifdef WITHPTHREADS
4299 snprintf((char *)(THRbuf),100,"StoreTerm(%d)",AT.identity);
4300 PrintTerm(term,(char *)(THRbuf));
4301#else
4302 PrintTerm(term,"StoreTerm");
4303#endif
4304 }
4305 if ( AM.exitflag && AR.sLevel == 0 ) return(0);
4306 S->sFill = *(S->PoinFill);
4307 if ( S->sTerms >= S->TermsInSmall || ( S->sFill + *term ) >= S->sTop ) {
4308/*
4309 The small buffer is full. It has to be sorted and written.
4310*/
4311 // Update SortVerbose counters
4312 if ( S->sTerms >= S->TermsInSmall ) S->verbSBsortTerms++;
4313 else S->verbSBsortCap++;
4314
4315 tover = over = S->sTerms;
4316 ss = S->sPointer;
4317 ss[over] = 0;
4318#ifdef SPLITTIME
4319 PrintTime((UBYTE *)"Before SplitMerge");
4320#endif
4321 ss[SplitMerge(BHEAD ss,over)] = 0;
4322#ifdef SPLITTIME
4323 PrintTime((UBYTE *)"After SplitMerge");
4324#endif
4325 sSpace = 0;
4326 if ( over > 0 ) {
4327 sSpace = ComPress(ss,&RetCode);
4328 S->TermsLeft -= over - RetCode;
4329 }
4330 sSpace++;
4331
4332 lSpace = sSpace + (S->lFill - S->lBuffer)
4333 - (AM.MaxTer/sizeof(WORD))*((LONG)S->lPatch);
4334 SETBASEPOSITION(pp,lSpace);
4335 MULPOS(pp,sizeof(WORD));
4336 if ( S->file.handle >= 0 ) {
4337 ADD2POS(pp,S->fPatches[S->fPatchN]);
4338 }
4339 if ( S == AT.S0 ) { /* Only statistics at ground level */
4340 WriteStats(&pp,STATSSPLITMERGE,CHECKLOGTYPE);
4341 }
4342 if ( ( S->lPatch >= S->MaxPatches ) ||
4343 ( ( (WORD *)(((UBYTE *)(S->lFill + sSpace)) + 2*AM.MaxTer ) ) >= S->lTop ) ) {
4344/*
4345 The large buffer is too full. Merge and write it
4346*/
4347 // Update SortVerbose counters
4348 if ( S->lPatch >= S->MaxPatches ) S->verbLBsortPatches++;
4349 else S->verbLBsortCap++;
4350
4351 if ( MergePatches(1) ) goto StoreCall;
4352/*
4353 pp = S->SizeInFile[1];
4354 ADDPOS(pp,sSpace);
4355 MULPOS(pp,sizeof(WORD));
4356*/
4357 SETBASEPOSITION(pp,sSpace);
4358 MULPOS(pp,sizeof(WORD));
4359 ADD2POS(pp,S->fPatches[S->fPatchN]);
4360
4361 if ( S == AT.S0 ) { /* Only statistics at ground level */
4362 WriteStats(&pp,STATSMERGETOFILE,CHECKLOGTYPE);
4363 }
4364 S->lPatch = 0;
4365 S->lFill = S->lBuffer;
4366 }
4367 S->Patches[S->lPatch++] = S->lFill;
4368 lfill = (WORD *)(((UBYTE *)(S->lFill)) + AM.MaxTer);
4369 if ( tover > 0 ) {
4370 ss = S->sPointer;
4371 while ( ( t = *ss++ ) != 0 ) {
4372 j = *t;
4373 if ( j < 0 ) j = t[1] + 2;
4374 while ( --j >= 0 ){
4375 *lfill++ = *t++;
4376 }
4377 }
4378 }
4379 *lfill++ = 0;
4380 S->lFill = lfill;
4381 S->sTerms = 0;
4382 S->PoinFill = S->sPointer;
4383 *(S->PoinFill) = S->sFill = S->sBuffer;
4384 }
4385 j = *term;
4386 while ( --j >= 0 ) *S->sFill++ = *term++;
4387 S->sTerms++;
4388 S->GenTerms++;
4389 S->TermsLeft++;
4390 *++S->PoinFill = S->sFill;
4391
4392 return(0);
4393
4394StoreCall:
4395 MLOCK(ErrorMessageLock);
4396 MesCall("StoreTerm");
4397 MUNLOCK(ErrorMessageLock);
4398 SETERROR(-1)
4399}
4400
4401/*
4402 #] StoreTerm :
4403 #[ StageSort : void StageSort(FILEHANDLE *fout)
4404*/
4411void StageSort(FILEHANDLE *fout)
4412{
4413 GETIDENTITY
4414 SORTING *S = AT.SS;
4415 if ( S->fPatchN >= S->MaxFpatches ) {
4416 POSITION position;
4417 if ( S != AT.S0 ) {
4418/*
4419 There are no proper provisions for stage 4 or higher sorts
4420 for function arguments and $ variables. The reason:
4421 The current code maps out the patches, based on the size of
4422 the buffers in the FoStage4 structs, while they are used
4423 inside the S->file struct that may have far smaller buffers.
4424 By itself that might still be repairable, but it goes completely
4425 wrong when during the sort polyRatFuns have to be added and they
4426 would go into stage4 (very rare but possible).
4427 The only really correct solution would be to put FoStage4 structs
4428 in all sort levels. Messy. (JV 8-oct-2018).
4429*/
4430 MLOCK(ErrorMessageLock);
4431 MesPrint("Currently Stage 4 sorts are not allowed for function arguments or $ variables.");
4432 MesPrint("Please increase correspondingsorting parameters (sub-) in the setup.");
4433 MUNLOCK(ErrorMessageLock);
4434 Terminate(-1);
4435 }
4436 PUTZERO(position);
4437 MLOCK(ErrorMessageLock);
4438#ifdef WITHPTHREADS
4439 MesPrint("StageSort in thread %d",identity);
4440#elif defined(WITHMPI)
4441 MesPrint("StageSort in process %d",PF.me);
4442#else
4443 MesPrint("StageSort");
4444#endif
4445 MUNLOCK(ErrorMessageLock);
4446 SeekFile(fout->handle,&position,SEEK_END);
4447/*
4448 No extra compression data has to be written.
4449 S->fpincompressed should remain valid.
4450*/
4451 if ( (ULONG)WriteFile(fout->handle,(UBYTE *)(&(S->fPatchN)),(LONG)sizeof(WORD)) !=
4452 sizeof(WORD)
4453 || (ULONG)WriteFile(fout->handle,(UBYTE *)(&(S->OldPosOut)),(LONG)sizeof(POSITION)) !=
4454 sizeof(POSITION)
4455 || (ULONG)WriteFile(fout->handle,(UBYTE *)(S->fPatches),(LONG)(S->fPatchN+1)
4456 *sizeof(POSITION)) != (S->fPatchN+1)*sizeof(POSITION) ) {
4457 MLOCK(ErrorMessageLock);
4458 MesPrint("Write error while staging sort. Disk full?");
4459 MUNLOCK(ErrorMessageLock);
4460 Terminate(-1);
4461 }
4462 S->OldPosOut = position;
4463 fout->filesize = position;
4464 ADDPOS(fout->filesize,(S->fPatchN+2)*sizeof(POSITION) + sizeof(WORD));
4465 fout->POposition = fout->filesize;
4466 S->fPatches[0] = fout->filesize;
4467 S->fPatchN = 0;
4468
4469 if ( AR.FoStage4[0].PObuffer == 0 ) {
4470 AR.FoStage4[0].PObuffer = (WORD *)Malloc1(AR.FoStage4[0].POsize*sizeof(WORD)
4471 ,"Stage 4 buffer");
4472 AR.FoStage4[0].POfill = AR.FoStage4[0].PObuffer;
4473 AR.FoStage4[0].POstop = AR.FoStage4[0].PObuffer
4474 + AR.FoStage4[0].POsize/sizeof(WORD);
4475#ifdef WITHPTHREADS
4476 AR.FoStage4[0].pthreadslock = dummylock;
4477#endif
4478 }
4479 if ( AR.FoStage4[1].PObuffer == 0 ) {
4480 AR.FoStage4[1].PObuffer = (WORD *)Malloc1(AR.FoStage4[1].POsize*sizeof(WORD)
4481 ,"Stage 4 buffer");
4482 AR.FoStage4[1].POfill = AR.FoStage4[1].PObuffer;
4483 AR.FoStage4[1].POstop = AR.FoStage4[1].PObuffer
4484 + AR.FoStage4[1].POsize/sizeof(WORD);
4485#ifdef WITHPTHREADS
4486 AR.FoStage4[1].pthreadslock = dummylock;
4487#endif
4488 }
4489 S->stage4 = 1;
4490 }
4491}
4492
4493/*
4494 #] StageSort :
4495 #[ SortWild : WORD SortWild(w,nw)
4496*/
4510int SortWild(WORD *w, WORD nw)
4511{
4512 GETIDENTITY
4513 WORD *v, *s, *m, k, i;
4514 WORD *pScrat, *stop, *sv;
4515 int error = 0;
4516 pScrat = AT.WorkPointer;
4517 if ( ( AT.WorkPointer + 8 * AM.MaxWildcards ) >= AT.WorkTop ) {
4518 MLOCK(ErrorMessageLock);
4519 MesWork();
4520 MUNLOCK(ErrorMessageLock);
4521 return(-1);
4522 }
4523 stop = w + nw;
4524 i = 0;
4525 while ( i < nw ) {
4526 m = w + i;
4527 v = m + m[1];
4528 while ( v < stop && (
4529 *v == FROMSET || *v == SETTONUM || *v == LOADDOLLAR ) ) v += v[1];
4530 while ( v < stop ) {
4531 if ( *v >= 0 ) {
4532 if ( AM.Ordering[*v] < AM.Ordering[*m] ) {
4533 m = v;
4534 }
4535 else if ( *v == *m ) {
4536 if ( v[2] < m[2] ) {
4537 m = v;
4538 }
4539 else if ( v[2] == m[2] ) {
4540 s = m + m[1];
4541 sv = v + v[1];
4542 if ( s < stop && ( *s == FROMSET
4543 || *s == SETTONUM || *s == LOADDOLLAR ) ) {
4544 if ( sv < stop && ( *sv == FROMSET
4545 || *sv == SETTONUM || *sv == LOADDOLLAR ) ) {
4546 if ( s[2] != sv[2] ) {
4547 error = -1;
4548 MLOCK(ErrorMessageLock);
4549 MesPrint("&Wildcard set conflict");
4550 MUNLOCK(ErrorMessageLock);
4551 }
4552 }
4553 *v = -1;
4554 }
4555 else {
4556 if ( sv < stop && ( *sv == FROMSET
4557 || *sv == SETTONUM || *sv == LOADDOLLAR ) ) {
4558 *m = -1;
4559 m = v;
4560 }
4561 else {
4562 *v = -1;
4563 }
4564 }
4565 }
4566 }
4567 }
4568 v += v[1];
4569 while ( v < stop && ( *v == FROMSET
4570 || *v == SETTONUM || *v == LOADDOLLAR ) ) v += v[1];
4571 }
4572 s = pScrat;
4573 v = m;
4574 k = m[1];
4575 NCOPY(s,m,k);
4576 while ( m < stop && ( *m == FROMSET
4577 || *m == SETTONUM || *m == LOADDOLLAR ) ) {
4578 k = m[1];
4579 NCOPY(s,m,k);
4580 }
4581 *v = -1;
4582 pScrat = s;
4583 i = 0;
4584 while ( i < nw && ( w[i] < 0 || w[i] == FROMSET
4585 || w[i] == SETTONUM || w[i] == LOADDOLLAR ) ) i += w[i+1];
4586 }
4587 AC.NwildC = k = WORDDIF(pScrat,AT.WorkPointer);
4588 s = AT.WorkPointer;
4589 m = w;
4590 NCOPY(m,s,k);
4591 AC.WildC = m;
4592 return(error);
4593}
4594
4595/*
4596 #] SortWild :
4597 #[ CleanUpSort : void CleanUpSort(num)
4598*/
4603void CleanUpSort(int num)
4604{
4605 GETIDENTITY
4606 SORTING *S;
4607 int minnum = num, i;
4608 if ( AN.FunSorts ) {
4609 if ( num == -1 ) {
4610 if ( AN.MaxFunSorts > 3 ) {
4611 minnum = (AN.MaxFunSorts+4)/2;
4612 }
4613 else minnum = 4;
4614 }
4615 else if ( minnum == 0 ) minnum = 1;
4616 for ( i = minnum; i < AN.NumFunSorts; i++ ) {
4617 S = AN.FunSorts[i];
4618 if ( S ) {
4619 if ( S->file.handle >= 0 ) {
4620/* TruncateFile(S->file.handle); */
4621 UpdateMaxSize();
4622#ifdef WITHZLIB
4623 ClearSortGZIP(&(S->file));
4624#endif
4625 CloseFile(S->file.handle);
4626 S->file.handle = -1;
4627 remove(S->file.name);
4628#ifdef GZIPDEBUG
4629 MLOCK(ErrorMessageLock);
4630 MesPrint("%w CleanUpSort removed file %s",S->file.name);
4631 MUNLOCK(ErrorMessageLock);
4632#endif
4633 }
4634 M_free(S->sPointer, "CleanUpSort: sPointer");
4635 M_free(S->Patches, "CleanUpSort: Patches");
4636 M_free(S->pStop, "CleanUpSort: pStop");
4637 M_free(S->poina, "CleanUpSort: poina");
4638 M_free(S->poin2a, "CleanUpSort: poin2a");
4639 M_free(S->fPatches, "CleanUpSort: fPatches");
4640 M_free(S->fPatchesStop, "CleanUpSort: fPatchesStop");
4641 M_free(S->inPatches, "CleanUpSort: inPatches");
4642 M_free(S->tree, "CleanUpSort: tree");
4643 M_free(S->used, "CleanUpSort: used");
4644#ifdef WITHZLIB
4645 M_free(S->fpcompressed, "CleanUpSort: fpcompressed");
4646 M_free(S->fpincompressed, "CleanUpSort: fpincompressed");
4647#endif
4648 M_free(S->ktoi, "CleanUpSort: ktoi");
4649 M_free(S->lBuffer, "CleanUpSort: lBuffer+sBuffer");
4650 M_free(S->file.PObuffer, "CleanUpSort: PObuffer");
4651 M_free(S, "CleanUpSort: sorting struct");
4652 }
4653 AN.FunSorts[i] = 0;
4654 }
4655 AN.MaxFunSorts = minnum;
4656 if ( num == 0 ) {
4657 S = AN.FunSorts[0];
4658 if ( S ) {
4659 if ( S->file.handle >= 0 ) {
4660/* TruncateFile(S->file.handle); */
4661 UpdateMaxSize();
4662#ifdef WITHZLIB
4663 ClearSortGZIP(&(S->file));
4664#endif
4665 CloseFile(S->file.handle);
4666 S->file.handle = -1;
4667 remove(S->file.name);
4668#ifdef GZIPDEBUG
4669 MLOCK(ErrorMessageLock);
4670 MesPrint("%w CleanUpSort removed file %s",S->file.name);
4671 MUNLOCK(ErrorMessageLock);
4672#endif
4673 }
4674 }
4675 }
4676 }
4677 for ( i = 0; i < 2; i++ ) {
4678 if ( AR.FoStage4[i].handle >= 0 ) {
4679 UpdateMaxSize();
4680#ifdef WITHZLIB
4681 ClearSortGZIP(&(AR.FoStage4[i]));
4682#endif
4683 CloseFile(AR.FoStage4[i].handle);
4684 remove(AR.FoStage4[i].name);
4685 AR.FoStage4[i].handle = -1;
4686#ifdef GZIPDEBUG
4687 MLOCK(ErrorMessageLock);
4688 MesPrint("%w CleanUpSort removed stage4 file %s",AR.FoStage4[i].name);
4689 MUNLOCK(ErrorMessageLock);
4690#endif
4691 }
4692 }
4693}
4694
4695/*
4696 #] CleanUpSort :
4697 #[ LowerSortLevel : void LowerSortLevel()
4698*/
4703void LowerSortLevel(void)
4704{
4705 GETIDENTITY
4706 if ( AR.sLevel >= 0 ) {
4707 AR.sLevel--;
4708 if ( AR.sLevel >= 0 ) AT.SS = AN.FunSorts[AR.sLevel];
4709 }
4710}
4711
4712/*
4713 #] LowerSortLevel :
4714 #[ PolyRatFunSpecial :
4715
4716 Keeps only the most divergent term in AR.PolyFunVar
4717 We assume that the terms are already in that notation.
4718*/
4719
4720WORD *PolyRatFunSpecial(PHEAD WORD *t1, WORD *t2)
4721{
4722 WORD *oldworkpointer = AT.WorkPointer, *t, *r;
4723 WORD exp1, exp2;
4724 int i;
4725 t = t1+FUNHEAD;
4726 if ( *t == -SYMBOL ) {
4727 if ( t[1] != AR.PolyFunVar ) goto Illegal;
4728 exp1 = 1;
4729 if ( t[2] != -SNUMBER ) goto Illegal;
4730 t[3] = 1;
4731 }
4732 else if ( *t == -SNUMBER ) {
4733 t[1] = 1;
4734 t += 2;
4735 if ( *t == -SYMBOL ) {
4736 if ( t[1] != AR.PolyFunVar ) goto Illegal;
4737 exp1 = -1;
4738 }
4739 else if ( *t == -SNUMBER ) {
4740 t[1] = 1;
4741 exp1 = 0;
4742 }
4743 else if ( *t == ARGHEAD+8 && t[ARGHEAD] == 8 && t[ARGHEAD+1] == SYMBOL
4744 && t[ARGHEAD+3] == AR.PolyFunVar ) {
4745 t[ARGHEAD+5] = 1;
4746 t[ARGHEAD+6] = 1;
4747 t[ARGHEAD+7] = 3;
4748 exp1 = -t[ARGHEAD+4];
4749 }
4750 else goto Illegal;
4751 }
4752 else if ( *t == ARGHEAD+8 && t[ARGHEAD] == 8 && t[ARGHEAD+1] == SYMBOL
4753 && t[ARGHEAD+3] == AR.PolyFunVar ) {
4754 t[ARGHEAD+5] = 1;
4755 t[ARGHEAD+6] = 1;
4756 t[ARGHEAD+7] = 3;
4757 exp1 = t[ARGHEAD+4];
4758 t += *t;
4759 if ( *t != -SNUMBER ) goto Illegal;
4760 t[1] = 1;
4761 }
4762 else goto Illegal;
4763
4764 t = t2+FUNHEAD;
4765 if ( *t == -SYMBOL ) {
4766 if ( t[1] != AR.PolyFunVar ) goto Illegal;
4767 exp2 = 1;
4768 if ( t[2] != -SNUMBER ) goto Illegal;
4769 t[3] = 1;
4770 }
4771 else if ( *t == -SNUMBER ) {
4772 t[1] = 1;
4773 t += 2;
4774 if ( *t == -SYMBOL ) {
4775 if ( t[1] != AR.PolyFunVar ) goto Illegal;
4776 exp2 = -1;
4777 }
4778 else if ( *t == -SNUMBER ) {
4779 t[1] = 1;
4780 exp2 = 0;
4781 }
4782 else if ( *t == ARGHEAD+8 && t[ARGHEAD] == 8 && t[ARGHEAD+1] == SYMBOL
4783 && t[ARGHEAD+3] == AR.PolyFunVar ) {
4784 t[ARGHEAD+5] = 1;
4785 t[ARGHEAD+6] = 1;
4786 t[ARGHEAD+7] = 3;
4787 exp2 = -t[ARGHEAD+4];
4788 }
4789 else goto Illegal;
4790 }
4791 else if ( *t == ARGHEAD+8 && t[ARGHEAD] == 8 && t[ARGHEAD+1] == SYMBOL
4792 && t[ARGHEAD+3] == AR.PolyFunVar ) {
4793 t[ARGHEAD+5] = 1;
4794 t[ARGHEAD+6] = 1;
4795 t[ARGHEAD+7] = 3;
4796 exp2 = t[ARGHEAD+4];
4797 t += *t;
4798 if ( *t != -SNUMBER ) goto Illegal;
4799 t[1] = 1;
4800 }
4801 else goto Illegal;
4802
4803 if ( exp1 <= exp2 ) { i = t1[1]; r = t1; }
4804 else { i = t2[1]; r = t2; }
4805 t = oldworkpointer;
4806 NCOPY(t,r,i)
4807
4808 return(oldworkpointer);
4809Illegal:
4810 MesPrint("Illegal occurrence of PolyRatFun with divergent option");
4811 Terminate(-1);
4812 return(0);
4813}
4814
4815/*
4816 #] PolyRatFunSpecial :
4817 #[ SimpleSplitMerge :
4818
4819 Sorts an array of WORDs. No adding of equal objects.
4820*/
4821
4822void SimpleSplitMergeRec(WORD *array,WORD num,WORD *auxarray)
4823{
4824 WORD n1,n2,i,j,k,*t1,*t2;
4825 if ( num < 2 ) return;
4826 if ( num == 2 ) {
4827 if ( array[0] > array[1] ) {
4828 EXCH(array[0],array[1])
4829 }
4830 return;
4831 }
4832 n1 = num/2;
4833 n2 = num - n1;
4834 SimpleSplitMergeRec(array,n1,auxarray);
4835 SimpleSplitMergeRec(array+n1,n2,auxarray);
4836 if ( array[n1-1] <= array[n1] ) return;
4837
4838 t1 = array; t2 = auxarray; i = n1; NCOPY(t2,t1,i);
4839 i = 0; j = n1; k = 0;
4840 while ( i < n1 && j < num ) {
4841 if ( auxarray[i] <= array[j] ) { array[k++] = auxarray[i++]; }
4842 else { array[k++] = array[j++]; }
4843 }
4844 while ( i < n1 ) array[k++] = auxarray[i++];
4845/*
4846 Remember: remnants of j are still in place!
4847*/
4848}
4849
4850void SimpleSplitMerge(WORD *array,WORD num)
4851{
4852 WORD *auxarray = Malloc1(sizeof(WORD)*num/2,"SimpleSplitMerge");
4853 SimpleSplitMergeRec(array,num,auxarray);
4854 M_free(auxarray,"SimpleSplitMerge");
4855}
4856
4857/*
4858 #] SimpleSplitMerge :
4859 #[ BinarySearch :
4860
4861 Searches in the sorted array with length num for the object x.
4862 If x is in the list, it returns the number of the array element
4863 that matched. If it is not in the list, it returns -1.
4864 If there are identical objects in the list, which one will
4865 match is quasi random.
4866*/
4867
4868WORD BinarySearch(WORD *array,WORD num,WORD x)
4869{
4870 WORD i, bot, top, med;
4871 if ( num < 8 ) {
4872 for ( i = 0; i < num; i++ ) if ( array[i] == x ) return(i);
4873 return(-1);
4874 }
4875 if ( array[0] > x || array[num-1] < x ) return(-1);
4876 bot = 0; top = num-1; med = (top+bot)/2;
4877 do {
4878 if ( array[med] == x ) return(med);
4879 if ( array[med] < x ) { bot = med+1; }
4880 else { top = med-1; }
4881 med = (top+bot)/2;
4882 } while ( med >= bot && med <= top );
4883 return(-1);
4884}
4885
4886/*
4887 #] BinarySearch :
4888 #] SortUtilities :
4889*/
poly_ratfun_add
WORD * poly_ratfun_add(PHEAD WORD *, WORD *)
Definition polywrap.cc:633
CompCoef
WORD CompCoef(WORD *, WORD *)
Definition reken.c:3048
TimeWallClock
LONG TimeWallClock(WORD)
Definition tools.c:3415
NormalModulus
int NormalModulus(UWORD *, WORD *)
Definition reken.c:1404
TimeCPU
LONG TimeCPU(WORD)
Definition tools.c:3489
PF_ISendSbuf
int PF_ISendSbuf(int to, int tag)
Definition mpi.c:266
PF_EndSort
int PF_EndSort(void)
Definition parallel.c:874
FlushOut
int FlushOut(POSITION *position, FILEHANDLE *fi, int compr)
Definition sort.c:1565
PutIn
LONG PutIn(FILEHANDLE *file, POSITION *position, WORD *buffer, WORD **take, int npat)
Definition sort.c:1057
SplitMerge
LONG SplitMerge(PHEAD WORD **Pointer, LONG number)
Definition sort.c:3107
Compare1
WORD Compare1(PHEAD WORD *term1, WORD *term2, WORD level)
Definition sort.c:2375
EndSort
LONG EndSort(PHEAD WORD *buffer, int par)
Definition sort.c:486
GarbHand
void GarbHand(void)
Definition sort.c:3387
CompareHSymbols
WORD CompareHSymbols(PHEAD WORD *term1, WORD *term2, WORD par)
Definition sort.c:2888
LowerSortLevel
void LowerSortLevel(void)
Definition sort.c:4703
ComPress
LONG ComPress(WORD **ss, LONG *n)
Definition sort.c:2941
AddCoef
int AddCoef(PHEAD WORD **ps1, WORD **ps2)
Definition sort.c:1779
PutOut
WORD PutOut(PHEAD WORD *term, POSITION *position, FILEHANDLE *fi, WORD ncomp)
Definition sort.c:1203
StoreTerm
int StoreTerm(PHEAD WORD *term)
Definition sort.c:4285
NewSort
int NewSort(PHEAD0)
Definition sort.c:395
SortWild
int SortWild(WORD *w, WORD nw)
Definition sort.c:4510
WriteStats
void WriteStats(POSITION *plspace, WORD par, WORD checkLogType)
Definition sort.c:136
CompareSymbols
WORD CompareSymbols(PHEAD WORD *term1, WORD *term2, WORD par)
Definition sort.c:2838
AddArgs
void AddArgs(PHEAD WORD *s1, WORD *s2, WORD *m)
Definition sort.c:2082
CleanUpSort
void CleanUpSort(int num)
Definition sort.c:4603
StageSort
void StageSort(FILEHANDLE *fout)
Definition sort.c:4411
MergePatches
int MergePatches(WORD par)
Definition sort.c:3502
AddPoly
int AddPoly(PHEAD WORD **ps1, WORD **ps2)
Definition sort.c:1909
Sflush
int Sflush(FILEHANDLE *fi)
Definition sort.c:1117
BrAcKeTiNfO::indexbuffer
BRACKETINDEX * indexbuffer
Definition structs.h:323
FiLe::handle
int handle
Definition structs.h:709
PF_BUFFER
Definition parallel.h:159
Generated by doxygen 1.9.8