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