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