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