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