source: git/kernel/kutil.cc @ 521349

spielwiese
Last change on this file since 521349 was 521349, checked in by Oliver Wienand <wienand@…>, 15 years ago
pNorm nicht für Ringe git-svn-id: file:///usr/local/Singular/svn/trunk@10840 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 172.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.97 2008-07-07 13:18:56 wienand Exp $ */
5/*
6* ABSTRACT: kernel: utils for kStd
7*/
8
9#ifndef KUTIL_CC
10#define KUTIL_CC
11
12// #define PDEBUG 2
13// #define PDIV_DEBUG
14#include <stdlib.h>
15#include <string.h>
16#include "mod2.h"
17#include <mylimits.h>
18#include "structs.h"
19#include "gring.h"
20#include "sca.h"
21#ifdef KDEBUG
22#undef KDEBUG
23#define KDEBUG 2
24#endif
25
26#ifdef HAVE_RING2TOM
27#include "ideals.h"
28#endif
29
30// define if enterL, enterT should use memmove instead of doing it manually
31// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
32#ifndef SunOS_4
33#define ENTER_USE_MEMMOVE
34#endif
35
36// define, if the my_memmove inlines should be used instead of
37// system memmove -- it does not seem to pay off, though
38// #define ENTER_USE_MYMEMMOVE
39
40#include "kutil.h"
41#include "febase.h"
42#include "omalloc.h"
43#include "numbers.h"
44#include "polys.h"
45#include "ring.h"
46#include "ideals.h"
47#include "timer.h"
48//#include "cntrlc.h"
49#include "stairc.h"
50#include "kstd1.h"
51#include "pShallowCopyDelete.h"
52
53/* shiftgb stuff */
54#include "shiftgb.h"
55#include "prCopy.h"
56
57#ifdef KDEBUG
58#undef KDEBUG
59#define KDEBUG 2
60#endif
61
62
63#ifdef ENTER_USE_MYMEMMOVE
64inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
65{
66  register unsigned long* _dl = (unsigned long*) d;
67  register unsigned long* _sl = (unsigned long*) s;
68  register long _i = l - 1;
69
70  do
71  {
72    _dl[_i] = _sl[_i];
73    _i--;
74  }
75  while (_i >= 0);
76}
77
78inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
79{
80  register long _ll = l;
81  register unsigned long* _dl = (unsigned long*) d;
82  register unsigned long* _sl = (unsigned long*) s;
83  register long _i = 0;
84
85  do
86  {
87    _dl[_i] = _sl[_i];
88    _i++;
89  }
90  while (_i < _ll);
91}
92
93inline void _my_memmove(void* d, void* s, long l)
94{
95  unsigned long _d = (unsigned long) d;
96  unsigned long _s = (unsigned long) s;
97  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
98
99  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
100  else _my_memmove_d_lt_s(_d, _s, _l);
101}
102
103#undef memmove
104#define memmove(d,s,l) _my_memmove(d, s, l)
105#endif
106
107static poly redMora (poly h,int maxIndex,kStrategy strat);
108static poly redBba (poly h,int maxIndex,kStrategy strat);
109
110#ifdef HAVE_RINGS
111#define pDivComp_EQUAL 2
112#define pDivComp_LESS 1
113#define pDivComp_GREATER -1
114#define pDivComp_INCOMP 0
115/* Checks the relation of LM(p) and LM(q)
116     LM(p) = LM(q) => return pDivComp_EQUAL
117     LM(p) | LM(q) => return pDivComp_LESS
118     LM(q) | LM(p) => return pDivComp_GREATER
119     else return pDivComp_INCOMP */
120static inline int pDivCompRing(poly p, poly q)
121{
122  if (pGetComp(p) == pGetComp(q))
123  {
124    BOOLEAN a=FALSE, b=FALSE;
125    int i;
126    unsigned long la, lb;
127    unsigned long divmask = currRing->divmask;
128    for (i=0; i<currRing->VarL_Size; i++)
129    {
130      la = p->exp[currRing->VarL_Offset[i]];
131      lb = q->exp[currRing->VarL_Offset[i]];
132      if (la != lb)
133      {
134        if (la < lb)
135        {
136          if (b) return pDivComp_INCOMP;
137          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
138            return pDivComp_INCOMP;
139          a = TRUE;
140        }
141        else
142        {
143          if (a) return pDivComp_INCOMP;
144          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
145            return pDivComp_INCOMP;
146          b = TRUE;
147        }
148      }
149    }
150    if (a) return pDivComp_LESS;
151    if (b) return pDivComp_GREATER;
152    if (!a & !b) return pDivComp_EQUAL;
153  }
154  return 0;
155}
156#endif
157
158static inline int pDivComp(poly p, poly q)
159{
160  if (pGetComp(p) == pGetComp(q))
161  {
162    BOOLEAN a=FALSE, b=FALSE;
163    int i;
164    unsigned long la, lb;
165    unsigned long divmask = currRing->divmask;
166    for (i=0; i<currRing->VarL_Size; i++)
167    {
168      la = p->exp[currRing->VarL_Offset[i]];
169      lb = q->exp[currRing->VarL_Offset[i]];
170      if (la != lb)
171      {
172        if (la < lb)
173        {
174          if (b) return 0;
175          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
176            return 0;
177          a = TRUE;
178        }
179        else
180        {
181          if (a) return 0;
182          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
183            return 0;
184          b = TRUE;
185        }
186      }
187    }
188    if (a) return 1;
189    if (b) return -1;
190  }
191  return 0;
192}
193
194
195BITSET  test=(BITSET)0;
196int     HCord;
197int     Kstd1_deg;
198int     mu=32000;
199
200/*2
201*deletes higher monomial of p, re-compute ecart and length
202*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
203*/
204void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
205{
206  if (strat->kHEdgeFound)
207  {
208    kTest_L(L);
209    poly p1;
210    poly p = L->GetLmTailRing();
211    int l = 1;
212    kBucket_pt bucket = NULL;
213    if (L->bucket != NULL)
214    {
215      kBucketClear(L->bucket, &pNext(p), &L->pLength);
216      L->pLength++;
217      bucket = L->bucket;
218      L->bucket = NULL;
219      L->last = NULL;
220    }
221
222    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
223    {
224      L->Delete();
225      L->Clear();
226      L->ecart = -1;
227      if (bucket != NULL) kBucketDestroy(&bucket);
228      return;
229    }
230    p1 = p;
231    while (pNext(p1)!=NULL)
232    {
233      if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
234      {
235        L->last = p1;
236        p_Delete(&pNext(p1), L->tailRing);
237        if (p1 == p)
238        {
239          if (L->t_p != NULL)
240          {
241            assume(L->p != NULL && p == L->t_p);
242            pNext(L->p) = NULL;
243          }
244          L->max  = NULL;
245        }
246        else if (fromNext)
247          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
248        //if (L->pLength != 0)
249        L->pLength = l;
250        // Hmmm when called from updateT, then only
251        // reset ecart when cut
252        if (fromNext)
253          L->ecart = L->pLDeg() - L->GetpFDeg();
254        break;
255      }
256      l++;
257      pIter(p1);
258    }
259    if (! fromNext)
260    {
261      L->SetpFDeg();
262      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
263    }
264    if (bucket != NULL)
265    {
266      if (L->pLength > 1)
267      {
268        kBucketInit(bucket, pNext(p), L->pLength - 1);
269        pNext(p) = NULL;
270        if (L->t_p != NULL) pNext(L->t_p) = NULL;
271        L->pLength = 0;
272        L->bucket = bucket;
273        L->last = NULL;
274      }
275      else
276        kBucketDestroy(&bucket);
277    }
278    kTest_L(L);
279  }
280}
281
282void deleteHC(poly* p, int* e, int* l,kStrategy strat)
283{
284  LObject L(*p, currRing, strat->tailRing);
285
286  deleteHC(&L, strat);
287  *p = L.p;
288  *e = L.ecart;
289  *l = L.length;
290  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
291}
292
293/*2
294*tests if p.p=monomial*unit and cancels the unit
295*/
296void cancelunit (LObject* L,BOOLEAN inNF)
297{
298  int  i;
299  poly h;
300
301  if(currRing->OrdSgn != -1) return;
302  if(TEST_OPT_CANCELUNIT) return;
303
304  ring r = L->tailRing;
305  poly p = L->GetLmTailRing();
306
307  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
308
309  if (L->ecart != 0)
310  {
311//    for(i=r->N;i>0;i--)
312//    {
313//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
314//    }
315    h = pNext(p);
316    loop
317    {
318      if (h==NULL)
319      {
320        p_Delete(&pNext(p), r);
321        if (!inNF)
322        {
323          number eins=nInit(1);
324          if (L->p != NULL)  pSetCoeff(L->p,eins);
325          else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
326          if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
327        }
328        L->ecart = 0;
329        L->length = 1;
330        //if (L->pLength > 0)
331        L->pLength = 1;
332        if (L->last != NULL) L->last = p;
333
334        if (L->t_p != NULL && pNext(L->t_p) != NULL)
335          pNext(L->t_p) = NULL;
336        if (L->p != NULL && pNext(L->p) != NULL)
337          pNext(L->p) = NULL;
338        return;
339      }
340      i = 0;
341      loop
342      {
343        i++;
344        if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
345        if (i == r->N) break; // does divide, try next monom
346      }
347      pIter(h);
348    }
349  }
350}
351
352/*2
353*pp is the new element in s
354*returns TRUE (in strat->kHEdgeFound) if
355*-HEcke is allowed
356*-we are in the last componente of the vector
357*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
358*returns FALSE for pLexOrderings,
359*assumes in module case an ordering of type c* !!
360* HEckeTest is only called with strat->kHEdgeFound==FALSE !
361*/
362void HEckeTest (poly pp,kStrategy strat)
363{
364  int   j,k,p;
365
366  strat->kHEdgeFound=FALSE;
367  if (pLexOrder || currRing->MixedOrder)
368  {
369    return;
370  }
371  if (strat->ak > 1)           /*we are in the module case*/
372  {
373    return; // until ....
374    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
375    //  return FALSE;
376    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
377    //  return FALSE;
378  }
379  k = 0;
380  p=pIsPurePower(pp);
381  if (p!=0) strat->NotUsedAxis[p] = FALSE;
382  /*- the leading term of pp is a power of the p-th variable -*/
383  for (j=pVariables;j>0; j--)
384  {
385    if (strat->NotUsedAxis[j])
386    {
387      return;
388    }
389  }
390  strat->kHEdgeFound=TRUE;
391}
392
393/*2
394*utilities for TSet, LSet
395*/
396inline static intset initec (const int maxnr)
397{
398  return (intset)omAlloc(maxnr*sizeof(int));
399}
400
401inline static unsigned long* initsevS (const int maxnr)
402{
403  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
404}
405inline static int* initS_2_R (const int maxnr)
406{
407  return (int*)omAlloc0(maxnr*sizeof(int));
408}
409
410static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
411                             int &length, const int incr)
412{
413  assume(T!=NULL);
414  assume(sevT!=NULL);
415  assume(R!=NULL);
416  assume((length+incr) > 0);
417
418  int i;
419  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
420                           (length+incr)*sizeof(TObject));
421
422  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
423                           (length+incr)*sizeof(long*));
424
425  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
426                                (length+incr)*sizeof(TObject*));
427  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
428  length += incr;
429}
430
431void cleanT (kStrategy strat)
432{
433  int i,j;
434  poly  p;
435  assume(currRing == strat->tailRing || strat->tailRing != NULL);
436
437  pShallowCopyDeleteProc p_shallow_copy_delete =
438    (strat->tailRing != currRing ?
439     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
440     NULL);
441
442  for (j=0; j<=strat->tl; j++)
443  {
444    p = strat->T[j].p;
445    strat->T[j].p=NULL;
446    if (strat->T[j].max != NULL)
447      p_LmFree(strat->T[j].max, strat->tailRing);
448    i = -1;
449    loop
450    {
451      i++;
452      if (i>strat->sl)
453      {
454        if (strat->T[j].t_p != NULL)
455        {
456          p_Delete(&(strat->T[j].t_p), strat->tailRing);
457          p_LmFree(p, currRing);
458        }
459        else
460          pDelete(&p);
461        break;
462      }
463      if (p == strat->S[i])
464      {
465        if (strat->T[j].t_p != NULL)
466        {
467          assume(p_shallow_copy_delete != NULL);
468          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
469                                           currRing->PolyBin);
470          p_LmFree(strat->T[j].t_p, strat->tailRing);
471        }
472        break;
473      }
474    }
475  }
476  strat->tl=-1;
477}
478
479//LSet initL ()
480//{
481//  int i;
482//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
483//  return l;
484//}
485
486static inline void enlargeL (LSet* L,int* length,const int incr)
487{
488  assume((*L)!=NULL);
489  assume((length+incr)>0);
490
491  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
492                                   ((*length)+incr)*sizeof(LObject));
493  (*length) += incr;
494}
495
496void initPairtest(kStrategy strat)
497{
498  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
499}
500
501/*2
502*test whether (p1,p2) or (p2,p1) is in L up position length
503*it returns TRUE if yes and the position k
504*/
505BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
506{
507  LObject *p=&(strat->L[length]);
508
509  *k = length;
510  loop
511  {
512    if ((*k) < 0) return FALSE;
513    if (((p1 == (*p).p1) && (p2 == (*p).p2))
514    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
515      return TRUE;
516    (*k)--;
517    p--;
518  }
519}
520
521/*2
522*in B all pairs have the same element p on the right
523*it tests whether (q,p) is in B and returns TRUE if yes
524*and the position k
525*/
526BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
527{
528  LObject *p=&(strat->B[strat->Bl]);
529
530  *k = strat->Bl;
531  loop
532  {
533    if ((*k) < 0) return FALSE;
534    if (q == (*p).p1)
535      return TRUE;
536    (*k)--;
537    p--;
538  }
539}
540
541int kFindInT(poly p, TSet T, int tlength)
542{
543  int i;
544
545  for (i=0; i<=tlength; i++)
546  {
547    if (T[i].p == p) return i;
548  }
549  return -1;
550}
551
552int kFindInT(poly p, kStrategy strat)
553{
554  int i;
555  do
556  {
557    i = kFindInT(p, strat->T, strat->tl);
558    if (i >= 0) return i;
559    strat = strat->next;
560  }
561  while (strat != NULL);
562  return -1;
563}
564
565#ifdef KDEBUG
566
567void sTObject::wrp()
568{
569  if (t_p != NULL) p_wrp(t_p, tailRing);
570  else if (p != NULL) p_wrp(p, currRing, tailRing);
571  else ::wrp(NULL);
572}
573
574#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
575
576// check that Lm's of a poly from T are "equal"
577static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
578{
579  int i;
580  for (i=1; i<=tailRing->N; i++)
581  {
582    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
583      return "Lm[i] different";
584  }
585  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
586    return "Lm[0] different";
587  if (pNext(p) != pNext(t_p))
588    return "Lm.next different";
589  if (pGetCoeff(p) != pGetCoeff(t_p))
590    return "Lm.coeff different";
591  return NULL;
592}
593
594static BOOLEAN sloppy_max = FALSE;
595BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
596{
597  ring tailRing = T->tailRing;
598  if (strat_tailRing == NULL) strat_tailRing = tailRing;
599  r_assume(strat_tailRing == tailRing);
600
601  poly p = T->p;
602  ring r = currRing;
603
604  if (T->p == NULL && T->t_p == NULL && i >= 0)
605    return dReportError("%c[%d].poly is NULL", TN, i);
606
607  if (T->tailRing != currRing)
608  {
609    if (T->t_p == NULL && i > 0)
610      return dReportError("%c[%d].t_p is NULL", TN, i);
611    pFalseReturn(p_Test(T->t_p, T->tailRing));
612    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
613    if (T->p != NULL && T->t_p != NULL)
614    {
615      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
616      if (msg != NULL)
617        return dReportError("%c[%d] %s", TN, i, msg);
618      r = T->tailRing;
619      p = T->t_p;
620    }
621    if (T->p == NULL)
622    {
623      p = T->t_p;
624      r = T->tailRing;
625    }
626    if (T->t_p != NULL && i >= 0 && TN == 'T')
627    {
628      if (pNext(T->t_p) == NULL)
629      {
630        if (T->max != NULL)
631          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
632      }
633      else
634      {
635        if (T->max == NULL)
636          return dReportError("%c[%d].max is NULL", TN, i);
637        if (pNext(T->max) != NULL)
638          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
639
640        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
641        omCheckBinAddrSize(T->max, (tailRing->PolyBin->sizeW)*SIZEOF_LONG);
642#if KDEBUG > 0
643        if (! sloppy_max)
644        {
645          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
646          p_Setm(T->max, tailRing);
647          p_Setm(test_max, tailRing);
648          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
649          if (! equal)
650            return dReportError("%c[%d].max out of sync", TN, i);
651          p_LmFree(test_max, tailRing);
652        }
653#endif
654      }
655    }
656  }
657  else
658  {
659    if (T->max != NULL)
660      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
661    if (T->t_p != NULL)
662      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
663    if (T->p == NULL && i > 0)
664      return dReportError("%c[%d].p is NULL", TN, i);
665    pFalseReturn(p_Test(T->p, currRing));
666  }
667
668  if (i >= 0 && T->pLength != 0 && T->pLength != pLength(p))
669  {
670    int l=T->pLength;
671    T->pLength=pLength(p);
672    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
673                        TN, i , pLength(p), l);
674  }
675
676  // check FDeg,  for elements in L and T
677  if (i >= 0 && (TN == 'T' || TN == 'L'))
678  {
679    // FDeg has ir element from T of L set
680    if (T->FDeg  != T->pFDeg())
681    {
682      int d=T->FDeg;
683      T->FDeg=T->pFDeg();
684      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
685                          TN, i , T->pFDeg(), d);
686    }
687  }
688
689  // check is_normalized for elements in T
690  if (i >= 0 && TN == 'T')
691  {
692    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
693      return dReportError("T[%d] is_normalized error", i);
694
695  }
696  return TRUE;
697}
698
699BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
700                BOOLEAN testp, int lpos, TSet T, int tlength)
701{
702  if (testp)
703  {
704    poly pn = NULL;
705    if (L->bucket != NULL)
706    {
707      kFalseReturn(kbTest(L->bucket));
708      r_assume(L->bucket->bucket_ring == L->tailRing);
709      if (L->p != NULL && pNext(L->p) != NULL)
710      {
711        pn = pNext(L->p);
712        pNext(L->p) = NULL;
713      }
714    }
715    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
716    if (pn != NULL)
717      pNext(L->p) = pn;
718
719    ring r;
720    poly p;
721    L->GetLm(p, r);
722    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
723    {
724      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
725                          lpos, p_GetShortExpVector(p, r), L->sev);
726    }
727    if (lpos > 0 && L->last != NULL && pLast(p) != L->last)
728    {
729      return dReportError("L[%d] last wrong: has %p specified to have %p",
730                          lpos, pLast(p), L->last);
731    }
732  }
733  if (L->p1 == NULL)
734  {
735    // L->p2 either NULL or "normal" poly
736    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
737  }
738  else if (tlength > 0 && T != NULL && (lpos >=0))
739  {
740    // now p1 and p2 must be != NULL and must be contained in T
741    int i;
742    i = kFindInT(L->p1, T, tlength);
743    if (i < 0)
744      return dReportError("L[%d].p1 not in T",lpos);
745    i = kFindInT(L->p2, T, tlength);
746    if (i < 0)
747      return dReportError("L[%d].p2 not in T",lpos);
748  }
749  return TRUE;
750}
751
752BOOLEAN kTest (kStrategy strat)
753{
754  int i;
755
756  // test P
757  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
758                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
759                       -1, strat->T, strat->tl));
760
761  // test T
762  if (strat->T != NULL)
763  {
764    for (i=0; i<=strat->tl; i++)
765    {
766      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
767      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
768        return dReportError("strat->sevT[%d] out of sync", i);
769    }
770  }
771
772  // test L
773  if (strat->L != NULL)
774  {
775    for (i=0; i<=strat->Ll; i++)
776    {
777      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
778                           strat->L[i].Next() != strat->tail, i,
779                           strat->T, strat->tl));
780      if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
781          strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
782      {
783        assume(strat->L[i].bucket != NULL);
784      }
785    }
786  }
787
788  // test S
789  if (strat->S != NULL)
790    kFalseReturn(kTest_S(strat));
791
792  return TRUE;
793}
794
795BOOLEAN kTest_S(kStrategy strat)
796{
797  int i;
798  BOOLEAN ret = TRUE;
799  for (i=0; i<=strat->sl; i++)
800  {
801    if (strat->S[i] != NULL &&
802        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
803    {
804      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
805                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
806    }
807  }
808  return ret;
809}
810
811
812
813BOOLEAN kTest_TS(kStrategy strat)
814{
815  int i, j;
816  BOOLEAN ret = TRUE;
817  kFalseReturn(kTest(strat));
818
819  // test strat->R, strat->T[i].i_r
820  for (i=0; i<=strat->tl; i++)
821  {
822    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
823      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
824                          strat->T[i].i_r);
825    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
826      return dReportError("T[%d].i_r with R out of sync", i);
827  }
828  // test containment of S inT
829  if (strat->S != NULL)
830  {
831    for (i=0; i<=strat->sl; i++)
832    {
833      j = kFindInT(strat->S[i], strat->T, strat->tl);
834      if (j < 0)
835        return dReportError("S[%d] not in T", i);
836      if (strat->S_2_R[i] != strat->T[j].i_r)
837        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
838                            i, strat->S_2_R[i], j, strat->T[j].i_r);
839    }
840  }
841  // test strat->L[i].i_r1
842  for (i=0; i<=strat->Ll; i++)
843  {
844    if (strat->L[i].p1 != NULL && strat->L[i].p2)
845    {
846      if (strat->L[i].i_r1 < 0 ||
847          strat->L[i].i_r1 > strat->tl ||
848          strat->L[i].T_1(strat)->p != strat->L[i].p1)
849        return dReportError("L[%d].i_r1 out of sync", i);
850      if (strat->L[i].i_r2 < 0 ||
851          strat->L[i].i_r2 > strat->tl ||
852          strat->L[i].T_2(strat)->p != strat->L[i].p2);
853    }
854    else
855    {
856      if (strat->L[i].i_r1 != -1)
857        return dReportError("L[%d].i_r1 out of sync", i);
858      if (strat->L[i].i_r2 != -1)
859        return dReportError("L[%d].i_r2 out of sync", i);
860    }
861    if (strat->L[i].i_r != -1)
862      return dReportError("L[%d].i_r out of sync", i);
863  }
864  return TRUE;
865}
866
867#endif // KDEBUG
868
869/*2
870*cancels the i-th polynomial in the standardbase s
871*/
872void deleteInS (int i,kStrategy strat)
873{
874#ifdef ENTER_USE_MEMMOVE
875  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
876  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
877  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(long));
878  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
879#else
880  int j;
881  for (j=i; j<strat->sl; j++)
882  {
883    strat->S[j] = strat->S[j+1];
884    strat->ecartS[j] = strat->ecartS[j+1];
885    strat->sevS[j] = strat->sevS[j+1];
886    strat->S_2_R[j] = strat->S_2_R[j+1];
887  }
888#endif
889  if (strat->lenS!=NULL)
890  {
891#ifdef ENTER_USE_MEMMOVE
892    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
893#else
894    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
895#endif
896  }
897  if (strat->lenSw!=NULL)
898  {
899#ifdef ENTER_USE_MEMMOVE
900    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
901#else
902    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
903#endif
904  }
905  if (strat->fromQ!=NULL)
906  {
907#ifdef ENTER_USE_MEMMOVE
908    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
909#else
910    for (j=i; j<strat->sl; j++)
911    {
912      strat->fromQ[j] = strat->fromQ[j+1];
913    }
914#endif
915  }
916  strat->S[strat->sl] = NULL;
917  strat->sl--;
918}
919
920/*2
921*cancels the j-th polynomial in the set
922*/
923void deleteInL (LSet set, int *length, int j,kStrategy strat)
924{
925  if (set[j].lcm!=NULL)
926  {
927#ifdef HAVE_RINGS
928    if (pGetCoeff(set[j].lcm) != NULL)
929      pLmDelete(set[j].lcm);
930    else
931#endif
932      pLmFree(set[j].lcm);
933  }
934  if (set[j].p!=NULL)
935  {
936    if (pNext(set[j].p) == strat->tail)
937    {
938#ifdef HAVE_RINGS
939      if (pGetCoeff(set[j].p) != NULL)
940        pLmDelete(set[j].p);
941      else
942#endif
943        pLmFree(set[j].p);
944      /*- tail belongs to several int spolys -*/
945    }
946    else
947    {
948      // search p in T, if it is there, do not delete it
949      if (pOrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
950      {
951        // assure that for global orderings kFindInT fails
952        assume(pOrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
953        set[j].Delete();
954      }
955    }
956  }
957  if (*length > 0 && j < *length)
958  {
959#ifdef ENTER_USE_MEMMOVE
960    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
961#else
962    int i;
963    for (i=j; i < (*length); i++)
964      set[i] = set[i+1];
965#endif
966  }
967#ifdef KDEBUG
968  memset(&(set[*length]),0,sizeof(LObject));
969#endif
970  (*length)--;
971}
972
973/*2
974*enters p at position at in L
975*/
976void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
977{
978#ifdef PDEBUG
979  /*  zaehler++; */
980#endif /*PDEBUG*/
981  int i;
982  // this should be corrected
983  assume(p.FDeg == p.pFDeg());
984
985  if ((*length)>=0)
986  {
987    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
988    if (at <= (*length))
989#ifdef ENTER_USE_MEMMOVE
990      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
991#else
992    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
993#endif
994  }
995  else at = 0;
996  (*set)[at] = p;
997  (*length)++;
998}
999
1000/*2
1001* computes the normal ecart;
1002* used in mora case and if pLexOrder & sugar in bba case
1003*/
1004void initEcartNormal (LObject* h)
1005{
1006  h->FDeg = h->pFDeg();
1007  h->ecart = h->pLDeg() - h->FDeg;
1008  // h->length is set by h->pLDeg
1009  h->length=h->pLength=pLength(h->p);
1010}
1011
1012void initEcartBBA (LObject* h)
1013{
1014  h->FDeg = h->pFDeg();
1015  (*h).ecart = 0;
1016  h->length=h->pLength=pLength(h->p);
1017}
1018
1019void initEcartPairBba (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
1020{
1021  Lp->FDeg = Lp->pFDeg();
1022  (*Lp).ecart = 0;
1023  (*Lp).length = 0;
1024}
1025
1026void initEcartPairMora (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
1027{
1028  Lp->FDeg = Lp->pFDeg();
1029  (*Lp).ecart = si_max(ecartF,ecartG);
1030  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -pFDeg((*Lp).lcm,currRing));
1031  (*Lp).length = 0;
1032}
1033
1034/*2
1035*if ecart1<=ecart2 it returns TRUE
1036*/
1037static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
1038{
1039  return (ecart1 <= ecart2);
1040}
1041
1042#ifdef HAVE_RINGS
1043/*2
1044* put the pair (s[i],p)  into the set B, ecart=ecart(p) (ring case)
1045*/
1046void enterOnePairRing (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1047{
1048  assume(i<=strat->sl);
1049  int      l,j,compare,compareCoeff;
1050  LObject  Lp;
1051
1052  if (strat->interred_flag) return;
1053#ifdef KDEBUG
1054  Lp.ecart=0; Lp.length=0;
1055#endif
1056  /*- computes the lcm(s[i],p) -*/
1057  Lp.lcm = pInit();
1058  pSetCoeff0(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing));
1059  // Lp.lcm == 0
1060  if (nIsZero(pGetCoeff(Lp.lcm)))
1061  {
1062#ifdef KDEBUG
1063      if (TEST_OPT_DEBUG)
1064      {
1065        PrintS("--- Lp.lcm == 0\n");
1066        PrintS("p:");
1067        wrp(p);
1068        Print("  strat->S[%d]:", i);
1069        wrp(strat->S[i]);
1070        PrintLn();
1071      }
1072#endif
1073      strat->cp++;
1074      pLmDelete(Lp.lcm);
1075      return;
1076  }
1077  // basic product criterion
1078  pLcm(p,strat->S[i],Lp.lcm);
1079  pSetm(Lp.lcm);
1080  assume(!strat->sugarCrit);
1081  if (pHasNotCF(p,strat->S[i]) && nIsUnit(pGetCoeff(p)) && nIsUnit(pGetCoeff(strat->S[i])))
1082  {
1083#ifdef KDEBUG
1084      if (TEST_OPT_DEBUG)
1085      {
1086        PrintS("--- product criterion func enterOnePairRing type 1\n");
1087        PrintS("p:");
1088        wrp(p);
1089        Print("  strat->S[%d]:", i);
1090        wrp(strat->S[i]);
1091        PrintLn();
1092      }
1093#endif
1094      strat->cp++;
1095      pLmDelete(Lp.lcm);
1096      return;
1097  }
1098  assume(!strat->fromT);
1099  /*
1100  *the set B collects the pairs of type (S[j],p)
1101  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
1102  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1103  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1104  */
1105  for(j = strat->Bl;j>=0;j--)
1106  {
1107    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
1108    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
1109    if (compareCoeff == 0 || compare == compareCoeff)
1110    {
1111      if (compare == 1)
1112      {
1113        strat->c3++;
1114#ifdef KDEBUG
1115        if (TEST_OPT_DEBUG)
1116        {
1117          PrintS("--- chain criterion type 1\n");
1118          PrintS("strat->B[j]:");
1119          wrp(strat->B[j].lcm);
1120          PrintS("  Lp.lcm:");
1121          wrp(Lp.lcm);
1122          PrintLn();
1123        }
1124#endif
1125        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1126        {
1127          pLmDelete(Lp.lcm);
1128          return;
1129        }
1130        break;
1131      }
1132      else
1133      if (compare == -1)
1134      {
1135#ifdef KDEBUG
1136        if (TEST_OPT_DEBUG)
1137        {
1138          PrintS("--- chain criterion type 2\n");
1139          Print("strat->B[%d].lcm:",j);
1140          wrp(strat->B[j].lcm);
1141          PrintS("  Lp.lcm:");
1142          wrp(Lp.lcm);
1143          PrintLn();
1144        }
1145#endif
1146        deleteInL(strat->B,&strat->Bl,j,strat);
1147        strat->c3++;
1148      }
1149    }
1150    if ((compare == pDivComp_EQUAL) && (compareCoeff != 2))
1151    {
1152      if (compareCoeff == pDivComp_LESS)
1153      {
1154#ifdef KDEBUG
1155        if (TEST_OPT_DEBUG)
1156        {
1157          PrintS("--- chain criterion type 3\n");
1158          Print("strat->B[%d].lcm:", j);
1159          wrp(strat->B[j].lcm);
1160          PrintS("  Lp.lcm:");
1161          wrp(Lp.lcm);
1162          PrintLn();
1163        }
1164#endif
1165        strat->c3++;
1166        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1167        {
1168          pLmDelete(Lp.lcm);
1169          return;
1170        }
1171        break;
1172      }
1173      else
1174      // Add hint for same LM and LC (later) (TODO Oliver)
1175      // if (compareCoeff == pDivComp_GREATER)
1176      {
1177#ifdef KDEBUG
1178        if (TEST_OPT_DEBUG)
1179        {
1180          PrintS("--- chain criterion type 4\n");
1181          Print("strat->B[%d].lcm:", j);
1182          wrp(strat->B[j].lcm);
1183          PrintS("  Lp.lcm:");
1184          wrp(Lp.lcm);
1185          PrintLn();
1186        }
1187#endif
1188        deleteInL(strat->B,&strat->Bl,j,strat);
1189        strat->c3++;
1190      }
1191    }
1192  }
1193  /*
1194  *the pair (S[i],p) enters B if the spoly != 0
1195  */
1196  /*-  compute the short s-polynomial -*/
1197  if ((strat->S[i]==NULL) || (p==NULL)) {
1198#ifdef KDEBUG
1199    if (TEST_OPT_DEBUG)
1200    {
1201      PrintS("--- spoly = NULL\n");
1202    }
1203#endif
1204    pLmDelete(Lp.lcm);
1205    return;
1206  }
1207  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1208  {
1209    // Is from a previous computed GB, therefore we know that spoly will
1210    // reduce to zero. Oliver.
1211    WarnS("Could we come here? 8738947389");
1212    Lp.p=NULL;
1213  }
1214  else
1215  {
1216    Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1217  }
1218  if (Lp.p == NULL)
1219  {
1220#ifdef KDEBUG
1221    if (TEST_OPT_DEBUG)
1222    {
1223      PrintS("--- spoly = NULL\n");
1224    }
1225#endif
1226    /*- the case that the s-poly is 0 -*/
1227    if (strat->pairtest==NULL) initPairtest(strat);
1228    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1229    strat->pairtest[strat->sl+1] = TRUE;
1230    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1231    /*
1232    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1233    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1234    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1235    *term of p devides the lcm(s,r)
1236    *(this canceling should be done here because
1237    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1238    *the first case is handeled in chainCrit
1239    */
1240    pLmDelete(Lp.lcm);
1241  }
1242  else
1243  {
1244    /*- the pair (S[i],p) enters B -*/
1245    Lp.p1 = strat->S[i];
1246    Lp.p2 = p;
1247
1248    pNext(Lp.p) = strat->tail;
1249
1250    if (atR >= 0)
1251    {
1252      Lp.i_r2 = atR;
1253      Lp.i_r1 = strat->S_2_R[i];
1254    }
1255    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1256    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1257    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1258  }
1259}
1260
1261
1262/*2
1263* put the  lcm(s[i],p)  into the set B
1264*/
1265
1266BOOLEAN enterOneStrongPoly (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1267{
1268  number d, s, t;
1269  assume(i<=strat->sl);
1270  LObject  Lp;
1271  poly m1, m2, erg, gcd;
1272
1273  d = nExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t);
1274
1275  if (nIsZero(s) || nIsZero(t))  // evtl. durch divBy tests ersetzen
1276  {
1277    nDelete(&d);
1278    nDelete(&s);
1279    nDelete(&t);
1280    return FALSE;
1281  }
1282
1283  k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1284
1285  pSetCoeff0(m1, s);
1286  pSetCoeff0(m2, t);
1287  pSetCoeff0(gcd, d);
1288
1289
1290#ifdef KDEBUG
1291  if (TEST_OPT_DEBUG)
1292  {
1293    Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1294    PrintS("m1 = ");
1295    p_wrp(m1, strat->tailRing);
1296    PrintS(" ; m2 = ");
1297    p_wrp(m2, strat->tailRing);
1298    PrintS(" ; gcd = ");
1299    wrp(gcd);
1300    PrintS("\n--- create strong gcd poly: ");
1301    Print("\n p: ", i);
1302    wrp(p);
1303    Print("\n strat->S[%d]: ", i);
1304    wrp(strat->S[i]);
1305    PrintS(" ---> ");
1306  }
1307#endif
1308
1309  erg = p_Add_q(pp_Mult_mm(pNext(p), m1, strat->tailRing), pp_Mult_mm(pNext(strat->S[i]), m2, strat->tailRing), strat->tailRing);
1310  pNext(gcd) = erg;
1311  pLmDelete(m1);
1312  pLmDelete(m2);
1313
1314#ifdef KDEBUG
1315    if (TEST_OPT_DEBUG)
1316    {
1317      wrp(gcd);
1318      PrintLn();
1319    }
1320#endif
1321
1322  LObject h;
1323  h.p = gcd;
1324  h.tailRing = strat->tailRing;
1325  int posx;
1326  if (h.p!=NULL)
1327  {
1328    if (TEST_OPT_INTSTRATEGY)
1329    {
1330      h.pCleardenom(); // also does a pContent
1331    }
1332    else
1333    {
1334      h.pNorm();
1335    }
1336    strat->initEcart(&h);
1337    if (strat->Ll==-1)
1338      posx =0;
1339    else
1340      posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1341    h.sev = pGetShortExpVector(h.p);
1342    h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1343    if (pNext(p) != NULL)
1344    {
1345      // What does this? (Oliver)
1346      // pShallowCopyDeleteProc p_shallow_copy_delete
1347      //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
1348      // pNext(p) = p_shallow_copy_delete(pNext(p),
1349      //              currRing, strat->tailRing, strat->tailRing->PolyBin);
1350    }
1351    enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1352  }
1353  return TRUE;
1354}
1355#endif
1356
1357/*2
1358* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1359*/
1360
1361
1362void enterOnePair (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1363{
1364  assume(i<=strat->sl);
1365  if (strat->interred_flag) return;
1366
1367  int      l,j,compare;
1368  LObject  Lp;
1369  Lp.i_r = -1;
1370
1371#ifdef KDEBUG
1372  Lp.ecart=0; Lp.length=0;
1373#endif
1374  /*- computes the lcm(s[i],p) -*/
1375  Lp.lcm = pInit();
1376
1377  pLcm(p,strat->S[i],Lp.lcm);
1378  pSetm(Lp.lcm);
1379
1380#define MYTEST 0
1381
1382#ifdef HAVE_PLURAL
1383  const BOOLEAN bIsPluralRing = rIsPluralRing(currRing);
1384  const BOOLEAN bIsSCA        = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
1385  const BOOLEAN bNCProdCrit   = ( !bIsPluralRing || bIsSCA ); // commutative or homogeneous SCA
1386
1387#else
1388  const BOOLEAN bIsPluralRing = FALSE;
1389  const BOOLEAN bIsSCA        = FALSE;
1390  const BOOLEAN bNCProdCrit   = TRUE;
1391#endif
1392
1393
1394  if (strat->sugarCrit && bNCProdCrit)
1395  {
1396    if((!((strat->ecartS[i]>0)&&(ecart>0)))
1397    && pHasNotCF(p,strat->S[i]))
1398    {
1399    /*
1400    *the product criterion has applied for (s,p),
1401    *i.e. lcm(s,p)=product of the leading terms of s and p.
1402    *Suppose (s,r) is in L and the leading term
1403    *of p divides lcm(s,r)
1404    *(==> the leading term of p divides the leading term of r)
1405    *but the leading term of s does not divide the leading term of r
1406    *(notice that tis condition is automatically satisfied if r is still
1407    *in S), then (s,r) can be cancelled.
1408    *This should be done here because the
1409    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1410    *
1411    *Moreover, skipping (s,r) holds also for the noncommutative case.
1412    */
1413      strat->cp++;
1414      pLmFree(Lp.lcm);
1415      Lp.lcm=NULL;
1416      return;
1417    }
1418    else
1419      Lp.ecart = si_max(ecart,strat->ecartS[i]);
1420    if (strat->fromT && (strat->ecartS[i]>ecart))
1421    {
1422      pLmFree(Lp.lcm);
1423      Lp.lcm=NULL;
1424      return;
1425      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1426    }
1427    /*
1428    *the set B collects the pairs of type (S[j],p)
1429    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1430    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1431    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1432    */
1433    {
1434      j = strat->Bl;
1435      loop
1436      {
1437        if (j < 0)  break;
1438        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1439        if ((compare==1)
1440        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
1441        {
1442          strat->c3++;
1443          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1444          {
1445            pLmFree(Lp.lcm);
1446            return;
1447          }
1448          break;
1449        }
1450        else
1451        if ((compare ==-1)
1452        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1453        {
1454          deleteInL(strat->B,&strat->Bl,j,strat);
1455          strat->c3++;
1456        }
1457        j--;
1458      }
1459    }
1460  }
1461  else /*sugarcrit*/
1462  {
1463    if (bNCProdCrit)
1464    {
1465      // if currRing->nc_type!=quasi (or skew)
1466      // TODO: enable productCrit for super commutative algebras...
1467      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1468      pHasNotCF(p,strat->S[i]))
1469      {
1470      /*
1471      *the product criterion has applied for (s,p),
1472      *i.e. lcm(s,p)=product of the leading terms of s and p.
1473      *Suppose (s,r) is in L and the leading term
1474      *of p devides lcm(s,r)
1475      *(==> the leading term of p devides the leading term of r)
1476      *but the leading term of s does not devide the leading term of r
1477      *(notice that tis condition is automatically satisfied if r is still
1478      *in S), then (s,r) can be canceled.
1479      *This should be done here because the
1480      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1481      */
1482          strat->cp++;
1483          pLmFree(Lp.lcm);
1484          Lp.lcm=NULL;
1485          return;
1486      }
1487      if (strat->fromT && (strat->ecartS[i]>ecart))
1488      {
1489        pLmFree(Lp.lcm);
1490        Lp.lcm=NULL;
1491        return;
1492        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1493      }
1494      /*
1495      *the set B collects the pairs of type (S[j],p)
1496      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1497      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1498      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1499      */
1500      for(j = strat->Bl;j>=0;j--)
1501      {
1502        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1503        if (compare==1)
1504        {
1505          strat->c3++;
1506          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1507          {
1508            pLmFree(Lp.lcm);
1509            return;
1510          }
1511          break;
1512        }
1513        else
1514        if (compare ==-1)
1515        {
1516          deleteInL(strat->B,&strat->Bl,j,strat);
1517          strat->c3++;
1518        }
1519      }
1520    }
1521  }
1522  /*
1523  *the pair (S[i],p) enters B if the spoly != 0
1524  */
1525  /*-  compute the short s-polynomial -*/
1526  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1527    pNorm(p);
1528
1529  if ((strat->S[i]==NULL) || (p==NULL))
1530    return;
1531
1532  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1533    Lp.p=NULL;
1534  else
1535  {
1536    #ifdef HAVE_PLURAL
1537    if ( bIsPluralRing )
1538    {
1539      if(pHasNotCF(p, strat->S[i]))
1540      {
1541//         if(ncRingType(currRing) == nc_lie)
1542//         {
1543//             // generalized prod-crit for lie-type
1544//             strat->cp++;
1545//             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]);
1546//         }
1547//         else
1548        if( bIsSCA )
1549        {
1550            // product criterion for homogeneous case in SCA
1551            strat->cp++;
1552            Lp.p = NULL;
1553        }
1554        else
1555          Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1556                 nc_CreateShortSpoly(strat->S[i], p, currRing); 
1557      }
1558      else
1559        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1560                nc_CreateShortSpoly(strat->S[i], p, currRing); 
1561
1562     
1563#if MYTEST
1564      if (TEST_OPT_DEBUG)
1565      {
1566        PrintS("strat->S[i]: "); pWrite(strat->S[i]);
1567        PrintS("p: "); pWrite(p);
1568        PrintS("SPoly: "); pWrite(Lp.p);
1569      }
1570#endif     
1571     
1572    }
1573    else
1574    #endif
1575    {
1576      assume(!rIsPluralRing(currRing));
1577      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1578#if MYTEST
1579      if (TEST_OPT_DEBUG)
1580      {
1581        PrintS("strat->S[i]: "); pWrite(strat->S[i]);
1582        PrintS("p: "); pWrite(p);
1583        PrintS("commutative SPoly: "); pWrite(Lp.p);
1584      }
1585#endif     
1586
1587      }
1588  }
1589  if (Lp.p == NULL)
1590  {
1591    /*- the case that the s-poly is 0 -*/
1592    if (strat->pairtest==NULL) initPairtest(strat);
1593    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1594    strat->pairtest[strat->sl+1] = TRUE;
1595    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1596    /*
1597    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1598    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1599    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1600    *term of p devides the lcm(s,r)
1601    *(this canceling should be done here because
1602    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1603    *the first case is handeled in chainCrit
1604    */
1605    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1606  }
1607  else
1608  {
1609    /*- the pair (S[i],p) enters B -*/
1610    Lp.p1 = strat->S[i];
1611    Lp.p2 = p;
1612
1613//    if ( !bIsPluralRing ) // !!!!
1614    assume(pNext(Lp.p)==NULL);
1615    pNext(Lp.p) = strat->tail; // !!!
1616
1617    if (atR >= 0)
1618    {
1619      Lp.i_r1 = strat->S_2_R[i];
1620      Lp.i_r2 = atR;
1621    }
1622    else
1623    {
1624      Lp.i_r1 = -1;
1625      Lp.i_r2 = -1;
1626    }
1627    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1628
1629    if (TEST_OPT_INTSTRATEGY)
1630    {
1631      if (!bIsPluralRing)
1632        nDelete(&(Lp.p->coef));
1633    }
1634
1635    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1636    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1637  }
1638}
1639
1640/*2
1641* put the pair (s[i],p) into the set L, ecart=ecart(p)
1642* in the case that s forms a SB of (s)
1643*/
1644void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
1645{
1646  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
1647  if(pHasNotCF(p,strat->S[i]))
1648  {
1649    //PrintS("prod-crit\n");
1650    #ifdef HAVE_PLURAL
1651    if((!rIsPluralRing(currRing)) || (rIsSCA(currRing) && strat->z2homog))
1652    #endif
1653    {
1654      //PrintS("prod-crit\n");
1655      strat->cp++;
1656      return;
1657    }
1658  }
1659
1660  int      l,j,compare;
1661  LObject  Lp;
1662  Lp.i_r = -1;
1663
1664  Lp.lcm = pInit();
1665  pLcm(p,strat->S[i],Lp.lcm);
1666  pSetm(Lp.lcm);
1667  for(j = strat->Ll;j>=0;j--)
1668  {
1669    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
1670    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
1671    {
1672      //PrintS("c3-crit\n");
1673      strat->c3++;
1674      pLmFree(Lp.lcm);
1675      return;
1676    }
1677    else if (compare ==-1)
1678    {
1679      //Print("c3-crit with L[%d]\n",j);
1680      deleteInL(strat->L,&strat->Ll,j,strat);
1681      strat->c3++;
1682    }
1683  }
1684  /*-  compute the short s-polynomial -*/
1685
1686  #ifdef HAVE_PLURAL
1687  if (rIsPluralRing(currRing))
1688  {
1689    Lp.p = nc_CreateShortSpoly(strat->S[i],p); // ??? strat->tailRing?
1690  }
1691  else
1692  #endif
1693    Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
1694
1695  if (Lp.p == NULL)
1696  {
1697     //PrintS("short spoly==NULL\n");
1698     pLmFree(Lp.lcm);
1699  }
1700  else
1701  {
1702    /*- the pair (S[i],p) enters L -*/
1703    Lp.p1 = strat->S[i];
1704    Lp.p2 = p;
1705    if (atR >= 0)
1706    {
1707      Lp.i_r1 = strat->S_2_R[i];
1708      Lp.i_r2 = atR;
1709    }
1710    else
1711    {
1712      Lp.i_r1 = -1;
1713      Lp.i_r2 = -1;
1714    }
1715    assume(pNext(Lp.p) == NULL);
1716    pNext(Lp.p) = strat->tail;
1717    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1718    if (TEST_OPT_INTSTRATEGY)
1719    {
1720      nDelete(&(Lp.p->coef));
1721    }
1722    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
1723    //Print("-> L[%d]\n",l);
1724    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
1725  }
1726}
1727
1728/*2
1729*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1730*using the chain-criterion in B and L and enters B to L
1731*/
1732void chainCrit (poly p,int ecart,kStrategy strat)
1733{
1734  int i,j,l;
1735
1736  /*
1737  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1738  *In this case all elements in B such
1739  *that their lcm is divisible by the leading term of S[i] can be canceled
1740  */
1741  if (strat->pairtest!=NULL)
1742  {
1743    {
1744      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1745      for (j=0; j<=strat->sl; j++)
1746      {
1747        if (strat->pairtest[j])
1748        {
1749          for (i=strat->Bl; i>=0; i--)
1750          {
1751            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1752            {
1753              deleteInL(strat->B,&strat->Bl,i,strat);
1754              strat->c3++;
1755            }
1756          }
1757        }
1758      }
1759    }
1760    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1761    strat->pairtest=NULL;
1762  }
1763  if (strat->Gebauer || strat->fromT)
1764  {
1765    if (strat->sugarCrit)
1766    {
1767    /*
1768    *suppose L[j] == (s,r) and p/lcm(s,r)
1769    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1770    *and in case the sugar is o.k. then L[j] can be canceled
1771    */
1772      for (j=strat->Ll; j>=0; j--)
1773      {
1774        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
1775        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
1776        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1777        {
1778          if (strat->L[j].p == strat->tail)
1779          {
1780              deleteInL(strat->L,&strat->Ll,j,strat);
1781              strat->c3++;
1782          }
1783        }
1784      }
1785      /*
1786      *this is GEBAUER-MOELLER:
1787      *in B all elements with the same lcm except the "best"
1788      *(i.e. the last one in B with this property) will be canceled
1789      */
1790      j = strat->Bl;
1791      loop /*cannot be changed into a for !!! */
1792      {
1793        if (j <= 0) break;
1794        i = j-1;
1795        loop
1796        {
1797          if (i <  0) break;
1798          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1799          {
1800            strat->c3++;
1801            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
1802            {
1803              deleteInL(strat->B,&strat->Bl,i,strat);
1804              j--;
1805            }
1806            else
1807            {
1808              deleteInL(strat->B,&strat->Bl,j,strat);
1809              break;
1810            }
1811          }
1812          i--;
1813        }
1814        j--;
1815      }
1816    }
1817    else /*sugarCrit*/
1818    {
1819      /*
1820      *suppose L[j] == (s,r) and p/lcm(s,r)
1821      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1822      *and in case the sugar is o.k. then L[j] can be canceled
1823      */
1824      for (j=strat->Ll; j>=0; j--)
1825      {
1826        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1827        {
1828          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1829          {
1830            deleteInL(strat->L,&strat->Ll,j,strat);
1831            strat->c3++;
1832          }
1833        }
1834      }
1835      /*
1836      *this is GEBAUER-MOELLER:
1837      *in B all elements with the same lcm except the "best"
1838      *(i.e. the last one in B with this property) will be canceled
1839      */
1840      j = strat->Bl;
1841      loop   /*cannot be changed into a for !!! */
1842      {
1843        if (j <= 0) break;
1844        for(i=j-1; i>=0; i--)
1845        {
1846          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1847          {
1848            strat->c3++;
1849            deleteInL(strat->B,&strat->Bl,i,strat);
1850            j--;
1851          }
1852        }
1853        j--;
1854      }
1855    }
1856    /*
1857    *the elements of B enter L/their order with respect to B is kept
1858    *j = posInL(L,j,B[i]) would permutate the order
1859    *if once B is ordered different from L
1860    *then one should use j = posInL(L,Ll,B[i])
1861    */
1862    j = strat->Ll+1;
1863    for (i=strat->Bl; i>=0; i--)
1864    {
1865      j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
1866      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1867    }
1868    strat->Bl = -1;
1869  }
1870  else
1871  {
1872    for (j=strat->Ll; j>=0; j--)
1873    {
1874      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1875      {
1876        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1877        {
1878          deleteInL(strat->L,&strat->Ll,j,strat);
1879          strat->c3++;
1880        }
1881      }
1882    }
1883    /*
1884    *this is our MODIFICATION of GEBAUER-MOELLER:
1885    *First the elements of B enter L,
1886    *then we fix a lcm and the "best" element in L
1887    *(i.e the last in L with this lcm and of type (s,p))
1888    *and cancel all the other elements of type (r,p) with this lcm
1889    *except the case the element (s,r) has also the same lcm
1890    *and is on the worst position with respect to (s,p) and (r,p)
1891    */
1892    /*
1893    *B enters to L/their order with respect to B is permutated for elements
1894    *B[i].p with the same leading term
1895    */
1896    j = strat->Ll;
1897    for (i=strat->Bl; i>=0; i--)
1898    {
1899      j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
1900      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1901    }
1902    strat->Bl = -1;
1903    j = strat->Ll;
1904    loop  /*cannot be changed into a for !!! */
1905    {
1906      if (j <= 0)
1907      {
1908        /*now L[0] cannot be canceled any more and the tail can be removed*/
1909        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
1910        break;
1911      }
1912      if (strat->L[j].p2 == p)
1913      {
1914        i = j-1;
1915        loop
1916        {
1917          if (i < 0)  break;
1918          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
1919          {
1920            /*L[i] could be canceled but we search for a better one to cancel*/
1921            strat->c3++;
1922            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
1923            && (pNext(strat->L[l].p) == strat->tail)
1924            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
1925            && pDivisibleBy(p,strat->L[l].lcm))
1926            {
1927              /*
1928              *"NOT equal(...)" because in case of "equal" the element L[l]
1929              *is "older" and has to be from theoretical point of view behind
1930              *L[i], but we do not want to reorder L
1931              */
1932              strat->L[i].p2 = strat->tail;
1933              /*
1934              *L[l] will be canceled, we cannot cancel L[i] later on,
1935              *so we mark it with "tail"
1936              */
1937              deleteInL(strat->L,&strat->Ll,l,strat);
1938              i--;
1939            }
1940            else
1941            {
1942              deleteInL(strat->L,&strat->Ll,i,strat);
1943            }
1944            j--;
1945          }
1946          i--;
1947        }
1948      }
1949      else if (strat->L[j].p2 == strat->tail)
1950      {
1951        /*now L[j] cannot be canceled any more and the tail can be removed*/
1952        strat->L[j].p2 = p;
1953      }
1954      j--;
1955    }
1956  }
1957}
1958
1959/*2
1960*(s[0],h),...,(s[k],h) will be put to the pairset L
1961*/
1962void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
1963{
1964
1965  if ((strat->syzComp==0)
1966  || (pGetComp(h)<=strat->syzComp))
1967  {
1968    int j;
1969    BOOLEAN new_pair=FALSE;
1970
1971    if (pGetComp(h)==0)
1972    {
1973      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
1974      if ((isFromQ)&&(strat->fromQ!=NULL))
1975      {
1976        for (j=0; j<=k; j++)
1977        {
1978          if (!strat->fromQ[j])
1979          {
1980            new_pair=TRUE;
1981            enterOnePair(j,h,ecart,isFromQ,strat, atR);
1982          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1983          }
1984        }
1985      }
1986      else
1987      {
1988        new_pair=TRUE;
1989        for (j=0; j<=k; j++)
1990        {
1991          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1992          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1993        }
1994      }
1995    }
1996    else
1997    {
1998      for (j=0; j<=k; j++)
1999      {
2000        if ((pGetComp(h)==pGetComp(strat->S[j]))
2001        || (pGetComp(strat->S[j])==0))
2002        {
2003          new_pair=TRUE;
2004          enterOnePair(j,h,ecart,isFromQ,strat, atR);
2005        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2006        }
2007      }
2008    }
2009
2010    if (new_pair) chainCrit(h,ecart,strat);
2011
2012  }
2013}
2014
2015#ifdef HAVE_RINGS
2016/*2
2017*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2018*using the chain-criterion in B and L and enters B to L
2019*/
2020void chainCritRing (poly p,int ecart,kStrategy strat)
2021{
2022  int i,j,l;
2023  /*
2024  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2025  *In this case all elements in B such
2026  *that their lcm is divisible by the leading term of S[i] can be canceled
2027  */
2028  if (strat->pairtest!=NULL)
2029  {
2030    {
2031      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2032      for (j=0; j<=strat->sl; j++)
2033      {
2034        if (strat->pairtest[j])
2035        {
2036          for (i=strat->Bl; i>=0; i--)
2037          {
2038            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2039            {
2040#ifdef KDEBUG
2041              if (TEST_OPT_DEBUG)
2042              {
2043                PrintS("--- chain criterion func chainCritRing type 1\n");
2044                PrintS("strat->S[j]:");
2045                wrp(strat->S[j]);
2046                PrintS("  strat->B[i].lcm:");
2047                wrp(strat->B[i].lcm);
2048                PrintLn();
2049              }
2050#endif
2051              deleteInL(strat->B,&strat->Bl,i,strat);
2052              strat->c3++;
2053            }
2054          }
2055        }
2056      }
2057    }
2058    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2059    strat->pairtest=NULL;
2060  }
2061  assume(!(strat->Gebauer || strat->fromT));
2062  for (j=strat->Ll; j>=0; j--)
2063  {
2064    if (strat->L[j].lcm != NULL && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p)))
2065    {
2066      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2067      {
2068        if ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2069        {
2070          deleteInL(strat->L,&strat->Ll,j,strat);
2071          strat->c3++;
2072#ifdef KDEBUG
2073              if (TEST_OPT_DEBUG)
2074              {
2075                PrintS("--- chain criterion func chainCritRing type 2\n");
2076                PrintS("strat->L[j].p:");
2077                wrp(strat->L[j].p);
2078                PrintS("  p:");
2079                wrp(p);
2080                PrintLn();
2081              }
2082#endif
2083        }
2084      }
2085    }
2086  }
2087  /*
2088  *this is our MODIFICATION of GEBAUER-MOELLER:
2089  *First the elements of B enter L,
2090  *then we fix a lcm and the "best" element in L
2091  *(i.e the last in L with this lcm and of type (s,p))
2092  *and cancel all the other elements of type (r,p) with this lcm
2093  *except the case the element (s,r) has also the same lcm
2094  *and is on the worst position with respect to (s,p) and (r,p)
2095  */
2096  /*
2097  *B enters to L/their order with respect to B is permutated for elements
2098  *B[i].p with the same leading term
2099  */
2100  j = strat->Ll;
2101  for (i=strat->Bl; i>=0; i--)
2102  {
2103    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
2104    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2105  }
2106  strat->Bl = -1;
2107  j = strat->Ll;
2108  loop  /*cannot be changed into a for !!! */
2109  {
2110    if (j <= 0)
2111    {
2112      /*now L[0] cannot be canceled any more and the tail can be removed*/
2113      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2114      break;
2115    }
2116    if (strat->L[j].p2 == p) // Was the element added from B?
2117    {
2118      i = j-1;
2119      loop
2120      {
2121        if (i < 0)  break;
2122        // Element is from B and has the same lcm as L[j]
2123        if ((strat->L[i].p2 == p) && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm))
2124             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2125        {
2126          /*L[i] could be canceled but we search for a better one to cancel*/
2127          strat->c3++;
2128#ifdef KDEBUG
2129          if (TEST_OPT_DEBUG)
2130          {
2131            PrintS("--- chain criterion func chainCritRing type 3\n");
2132            PrintS("strat->L[j].lcm:");
2133            wrp(strat->L[j].lcm);
2134            PrintS("  strat->L[i].lcm:");
2135            wrp(strat->L[i].lcm);
2136            PrintLn();
2137          }
2138#endif
2139          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2140          && (pNext(strat->L[l].p) == strat->tail)
2141          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2142          && pDivisibleBy(p,strat->L[l].lcm))
2143          {
2144            /*
2145            *"NOT equal(...)" because in case of "equal" the element L[l]
2146            *is "older" and has to be from theoretical point of view behind
2147            *L[i], but we do not want to reorder L
2148            */
2149            strat->L[i].p2 = strat->tail;
2150            /*
2151            *L[l] will be canceled, we cannot cancel L[i] later on,
2152            *so we mark it with "tail"
2153            */
2154            deleteInL(strat->L,&strat->Ll,l,strat);
2155            i--;
2156          }
2157          else
2158          {
2159            deleteInL(strat->L,&strat->Ll,i,strat);
2160          }
2161          j--;
2162        }
2163        i--;
2164      }
2165    }
2166    else if (strat->L[j].p2 == strat->tail)
2167    {
2168      /*now L[j] cannot be canceled any more and the tail can be removed*/
2169      strat->L[j].p2 = p;
2170    }
2171    j--;
2172  }
2173}
2174#endif
2175
2176#ifdef HAVE_RING2TOM
2177long ind2(long arg)
2178{
2179  long ind = 0;
2180  if (arg <= 0) return 0;
2181  while (arg%2 == 0)
2182  {
2183    arg = arg / 2;
2184    ind++;
2185  }
2186  return ind;
2187}
2188
2189long ind_fact_2(long arg)
2190{
2191  long ind = 0;
2192  if (arg <= 0) return 0;
2193  if (arg%2 == 1) { arg--; }
2194  while (arg > 0)
2195  {
2196    ind += ind2(arg);
2197    arg = arg - 2;
2198  }
2199  return ind;
2200}
2201#endif
2202
2203#ifdef HAVE_VANIDEAL
2204long twoPow(long arg)
2205{
2206  return 1L << arg;
2207}
2208
2209/*2
2210* put the pair (p, f) in B and f in T
2211*/
2212void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
2213{
2214  int      l,j,compare,compareCoeff;
2215  LObject  Lp;
2216
2217  if (strat->interred_flag) return;
2218#ifdef KDEBUG
2219  Lp.ecart=0; Lp.length=0;
2220#endif
2221  /*- computes the lcm(s[i],p) -*/
2222  Lp.lcm = pInit();
2223
2224  pLcm(p,f,Lp.lcm);
2225  pSetm(Lp.lcm);
2226  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
2227  assume(!strat->sugarCrit);
2228  assume(!strat->fromT);
2229  /*
2230  *the set B collects the pairs of type (S[j],p)
2231  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
2232  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
2233  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
2234  */
2235  for(j = strat->Bl;j>=0;j--)
2236  {
2237    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
2238    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
2239    if (compareCoeff == 0 || compare == compareCoeff)
2240    {
2241      if (compare == 1)
2242      {
2243        strat->c3++;
2244        pLmDelete(Lp.lcm);
2245        return;
2246      }
2247      else
2248      if (compare == -1)
2249      {
2250        deleteInL(strat->B,&strat->Bl,j,strat);
2251        strat->c3++;
2252      }
2253    }
2254    if (compare == pDivComp_EQUAL)
2255    {
2256      // Add hint for same LM and direction of LC (later) (TODO Oliver)
2257      if (compareCoeff == 1)
2258      {
2259        strat->c3++;
2260        pLmDelete(Lp.lcm);
2261        return;
2262      }
2263      else
2264      if (compareCoeff == -1)
2265      {
2266        deleteInL(strat->B,&strat->Bl,j,strat);
2267        strat->c3++;
2268      }
2269    }
2270  }
2271  /*
2272  *the pair (S[i],p) enters B if the spoly != 0
2273  */
2274  /*-  compute the short s-polynomial -*/
2275  if ((f==NULL) || (p==NULL)) return;
2276  pNorm(p);
2277  {
2278    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
2279  }
2280  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
2281  {
2282    /*- the case that the s-poly is 0 -*/
2283//    if (strat->pairtest==NULL) initPairtest(strat);
2284//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2285//    strat->pairtest[strat->sl+1] = TRUE;
2286    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2287    /*
2288    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2289    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2290    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2291    *term of p devides the lcm(s,r)
2292    *(this canceling should be done here because
2293    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2294    *the first case is handeled in chainCrit
2295    */
2296    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
2297  }
2298  else
2299  {
2300    /*- the pair (S[i],p) enters B -*/
2301    Lp.p1 = f;
2302    Lp.p2 = p;
2303
2304    pNext(Lp.p) = strat->tail;
2305
2306    LObject tmp_h(f, currRing, strat->tailRing);
2307    tmp_h.SetShortExpVector();
2308    strat->initEcart(&tmp_h);
2309    tmp_h.sev = pGetShortExpVector(tmp_h.p);
2310    tmp_h.t_p = t_p;
2311
2312    enterT(tmp_h, strat, strat->tl + 1);
2313
2314    if (atR >= 0)
2315    {
2316      Lp.i_r2 = atR;
2317      Lp.i_r1 = strat->tl;
2318    }
2319
2320    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
2321    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2322    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
2323  }
2324}
2325
2326/* Helper for kCreateZeroPoly
2327 * enumerating the exponents
2328ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
2329 */
2330
2331int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
2332/* gives the next exponent from the set H_1 */
2333{
2334  long add = ind2(cexp[1] + 2);
2335  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
2336  {
2337    cexp[1] += 2;
2338    cind[1] += add;
2339    *cabsind += add;
2340  }
2341  else
2342  {
2343    // cabsind >= habsind
2344    if (N == 1) return 0;
2345    int i = 1;
2346    while (exp[i] == cexp[i] && i <= N) i++;
2347    cexp[i] = exp[i];
2348    *cabsind -= cind[i];
2349    cind[i] = ind[i];
2350    step[i] = 500000;
2351    *cabsind += cind[i];
2352    // Print("in: %d\n", *cabsind);
2353    i += 1;
2354    if (i > N) return 0;
2355    do
2356    {
2357      step[1] = 500000;
2358      for (int j = i + 1; j <= N; j++)
2359      {
2360        if (step[1] > step[j]) step[1] = step[j];
2361      }
2362      add = ind2(cexp[i] + 2);
2363      if (*cabsind - step[1] + add >= bound)
2364      {
2365        cexp[i] = exp[i];
2366        *cabsind -= cind[i];
2367        cind[i] = ind[i];
2368        *cabsind += cind[i];
2369        step[i] = 500000;
2370        i += 1;
2371        if (i > N) return 0;
2372      }
2373      else step[1] = -1;
2374    } while (step[1] != -1);
2375    step[1] = 500000;
2376    cexp[i] += 2;
2377    cind[i] += add;
2378    *cabsind += add;
2379    if (add < step[i]) step[i] = add;
2380    for (i = 2; i <= N; i++)
2381    {
2382      if (step[1] > step[i]) step[1] = step[i];
2383    }
2384  }
2385  return 1;
2386}
2387
2388/*
2389 * Creates the zero Polynomial on position exp
2390 * long exp[] : exponent of leading term
2391 * cabsind    : total 2-ind of exp (if -1 will be computed)
2392 * poly* t_p  : will hold the LT in tailRing
2393 * leadRing   : ring for the LT
2394 * tailRing   : ring for the tail
2395 */
2396
2397poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
2398{
2399
2400  poly zeroPoly = NULL;
2401
2402  number tmp1;
2403  poly tmp2, tmp3;
2404
2405  if (cabsind == -1)
2406  {
2407    cabsind = 0;
2408    for (int i = 1; i <= leadRing->N; i++)
2409    {
2410      cabsind += ind_fact_2(exp[i]);
2411    }
2412//    Print("cabsind: %d\n", cabsind);
2413  }
2414  if (cabsind < leadRing->ch)
2415  {
2416    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
2417  }
2418  else
2419  {
2420    zeroPoly = p_ISet(1, tailRing);
2421  }
2422  for (int i = 1; i <= leadRing->N; i++)
2423  {
2424    for (long j = 1; j <= exp[i]; j++)
2425    {
2426      tmp1 = nInit(j);
2427      tmp2 = p_ISet(1, tailRing);
2428      p_SetExp(tmp2, i, 1, tailRing);
2429      p_Setm(tmp2, tailRing);
2430      if (nIsZero(tmp1))
2431      { // should nowbe obsolet, test ! TODO OLIVER
2432        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
2433      }
2434      else
2435      {
2436        tmp3 = p_NSet(nCopy(tmp1), tailRing);
2437        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
2438      }
2439    }
2440  }
2441  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
2442  for (int i = 1; i <= leadRing->N; i++)
2443  {
2444    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
2445  }
2446  p_Setm(tmp2, leadRing);
2447  *t_p = zeroPoly;
2448  zeroPoly = pNext(zeroPoly);
2449  pNext(*t_p) = NULL;
2450  pNext(tmp2) = zeroPoly;
2451  return tmp2;
2452}
2453
2454// #define OLI_DEBUG
2455
2456/*
2457 * Generate the s-polynomial for the virtual set of zero-polynomials
2458 */
2459
2460void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
2461{
2462  // Initialize
2463  long exp[50];            // The exponent of \hat{X} (basepoint)
2464  long cexp[50];           // The current exponent for iterating over all
2465  long ind[50];            // The power of 2 in the i-th component of exp
2466  long cind[50];           // analog for cexp
2467  long mult[50];           // How to multiply the elements of G
2468  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2469  long habsind = 0;        // The abs. index of the coefficient of h
2470  long step[50];           // The last increases
2471  for (int i = 1; i <= currRing->N; i++)
2472  {
2473    exp[i] = p_GetExp(p, i, currRing);
2474    if (exp[i] & 1 != 0)
2475    {
2476      exp[i] = exp[i] - 1;
2477      mult[i] = 1;
2478    }
2479    cexp[i] = exp[i];
2480    ind[i] = ind_fact_2(exp[i]);
2481    cabsind += ind[i];
2482    cind[i] = ind[i];
2483    step[i] = 500000;
2484  }
2485  step[1] = 500000;
2486  habsind = ind2((long) p_GetCoeff(p, currRing));
2487  long bound = currRing->ch - habsind;
2488#ifdef OLI_DEBUG
2489  PrintS("-------------\npoly  :");
2490  wrp(p);
2491  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2492  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2493  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2494  Print("bound : %d\n", bound);
2495  Print("cind  : %d\n", cabsind);
2496#endif
2497  if (cabsind == 0)
2498  {
2499    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2500    {
2501      return;
2502    }
2503  }
2504  // Now the whole simplex
2505  do
2506  {
2507    // Build s-polynomial
2508    // 2**ind-def * mult * g - exp-def * h
2509    poly t_p;
2510    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
2511#ifdef OLI_DEBUG
2512    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2513    Print("zPoly : ");
2514    wrp(zeroPoly);
2515    Print("\n");
2516#endif
2517    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
2518  }
2519  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2520}
2521
2522/*
2523 * Create the Groebner basis of the vanishing polynomials.
2524 */
2525
2526ideal createG0()
2527{
2528  // Initialize
2529  long exp[50];            // The exponent of \hat{X} (basepoint)
2530  long cexp[50];           // The current exponent for iterating over all
2531  long ind[50];            // The power of 2 in the i-th component of exp
2532  long cind[50];           // analog for cexp
2533  long mult[50];           // How to multiply the elements of G
2534  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2535  long habsind = 0;        // The abs. index of the coefficient of h
2536  long step[50];           // The last increases
2537  for (int i = 1; i <= currRing->N; i++)
2538  {
2539    exp[i] = 0;
2540    cexp[i] = exp[i];
2541    ind[i] = 0;
2542    step[i] = 500000;
2543    cind[i] = ind[i];
2544  }
2545  long bound = currRing->ch;
2546  step[1] = 500000;
2547#ifdef OLI_DEBUG
2548  PrintS("-------------\npoly  :");
2549//  wrp(p);
2550  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2551  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2552  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2553  Print("bound : %d\n", bound);
2554  Print("cind  : %d\n", cabsind);
2555#endif
2556  if (cabsind == 0)
2557  {
2558    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2559    {
2560      return idInit(1, 1);
2561    }
2562  }
2563  ideal G0 = idInit(1, 1);
2564  // Now the whole simplex
2565  do
2566  {
2567    // Build s-polynomial
2568    // 2**ind-def * mult * g - exp-def * h
2569    poly t_p;
2570    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
2571#ifdef OLI_DEBUG
2572    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2573    Print("zPoly : ");
2574    wrp(zeroPoly);
2575    Print("\n");
2576#endif
2577    // Add to ideal
2578    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
2579    IDELEMS(G0) += 1;
2580    G0->m[IDELEMS(G0) - 1] = zeroPoly;
2581  }
2582  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2583  idSkipZeroes(G0);
2584  return G0;
2585}
2586#endif
2587
2588#ifdef HAVE_RINGS
2589/*2
2590*(s[0],h),...,(s[k],h) will be put to the pairset L
2591*/
2592void initenterpairsRing (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2593{
2594
2595  if ((strat->syzComp==0) || (pGetComp(h)<=strat->syzComp))
2596  {
2597    int j;
2598    BOOLEAN new_pair=FALSE;
2599
2600    if (pGetComp(h)==0)
2601    {
2602      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2603      if ((isFromQ)&&(strat->fromQ!=NULL))
2604      {
2605        for (j=0; j<=k; j++)
2606        {
2607          if (!strat->fromQ[j])
2608          {
2609            new_pair=TRUE;
2610            Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2611            enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2612          }
2613        }
2614      }
2615      else
2616      {
2617        new_pair=TRUE;
2618        for (j=0; j<=k; j++)
2619        {
2620          // Print("j:%d, Ll:%d\n",j,strat->Ll);
2621          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2622        }
2623      }
2624    }
2625    else
2626    {
2627      for (j=0; j<=k; j++)
2628      {
2629        if ((pGetComp(h)==pGetComp(strat->S[j])) || (pGetComp(strat->S[j])==0))
2630        {
2631          new_pair=TRUE;
2632          Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2633          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2634        }
2635      }
2636    }
2637
2638#ifdef HAVE_VANGB
2639    // initenterzeropairsRing(h, ecart, strat, atR);
2640#endif
2641
2642    if (new_pair) chainCritRing(h,ecart,strat);
2643
2644  }
2645/*
2646ring r=256,(x,y,z),dp;
2647ideal I=12xz-133y, 2xy-z;
2648*/
2649
2650}
2651
2652/*2
2653*(s[0],h),...,(s[k],h) will be put to the pairset L
2654*/
2655void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2656{
2657
2658  if (!nIsOne(pGetCoeff(h)))
2659  {
2660    int j;
2661    BOOLEAN new_pair=FALSE;
2662
2663    for (j=0; j<=k; j++)
2664    {
2665      // Print("j:%d, Ll:%d\n",j,strat->Ll);
2666//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
2667//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
2668      {
2669        if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
2670          new_pair=TRUE;
2671      }
2672    }
2673  }
2674/*
2675ring r=256,(x,y,z),dp;
2676ideal I=12xz-133y, 2xy-z;
2677*/
2678
2679}
2680
2681/*2
2682* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
2683*/
2684void enterExtendedSpoly(poly h,kStrategy strat)
2685{
2686  if (nIsOne(pGetCoeff(h))) return;
2687  number gcd;
2688  bool go = false;
2689  if (nDivBy((number) 0, pGetCoeff(h)))
2690  {
2691    gcd = nIntDiv((number) 0, pGetCoeff(h));
2692    go = true;
2693  }
2694  else
2695    gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
2696  if (go || !nIsOne(gcd))
2697  {
2698    poly p = h->next;
2699    if (!go)
2700    {
2701      number tmp = gcd;
2702      gcd = nIntDiv(0, gcd);
2703      nDelete(&tmp);
2704    }
2705    p = pp_Mult_nn(p, gcd, strat->tailRing);
2706    nDelete(&gcd);
2707
2708    if (p != NULL)
2709    {
2710      if (TEST_OPT_PROT)
2711      {
2712        PrintS("Z");
2713      }
2714#ifdef KDEBUG
2715      if (TEST_OPT_DEBUG)
2716      {
2717        PrintS("--- create zero spoly: ");
2718        wrp(h);
2719        PrintS(" ---> ");
2720      }
2721#endif
2722      poly tmp = pInit();
2723      pSetCoeff0(tmp, pGetCoeff(p));
2724      for (int i = 1; i <= currRing->N; i++)
2725      {
2726        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
2727      }
2728      p_Setm(tmp, currRing);
2729      p = p_LmFreeAndNext(p, strat->tailRing);
2730      pNext(tmp) = p;
2731      LObject h;
2732      h.p = tmp;
2733      h.tailRing = strat->tailRing;
2734      int posx;
2735      if (h.p!=NULL)
2736      {
2737        if (TEST_OPT_INTSTRATEGY)
2738        {
2739          //pContent(h.p);
2740          h.pCleardenom(); // also does a pContent
2741        }
2742        else
2743        {
2744          h.pNorm();
2745        }
2746        strat->initEcart(&h);
2747        if (strat->Ll==-1)
2748          posx =0;
2749        else
2750          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
2751        h.sev = pGetShortExpVector(h.p);
2752        h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
2753        if (pNext(p) != NULL)
2754        {
2755          // What does this? (Oliver)
2756          // pShallowCopyDeleteProc p_shallow_copy_delete
2757          //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
2758          // pNext(p) = p_shallow_copy_delete(pNext(p),
2759          //              currRing, strat->tailRing, strat->tailRing->PolyBin);
2760        }
2761#ifdef KDEBUG
2762        if (TEST_OPT_DEBUG)
2763        {
2764          wrp(tmp);
2765          PrintLn();
2766        }
2767#endif
2768        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
2769      }
2770    }
2771  }
2772  nDelete(&gcd);
2773}
2774
2775void clearSbatch (poly h,int k,int pos,kStrategy strat)
2776{
2777  int j = pos;
2778  if ( (!strat->fromT)
2779  && (1//(strat->syzComp==0)
2780    //||(pGetComp(h)<=strat->syzComp)))
2781  ))
2782  {
2783    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
2784    unsigned long h_sev = pGetShortExpVector(h);
2785    loop
2786    {
2787      if (j > k) break;
2788      clearS(h,h_sev, &j,&k,strat);
2789      j++;
2790    }
2791    // Print("end clearS sl=%d\n",strat->sl);
2792  }
2793}
2794
2795/*2
2796* Generates a sufficient set of spolys (maybe just a finite generating
2797* set of the syzygys)
2798*/
2799void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
2800{
2801    assume (rField_is_Ring(currRing));
2802    // enter also zero divisor * poly, if this is non zero and of smaller degree
2803    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
2804    initenterpairsRing(h, k, ecart, 0, strat, atR);
2805    initenterstrongPairs(h, k, ecart, 0, strat, atR);
2806    clearSbatch(h, k, pos, strat);
2807}
2808#endif
2809
2810/*2
2811*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
2812*superfluous elements in S will be deleted
2813*/
2814void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
2815{
2816  int j=pos;
2817
2818#ifdef HAVE_RINGS
2819  assume (!rField_is_Ring(currRing));
2820#endif
2821
2822  initenterpairs(h,k,ecart,0,strat, atR);
2823  if ( (!strat->fromT)
2824  && ((strat->syzComp==0)
2825    ||(pGetComp(h)<=strat->syzComp)))
2826  {
2827    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
2828    unsigned long h_sev = pGetShortExpVector(h);
2829    loop
2830    {
2831      if (j > k) break;
2832      clearS(h,h_sev, &j,&k,strat);
2833      j++;
2834    }
2835    //Print("end clearS sl=%d\n",strat->sl);
2836  }
2837 // PrintS("end enterpairs\n");
2838}
2839
2840/*2
2841*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
2842*superfluous elements in S will be deleted
2843*/
2844void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
2845{
2846  int j;
2847
2848  for (j=0; j<=k; j++)
2849  {
2850    if ((pGetComp(h)==pGetComp(strat->S[j]))
2851    || (0==pGetComp(strat->S[j])))
2852    {
2853      enterOnePairSpecial(j,h,ecart,strat, atR);
2854    }
2855  }
2856//   #ifdef HAVE_PLURAL
2857  if (!rIsPluralRing(currRing))
2858//   #endif
2859  {
2860    j=pos;
2861    loop
2862    {
2863      unsigned long h_sev = pGetShortExpVector(h);
2864      if (j > k) break;
2865      clearS(h,h_sev,&j,&k,strat);
2866      j++;
2867    }
2868  }
2869}
2870
2871/*2
2872*reorders  s with respect to posInS,
2873*suc is the first changed index or zero
2874*/
2875
2876void reorderS (int* suc,kStrategy strat)
2877{
2878  int i,j,at,ecart, s2r;
2879  int fq=0;
2880  unsigned long sev;
2881  poly  p;
2882  int new_suc=strat->sl+1;
2883  i= *suc;
2884  if (i<0) i=0;
2885
2886  for (; i<=strat->sl; i++)
2887  {
2888    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
2889    if (at != i)
2890    {
2891      if (new_suc > at) new_suc = at;
2892      p = strat->S[i];
2893      ecart = strat->ecartS[i];
2894      sev = strat->sevS[i];
2895      s2r = strat->S_2_R[i];
2896      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
2897      for (j=i; j>=at+1; j--)
2898      {
2899        strat->S[j] = strat->S[j-1];
2900        strat->ecartS[j] = strat->ecartS[j-1];
2901        strat->sevS[j] = strat->sevS[j-1];
2902        strat->S_2_R[j] = strat->S_2_R[j-1];
2903      }
2904      strat->S[at] = p;
2905      strat->ecartS[at] = ecart;
2906      strat->sevS[at] = sev;
2907      strat->S_2_R[at] = s2r;
2908      if (strat->fromQ!=NULL)
2909      {
2910        for (j=i; j>=at+1; j--)
2911        {
2912          strat->fromQ[j] = strat->fromQ[j-1];
2913        }
2914        strat->fromQ[at]=fq;
2915      }
2916    }
2917  }
2918  if (new_suc <= strat->sl) *suc=new_suc;
2919  else                      *suc=-1;
2920}
2921
2922
2923/*2
2924*looks up the position of p in set
2925*set[0] is the smallest with respect to the ordering-procedure deg/pComp
2926* Assumption: posInS only depends on the leading term
2927*             otherwise, bba has to be changed
2928*/
2929int posInS (const kStrategy strat, const int length,const poly p,
2930            const int ecart_p)
2931{
2932  if(length==-1) return 0;
2933  polyset set=strat->S;
2934  int i;
2935  int an = 0;
2936  int en = length;
2937  int cmp_int = pOrdSgn;
2938  int pc=pGetComp(p);
2939  if ((currRing->MixedOrder)
2940#if 0
2941  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
2942#endif
2943  )
2944  {
2945    int o=pWTotaldegree(p);
2946    int oo=pWTotaldegree(set[length]);
2947
2948    if ((oo<o)
2949    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
2950      return length+1;
2951
2952    loop
2953    {
2954      if (an >= en-1)
2955      {
2956        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
2957        {
2958          return an;
2959        }
2960        return en;
2961      }
2962      i=(an+en) / 2;
2963      if ((pWTotaldegree(set[i])>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
2964      else                              an=i;
2965    }
2966  }
2967  else
2968  {
2969#ifdef HAVE_RINGS
2970    if (rField_is_Ring(currRing))
2971    {
2972      if (pLmCmp(set[length],p)== -cmp_int)
2973        return length+1;
2974      int cmp;
2975      loop
2976      {
2977        if (an >= en-1)
2978        {
2979          cmp = pLmCmp(set[an],p);
2980          if (cmp == cmp_int)  return an;
2981          if (cmp == -cmp_int) return en;
2982          if (nDivBy(pGetCoeff(p), pGetCoeff(set[an]))) return en;
2983          return an;
2984        }
2985        i = (an+en) / 2;
2986        cmp = pLmCmp(set[i],p);
2987        if (cmp == cmp_int)         en = i;
2988        else if (cmp == -cmp_int)   an = i;
2989        else
2990        {
2991          if (nDivBy(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
2992          else en = i;
2993        }
2994      }
2995    }
2996    else
2997#endif
2998    if (pLmCmp(set[length],p)== -cmp_int)
2999      return length+1;
3000
3001    loop
3002    {
3003      if (an >= en-1)
3004      {
3005        if (pLmCmp(set[an],p) == cmp_int) return an;
3006        if (pLmCmp(set[an],p) == -cmp_int) return en;
3007        if ((cmp_int!=1)
3008        && ((strat->ecartS[an])>ecart_p))
3009          return an;
3010        return en;
3011      }
3012      i=(an+en) / 2;
3013      if (pLmCmp(set[i],p) == cmp_int) en=i;
3014      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3015      else
3016      {
3017        if ((cmp_int!=1)
3018        &&((strat->ecartS[i])<ecart_p))
3019          en=i;
3020        else
3021          an=i;
3022      }
3023    }
3024  }
3025}
3026
3027
3028/*2
3029* looks up the position of p in set
3030* the position is the last one
3031*/
3032int posInT0 (const TSet set,const int length,LObject &p)
3033{
3034  return (length+1);
3035}
3036
3037
3038/*2
3039* looks up the position of p in T
3040* set[0] is the smallest with respect to the ordering-procedure
3041* pComp
3042*/
3043int posInT1 (const TSet set,const int length,LObject &p)
3044{
3045  if (length==-1) return 0;
3046
3047  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
3048
3049  int i;
3050  int an = 0;
3051  int en= length;
3052
3053  loop
3054  {
3055    if (an >= en-1)
3056    {
3057      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
3058      return en;
3059    }
3060    i=(an+en) / 2;
3061    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
3062    else                                 an=i;
3063  }
3064}
3065
3066/*2
3067* looks up the position of p in T
3068* set[0] is the smallest with respect to the ordering-procedure
3069* length
3070*/
3071int posInT2 (const TSet set,const int length,LObject &p)
3072{
3073  if (length==-1)
3074    return 0;
3075  if (set[length].length<p.length)
3076    return length+1;
3077
3078  int i;
3079  int an = 0;
3080  int en= length;
3081
3082  loop
3083  {
3084    if (an >= en-1)
3085    {
3086      if (set[an].length>p.length) return an;
3087      return en;
3088    }
3089    i=(an+en) / 2;
3090    if (set[i].length>p.length) en=i;
3091    else                        an=i;
3092  }
3093}
3094
3095/*2
3096* looks up the position of p in T
3097* set[0] is the smallest with respect to the ordering-procedure
3098* totaldegree,pComp
3099*/
3100int posInT11 (const TSet set,const int length,LObject &p)
3101/*{
3102 * int j=0;
3103 * int o;
3104 *
3105 * o = p.GetpFDeg();
3106 * loop
3107 * {
3108 *   if ((pFDeg(set[j].p) > o)
3109 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3110 *   {
3111 *     return j;
3112 *   }
3113 *   j++;
3114 *   if (j > length) return j;
3115 * }
3116 *}
3117 */
3118{
3119  if (length==-1) return 0;
3120
3121  int o = p.GetpFDeg();
3122  int op = set[length].GetpFDeg();
3123
3124  if ((op < o)
3125  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3126    return length+1;
3127
3128  int i;
3129  int an = 0;
3130  int en= length;
3131
3132  loop
3133  {
3134    if (an >= en-1)
3135    {
3136      op= set[an].GetpFDeg();
3137      if ((op > o)
3138      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3139        return an;
3140      return en;
3141    }
3142    i=(an+en) / 2;
3143    op = set[i].GetpFDeg();
3144    if (( op > o)
3145    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3146      en=i;
3147    else
3148      an=i;
3149  }
3150}
3151
3152/*2 Pos for rings T: Here I am
3153* looks up the position of p in T
3154* set[0] is the smallest with respect to the ordering-procedure
3155* totaldegree,pComp
3156*/
3157int posInTrg0 (const TSet set,const int length,LObject &p)
3158{
3159  if (length==-1) return 0;
3160  int o = p.GetpFDeg();
3161  int op = set[length].GetpFDeg();
3162  int i;
3163  int an = 0;
3164  int en = length;
3165  int cmp_int = pOrdSgn;
3166  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3167    return length+1;
3168  int cmp;
3169  loop
3170  {
3171    if (an >= en-1)
3172    {
3173      op = set[an].GetpFDeg();
3174      if (op > o) return an;
3175      if (op < 0) return en;
3176      cmp = pLmCmp(set[an].p,p.p);
3177      if (cmp == cmp_int)  return an;
3178      if (cmp == -cmp_int) return en;
3179      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3180      return an;
3181    }
3182    i = (an + en) / 2;
3183    op = set[i].GetpFDeg();
3184    if (op > o)       en = i;
3185    else if (op < o)  an = i;
3186    else
3187    {
3188      cmp = pLmCmp(set[i].p,p.p);
3189      if (cmp == cmp_int)                                     en = i;
3190      else if (cmp == -cmp_int)                               an = i;
3191      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
3192      else                                                    en = i;
3193    }
3194  }
3195}
3196/*
3197  int o = p.GetpFDeg();
3198  int op = set[length].GetpFDeg();
3199
3200  if ((op < o)
3201  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3202    return length+1;
3203
3204  int i;
3205  int an = 0;
3206  int en= length;
3207
3208  loop
3209  {
3210    if (an >= en-1)
3211    {
3212      op= set[an].GetpFDeg();
3213      if ((op > o)
3214      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3215        return an;
3216      return en;
3217    }
3218    i=(an+en) / 2;
3219    op = set[i].GetpFDeg();
3220    if (( op > o)
3221    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3222      en=i;
3223    else
3224      an=i;
3225  }
3226}
3227  */
3228/*2
3229* looks up the position of p in T
3230* set[0] is the smallest with respect to the ordering-procedure
3231* totaldegree,pComp
3232*/
3233int posInT110 (const TSet set,const int length,LObject &p)
3234{
3235  if (length==-1) return 0;
3236
3237  int o = p.GetpFDeg();
3238  int op = set[length].GetpFDeg();
3239
3240  if (( op < o)
3241  || (( op == o) && (set[length].length<p.length))
3242  || (( op == o) && (set[length].length == p.length)
3243     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3244    return length+1;
3245
3246  int i;
3247  int an = 0;
3248  int en= length;
3249  loop
3250  {
3251    if (an >= en-1)
3252    {
3253      op = set[an].GetpFDeg();
3254      if (( op > o)
3255      || (( op == o) && (set[an].length > p.length))
3256      || (( op == o) && (set[an].length == p.length)
3257         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3258        return an;
3259      return en;
3260    }
3261    i=(an+en) / 2;
3262    op = set[i].GetpFDeg();
3263    if (( op > o)
3264    || (( op == o) && (set[i].length > p.length))
3265    || (( op == o) && (set[i].length == p.length)
3266       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3267      en=i;
3268    else
3269      an=i;
3270  }
3271}
3272
3273/*2
3274* looks up the position of p in set
3275* set[0] is the smallest with respect to the ordering-procedure
3276* pFDeg
3277*/
3278int posInT13 (const TSet set,const int length,LObject &p)
3279{
3280  if (length==-1) return 0;
3281
3282  int o = p.GetpFDeg();
3283
3284  if (set[length].GetpFDeg() <= o)
3285    return length+1;
3286
3287  int i;
3288  int an = 0;
3289  int en= length;
3290  loop
3291  {
3292    if (an >= en-1)
3293    {
3294      if (set[an].GetpFDeg() > o)
3295        return an;
3296      return en;
3297    }
3298    i=(an+en) / 2;
3299    if (set[i].GetpFDeg() > o)
3300      en=i;
3301    else
3302      an=i;
3303  }
3304}
3305
3306// determines the position based on: 1.) Ecart 2.) pLength
3307int posInT_EcartpLength(const TSet set,const int length,LObject &p)
3308{
3309  if (length==-1) return 0;
3310
3311  int op=p.ecart;
3312  int ol = p.GetpLength();
3313
3314  int oo=set[length].ecart;
3315  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
3316    return length+1;
3317
3318  int i;
3319  int an = 0;
3320  int en= length;
3321  loop
3322    {
3323      if (an >= en-1)
3324      {
3325        int oo=set[an].ecart;
3326        if((oo > op)
3327           || ((oo==op) && (set[an].pLength > ol)))
3328          return an;
3329        return en;
3330      }
3331      i=(an+en) / 2;
3332      int oo=set[i].ecart;
3333      if ((oo > op)
3334          || ((oo == op) && (set[i].pLength > ol)))
3335        en=i;
3336      else
3337        an=i;
3338    }
3339}
3340
3341/*2
3342* looks up the position of p in set
3343* set[0] is the smallest with respect to the ordering-procedure
3344* maximaldegree, pComp
3345*/
3346int posInT15 (const TSet set,const int length,LObject &p)
3347/*{
3348 *int j=0;
3349 * int o;
3350 *
3351 * o = p.GetpFDeg()+p.ecart;
3352 * loop
3353 * {
3354 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
3355 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
3356 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3357 *   {
3358 *     return j;
3359 *   }
3360 *   j++;
3361 *   if (j > length) return j;
3362 * }
3363 *}
3364 */
3365{
3366  if (length==-1) return 0;
3367
3368  int o = p.GetpFDeg() + p.ecart;
3369  int op = set[length].GetpFDeg()+set[length].ecart;
3370
3371  if ((op < o)
3372  || ((op == o)
3373     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3374    return length+1;
3375
3376  int i;
3377  int an = 0;
3378  int en= length;
3379  loop
3380  {
3381    if (an >= en-1)
3382    {
3383      op = set[an].GetpFDeg()+set[an].ecart;
3384      if (( op > o)
3385      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3386        return an;
3387      return en;
3388    }
3389    i=(an+en) / 2;
3390    op = set[i].GetpFDeg()+set[i].ecart;
3391    if (( op > o)
3392    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3393      en=i;
3394    else
3395      an=i;
3396  }
3397}
3398
3399/*2
3400* looks up the position of p in set
3401* set[0] is the smallest with respect to the ordering-procedure
3402* pFDeg+ecart, ecart, pComp
3403*/
3404int posInT17 (const TSet set,const int length,LObject &p)
3405/*
3406*{
3407* int j=0;
3408* int  o;
3409*
3410*  o = p.GetpFDeg()+p.ecart;
3411*  loop
3412*  {
3413*    if ((pFDeg(set[j].p)+set[j].ecart > o)
3414*    || (((pFDeg(set[j].p)+set[j].ecart == o)
3415*      && (set[j].ecart < p.ecart)))
3416*    || ((pFDeg(set[j].p)+set[j].ecart == o)
3417*      && (set[j].ecart==p.ecart)
3418*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
3419*      return j;
3420*    j++;
3421*    if (j > length) return j;
3422*  }
3423* }
3424*/
3425{
3426  if (length==-1) return 0;
3427
3428  int o = p.GetpFDeg() + p.ecart;
3429  int op = set[length].GetpFDeg()+set[length].ecart;
3430
3431  if ((op < o)
3432  || (( op == o) && (set[length].ecart > p.ecart))
3433  || (( op == o) && (set[length].ecart==p.ecart)
3434     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3435    return length+1;
3436
3437  int i;
3438  int an = 0;
3439  int en= length;
3440  loop
3441  {
3442    if (an >= en-1)
3443    {
3444      op = set[an].GetpFDeg()+set[an].ecart;
3445      if (( op > o)
3446      || (( op == o) && (set[an].ecart < p.ecart))
3447      || (( op  == o) && (set[an].ecart==p.ecart)
3448         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3449        return an;
3450      return en;
3451    }
3452    i=(an+en) / 2;
3453    op = set[i].GetpFDeg()+set[i].ecart;
3454    if ((op > o)
3455    || (( op == o) && (set[i].ecart < p.ecart))
3456    || (( op == o) && (set[i].ecart == p.ecart)
3457       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3458      en=i;
3459    else
3460      an=i;
3461  }
3462}
3463/*2
3464* looks up the position of p in set
3465* set[0] is the smallest with respect to the ordering-procedure
3466* pGetComp, pFDeg+ecart, ecart, pComp
3467*/
3468int posInT17_c (const TSet set,const int length,LObject &p)
3469{
3470  if (length==-1) return 0;
3471
3472  int cc = (-1+2*currRing->order[0]==ringorder_c);
3473  /* cc==1 for (c,..), cc==-1 for (C,..) */
3474  int o = p.GetpFDeg() + p.ecart;
3475  int c = pGetComp(p.p)*cc;
3476
3477  if (pGetComp(set[length].p)*cc < c)
3478    return length+1;
3479  if (pGetComp(set[length].p)*cc == c)
3480  {
3481    int op = set[length].GetpFDeg()+set[length].ecart;
3482    if ((op < o)
3483    || ((op == o) && (set[length].ecart > p.ecart))
3484    || ((op == o) && (set[length].ecart==p.ecart)
3485       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3486      return length+1;
3487  }
3488
3489  int i;
3490  int an = 0;
3491  int en= length;
3492  loop
3493  {
3494    if (an >= en-1)
3495    {
3496      if (pGetComp(set[an].p)*cc < c)
3497        return en;
3498      if (pGetComp(set[an].p)*cc == c)
3499      {
3500        int op = set[an].GetpFDeg()+set[an].ecart;
3501        if ((op > o)
3502        || ((op == o) && (set[an].ecart < p.ecart))
3503        || ((op == o) && (set[an].ecart==p.ecart)
3504           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3505          return an;
3506      }
3507      return en;
3508    }
3509    i=(an+en) / 2;
3510    if (pGetComp(set[i].p)*cc > c)
3511      en=i;
3512    else if (pGetComp(set[i].p)*cc == c)
3513    {
3514      int op = set[i].GetpFDeg()+set[i].ecart;
3515      if ((op > o)
3516      || ((op == o) && (set[i].ecart < p.ecart))
3517      || ((op == o) && (set[i].ecart == p.ecart)
3518         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3519        en=i;
3520      else
3521        an=i;
3522    }
3523    else
3524      an=i;
3525  }
3526}
3527
3528/*2
3529* looks up the position of p in set
3530* set[0] is the smallest with respect to
3531* ecart, pFDeg, length
3532*/
3533int posInT19 (const TSet set,const int length,LObject &p)
3534{
3535  if (length==-1) return 0;
3536
3537  int o = p.ecart;
3538  int op=p.GetpFDeg();
3539
3540  if (set[length].ecart < o)
3541    return length+1;
3542  if (set[length].ecart == o)
3543  {
3544     int oo=set[length].GetpFDeg();
3545     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
3546       return length+1;
3547  }
3548
3549  int i;
3550  int an = 0;
3551  int en= length;
3552  loop
3553  {
3554    if (an >= en-1)
3555    {
3556      if (set[an].ecart > o)
3557        return an;
3558      if (set[an].ecart == o)
3559      {
3560         int oo=set[an].GetpFDeg();
3561         if((oo > op)
3562         || ((oo==op) && (set[an].length > p.length)))
3563           return an;
3564      }
3565      return en;
3566    }
3567    i=(an+en) / 2;
3568    if (set[i].ecart > o)
3569      en=i;
3570    else if (set[i].ecart == o)
3571    {
3572       int oo=set[i].GetpFDeg();
3573       if ((oo > op)
3574       || ((oo == op) && (set[i].length > p.length)))
3575         en=i;
3576       else
3577        an=i;
3578    }
3579    else
3580      an=i;
3581  }
3582}
3583
3584/*2
3585*looks up the position of polynomial p in set
3586*set[length] is the smallest element in set with respect
3587*to the ordering-procedure pComp
3588*/
3589int posInLSpecial (const LSet set, const int length,
3590                   LObject *p,const kStrategy strat)
3591{
3592  if (length<0) return 0;
3593
3594  int d=p->GetpFDeg();
3595  int op=set[length].GetpFDeg();
3596
3597  if ((op > d)
3598  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
3599  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
3600     return length+1;
3601
3602  int i;
3603  int an = 0;
3604  int en= length;
3605  loop
3606  {
3607    if (an >= en-1)
3608    {
3609      op=set[an].GetpFDeg();
3610      if ((op > d)
3611      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
3612      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
3613         return en;
3614      return an;
3615    }
3616    i=(an+en) / 2;
3617    op=set[i].GetpFDeg();
3618    if ((op>d)
3619    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
3620    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
3621      an=i;
3622    else
3623      en=i;
3624  }
3625}
3626
3627/*2
3628*looks up the position of polynomial p in set
3629*set[length] is the smallest element in set with respect
3630*to the ordering-procedure pComp
3631*/
3632int posInL0 (const LSet set, const int length,
3633             LObject* p,const kStrategy strat)
3634{
3635  if (length<0) return 0;
3636
3637  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
3638    return length+1;
3639
3640  int i;
3641  int an = 0;
3642  int en= length;
3643  loop
3644  {
3645    if (an >= en-1)
3646    {
3647      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
3648      return an;
3649    }
3650    i=(an+en) / 2;
3651    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
3652    else                                 en=i;
3653    /*aend. fuer lazy == in !=- machen */
3654  }
3655}
3656
3657/*2
3658* looks up the position of polynomial p in set
3659* e is the ecart of p
3660* set[length] is the smallest element in set with respect
3661* to the ordering-procedure totaldegree,pComp
3662*/
3663int posInL11 (const LSet set, const int length,
3664              LObject* p,const kStrategy strat)
3665/*{
3666 * int j=0;
3667 * int o;
3668 *
3669 * o = p->GetpFDeg();
3670 * loop
3671 * {
3672 *   if (j > length)            return j;
3673 *   if ((set[j].GetpFDeg() < o)) return j;
3674 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3675 *   {
3676 *     return j;
3677 *   }
3678 *   j++;
3679 * }
3680 *}
3681 */
3682{
3683  if (length<0) return 0;
3684
3685  int o = p->GetpFDeg();
3686  int op = set[length].GetpFDeg();
3687
3688  if ((op > o)
3689  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3690    return length+1;
3691  int i;
3692  int an = 0;
3693  int en= length;
3694  loop
3695  {
3696    if (an >= en-1)
3697    {
3698      op = set[an].GetpFDeg();
3699      if ((op > o)
3700      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3701        return en;
3702      return an;
3703    }
3704    i=(an+en) / 2;
3705    op = set[i].GetpFDeg();
3706    if ((op > o)
3707    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3708      an=i;
3709    else
3710      en=i;
3711  }
3712}
3713
3714/*2 Position for rings L: Here I am
3715* looks up the position of polynomial p in set
3716* e is the ecart of p
3717* set[length] is the smallest element in set with respect
3718* to the ordering-procedure totaldegree,pComp
3719*/
3720inline int getIndexRng(long coeff)
3721{
3722  if (coeff == 0) return -1;
3723  long tmp = coeff;
3724  int ind = 0;
3725  while (tmp % 2 == 0)
3726  {
3727    tmp = tmp / 2;
3728    ind++;
3729  }
3730  return ind;
3731}
3732
3733int posInLrg0 (const LSet set, const int length,
3734              LObject* p,const kStrategy strat)
3735/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
3736        if (pLmCmp(set[i],p) == cmp_int)         en = i;
3737        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
3738        else
3739        {
3740          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
3741          else en = i;
3742        }*/
3743{
3744  if (length < 0) return 0;
3745
3746  int o = p->GetpFDeg();
3747  int op = set[length].GetpFDeg();
3748
3749  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3750    return length + 1;
3751  int i;
3752  int an = 0;
3753  int en = length;
3754  loop
3755  {
3756    if (an >= en - 1)
3757    {
3758      op = set[an].GetpFDeg();
3759      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3760        return en;
3761      return an;
3762    }
3763    i = (an+en) / 2;
3764    op = set[i].GetpFDeg();
3765    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3766      an = i;
3767    else
3768      en = i;
3769  }
3770}
3771
3772/*{
3773  if (length < 0) return 0;
3774
3775  int o = p->GetpFDeg();
3776  int op = set[length].GetpFDeg();
3777
3778  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
3779  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
3780  int inda;
3781  int indi;
3782
3783  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))))
3784    return length + 1;
3785  int i;
3786  int an = 0;
3787  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
3788  int en = length;
3789  loop
3790  {
3791    if (an >= en-1)
3792    {
3793      op = set[an].GetpFDeg();
3794      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))))
3795        return en;
3796      return an;
3797    }
3798    i = (an + en) / 2;
3799    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
3800    op = set[i].GetpFDeg();
3801    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))))
3802    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3803    {
3804      an = i;
3805      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
3806    }
3807    else
3808      en = i;
3809  }
3810} */
3811
3812/*2
3813* looks up the position of polynomial p in set
3814* set[length] is the smallest element in set with respect
3815* to the ordering-procedure totaldegree,pLength0
3816*/
3817int posInL110 (const LSet set, const int length,
3818               LObject* p,const kStrategy strat)
3819{
3820  if (length<0) return 0;
3821
3822  int o = p->GetpFDeg();
3823  int op = set[length].GetpFDeg();
3824
3825  if ((op > o)
3826  || ((op == o) && (set[length].length >p->length))
3827  || ((op == o) && (set[length].length <= p->length)
3828     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3829    return length+1;
3830  int i;
3831  int an = 0;
3832  int en= length;
3833  loop
3834  {
3835    if (an >= en-1)
3836    {
3837      op = set[an].GetpFDeg();
3838      if ((op > o)
3839      || ((op == o) && (set[an].length >p->length))
3840      || ((op == o) && (set[an].length <=p->length)
3841         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3842        return en;
3843      return an;
3844    }
3845    i=(an+en) / 2;
3846    op = set[i].GetpFDeg();
3847    if ((op > o)
3848    || ((op == o) && (set[i].length > p->length))
3849    || ((op == o) && (set[i].length <= p->length)
3850       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3851      an=i;
3852    else
3853      en=i;
3854  }
3855}
3856
3857/*2
3858* looks up the position of polynomial p in set
3859* e is the ecart of p
3860* set[length] is the smallest element in set with respect
3861* to the ordering-procedure totaldegree
3862*/
3863int posInL13 (const LSet set, const int length,
3864              LObject* p,const kStrategy strat)
3865{
3866  if (length<0) return 0;
3867
3868  int o = p->GetpFDeg();
3869
3870  if (set[length].GetpFDeg() > o)
3871    return length+1;
3872
3873  int i;
3874  int an = 0;
3875  int en= length;
3876  loop
3877  {
3878    if (an >= en-1)
3879    {
3880      if (set[an].GetpFDeg() >= o)
3881        return en;
3882      return an;
3883    }
3884    i=(an+en) / 2;
3885    if (set[i].GetpFDeg() >= o)
3886      an=i;
3887    else
3888      en=i;
3889  }
3890}
3891
3892/*2
3893* looks up the position of polynomial p in set
3894* e is the ecart of p
3895* set[length] is the smallest element in set with respect
3896* to the ordering-procedure maximaldegree,pComp
3897*/
3898int posInL15 (const LSet set, const int length,
3899              LObject* p,const kStrategy strat)
3900/*{
3901 * int j=0;
3902 * int o;
3903 *
3904 * o = p->ecart+p->GetpFDeg();
3905 * loop
3906 * {
3907 *   if (j > length)                       return j;
3908 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
3909 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
3910 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3911 *   {
3912 *     return j;
3913 *   }
3914 *   j++;
3915 * }
3916 *}
3917 */
3918{
3919  if (length<0) return 0;
3920
3921  int o = p->GetpFDeg() + p->ecart;
3922  int op = set[length].GetpFDeg() + set[length].ecart;
3923
3924  if ((op > o)
3925  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3926    return length+1;
3927  int i;
3928  int an = 0;
3929  int en= length;
3930  loop
3931  {
3932    if (an >= en-1)
3933    {
3934      op = set[an].GetpFDeg() + set[an].ecart;
3935      if ((op > o)
3936      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3937        return en;
3938      return an;
3939    }
3940    i=(an+en) / 2;
3941    op = set[i].GetpFDeg() + set[i].ecart;
3942    if ((op > o)
3943    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3944      an=i;
3945    else
3946      en=i;
3947  }
3948}
3949
3950/*2
3951* looks up the position of polynomial p in set
3952* e is the ecart of p
3953* set[length] is the smallest element in set with respect
3954* to the ordering-procedure totaldegree
3955*/
3956int posInL17 (const LSet set, const int length,
3957              LObject* p,const kStrategy strat)
3958{
3959  if (length<0) return 0;
3960
3961  int o = p->GetpFDeg() + p->ecart;
3962
3963  if ((set[length].GetpFDeg() + set[length].ecart > o)
3964  || ((set[length].GetpFDeg() + set[length].ecart == o)
3965     && (set[length].ecart > p->ecart))
3966  || ((set[length].GetpFDeg() + set[length].ecart == o)
3967     && (set[length].ecart == p->ecart)
3968     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3969    return length+1;
3970  int i;
3971  int an = 0;
3972  int en= length;
3973  loop
3974  {
3975    if (an >= en-1)
3976    {
3977      if ((set[an].GetpFDeg() + set[an].ecart > o)
3978      || ((set[an].GetpFDeg() + set[an].ecart == o)
3979         && (set[an].ecart > p->ecart))
3980      || ((set[an].GetpFDeg() + set[an].ecart == o)
3981         && (set[an].ecart == p->ecart)
3982         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3983        return en;
3984      return an;
3985    }
3986    i=(an+en) / 2;
3987    if ((set[i].GetpFDeg() + set[i].ecart > o)
3988    || ((set[i].GetpFDeg() + set[i].ecart == o)
3989       && (set[i].ecart > p->ecart))
3990    || ((set[i].GetpFDeg() +set[i].ecart == o)
3991       && (set[i].ecart == p->ecart)
3992       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3993      an=i;
3994    else
3995      en=i;
3996  }
3997}
3998/*2
3999* looks up the position of polynomial p in set
4000* e is the ecart of p
4001* set[length] is the smallest element in set with respect
4002* to the ordering-procedure pComp
4003*/
4004int posInL17_c (const LSet set, const int length,
4005                LObject* p,const kStrategy strat)
4006{
4007  if (length<0) return 0;
4008
4009  int cc = (-1+2*currRing->order[0]==ringorder_c);
4010  /* cc==1 for (c,..), cc==-1 for (C,..) */
4011  int c = pGetComp(p->p)*cc;
4012  int o = p->GetpFDeg() + p->ecart;
4013
4014  if (pGetComp(set[length].p)*cc > c)
4015    return length+1;
4016  if (pGetComp(set[length].p)*cc == c)
4017  {
4018    if ((set[length].GetpFDeg() + set[length].ecart > o)
4019    || ((set[length].GetpFDeg() + set[length].ecart == o)
4020       && (set[length].ecart > p->ecart))
4021    || ((set[length].GetpFDeg() + set[length].ecart == o)
4022       && (set[length].ecart == p->ecart)
4023       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4024      return length+1;
4025  }
4026  int i;
4027  int an = 0;
4028  int en= length;
4029  loop
4030  {
4031    if (an >= en-1)
4032    {
4033      if (pGetComp(set[an].p)*cc > c)
4034        return en;
4035      if (pGetComp(set[an].p)*cc == c)
4036      {
4037        if ((set[an].GetpFDeg() + set[an].ecart > o)
4038        || ((set[an].GetpFDeg() + set[an].ecart == o)
4039           && (set[an].ecart > p->ecart))
4040        || ((set[an].GetpFDeg() + set[an].ecart == o)
4041           && (set[an].ecart == p->ecart)
4042           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4043          return en;
4044      }
4045      return an;
4046    }
4047    i=(an+en) / 2;
4048    if (pGetComp(set[i].p)*cc > c)
4049      an=i;
4050    else if (pGetComp(set[i].p)*cc == c)
4051    {
4052      if ((set[i].GetpFDeg() + set[i].ecart > o)
4053      || ((set[i].GetpFDeg() + set[i].ecart == o)
4054         && (set[i].ecart > p->ecart))
4055      || ((set[i].GetpFDeg() +set[i].ecart == o)
4056         && (set[i].ecart == p->ecart)
4057         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4058        an=i;
4059      else
4060        en=i;
4061    }
4062    else
4063      en=i;
4064  }
4065}
4066
4067/***************************************************************
4068 *
4069 * Tail reductions
4070 *
4071 ***************************************************************/
4072TObject*
4073kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
4074                    long ecart)
4075{
4076  int j = 0;
4077  const unsigned long not_sev = ~L->sev;
4078  const unsigned long* sev = strat->sevS;
4079  poly p;
4080  ring r;
4081  L->GetLm(p, r);
4082
4083  assume(~not_sev == p_GetShortExpVector(p, r));
4084
4085  if (r == currRing)
4086  {
4087    loop
4088    {
4089      if (j > pos) return NULL;
4090#if defined(PDEBUG) || defined(PDIV_DEBUG)
4091      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
4092          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4093        break;
4094#else
4095      if (!(sev[j] & not_sev) &&
4096          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
4097          p_LmDivisibleBy(strat->S[j], p, r))
4098        break;
4099
4100#endif
4101      j++;
4102    }
4103    // if called from NF, T objects do not exist:
4104    if (strat->tl < 0 || strat->S_2_R[j] == -1)
4105    {
4106      T->Set(strat->S[j], r, strat->tailRing);
4107      return T;
4108    }
4109    else
4110    {
4111/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
4112/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
4113//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
4114      return strat->S_2_T(j);
4115    }
4116  }
4117  else
4118  {
4119    TObject* t;
4120    loop
4121    {
4122      if (j > pos) return NULL;
4123      assume(strat->S_2_R[j] != -1);
4124#if defined(PDEBUG) || defined(PDIV_DEBUG)
4125      t = strat->S_2_T(j);
4126      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
4127      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
4128          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4129        return t;
4130#else
4131      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4132      {
4133        t = strat->S_2_T(j);
4134        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
4135        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
4136      }
4137#endif
4138      j++;
4139    }
4140  }
4141}
4142
4143poly redtail (LObject* L, int pos, kStrategy strat)
4144{
4145  poly h, hn;
4146  int j;
4147  unsigned long not_sev;
4148  strat->redTailChange=FALSE;
4149
4150  poly p = L->p;
4151  if (strat->noTailReduction || pNext(p) == NULL)
4152    return p;
4153
4154  LObject Ln(strat->tailRing);
4155  TObject* With;
4156  // placeholder in case strat->tl < 0
4157  TObject  With_s(strat->tailRing);
4158  h = p;
4159  hn = pNext(h);
4160  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
4161  long e;
4162  int l;
4163  BOOLEAN save_HE=strat->kHEdgeFound;
4164  strat->kHEdgeFound |=
4165    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
4166
4167  while(hn != NULL)
4168  {
4169    op = strat->tailRing->pFDeg(hn, strat->tailRing);
4170    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4171    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4172    loop
4173    {
4174      Ln.Set(hn, strat->tailRing);
4175      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
4176      if (strat->kHEdgeFound)
4177        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4178      else
4179        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
4180      if (With == NULL) break;
4181      With->length=0;
4182      With->pLength=0;
4183      strat->redTailChange=TRUE;
4184      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
4185      {
4186        // reducing the tail would violate the exp bound
4187        if (kStratChangeTailRing(strat, L))
4188        {
4189          strat->kHEdgeFound = save_HE;
4190          return redtail(L, pos, strat);
4191        }
4192        else
4193          return NULL;
4194      }
4195      hn = pNext(h);
4196      if (hn == NULL) goto all_done;
4197      op = strat->tailRing->pFDeg(hn, strat->tailRing);
4198      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4199      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4200    }
4201    h = hn;
4202    hn = pNext(h);
4203  }
4204
4205  all_done:
4206  if (strat->redTailChange)
4207  {
4208    L->last = 0;
4209    L->pLength = 0;
4210  }
4211  strat->kHEdgeFound = save_HE;
4212  return p;
4213}
4214
4215poly redtail (poly p, int pos, kStrategy strat)
4216{
4217  LObject L(p, currRing);
4218  return redtail(&L, pos, strat);
4219}
4220
4221poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
4222{
4223#define REDTAIL_CANONICALIZE 100
4224  strat->redTailChange=FALSE;
4225  if (strat->noTailReduction) return L->GetLmCurrRing();
4226  poly h, p;
4227  p = h = L->GetLmTailRing();
4228  if ((h==NULL) || (pNext(h)==NULL))
4229    return L->GetLmCurrRing();
4230
4231  TObject* With;
4232  // placeholder in case strat->tl < 0
4233  TObject  With_s(strat->tailRing);
4234
4235  LObject Ln(pNext(h), strat->tailRing);
4236  Ln.pLength = L->GetpLength() - 1;
4237
4238  pNext(h) = NULL;
4239  if (L->p != NULL) pNext(L->p) = NULL;
4240  L->pLength = 1;
4241
4242  Ln.PrepareRed(strat->use_buckets);
4243
4244  int cnt=REDTAIL_CANONICALIZE;
4245  while(!Ln.IsNull())
4246  {
4247    loop
4248    {
4249      Ln.SetShortExpVector();
4250      if (withT)
4251      {
4252        int j;
4253        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
4254        if (j < 0) break;
4255        With = &(strat->T[j]);
4256      }
4257      else
4258      {
4259        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4260        if (With == NULL) break;
4261      }
4262      cnt--;
4263      if (cnt==0)
4264      {
4265        cnt=REDTAIL_CANONICALIZE; 
4266        poly tmp=Ln.CanonicalizeP(); 
4267        if (normalize) 
4268        {
4269          Ln.Normalize();
4270          //pNormalize(tmp);
4271          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
4272        }
4273      }
4274      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
4275      {
4276        With->pNorm();
4277      }
4278      strat->redTailChange=TRUE;
4279      if (ksReducePolyTail(L, With, &Ln))
4280      {
4281        // reducing the tail would violate the exp bound
4282        //  set a flag and hope for a retry (in bba)
4283        strat->completeReduce_retry=TRUE;
4284        do
4285        {
4286          pNext(h) = Ln.LmExtractAndIter();
4287          pIter(h);
4288          L->pLength++;
4289        } while (!Ln.IsNull());
4290        goto all_done;
4291      }
4292      if (Ln.IsNull()) goto all_done;
4293      if (! withT) With_s.Init(currRing);
4294    }
4295    pNext(h) = Ln.LmExtractAndIter();
4296    pIter(h);
4297    pNormalize(h);
4298    L->pLength++;
4299  }
4300
4301  all_done:
4302  Ln.Delete();
4303  if (L->p != NULL) pNext(L->p) = pNext(p);
4304
4305  if (strat->redTailChange)
4306  {
4307    L->last = NULL;
4308    L->length = 0;
4309  }
4310
4311  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
4312  //L->Normalize(); // HANNES: should have a test
4313  kTest_L(L);
4314  return L->GetLmCurrRing();
4315}
4316
4317/*2
4318*checks the change degree and write progress report
4319*/
4320void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
4321{
4322  if (i != *olddeg)
4323  {
4324    Print("%d",i);
4325    *olddeg = i;
4326  }
4327  if (K_TEST_OPT_OLDSTD)
4328  {
4329    if (strat->Ll != *reduc)
4330    {
4331      if (strat->Ll != *reduc-1)
4332        Print("(%d)",strat->Ll+1);
4333      else
4334        PrintS("-");
4335      *reduc = strat->Ll;
4336    }
4337    else
4338      PrintS(".");
4339    mflush();
4340  }
4341  else
4342  {
4343    if (red_result == 0)
4344      PrintS("-");
4345    else if (red_result < 0)
4346      PrintS(".");
4347    if ((red_result > 0) || ((strat->Ll % 100)==99))
4348    {
4349      if (strat->Ll != *reduc && strat->Ll > 0)
4350      {
4351        Print("(%d)",strat->Ll+1);
4352        *reduc = strat->Ll;
4353      }
4354    }
4355  }
4356}
4357
4358/*2
4359*statistics
4360*/
4361void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
4362{
4363  //PrintS("\nUsage/Allocation of temporary storage:\n");
4364  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
4365  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
4366  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
4367  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
4368  /* in usual case strat->cv is 0, it gets changed only in shift routines */
4369  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
4370  /*mflush();*/
4371}
4372
4373#ifdef KDEBUG
4374/*2
4375*debugging output: all internal sets, if changed
4376*for testing purpuse only/has to be changed for later use
4377*/
4378void messageSets (kStrategy strat)
4379{
4380  int i;
4381  if (strat->news)
4382  {
4383    PrintS("set S");
4384    for (i=0; i<=strat->sl; i++)
4385    {
4386      Print("\n  %d:",i);
4387      p_wrp(strat->S[i], currRing, strat->tailRing);
4388    }
4389    strat->news = FALSE;
4390  }
4391  if (strat->newt)
4392  {
4393    PrintS("\nset T");
4394    for (i=0; i<=strat->tl; i++)
4395    {
4396      Print("\n  %d:",i);
4397      strat->T[i].wrp();
4398      Print(" o:%d e:%d l:%d",
4399        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
4400    }
4401    strat->newt = FALSE;
4402  }
4403  PrintS("\nset L");
4404  for (i=strat->Ll; i>=0; i--)
4405  {
4406    Print("\n%d:",i);
4407    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
4408    PrintS("  ");
4409    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
4410    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
4411    PrintS("\n  p : ");
4412    strat->L[i].wrp();
4413    Print("  o:%d e:%d l:%d",
4414          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
4415  }
4416  PrintLn();
4417}
4418
4419#endif
4420
4421
4422/*2
4423*construct the set s from F
4424*/
4425void initS (ideal F, ideal Q,kStrategy strat)
4426{
4427  int   i,pos;
4428
4429  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4430  else i=setmaxT;
4431  strat->ecartS=initec(i);
4432  strat->sevS=initsevS(i);
4433  strat->S_2_R=initS_2_R(i);
4434  strat->fromQ=NULL;
4435  strat->Shdl=idInit(i,F->rank);
4436  strat->S=strat->Shdl->m;
4437  /*- put polys into S -*/
4438  if (Q!=NULL)
4439  {
4440    strat->fromQ=initec(i);
4441    memset(strat->fromQ,0,i*sizeof(int));
4442    for (i=0; i<IDELEMS(Q); i++)
4443    {
4444      if (Q->m[i]!=NULL)
4445      {
4446        LObject h;
4447        h.p = pCopy(Q->m[i]);
4448        if (TEST_OPT_INTSTRATEGY)
4449        {
4450          //pContent(h.p);
4451          h.pCleardenom(); // also does a pContent
4452        }
4453        else
4454        {
4455          h.pNorm();
4456        }
4457        if (pOrdSgn==-1)
4458        {
4459          deleteHC(&h, strat);
4460        }
4461        if (h.p!=NULL)
4462        {
4463          strat->initEcart(&h);
4464          if (strat->sl==-1)
4465            pos =0;
4466          else
4467          {
4468            pos = posInS(strat,strat->sl,h.p,h.ecart);
4469          }
4470          h.sev = pGetShortExpVector(h.p);
4471          strat->enterS(h,pos,strat,-1);
4472          strat->fromQ[pos]=1;
4473        }
4474      }
4475    }
4476  }
4477  for (i=0; i<IDELEMS(F); i++)
4478  {
4479    if (F->m[i]!=NULL)
4480    {
4481      LObject h;
4482      h.p = pCopy(F->m[i]);
4483      if (pOrdSgn==-1)
4484      {
4485        cancelunit(&h);  /*- tries to cancel a unit -*/
4486        deleteHC(&h, strat);
4487      }
4488      if (TEST_OPT_INTSTRATEGY)
4489      {
4490        //pContent(h.p);
4491        h.pCleardenom(); // also does a pContent
4492      }
4493      else
4494      {
4495        h.pNorm();
4496      }
4497      if (h.p!=NULL)
4498      {
4499        strat->initEcart(&h);
4500        if (strat->sl==-1)
4501          pos =0;
4502        else
4503          pos = posInS(strat,strat->sl,h.p,h.ecart);
4504        h.sev = pGetShortExpVector(h.p);
4505        strat->enterS(h,pos,strat,-1);
4506      }
4507    }
4508  }
4509  /*- test, if a unit is in F -*/
4510  if ((strat->sl>=0)
4511#ifdef HAVE_RINGS
4512       && nIsUnit(pGetCoeff(strat->S[0]))
4513#endif
4514       && pIsConstant(strat->S[0]))
4515  {
4516    while (strat->sl>0) deleteInS(strat->sl,strat);
4517  }
4518}
4519
4520void initSL (ideal F, ideal Q,kStrategy strat)
4521{
4522  int   i,pos;
4523
4524  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4525  else i=setmaxT;
4526  strat->ecartS=initec(i);
4527  strat->sevS=initsevS(i);
4528  strat->S_2_R=initS_2_R(i);
4529  strat->fromQ=NULL;
4530  strat->Shdl=idInit(i,F->rank);
4531  strat->S=strat->Shdl->m;
4532  /*- put polys into S -*/
4533  if (Q!=NULL)
4534  {
4535    strat->fromQ=initec(i);
4536    memset(strat->fromQ,0,i*sizeof(int));
4537    for (i=0; i<IDELEMS(Q); i++)
4538    {
4539      if (Q->m[i]!=NULL)
4540      {
4541        LObject h;
4542        h.p = pCopy(Q->m[i]);
4543        if (pOrdSgn==-1)
4544        {
4545          deleteHC(&h,strat);
4546        }
4547        if (TEST_OPT_INTSTRATEGY)
4548        {
4549          //pContent(h.p);
4550          h.pCleardenom(); // also does a pContent
4551        }
4552        else
4553        {
4554          h.pNorm();
4555        }
4556        if (h.p!=NULL)
4557        {
4558          strat->initEcart(&h);
4559          if (strat->sl==-1)
4560            pos =0;
4561          else
4562          {
4563            pos = posInS(strat,strat->sl,h.p,h.ecart);
4564          }
4565          h.sev = pGetShortExpVector(h.p);
4566          strat->enterS(h,pos,strat,-1);
4567          strat->fromQ[pos]=1;
4568        }
4569      }
4570    }
4571  }
4572  for (i=0; i<IDELEMS(F); i++)
4573  {
4574    if (F->m[i]!=NULL)
4575    {
4576      LObject h;
4577      h.p = pCopy(F->m[i]);
4578      if (h.p!=NULL)
4579      {
4580        if (pOrdSgn==-1)
4581        {
4582          cancelunit(&h);  /*- tries to cancel a unit -*/
4583          deleteHC(&h, strat);
4584        }
4585        if (h.p!=NULL)
4586        {
4587          if (TEST_OPT_INTSTRATEGY)
4588          {
4589            //pContent(h.p);
4590            h.pCleardenom(); // also does a pContent
4591          }
4592          else
4593          {
4594            h.pNorm();
4595          }
4596          strat->initEcart(&h);
4597          if (strat->Ll==-1)
4598            pos =0;
4599          else
4600            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
4601          h.sev = pGetShortExpVector(h.p);
4602          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
4603        }
4604      }
4605    }
4606  }
4607  /*- test, if a unit is in F -*/
4608
4609  if ((strat->Ll>=0) 
4610#ifdef HAVE_RINGS
4611       && nIsUnit(pGetCoeff(strat->L[strat->Ll].p))
4612#endif
4613       && pIsConstant(strat->L[strat->Ll].p))
4614  {
4615    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
4616  }
4617}
4618
4619
4620/*2
4621*construct the set s from F and {P}
4622*/
4623void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
4624{
4625  int   i,pos;
4626
4627  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4628  else i=setmaxT;
4629  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
4630  strat->ecartS=initec(i);
4631  strat->sevS=initsevS(i);
4632  strat->S_2_R=initS_2_R(i);
4633  strat->fromQ=NULL;
4634  strat->Shdl=idInit(i,F->rank);
4635  strat->S=strat->Shdl->m;
4636
4637  /*- put polys into S -*/
4638  if (Q!=NULL)
4639  {
4640    strat->fromQ=initec(i);
4641    memset(strat->fromQ,0,i*sizeof(int));
4642    for (i=0; i<IDELEMS(Q); i++)
4643    {
4644      if (Q->m[i]!=NULL)
4645      {
4646        LObject h;
4647        h.p = pCopy(Q->m[i]);
4648        //if (TEST_OPT_INTSTRATEGY)
4649        //{
4650        //  //pContent(h.p);
4651        //  h.pCleardenom(); // also does a pContent
4652        //}
4653        //else
4654        //{
4655        //  h.pNorm();
4656        //}
4657        if (pOrdSgn==-1)
4658        {
4659          deleteHC(&h,strat);
4660        }
4661        if (h.p!=NULL)
4662        {
4663          strat->initEcart(&h);
4664          if (strat->sl==-1)
4665            pos =0;
4666          else
4667          {
4668            pos = posInS(strat,strat->sl,h.p,h.ecart);
4669          }
4670          h.sev = pGetShortExpVector(h.p);
4671          strat->enterS(h,pos,strat, strat->tl+1);
4672          enterT(h, strat);
4673          strat->fromQ[pos]=1;
4674        }
4675      }
4676    }
4677  }
4678  /*- put polys into S -*/
4679  for (i=0; i<IDELEMS(F); i++)
4680  {
4681    if (F->m[i]!=NULL)
4682    {
4683      LObject h;
4684      h.p = pCopy(F->m[i]);
4685      if (pOrdSgn==-1)
4686      {
4687        deleteHC(&h,strat);
4688      }
4689      else
4690      {
4691        h.p=redtailBba(h.p,strat->sl,strat);
4692      }
4693      if (h.p!=NULL)
4694      {
4695        strat->initEcart(&h);
4696        if (strat->sl==-1)
4697          pos =0;
4698        else
4699          pos = posInS(strat,strat->sl,h.p,h.ecart);
4700        h.sev = pGetShortExpVector(h.p);
4701        strat->enterS(h,pos,strat, strat->tl+1);
4702        enterT(h,strat);
4703      }
4704    }
4705  }
4706  for (i=0; i<IDELEMS(P); i++)
4707  {
4708    if (P->m[i]!=NULL)
4709    {
4710      LObject h;
4711      h.p=pCopy(P->m[i]);
4712      if (TEST_OPT_INTSTRATEGY)
4713      {
4714        h.pCleardenom();
4715      }
4716      else
4717      {
4718        h.pNorm();
4719      }
4720      if(strat->sl>=0)
4721      {
4722        if (pOrdSgn==1)
4723        {
4724          h.p=redBba(h.p,strat->sl,strat);
4725          if (h.p!=NULL)
4726          {
4727            h.p=redtailBba(h.p,strat->sl,strat);
4728          }
4729        }
4730        else
4731        {
4732          h.p=redMora(h.p,strat->sl,strat);
4733        }
4734        if(h.p!=NULL)
4735        {
4736          strat->initEcart(&h);
4737          if (TEST_OPT_INTSTRATEGY)
4738          {
4739            h.pCleardenom();
4740          }
4741          else
4742          {
4743            h.is_normalized = 0;
4744            h.pNorm();
4745          }
4746          h.sev = pGetShortExpVector(h.p);
4747          h.SetpFDeg();
4748          pos = posInS(strat,strat->sl,h.p,h.ecart);
4749          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
4750          strat->enterS(h,pos,strat, strat->tl+1);
4751          enterT(h,strat);
4752        }
4753      }
4754      else
4755      {
4756        h.sev = pGetShortExpVector(h.p);
4757        strat->initEcart(&h);
4758        strat->enterS(h,0,strat, strat->tl+1);
4759        enterT(h,strat);
4760      }
4761    }
4762  }
4763}
4764/*2
4765* reduces h using the set S
4766* procedure used in cancelunit1
4767*/
4768static poly redBba1 (poly h,int maxIndex,kStrategy strat)
4769{
4770  int j = 0;
4771  unsigned long not_sev = ~ pGetShortExpVector(h);
4772
4773  while (j <= maxIndex)
4774  {
4775    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
4776       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
4777    else j++;
4778  }
4779  return h;
4780}
4781
4782/*2
4783*tests if p.p=monomial*unit and cancels the unit
4784*/
4785void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
4786{
4787  int k;
4788  poly r,h,h1,q;
4789
4790  if (!pIsVector((*p).p) && ((*p).ecart != 0))
4791  {
4792    k = 0;
4793    h1 = r = pCopy((*p).p);
4794    h =pNext(r);
4795    loop
4796    {
4797      if (h==NULL)
4798      {
4799        pDelete(&r);
4800        pDelete(&(pNext((*p).p)));
4801        (*p).ecart = 0;
4802        (*p).length = 1;
4803        (*suc)=0;
4804        return;
4805      }
4806      if (!pDivisibleBy(r,h))
4807      {
4808        q=redBba1(h,index ,strat);
4809        if (q != h)
4810        {
4811          k++;
4812          pDelete(&h);
4813          pNext(h1) = h = q;
4814        }
4815        else
4816        {
4817          pDelete(&r);
4818          return;
4819        }
4820      }
4821      else
4822      {
4823        h1 = h;
4824        pIter(h);
4825      }
4826      if (k > 10)
4827      {
4828        pDelete(&r);
4829        return;
4830      }
4831    }
4832  }
4833}
4834
4835#if 0
4836/*2
4837* reduces h using the elements from Q in the set S
4838* procedure used in updateS
4839* must not be used for elements of Q or elements of an ideal !
4840*/
4841static poly redQ (poly h, int j, kStrategy strat)
4842{
4843  int start;
4844  unsigned long not_sev = ~ pGetShortExpVector(h);
4845  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
4846  start=j;
4847  while (j<=strat->sl)
4848  {
4849    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
4850    {
4851      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
4852      if (h==NULL) return NULL;
4853      j = start;
4854      not_sev = ~ pGetShortExpVector(h);
4855    }
4856    else j++;
4857  }
4858  return h;
4859}
4860#endif
4861
4862/*2
4863* reduces h using the set S
4864* procedure used in updateS
4865*/
4866static poly redBba (poly h,int maxIndex,kStrategy strat)
4867{
4868  int j = 0;
4869  unsigned long not_sev = ~ pGetShortExpVector(h);
4870
4871  while (j <= maxIndex)
4872  {
4873    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
4874    {
4875      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
4876      if (h==NULL) return NULL;
4877      j = 0;
4878      not_sev = ~ pGetShortExpVector(h);    }
4879    else j++;
4880  }
4881  return h;
4882}
4883
4884/*2
4885* reduces h using the set S
4886*e is the ecart of h
4887*procedure used in updateS
4888*/
4889static poly redMora (poly h,int maxIndex,kStrategy strat)
4890{
4891  int  j=0;
4892  int  e,l;
4893  unsigned long not_sev = ~ pGetShortExpVector(h);
4894
4895  if (maxIndex >= 0)
4896  {
4897    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
4898    do
4899    {
4900      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
4901      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
4902      {
4903#ifdef KDEBUG
4904        if (TEST_OPT_DEBUG)
4905          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
4906#endif
4907        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
4908#ifdef KDEBUG
4909        if(TEST_OPT_DEBUG)
4910          {PrintS(")\nto "); wrp(h); PrintLn();}
4911#endif
4912        // pDelete(&h);
4913        if (h == NULL) return NULL;
4914        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
4915        j = 0;
4916        not_sev = ~ pGetShortExpVector(h);
4917      }
4918      else j++;
4919    }
4920    while (j <= maxIndex);
4921  }
4922  return h;
4923}
4924
4925/*2
4926*updates S:
4927*the result is a set of polynomials which are in
4928*normalform with respect to S
4929*/
4930void updateS(BOOLEAN toT,kStrategy strat)
4931{
4932  LObject h;
4933  int i, suc=0;
4934  poly redSi=NULL;
4935  BOOLEAN change,any_change;
4936//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
4937//  for (i=0; i<=(strat->sl); i++)
4938//  {
4939//    Print("s%d:",i);
4940//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
4941//    pWrite(strat->S[i]);
4942//  }
4943//  Print("pOrdSgn=%d\n", pOrdSgn);
4944  any_change=FALSE;
4945  if (pOrdSgn==1)
4946  {
4947    while (suc != -1)
4948    {
4949      i=suc+1;
4950      while (i<=strat->sl)
4951      {
4952        change=FALSE;
4953        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
4954        {
4955          redSi = pHead(strat->S[i]);
4956          strat->S[i] = redBba(strat->S[i],i-1,strat);
4957          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
4958          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
4959          if (pCmp(redSi,strat->S[i])!=0)
4960          {
4961            change=TRUE;
4962            any_change=TRUE;
4963            #ifdef KDEBUG
4964            if (TEST_OPT_DEBUG)
4965            {
4966              PrintS("reduce:");
4967              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
4968            }
4969            #endif
4970            if (TEST_OPT_PROT)
4971            {
4972              if (strat->S[i]==NULL)
4973                PrintS("V");
4974              else
4975                PrintS("v");
4976              mflush();
4977            }
4978          }
4979          pDeleteLm(&redSi);
4980          if (strat->S[i]==NULL)
4981          {
4982            deleteInS(i,strat);
4983            i--;
4984          }
4985          else if (change)
4986          {
4987            if (TEST_OPT_INTSTRATEGY)
4988            {
4989              //pContent(strat->S[i]);
4990              pCleardenom(strat->S[i]);// also does a pContent
4991            }
4992            else
4993            {
4994              pNorm(strat->S[i]);
4995            }
4996            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
4997          }
4998        }
4999        i++;
5000      }
5001      if (any_change) reorderS(&suc,strat);
5002      else break;
5003    }
5004    if (toT)
5005    {
5006      for (i=0; i<=strat->sl; i++)
5007      {
5008        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5009        {
5010          h.p = redtailBba(strat->S[i],i-1,strat);
5011          if (TEST_OPT_INTSTRATEGY)
5012          {
5013            pCleardenom(h.p);// also does a pContent
5014          }
5015        }
5016        else
5017        {
5018          h.p = strat->S[i];
5019        }
5020        strat->initEcart(&h);
5021        if (strat->honey)
5022        {
5023          strat->ecartS[i] = h.ecart;
5024        }
5025        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
5026        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
5027        h.sev = strat->sevS[i];
5028        /*puts the elements of S also to T*/
5029        enterT(h,strat);
5030        strat->S_2_R[i] = strat->tl;
5031      }
5032    }
5033  }
5034  else
5035  {
5036    while (suc != -1)
5037    {
5038      i=suc;
5039      while (i<=strat->sl)
5040      {
5041        change=FALSE;
5042        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5043        {
5044          redSi=pHead((strat->S)[i]);
5045          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
5046          if ((strat->S)[i]==NULL)
5047          {
5048            deleteInS(i,strat);
5049            i--;
5050          }
5051          else if (pCmp((strat->S)[i],redSi)!=0)
5052          {
5053            any_change=TRUE;
5054            h.p = strat->S[i];
5055            strat->initEcart(&h);
5056            strat->ecartS[i] = h.ecart;
5057            if (TEST_OPT_INTSTRATEGY)
5058            {
5059              pCleardenom(strat->S[i]);// also does a pContent
5060            }
5061            else
5062            {
5063              pNorm(strat->S[i]); // == h.p
5064            }
5065            h.sev =  pGetShortExpVector(h.p);
5066            strat->sevS[i] = h.sev;
5067          }
5068          pDeleteLm(&redSi);
5069          kTest(strat);
5070        }
5071        i++;
5072      }
5073#ifdef KDEBUG
5074      kTest(strat);
5075#endif
5076      if (any_change) reorderS(&suc,strat);
5077      else { suc=-1; break; }
5078      if (h.p!=NULL)
5079      {
5080        if (!strat->kHEdgeFound)
5081        {
5082          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
5083        }
5084        if (strat->kHEdgeFound)
5085          newHEdge(strat->S,strat);
5086      }
5087    }
5088    for (i=0; i<=strat->sl; i++)
5089    {
5090      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5091      {
5092        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
5093        strat->initEcart(&h);
5094        strat->ecartS[i] = h.ecart;
5095        h.sev = pGetShortExpVector(h.p);
5096        strat->sevS[i] = h.sev;
5097      }
5098      else
5099      {
5100        h.p = strat->S[i];
5101        h.ecart=strat->ecartS[i];
5102        h.sev = strat->sevS[i];
5103        h.length = h.pLength = pLength(h.p);
5104      }
5105      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5106        cancelunit1(&h,&suc,strat->sl,strat);
5107      h.SetpFDeg();
5108      /*puts the elements of S also to T*/
5109      enterT(h,strat);
5110      strat->S_2_R[i] = strat->tl;
5111    }
5112    if (suc!= -1) updateS(toT,strat);
5113  }
5114#ifdef KDEBUG
5115  kTest(strat);
5116#endif
5117}
5118
5119
5120/*2
5121* -puts p to the standardbasis s at position at
5122* -saves the result in S
5123*/
5124void enterSBba (LObject p,int atS,kStrategy strat, int atR)
5125{
5126  int i;
5127  strat->news = TRUE;
5128  /*- puts p to the standardbasis s at position at -*/
5129  if (strat->sl == IDELEMS(strat->Shdl)-1)
5130  {
5131    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
5132                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
5133                                    (IDELEMS(strat->Shdl)+setmaxTinc)
5134                                                  *sizeof(unsigned long));
5135    strat->ecartS = (intset)omReallocSize(strat->ecartS,
5136                                          IDELEMS(strat->Shdl)*sizeof(int),
5137                                          (IDELEMS(strat->Shdl)+setmaxTinc)
5138                                                  *sizeof(int));
5139    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
5140                                         IDELEMS(strat->Shdl)*sizeof(int),
5141                                         (IDELEMS(strat->Shdl)+setmaxTinc)
5142                                                  *sizeof(int));
5143    if (strat->lenS!=NULL)
5144      strat->lenS=(int*)omRealloc0Size(strat->lenS,
5145                                       IDELEMS(strat->Shdl)*sizeof(int),
5146                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5147                                                 *sizeof(int));
5148    if (strat->lenSw!=NULL)
5149      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
5150                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
5151                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5152                                                 *sizeof(wlen_type));
5153    if (strat->fromQ!=NULL)
5154    {
5155      strat->fromQ = (intset)omReallocSize(strat->fromQ,
5156                                    IDELEMS(strat->Shdl)*sizeof(int),
5157                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
5158    }
5159    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
5160    IDELEMS(strat->Shdl)+=setmaxTinc;
5161    strat->Shdl->m=strat->S;
5162  }
5163  if (atS <= strat->sl)
5164  {
5165#ifdef ENTER_USE_MEMMOVE
5166// #if 0
5167    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
5168            (strat->sl - atS + 1)*sizeof(poly));
5169    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
5170            (strat->sl - atS + 1)*sizeof(int));
5171    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
5172            (strat->sl - atS + 1)*sizeof(unsigned long));
5173    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
5174            (strat->sl - atS + 1)*sizeof(int));
5175    if (strat->lenS!=NULL)
5176    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
5177            (strat->sl - atS + 1)*sizeof(int));
5178    if (strat->lenSw!=NULL)
5179    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
5180            (strat->sl - atS + 1)*sizeof(wlen_type));
5181#else
5182    for (i=strat->sl+1; i>=atS+1; i--)
5183    {
5184      strat->S[i] = strat->S[i-1];
5185      strat->ecartS[i] = strat->ecartS[i-1];
5186      strat->sevS[i] = strat->sevS[i-1];
5187      strat->S_2_R[i] = strat->S_2_R[i-1];
5188    }
5189    if (strat->lenS!=NULL)
5190    for (i=strat->sl+1; i>=atS+1; i--)
5191      strat->lenS[i] = strat->lenS[i-1];
5192    if (strat->lenSw!=NULL)
5193    for (i=strat->sl+1; i>=atS+1; i--)
5194      strat->lenSw[i] = strat->lenSw[i-1];
5195#endif
5196  }
5197  if (strat->fromQ!=NULL)
5198  {
5199#ifdef ENTER_USE_MEMMOVE
5200    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
5201                  (strat->sl - atS + 1)*sizeof(int));
5202#else
5203    for (i=strat->sl+1; i>=atS+1; i--)
5204    {
5205      strat->fromQ[i] = strat->fromQ[i-1];
5206    }
5207#endif
5208    strat->fromQ[atS]=0;
5209  }
5210
5211  /*- save result -*/
5212  strat->S[atS] = p.p;
5213  if (strat->honey) strat->ecartS[atS] = p.ecart;
5214  if (p.sev == 0)
5215    p.sev = pGetShortExpVector(p.p);
5216  else
5217    assume(p.sev == pGetShortExpVector(p.p));
5218  strat->sevS[atS] = p.sev;
5219  strat->ecartS[atS] = p.ecart;
5220  strat->S_2_R[atS] = atR;
5221  strat->sl++;
5222}
5223
5224/*2
5225* puts p to the set T at position atT
5226*/
5227void enterT(LObject p, kStrategy strat, int atT)
5228{
5229  int i;
5230
5231  pp_Test(p.p, currRing, p.tailRing);
5232  assume(strat->tailRing == p.tailRing);
5233  // redMoraNF complains about this -- but, we don't really
5234  // neeed this so far
5235  assume(p.pLength == 0 || pLength(p.p) == p.pLength);
5236  assume(p.FDeg == p.pFDeg());
5237  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
5238
5239#ifdef KDEBUG 
5240  // do not put an LObject twice into T:
5241  for(i=strat->tl;i>=0;i--)
5242  {
5243    if (p.p==strat->T[i].p) 
5244    {
5245      printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
5246      return;
5247    }
5248  }
5249#endif 
5250  strat->newt = TRUE;
5251  if (atT < 0)
5252    atT = strat->posInT(strat->T, strat->tl, p);
5253  if (strat->tl == strat->tmax-1)
5254    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
5255  if (atT <= strat->tl)
5256  {
5257#ifdef ENTER_USE_MEMMOVE
5258    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
5259            (strat->tl-atT+1)*sizeof(TObject));
5260    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
5261            (strat->tl-atT+1)*sizeof(unsigned long));
5262#endif
5263    for (i=strat->tl+1; i>=atT+1; i--)
5264    {
5265#ifndef ENTER_USE_MEMMOVE
5266      strat->T[i] = strat->T[i-1];
5267      strat->sevT[i] = strat->sevT[i-1];
5268#endif
5269      strat->R[strat->T[i].i_r] = &(strat->T[i]);
5270    }
5271  }
5272
5273  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
5274  {
5275    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
5276                                   (strat->tailRing != NULL ?
5277                                    strat->tailRing : currRing),
5278                                   strat->tailBin);
5279    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
5280  }
5281  strat->T[atT] = (TObject) p;
5282
5283  if (strat->tailRing != currRing && pNext(p.p) != NULL)
5284    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
5285  else
5286    strat->T[atT].max = NULL;
5287
5288  strat->tl++;
5289  strat->R[strat->tl] = &(strat->T[atT]);
5290  strat->T[atT].i_r = strat->tl;
5291  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
5292  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
5293  kTest_T(&(strat->T[atT]));
5294}
5295
5296void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
5297{
5298  if (strat->homog!=isHomog)
5299  {
5300    *hilb=NULL;
5301  }
5302}
5303
5304void initBuchMoraCrit(kStrategy strat)
5305{
5306  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
5307  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
5308  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
5309  strat->Gebauer =          strat->homog || strat->sugarCrit;
5310  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
5311  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
5312  strat->pairtest = NULL;
5313  /* alway use tailreduction, except:
5314  * - in local rings, - in lex order case, -in ring over extensions */
5315  strat->noTailReduction = !TEST_OPT_REDTAIL;
5316
5317#ifdef HAVE_PLURAL
5318  // and r is plural_ring
5319  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
5320  {    //or it has non-quasi-comm type... later
5321    strat->sugarCrit = FALSE;
5322    strat->Gebauer = FALSE;
5323    strat->honey = FALSE;
5324  }
5325#endif
5326
5327#ifdef HAVE_RINGS
5328  // Coefficient ring?
5329  if (rField_is_Ring(currRing))
5330  {
5331    strat->sugarCrit = FALSE;
5332    strat->Gebauer = FALSE ;
5333    strat->honey = FALSE;
5334  }
5335#endif
5336  #ifdef KDEBUG
5337  if (TEST_OPT_DEBUG)
5338  {
5339    if (strat->homog) PrintS("ideal/module is homogeneous\n");
5340    else              PrintS("ideal/module is not homogeneous\n");
5341  }
5342  #endif
5343}
5344
5345BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
5346                               (const LSet set, const int length,
5347                                LObject* L,const kStrategy strat))
5348{
5349  if (pos_in_l == posInL110 ||
5350      pos_in_l == posInL10)
5351    return TRUE;
5352
5353  return FALSE;
5354}
5355
5356void initBuchMoraPos (kStrategy strat)
5357{
5358  if (pOrdSgn==1)
5359  {
5360    if (strat->honey)
5361    {
5362      strat->posInL = posInL15;
5363      // ok -- here is the deal: from my experiments for Singular-2-0
5364      // I conclude that that posInT_EcartpLength is the best of
5365      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
5366      // see the table at the end of this file
5367      if (K_TEST_OPT_OLDSTD)
5368        strat->posInT = posInT15;
5369      else
5370        strat->posInT = posInT_EcartpLength;
5371    }
5372    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
5373    {
5374      strat->posInL = posInL11;
5375      strat->posInT = posInT11;
5376    }
5377    else if (TEST_OPT_INTSTRATEGY)
5378    {
5379      strat->posInL = posInL11;
5380      strat->posInT = posInT11;
5381    }
5382    else
5383    {
5384      strat->posInL = posInL0;
5385      strat->posInT = posInT0;
5386    }
5387    //if (strat->minim>0) strat->posInL =posInLSpecial;
5388    if (strat->homog)
5389    {
5390       strat->posInL = posInL110;
5391       strat->posInT = posInT110;
5392    }
5393  }
5394  else
5395  {
5396    if (strat->homog)
5397    {
5398      strat->posInL = posInL11;
5399      strat->posInT = posInT11;
5400    }
5401    else
5402    {
5403      if ((currRing->order[0]==ringorder_c)
5404      ||(currRing->order[0]==ringorder_C))
5405      {
5406        strat->posInL = posInL17_c;
5407        strat->posInT = posInT17_c;
5408      }
5409      else
5410      {
5411        strat->posInL = posInL17;
5412        strat->posInT = posInT17;
5413      }
5414    }
5415  }
5416  if (strat->minim>0) strat->posInL =posInLSpecial;
5417  // for further tests only
5418  if ((BTEST1(11)) || (BTEST1(12)))
5419    strat->posInL = posInL11;
5420  else if ((BTEST1(13)) || (BTEST1(14)))
5421    strat->posInL = posInL13;
5422  else if ((BTEST1(15)) || (BTEST1(16)))
5423    strat->posInL = posInL15;
5424  else if ((BTEST1(17)) || (BTEST1(18)))
5425    strat->posInL = posInL17;
5426  if (BTEST1(11))
5427    strat->posInT = posInT11;
5428  else if (BTEST1(13))
5429    strat->posInT = posInT13;
5430  else if (BTEST1(15))
5431    strat->posInT = posInT15;
5432  else if ((BTEST1(17)))
5433    strat->posInT = posInT17;
5434  else if ((BTEST1(19)))
5435    strat->posInT = posInT19;
5436  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
5437    strat->posInT = posInT1;
5438#ifdef HAVE_RINGS
5439  if (rField_is_Ring(currRing))
5440  {
5441    strat->posInL = posInL11;
5442    strat->posInT = posInT11;
5443  }
5444#endif
5445  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
5446}
5447
5448void initBuchMora (ideal F,ideal Q,kStrategy strat)
5449{
5450  strat->interpt = BTEST1(OPT_INTERRUPT);
5451  strat->kHEdge=NULL;
5452  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
5453  /*- creating temp data structures------------------- -*/
5454  strat->cp = 0;
5455  strat->c3 = 0;
5456  strat->tail = pInit();
5457  /*- set s -*/
5458  strat->sl = -1;
5459  /*- set L -*/
5460  strat->Lmax = setmaxL;
5461  strat->Ll = -1;
5462  strat->L = initL();
5463  /*- set B -*/
5464  strat->Bmax = setmaxL;
5465  strat->Bl = -1;
5466  strat->B = initL();
5467  /*- set T -*/
5468  strat->tl = -1;
5469  strat->tmax = setmaxT;
5470  strat->T = initT();
5471  strat->R = initR();
5472  strat->sevT = initsevT();
5473  /*- init local data struct.---------------------------------------- -*/
5474  strat->P.ecart=0;
5475  strat->P.length=0;
5476  if (pOrdSgn==-1)
5477  {
5478    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
5479    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
5480  }
5481  if(TEST_OPT_SB_1)
5482  {
5483    int i;
5484    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
5485    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5486    {
5487      P->m[i-strat->newIdeal] = F->m[i];
5488      F->m[i] = NULL;
5489    }
5490    initSSpecial(F,Q,P,strat);
5491    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5492    {
5493      F->m[i] = P->m[i-strat->newIdeal];
5494      P->m[i-strat->newIdeal] = NULL;
5495    }
5496    idDelete(&P);
5497  }
5498  else
5499  {
5500    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
5501    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
5502  }
5503  strat->kIdeal = NULL;
5504  strat->fromT = FALSE;
5505  strat->noTailReduction = !TEST_OPT_REDTAIL;
5506  if (!TEST_OPT_SB_1)
5507  {
5508    updateS(TRUE,strat);
5509  }
5510  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
5511  strat->fromQ=NULL;
5512}
5513
5514void exitBuchMora (kStrategy strat)
5515{
5516  /*- release temp data -*/
5517  cleanT(strat);
5518  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
5519  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
5520  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
5521  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
5522  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
5523  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
5524  /*- set L: should be empty -*/
5525  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
5526  /*- set B: should be empty -*/
5527  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
5528  pDeleteLm(&strat->tail);
5529  strat->syzComp=0;
5530  if (strat->kIdeal!=NULL)
5531  {
5532    omFreeBin(strat->kIdeal, sleftv_bin);
5533    strat->kIdeal=NULL;
5534  }
5535}
5536
5537/*2
5538* in the case of a standardbase of a module over a qring:
5539* replace polynomials in i by ak vectors,
5540* (the polynomial * unit vectors gen(1)..gen(ak)
5541* in every case (also for ideals:)
5542* deletes divisible vectors/polynomials
5543*/
5544void updateResult(ideal r,ideal Q, kStrategy strat)
5545{
5546  int l;
5547  if (strat->ak>0)
5548  {
5549    for (l=IDELEMS(r)-1;l>=0;l--)
5550    {
5551      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
5552      {
5553        pDelete(&r->m[l]); // and set it to NULL
5554      }
5555    }
5556    int q;
5557    poly p;
5558    for (l=IDELEMS(r)-1;l>=0;l--)
5559    {
5560      if ((r->m[l]!=NULL)
5561      && (strat->syzComp>0)
5562      && (pGetComp(r->m[l])<=strat->syzComp))
5563      {
5564        for(q=IDELEMS(Q)-1; q>=0;q--)
5565        {
5566          if ((Q->m[q]!=NULL)
5567          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
5568          {
5569            if (TEST_OPT_REDSB)
5570            {
5571              p=r->m[l];
5572              r->m[l]=kNF(Q,NULL,p);
5573              pDelete(&p);
5574            }
5575            else
5576            {
5577              pDelete(&r->m[l]); // and set it to NULL
5578            }
5579            break;
5580          }
5581        }
5582      }
5583    }
5584  }
5585  else
5586  {
5587    int q;
5588    poly p;
5589    for (l=IDELEMS(r)-1;l>=0;l--)
5590    {
5591      if (r->m[l]!=NULL)
5592      {
5593        for(q=IDELEMS(Q)-1; q>=0;q--)
5594        {
5595          if ((Q->m[q]!=NULL)
5596          &&(pLmEqual(r->m[l],Q->m[q])))
5597          {
5598            if (TEST_OPT_REDSB)
5599            {
5600              p=r->m[l];
5601              r->m[l]=kNF(Q,NULL,p);
5602              pDelete(&p);
5603            }
5604            else
5605            {
5606              pDelete(&r->m[l]); // and set it to NULL
5607            }
5608            break;
5609          }
5610        }
5611      }
5612    }
5613  }
5614  idSkipZeroes(r);
5615}
5616
5617void completeReduce (kStrategy strat, BOOLEAN withT)
5618{
5619  int i;
5620  int low = (pOrdSgn == 1 ? 1 : 0);
5621  LObject L;
5622
5623#ifdef KDEBUG
5624  // need to set this: during tailreductions of T[i], T[i].max is out of
5625  // sync
5626  sloppy_max = TRUE;
5627#endif
5628
5629  strat->noTailReduction = FALSE;
5630  if (TEST_OPT_PROT)
5631  {
5632    PrintLn();
5633    if (timerv) writeTime("standard base computed:");
5634  }
5635  if (TEST_OPT_PROT)
5636  {
5637    Print("(S:%d)",strat->sl);mflush();
5638  }
5639  for (i=strat->sl; i>=low; i--)
5640  {
5641    TObject* T_j = strat->s_2_t(i);
5642    if (T_j != NULL)
5643    {
5644      L = *T_j;
5645      poly p;
5646      if (pOrdSgn == 1)
5647        strat->S[i] = redtailBba(&L, i-1, strat, withT);
5648      else
5649        strat->S[i] = redtail(&L, strat->sl, strat);
5650
5651      if (strat->redTailChange && strat->tailRing != currRing)
5652      {
5653        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
5654        if (pNext(T_j->p) != NULL)
5655          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
5656        else
5657          T_j->max = NULL;
5658      }
5659      if (TEST_OPT_INTSTRATEGY)
5660        T_j->pCleardenom();
5661    }
5662    else
5663    {
5664      assume(currRing == strat->tailRing);
5665      if (pOrdSgn == 1)
5666        strat->S[i] = redtailBba(strat->S[i], i-1, strat, withT);
5667      else
5668        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
5669      if (TEST_OPT_INTSTRATEGY)
5670        pCleardenom(strat->S[i]);
5671    }
5672    if (TEST_OPT_PROT)
5673      PrintS("-");
5674  }
5675  if (TEST_OPT_PROT) PrintLn();
5676#ifdef KDEBUG
5677  sloppy_max = FALSE;
5678#endif
5679}
5680
5681
5682/*2
5683* computes the new strat->kHEdge and the new pNoether,
5684* returns TRUE, if pNoether has changed
5685*/
5686BOOLEAN newHEdge(polyset S, kStrategy strat)
5687{
5688  int i,j;
5689  poly newNoether;
5690
5691#if 0
5692  if (currRing->weight_all_1)
5693    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5694  else
5695    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5696#else   
5697  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5698#endif 
5699  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
5700  if (strat->tailRing != currRing)
5701    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
5702  /* compare old and new noether*/
5703  newNoether = pLmInit(strat->kHEdge);
5704  j = pFDeg(newNoether,currRing);
5705  for (i=1; i<=pVariables; i++)
5706  {
5707    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
5708  }
5709  pSetm(newNoether);
5710  if (j < strat->HCord) /*- statistics -*/
5711  {
5712    if (TEST_OPT_PROT)
5713    {
5714      Print("H(%d)",j);
5715      mflush();
5716    }
5717    strat->HCord=j;
5718    #ifdef KDEBUG
5719    if (TEST_OPT_DEBUG)
5720    {
5721      Print("H(%d):",j);
5722      wrp(strat->kHEdge);
5723      PrintLn();
5724    }
5725    #endif
5726  }
5727  if (pCmp(strat->kNoether,newNoether)!=1)
5728  {
5729    pDelete(&strat->kNoether);
5730    strat->kNoether=newNoether;
5731    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
5732    if (strat->tailRing != currRing)
5733      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
5734
5735    return TRUE;
5736  }
5737  pLmFree(newNoether);
5738  return FALSE;
5739}
5740
5741/***************************************************************
5742 *
5743 * Routines related for ring changes during std computations
5744 *
5745 ***************************************************************/
5746BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
5747{
5748  assume(L->p1 != NULL && L->p2 != NULL);
5749  // shift changes: from 0 to -1
5750  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
5751  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
5752  assume(strat->tailRing != currRing);
5753
5754  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
5755    return FALSE;
5756  // shift changes: extra case inserted
5757  if ((L->i_r1 == -1) || (L->i_r2 == -1) )
5758  {
5759    return TRUE;
5760  }
5761  poly p1_max = (strat->R[L->i_r1])->max;
5762  poly p2_max = (strat->R[L->i_r2])->max;
5763
5764  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
5765      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
5766  {
5767    p_LmFree(m1, strat->tailRing);
5768    p_LmFree(m2, strat->tailRing);
5769    m1 = NULL;
5770    m2 = NULL;
5771    return FALSE;
5772  }
5773  return TRUE;
5774}
5775
5776BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
5777{
5778  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
5779  if (expbound >= currRing->bitmask) return FALSE;
5780  ring new_tailRing = rModifyRing(currRing,
5781                                  // Hmmm .. the condition pFDeg == pDeg
5782                                  // might be too strong
5783#ifdef HAVE_RINGS
5784                                  (strat->homog && pFDeg == pDeg && !(rField_is_Ring(currRing))), // TODO Oliver
5785#else
5786                                  (strat->homog && pFDeg == pDeg),
5787#endif
5788                                  !strat->ak,
5789                                  expbound);
5790  if (new_tailRing == currRing) return TRUE;
5791
5792  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
5793  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
5794
5795  if (currRing->pFDeg != currRing->pFDegOrig)
5796  {
5797    new_tailRing->pFDeg = currRing->pFDeg;
5798    new_tailRing->pLDeg = currRing->pLDeg;
5799  }
5800
5801  if (TEST_OPT_PROT)
5802    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
5803  kTest_TS(strat);
5804  assume(new_tailRing != strat->tailRing);
5805  pShallowCopyDeleteProc p_shallow_copy_delete
5806    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
5807
5808  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
5809
5810  int i;
5811  for (i=0; i<=strat->tl; i++)
5812  {
5813    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
5814                                  p_shallow_copy_delete);
5815  }
5816  for (i=0; i<=strat->Ll; i++)
5817  {
5818    assume(strat->L[i].p != NULL);
5819    if (pNext(strat->L[i].p) != strat->tail)
5820      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
5821  }
5822  if (strat->P.t_p != NULL ||
5823      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
5824    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
5825
5826  if (L != NULL && L->tailRing != new_tailRing)
5827  {
5828    if (L->i_r < 0)
5829      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
5830    else
5831    {
5832      assume(L->i_r <= strat->tl);
5833      TObject* t_l = strat->R[L->i_r];
5834      assume(t_l != NULL);
5835      L->tailRing = new_tailRing;
5836      L->p = t_l->p;
5837      L->t_p = t_l->t_p;
5838      L->max = t_l->max;
5839    }
5840  }
5841
5842  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
5843    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
5844
5845  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
5846  if (strat->tailRing != currRing)
5847    rKillModifiedRing(strat->tailRing);
5848
5849  strat->tailRing = new_tailRing;
5850  strat->tailBin = new_tailBin;
5851  strat->p_shallow_copy_delete
5852    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
5853
5854  if (strat->kHEdge != NULL)
5855  {
5856    if (strat->t_kHEdge != NULL)
5857      p_LmFree(strat->t_kHEdge, strat->tailRing);
5858    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
5859  }
5860
5861  if (strat->kNoether != NULL)
5862  {
5863    if (strat->t_kNoether != NULL)
5864      p_LmFree(strat->t_kNoether, strat->tailRing);
5865    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
5866                                                   new_tailRing);
5867  }
5868  kTest_TS(strat);
5869  if (TEST_OPT_PROT)
5870    PrintS("]");
5871  return TRUE;
5872}
5873
5874void kStratInitChangeTailRing(kStrategy strat)
5875{
5876  unsigned long l = 0;
5877  int i;
5878  Exponent_t e;
5879  ring new_tailRing;
5880
5881  assume(strat->tailRing == currRing);
5882
5883  for (i=0; i<= strat->Ll; i++)
5884  {
5885    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
5886  }
5887  for (i=0; i<=strat->tl; i++)
5888  {
5889    // Hmm ... this we could do in one Step
5890    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
5891  }
5892  if (rField_is_Ring(currRing))
5893  {
5894    l += 20; // TEMP, TODO OLI
5895    l *= 2;
5896  }
5897  e = p_GetMaxExp(l, currRing);
5898  if (e <= 1) e = 2;
5899
5900  kStratChangeTailRing(strat, NULL, NULL, e);
5901}
5902
5903skStrategy::skStrategy()
5904{
5905  memset(this, 0, sizeof(skStrategy));
5906#ifndef NDEBUG
5907  strat_nr++;
5908  nr=strat_nr;
5909  if (strat_fac_debug) Print("s(%d) created\n",nr);
5910#endif
5911  tailRing = currRing;
5912  P.tailRing = currRing;
5913  tl = -1;
5914  sl = -1;
5915#ifdef HAVE_LM_BIN
5916  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
5917#endif
5918#ifdef HAVE_TAIL_BIN
5919  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
5920#endif
5921  pOrigFDeg = pFDeg;
5922  pOrigLDeg = pLDeg;
5923}
5924
5925
5926skStrategy::~skStrategy()
5927{
5928  if (lmBin != NULL)
5929    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
5930  if (tailBin != NULL)
5931    omMergeStickyBinIntoBin(tailBin,
5932                            (tailRing != NULL ? tailRing->PolyBin:
5933                             currRing->PolyBin));
5934  if (t_kHEdge != NULL)
5935    p_LmFree(t_kHEdge, tailRing);
5936  if (t_kNoether != NULL)
5937    p_LmFree(t_kNoether, tailRing);
5938
5939  if (currRing != tailRing)
5940    rKillModifiedRing(tailRing);
5941  pRestoreDegProcs(pOrigFDeg, pOrigLDeg);
5942}
5943
5944#if 0
5945Timings for the different possibilities of posInT:
5946            T15           EDL         DL          EL            L         1-2-3
5947Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
5948Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
5949Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
5950ahml         4.48        4.03        4.03        4.38        4.96       26.50
5951c7          15.02       13.98       15.16       13.24       17.31       47.89
5952c8         505.09      407.46      852.76      413.21      499.19        n/a
5953f855        12.65        9.27       14.97        8.78       14.23       33.12
5954gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
5955gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
5956ilias13     22.89       22.46       24.62       20.60       23.34       53.86
5957noon8       40.68       37.02       37.99       36.82       35.59      877.16
5958rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
5959rkat9       82.37       79.46       77.20       77.63       82.54      267.92
5960schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
5961test016     16.39       14.17       14.40       13.50       14.26       34.07
5962test017     34.70       36.01       33.16       35.48       32.75       71.45
5963test042     10.76       10.99       10.27       11.57       10.45       23.04
5964test058      6.78        6.75        6.51        6.95        6.22        9.47
5965test066     10.71       10.94       10.76       10.61       10.56       19.06
5966test073     10.75       11.11       10.17       10.79        8.63       58.10
5967test086     12.23       11.81       12.88       12.24       13.37       66.68
5968test103      5.05        4.80        5.47        4.64        4.89       11.90
5969test154     12.96       11.64       13.51       12.46       14.61       36.35
5970test162     65.27       64.01       67.35       59.79       67.54      196.46
5971test164      7.50        6.50        7.68        6.70        7.96       17.13
5972virasoro     3.39        3.50        3.35        3.47        3.70        7.66
5973#endif
5974
5975
5976#ifdef HAVE_MORE_POS_IN_T
5977// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
5978int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
5979{
5980
5981  if (length==-1) return 0;
5982
5983  int o = p.ecart;
5984  int op=p.GetpFDeg();
5985  int ol = p.GetpLength();
5986
5987  if (set[length].ecart < o)
5988    return length+1;
5989  if (set[length].ecart == o)
5990  {
5991     int oo=set[length].GetpFDeg();
5992     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
5993       return length+1;
5994  }
5995
5996  int i;
5997  int an = 0;
5998  int en= length;
5999  loop
6000  {
6001    if (an >= en-1)
6002    {
6003      if (set[an].ecart > o)
6004        return an;
6005      if (set[an].ecart == o)
6006      {
6007         int oo=set[an].GetpFDeg();
6008         if((oo > op)
6009         || ((oo==op) && (set[an].pLength > ol)))
6010           return an;
6011      }
6012      return en;
6013    }
6014    i=(an+en) / 2;
6015    if (set[i].ecart > o)
6016      en=i;
6017    else if (set[i].ecart == o)
6018    {
6019       int oo=set[i].GetpFDeg();
6020       if ((oo > op)
6021       || ((oo == op) && (set[i].pLength > ol)))
6022         en=i;
6023       else
6024        an=i;
6025    }
6026    else
6027      an=i;
6028  }
6029}
6030
6031// determines the position based on: 1.) FDeg 2.) pLength
6032int posInT_FDegpLength(const TSet set,const int length,LObject &p)
6033{
6034
6035  if (length==-1) return 0;
6036
6037  int op=p.GetpFDeg();
6038  int ol = p.GetpLength();
6039
6040  int oo=set[length].GetpFDeg();
6041  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
6042    return length+1;
6043
6044  int i;
6045  int an = 0;
6046  int en= length;
6047  loop
6048    {
6049      if (an >= en-1)
6050      {
6051        int oo=set[an].GetpFDeg();
6052        if((oo > op)
6053           || ((oo==op) && (set[an].pLength > ol)))
6054          return an;
6055