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