source: git/kernel/GBEngine/kutil.cc @ abf7a5

/****************************************
*  Computer Algebra System SINGULAR     *
****************************************/
/*
* ABSTRACT: kernel: utils for kStd
*/

// #define PDEBUG 2
// #define PDIV_DEBUG
#define KUTIL_CC

#define MYTEST 0

#include <kernel/mod2.h>

#include <misc/mylimits.h>
#include <misc/options.h>
#include <polys/nc/nc.h>
#include <polys/nc/sca.h>
#include <polys/weight.h> /* for kDebugPrint: maxdegreeWecart*/

#include <stdlib.h>
#include <string.h>

#ifdef KDEBUG
#undef KDEBUG
#define KDEBUG 2
#endif

#ifdef DEBUGF5
#undef DEBUGF5
//#define DEBUGF5 1
#endif

#ifdef HAVE_RINGS
#include <kernel/ideals.h>
#endif

// define if enterL, enterT should use memmove instead of doing it manually
// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
#ifndef SunOS_4
#define ENTER_USE_MEMMOVE
#endif

// define, if the my_memmove inlines should be used instead of
// system memmove -- it does not seem to pay off, though
// #define ENTER_USE_MYMEMMOVE

#include <kernel/GBEngine/kutil.h>
#include <polys/kbuckets.h>
#include <omalloc/omalloc.h>
#include <coeffs/numbers.h>
#include <kernel/polys.h>
#include <polys/monomials/ring.h>
#include <kernel/ideals.h>
//#include "cntrlc.h"
#include <kernel/combinatorics/stairc.h>
#include <kernel/GBEngine/kstd1.h>
#include <polys/operations/pShallowCopyDelete.h>

/* shiftgb stuff */
#include <kernel/GBEngine/shiftgb.h>
#include <polys/prCopy.h>

#ifdef HAVE_RATGRING
#include <kernel/GBEngine/ratgring.h>
#endif

#ifdef KDEBUG
#undef KDEBUG
#define KDEBUG 2
#endif

#ifdef DEBUGF5
#undef DEBUGF5
#define DEBUGF5 2
#endif

#define ADIDEBUG 0

denominator_list DENOMINATOR_LIST=NULL;


#ifdef ENTER_USE_MYMEMMOVE
inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
{
  register unsigned long* _dl = (unsigned long*) d;
  register unsigned long* _sl = (unsigned long*) s;
  register long _i = l - 1;

  do
  {
    _dl[_i] = _sl[_i];
    _i--;
  }
  while (_i >= 0);
}

inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
{
  register long _ll = l;
  register unsigned long* _dl = (unsigned long*) d;
  register unsigned long* _sl = (unsigned long*) s;
  register long _i = 0;

  do
  {
    _dl[_i] = _sl[_i];
    _i++;
  }
  while (_i < _ll);
}

inline void _my_memmove(void* d, void* s, long l)
{
  unsigned long _d = (unsigned long) d;
  unsigned long _s = (unsigned long) s;
  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;

  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
  else _my_memmove_d_lt_s(_d, _s, _l);
}

#undef memmove
#define memmove(d,s,l) _my_memmove(d, s, l)
#endif

static poly redMora (poly h,int maxIndex,kStrategy strat);
static poly redBba (poly h,int maxIndex,kStrategy strat);

#ifdef HAVE_RINGS
#define pDivComp_EQUAL 2
#define pDivComp_LESS 1
#define pDivComp_GREATER -1
#define pDivComp_INCOMP 0
/* Checks the relation of LM(p) and LM(q)
     LM(p) = LM(q) => return pDivComp_EQUAL
     LM(p) | LM(q) => return pDivComp_LESS
     LM(q) | LM(p) => return pDivComp_GREATER
     else return pDivComp_INCOMP */
static inline int pDivCompRing(poly p, poly q)
{
  if (pGetComp(p) == pGetComp(q))
  {
    BOOLEAN a=FALSE, b=FALSE;
    int i;
    unsigned long la, lb;
    unsigned long divmask = currRing->divmask;
    for (i=0; i<currRing->VarL_Size; i++)
    {
      la = p->exp[currRing->VarL_Offset[i]];
      lb = q->exp[currRing->VarL_Offset[i]];
      if (la != lb)
      {
        if (la < lb)
        {
          if (b) return pDivComp_INCOMP;
          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
            return pDivComp_INCOMP;
          a = TRUE;
        }
        else
        {
          if (a) return pDivComp_INCOMP;
          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
            return pDivComp_INCOMP;
          b = TRUE;
        }
      }
    }
    if (a) return pDivComp_LESS;
    if (b) return pDivComp_GREATER;
    if (!a & !b) return pDivComp_EQUAL;
  }
  return pDivComp_INCOMP;
}
#endif

static inline int pDivComp(poly p, poly q)
{
  if (pGetComp(p) == pGetComp(q))
  {
#ifdef HAVE_RATGRING
    if (rIsRatGRing(currRing))
    {
      if (_p_LmDivisibleByPart(p,currRing,
                           q,currRing,
                           currRing->real_var_start, currRing->real_var_end))
        return 0;
      return pLmCmp(q,p); // ONLY FOR GLOBAL ORDER!
    }
#endif
    BOOLEAN a=FALSE, b=FALSE;
    int i;
    unsigned long la, lb;
    unsigned long divmask = currRing->divmask;
    for (i=0; i<currRing->VarL_Size; i++)
    {
      la = p->exp[currRing->VarL_Offset[i]];
      lb = q->exp[currRing->VarL_Offset[i]];
      if (la != lb)
      {
        if (la < lb)
        {
          if (b) return 0;
          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
            return 0;
          a = TRUE;
        }
        else
        {
          if (a) return 0;
          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
            return 0;
          b = TRUE;
        }
      }
    }
    if (a) { /*assume(pLmCmp(q,p)==1);*/ return 1; }
    if (b) { /*assume(pLmCmp(q,p)==-1);*/return -1; }
    /*assume(pLmCmp(q,p)==0);*/
  }
  return 0;
}


int     HCord;
int     Kstd1_deg;
int     Kstd1_mu=32000;

/*2
*deletes higher monomial of p, re-compute ecart and length
*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
*/
void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
{
  if (strat->kHEdgeFound)
  {
    kTest_L(L);
    poly p1;
    poly p = L->GetLmTailRing();
    int l = 1;
    kBucket_pt bucket = NULL;
    if (L->bucket != NULL)
    {
      kBucketClear(L->bucket, &pNext(p), &L->pLength);
      L->pLength++;
      bucket = L->bucket;
      L->bucket = NULL;
    }

    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
    {
      L->Delete();
      L->Clear();
      L->ecart = -1;
      if (bucket != NULL) kBucketDestroy(&bucket);
      return;
    }
    p1 = p;
    while (pNext(p1)!=NULL)
    {
    if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
      {
        p_Delete(&pNext(p1), L->tailRing);
        if (p1 == p)
        {
          if (L->t_p != NULL)
          {
            assume(L->p != NULL && p == L->t_p);
            pNext(L->p) = NULL;
          }
          L->max  = NULL;
        }
        else if (fromNext)
          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
        //if (L->pLength != 0)
        L->pLength = l;
        // Hmmm when called from updateT, then only
        // reset ecart when cut
        if (fromNext)
          L->ecart = L->pLDeg() - L->GetpFDeg();
        break;
      }
      l++;
      pIter(p1);
    }
    if (! fromNext)
    {
      L->SetpFDeg();
      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
    }
    if (bucket != NULL)
    {
      if (L->pLength > 1)
      {
        kBucketInit(bucket, pNext(p), L->pLength - 1);
        pNext(p) = NULL;
        if (L->t_p != NULL) pNext(L->t_p) = NULL;
        L->pLength = 0;
        L->bucket = bucket;
      }
      else
        kBucketDestroy(&bucket);
    }
    kTest_L(L);
  }
}

void deleteHC(poly* p, int* e, int* l,kStrategy strat)
{
  LObject L(*p, currRing, strat->tailRing);

  deleteHC(&L, strat);
  *p = L.p;
  *e = L.ecart;
  *l = L.length;
  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
}

/*2
*tests if p.p=monomial*unit and cancels the unit
*/
void cancelunit (LObject* L,BOOLEAN inNF)
{
  int  i;
  poly h;
  number lc;

  if(rHasGlobalOrdering (currRing)) return;
  if(TEST_OPT_CANCELUNIT) return;

  ring r = L->tailRing;
  poly p = L->GetLmTailRing();

#ifdef HAVE_RINGS
    if (rField_is_Ring(r) /*&& (rHasLocalOrMixedOrdering(r))*/)
      lc = pGetCoeff(p);
#endif

#ifdef HAVE_RINGS
  // Leading coef have to be a unit
  if ( !(n_IsUnit(pGetCoeff(p), r->cf)) ) return;
#endif

  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;

//    for(i=r->N;i>0;i--)
//    {
//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
//    }
  h = pNext(p);

  loop
  {
    if (h==NULL)
    {
      p_Delete(&pNext(p), r);
      if (!inNF)
      {
        number eins;
#ifdef HAVE_RINGS
        if (rField_is_Ring(r) /*&& (rHasLocalOrMixedOrdering(r))*/)
          eins = nCopy(lc);
        else
#endif
          eins=nInit(1);
        if (L->p != NULL)
        {
          pSetCoeff(L->p,eins);
          if (L->t_p != NULL)
            pSetCoeff0(L->t_p,eins);
        }
        else
          pSetCoeff(L->t_p,eins);
        /* p and t_p share the same coeff, if both are !=NULL */
        /* p==NULL==t_p cannot happen here */
      }
      L->ecart = 0;
      L->length = 1;
      //if (L->pLength > 0)
      L->pLength = 1;
      L->max = NULL;

      if (L->t_p != NULL && pNext(L->t_p) != NULL)
        p_Delete(&pNext(L->t_p),r);
      if (L->p != NULL && pNext(L->p) != NULL)
        pNext(L->p) = NULL;

      return;
    }
    i = 0;
    loop
    {
      i++;
      if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
      #ifdef HAVE_RINGS
      // Note: As long as qring j forbidden if j contains integer (i.e. ground rings are
      //       domains), no zerodivisor test needed  CAUTION
      if (rField_is_Ring(r) /*&&(rHasLocalOrMixedOrdering(r)) */)
        if(n_DivBy(pGetCoeff(h),lc,r->cf) == 0)
          return;
      #endif
      if (i == r->N) break; // does divide, try next monom
    }
    pIter(h);
  }
}

/*2
*pp is the new element in s
*returns TRUE (in strat->kHEdgeFound) if
*-HEcke is allowed
*-we are in the last componente of the vector
*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
*returns FALSE for pLexOrderings,
*assumes in module case an ordering of type c* !!
* HEckeTest is only called with strat->kHEdgeFound==FALSE !
*/
void HEckeTest (poly pp,kStrategy strat)
{
  int   j,/*k,*/p;

  strat->kHEdgeFound=FALSE;
  if (currRing->pLexOrder || currRing->MixedOrder)
  {
    return;
  }
  if (strat->ak > 1)           /*we are in the module case*/
  {
    return; // until ....
    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
    //  return FALSE;
    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
    //  return FALSE;
  }
  // k = 0;
  p=pIsPurePower(pp);
  if (p!=0) strat->NotUsedAxis[p] = FALSE;
  /*- the leading term of pp is a power of the p-th variable -*/
  for (j=(currRing->N);j>0; j--)
  {
    if (strat->NotUsedAxis[j])
    {
      return;
    }
  }
  strat->kHEdgeFound=TRUE;
}

/*2
*utilities for TSet, LSet
*/
inline static intset initec (const int maxnr)
{
  return (intset)omAlloc(maxnr*sizeof(int));
}

inline static unsigned long* initsevS (const int maxnr)
{
  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
}
inline static int* initS_2_R (const int maxnr)
{
  return (int*)omAlloc0(maxnr*sizeof(int));
}

static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
                             int &length, const int incr)
{
  assume(T!=NULL);
  assume(sevT!=NULL);
  assume(R!=NULL);
  assume((length+incr) > 0);

  int i;
  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
                           (length+incr)*sizeof(TObject));

  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
                           (length+incr)*sizeof(long*));

  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
                                (length+incr)*sizeof(TObject*));
  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
  length += incr;
}

void cleanT (kStrategy strat)
{
  int i,j;
  poly  p;
  assume(currRing == strat->tailRing || strat->tailRing != NULL);

  pShallowCopyDeleteProc p_shallow_copy_delete =
    (strat->tailRing != currRing ?
     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
     NULL);

  for (j=0; j<=strat->tl; j++)
  {
    p = strat->T[j].p;
    strat->T[j].p=NULL;
    if (strat->T[j].max != NULL)
    {
      p_LmFree(strat->T[j].max, strat->tailRing);
    }
    i = -1;
    loop
    {
      i++;
      if (i>strat->sl)
      {
        if (strat->T[j].t_p != NULL)
        {
          p_Delete(&(strat->T[j].t_p), strat->tailRing);
          p_LmFree(p, currRing);
        }
        else
          pDelete(&p);
        break;
      }
      if (p == strat->S[i])
      {
        if (strat->T[j].t_p != NULL)
        {
          assume(p_shallow_copy_delete != NULL);
          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
                                           currRing->PolyBin);
          p_LmFree(strat->T[j].t_p, strat->tailRing);
        }
        break;
      }
    }
  }
  strat->tl=-1;
}

//LSet initL ()
//{
//  int i;
//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
//  return l;
//}

static inline void enlargeL (LSet* L,int* length,const int incr)
{
  assume((*L)!=NULL);
  assume(((*length)+incr)>0);

  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
                                   ((*length)+incr)*sizeof(LObject));
  (*length) += incr;
}

void initPairtest(kStrategy strat)
{
  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
}

/*2
*test whether (p1,p2) or (p2,p1) is in L up position length
*it returns TRUE if yes and the position k
*/
BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
{
  LObject *p=&(strat->L[length]);

  *k = length;
  loop
  {
    if ((*k) < 0) return FALSE;
    if (((p1 == (*p).p1) && (p2 == (*p).p2))
    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
      return TRUE;
    (*k)--;
    p--;
  }
}

/*2
*in B all pairs have the same element p on the right
*it tests whether (q,p) is in B and returns TRUE if yes
*and the position k
*/
BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
{
  LObject *p=&(strat->B[strat->Bl]);

  *k = strat->Bl;
  loop
  {
    if ((*k) < 0) return FALSE;
    if (q == (*p).p1)
      return TRUE;
    (*k)--;
    p--;
  }
}

int kFindInT(poly p, TSet T, int tlength)
{
  int i;

  for (i=0; i<=tlength; i++)
  {
    if (T[i].p == p) return i;
  }
  return -1;
}

int kFindInT(poly p, kStrategy strat)
{
  int i;
  do
  {
    i = kFindInT(p, strat->T, strat->tl);
    if (i >= 0) return i;
    strat = strat->next;
  }
  while (strat != NULL);
  return -1;
}

#ifdef KDEBUG

void sTObject::wrp()
{
  if (t_p != NULL) p_wrp(t_p, tailRing);
  else if (p != NULL) p_wrp(p, currRing, tailRing);
  else ::wrp(NULL);
}

#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)

// check that Lm's of a poly from T are "equal"
static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
{
  int i;
  for (i=1; i<=tailRing->N; i++)
  {
    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
      return "Lm[i] different";
  }
  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
    return "Lm[0] different";
  if (pNext(p) != pNext(t_p))
    return "Lm.next different";
  if (pGetCoeff(p) != pGetCoeff(t_p))
    return "Lm.coeff different";
  return NULL;
}

static BOOLEAN sloppy_max = FALSE;
BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
{
  ring tailRing = T->tailRing;
  if (strat_tailRing == NULL) strat_tailRing = tailRing;
  r_assume(strat_tailRing == tailRing);

  poly p = T->p;
  // ring r = currRing;

  if (T->p == NULL && T->t_p == NULL && i >= 0)
    return dReportError("%c[%d].poly is NULL", TN, i);

  if (T->tailRing != currRing)
  {
    if (T->t_p == NULL && i > 0)
      return dReportError("%c[%d].t_p is NULL", TN, i);
    pFalseReturn(p_Test(T->t_p, T->tailRing));
    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
    if (T->p != NULL && T->t_p != NULL)
    {
      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
      if (msg != NULL)
        return dReportError("%c[%d] %s", TN, i, msg);
      // r = T->tailRing;
      p = T->t_p;
    }
    if (T->p == NULL)
    {
      p = T->t_p;
      // r = T->tailRing;
    }
    if (T->t_p != NULL && i >= 0 && TN == 'T')
    {
      if (pNext(T->t_p) == NULL)
      {
        if (T->max != NULL)
          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
      }
      else
      {
        if (T->max == NULL)
          return dReportError("%c[%d].max is NULL", TN, i);
        if (pNext(T->max) != NULL)
          return dReportError("pNext(%c[%d].max) != NULL", TN, i);

        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
        omCheckBinAddrSize(T->max, (omSizeWOfBin(tailRing->PolyBin))*SIZEOF_LONG);
#if KDEBUG > 0
        if (! sloppy_max)
        {
          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
          p_Setm(T->max, tailRing);
          p_Setm(test_max, tailRing);
          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
          if (! equal)
            return dReportError("%c[%d].max out of sync", TN, i);
          p_LmFree(test_max, tailRing);
        }
#endif
      }
    }
  }
  else
  {
    if (T->max != NULL)
      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
    if (T->t_p != NULL)
      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
    if (T->p == NULL && i > 0)
      return dReportError("%c[%d].p is NULL", TN, i);
    pFalseReturn(p_Test(T->p, currRing));
  }

  if ((i >= 0) && (T->pLength != 0)
  && (! rIsSyzIndexRing(currRing)) && (T->pLength != pLength(p)))
  {
    int l=T->pLength;
    T->pLength=pLength(p);
    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
                        TN, i , pLength(p), l);
  }

  // check FDeg,  for elements in L and T
  if (i >= 0 && (TN == 'T' || TN == 'L'))
  {
    // FDeg has ir element from T of L set
    if (T->FDeg  != T->pFDeg())
    {
      int d=T->FDeg;
      T->FDeg=T->pFDeg();
      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
                          TN, i , T->pFDeg(), d);
    }
  }

  // check is_normalized for elements in T
  if (i >= 0 && TN == 'T')
  {
    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
      return dReportError("T[%d] is_normalized error", i);

  }
  return TRUE;
}

BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
                BOOLEAN testp, int lpos, TSet T, int tlength)
{
  if (testp)
  {
    poly pn = NULL;
    if (L->bucket != NULL)
    {
      kFalseReturn(kbTest(L->bucket));
      r_assume(L->bucket->bucket_ring == L->tailRing);
      if (L->p != NULL && pNext(L->p) != NULL)
      {
        pn = pNext(L->p);
        pNext(L->p) = NULL;
      }
    }
    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
    if (pn != NULL)
      pNext(L->p) = pn;

    ring r;
    poly p;
    L->GetLm(p, r);
    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
    {
      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
                          lpos, p_GetShortExpVector(p, r), L->sev);
    }
  }
  if (L->p1 == NULL)
  {
    // L->p2 either NULL or "normal" poly
    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
  }
  else if (tlength > 0 && T != NULL && (lpos >=0))
  {
    // now p1 and p2 must be != NULL and must be contained in T
    int i;
    i = kFindInT(L->p1, T, tlength);
    if (i < 0)
      return dReportError("L[%d].p1 not in T",lpos);
    i = kFindInT(L->p2, T, tlength);
    if (i < 0)
      return dReportError("L[%d].p2 not in T",lpos);
  }
  return TRUE;
}

BOOLEAN kTest (kStrategy strat)
{
  int i;

  // test P
  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
                       -1, strat->T, strat->tl));

  // test T
  if (strat->T != NULL)
  {
    for (i=0; i<=strat->tl; i++)
    {
      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
        return dReportError("strat->sevT[%d] out of sync", i);
    }
  }

  // test L
  if (strat->L != NULL)
  {
    for (i=0; i<=strat->Ll; i++)
    {
      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
                           strat->L[i].Next() != strat->tail, i,
                           strat->T, strat->tl));
      // may be unused
      //if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
      //    strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
      //{
      //  assume(strat->L[i].bucket != NULL);
      //}
    }
  }

  // test S
  if (strat->S != NULL)
    kFalseReturn(kTest_S(strat));

  return TRUE;
}

BOOLEAN kTest_S(kStrategy strat)
{
  int i;
  BOOLEAN ret = TRUE;
  for (i=0; i<=strat->sl; i++)
  {
    if (strat->S[i] != NULL &&
        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
    {
      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
    }
  }
  return ret;
}



BOOLEAN kTest_TS(kStrategy strat)
{
  int i, j;
  // BOOLEAN ret = TRUE;
  kFalseReturn(kTest(strat));

  // test strat->R, strat->T[i].i_r
  for (i=0; i<=strat->tl; i++)
  {
    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
                          strat->T[i].i_r);
    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
      return dReportError("T[%d].i_r with R out of sync", i);
  }
  // test containment of S inT
  if (strat->S != NULL)
  {
    for (i=0; i<=strat->sl; i++)
    {
      j = kFindInT(strat->S[i], strat->T, strat->tl);
      if (j < 0)
        return dReportError("S[%d] not in T", i);
      if (strat->S_2_R[i] != strat->T[j].i_r)
        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
                            i, strat->S_2_R[i], j, strat->T[j].i_r);
    }
  }
  // test strat->L[i].i_r1
  for (i=0; i<=strat->Ll; i++)
  {
    if (strat->L[i].p1 != NULL && strat->L[i].p2)
    {
      if (strat->L[i].i_r1 < 0 ||
          strat->L[i].i_r1 > strat->tl ||
          strat->L[i].T_1(strat)->p != strat->L[i].p1)
        return dReportError("L[%d].i_r1 out of sync", i);
      if (strat->L[i].i_r2 < 0 ||
          strat->L[i].i_r2 > strat->tl ||
          strat->L[i].T_2(strat)->p != strat->L[i].p2)
        return dReportError("L[%d].i_r2 out of sync", i);
    }
    else
    {
      if (strat->L[i].i_r1 != -1)
        return dReportError("L[%d].i_r1 out of sync", i);
      if (strat->L[i].i_r2 != -1)
        return dReportError("L[%d].i_r2 out of sync", i);
    }
    if (strat->L[i].i_r != -1)
      return dReportError("L[%d].i_r out of sync", i);
  }
  return TRUE;
}

#endif // KDEBUG

/*2
*cancels the i-th polynomial in the standardbase s
*/
void deleteInS (int i,kStrategy strat)
{
#ifdef ENTER_USE_MEMMOVE
  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
#else
  int j;
  for (j=i; j<strat->sl; j++)
  {
    strat->S[j] = strat->S[j+1];
    strat->ecartS[j] = strat->ecartS[j+1];
    strat->sevS[j] = strat->sevS[j+1];
    strat->S_2_R[j] = strat->S_2_R[j+1];
  }
#endif
  if (strat->lenS!=NULL)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
#else
    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
#endif
  }
  if (strat->lenSw!=NULL)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
#else
    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
#endif
  }
  if (strat->fromQ!=NULL)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
#else
    for (j=i; j<strat->sl; j++)
    {
      strat->fromQ[j] = strat->fromQ[j+1];
    }
#endif
  }
  strat->S[strat->sl] = NULL;
  strat->sl--;
}


/*2
*cancels the i-th polynomial in the standardbase s
*/
void deleteInSSba (int i,kStrategy strat)
{
#ifdef ENTER_USE_MEMMOVE
  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
  memmove(&(strat->sig[i]), &(strat->sig[i+1]), (strat->sl - i)*sizeof(poly));
  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
  memmove(&(strat->sevSig[i]),&(strat->sevSig[i+1]),(strat->sl - i)*sizeof(unsigned long));
  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
#else
  int j;
  for (j=i; j<strat->sl; j++)
  {
    strat->S[j] = strat->S[j+1];
    strat->sig[j] = strat->sig[j+1];
    strat->ecartS[j] = strat->ecartS[j+1];
    strat->sevS[j] = strat->sevS[j+1];
    strat->sevSig[j] = strat->sevSig[j+1];
    strat->S_2_R[j] = strat->S_2_R[j+1];
  }
#endif
  if (strat->lenS!=NULL)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
#else
    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
#endif
  }
  if (strat->lenSw!=NULL)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
#else
    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
#endif
  }
  if (strat->fromQ!=NULL)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
#else
    for (j=i; j<strat->sl; j++)
    {
      strat->fromQ[j] = strat->fromQ[j+1];
    }
#endif
  }
  strat->S[strat->sl] = NULL;
  strat->sl--;
}

/*2
*cancels the j-th polynomial in the set
*/
void deleteInL (LSet set, int *length, int j,kStrategy strat)
{
  if (set[j].lcm!=NULL)
  {
#ifdef HAVE_RINGS
    if (pGetCoeff(set[j].lcm) != NULL)
      pLmDelete(set[j].lcm);
    else
#endif
      pLmFree(set[j].lcm);
  }
  if (set[j].sig!=NULL)
  {
#ifdef HAVE_RINGS
    if (pGetCoeff(set[j].sig) != NULL)
      pLmDelete(set[j].sig);
    else
#endif
      pLmFree(set[j].sig);
  }
  if (set[j].p!=NULL)
  {
    if (pNext(set[j].p) == strat->tail)
    {
#ifdef HAVE_RINGS
      if (pGetCoeff(set[j].p) != NULL)
        pLmDelete(set[j].p);
      else
#endif
        pLmFree(set[j].p);
      /*- tail belongs to several int spolys -*/
    }
    else
    {
      // search p in T, if it is there, do not delete it
      if (rHasGlobalOrdering(currRing) || (kFindInT(set[j].p, strat) < 0))
      {
        // assure that for global orderings kFindInT fails
        //assume((rHasLocalOrMixedOrdering(currRing)) && (kFindInT(set[j].p, strat) >= 0));
        set[j].Delete();
      }
    }
  }
  if (*length > 0 && j < *length)
  {
#ifdef ENTER_USE_MEMMOVE
    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
#else
    int i;
    for (i=j; i < (*length); i++)
      set[i] = set[i+1];
#endif
  }
#ifdef KDEBUG
  memset(&(set[*length]),0,sizeof(LObject));
#endif
  (*length)--;
}

/*2
*enters p at position at in L
*/
void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
{
  // this should be corrected
  assume(p.FDeg == p.pFDeg());

  if ((*length)>=0)
  {
    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
    if (at <= (*length))
#ifdef ENTER_USE_MEMMOVE
      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
#else
    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
#endif
  }
  else at = 0;
  (*set)[at] = p;
  (*length)++;
}

/*2
* computes the normal ecart;
* used in mora case and if pLexOrder & sugar in bba case
*/
void initEcartNormal (TObject* h)
{
  h->FDeg = h->pFDeg();
  h->ecart = h->pLDeg() - h->FDeg;
  // h->length is set by h->pLDeg
  h->length=h->pLength=pLength(h->p);
}

void initEcartBBA (TObject* h)
{
  h->FDeg = h->pFDeg();
  (*h).ecart = 0;
  h->length=h->pLength=pLength(h->p);
}

void initEcartPairBba (LObject* Lp,poly /*f*/,poly /*g*/,int /*ecartF*/,int /*ecartG*/)
{
  Lp->FDeg = Lp->pFDeg();
  (*Lp).ecart = 0;
  (*Lp).length = 0;
}

void initEcartPairMora (LObject* Lp,poly /*f*/,poly /*g*/,int ecartF,int ecartG)
{
  Lp->FDeg = Lp->pFDeg();
  (*Lp).ecart = si_max(ecartF,ecartG);
  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -p_FDeg((*Lp).lcm,currRing));
  (*Lp).length = 0;
}

/*2
*if ecart1<=ecart2 it returns TRUE
*/
static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
{
  return (ecart1 <= ecart2);
}

#ifdef HAVE_RINGS
/*2
* put the pair (s[i],p)  into the set B, ecart=ecart(p) (ring case)
*/
void enterOnePairRing (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
{
  assume(i<=strat->sl);
  int      l,j,compare,compareCoeff;
  LObject  Lp;

  if (strat->interred_flag) return;
#ifdef KDEBUG
  Lp.ecart=0; Lp.length=0;
#endif
  /*- computes the lcm(s[i],p) -*/
  Lp.lcm = pInit();
  pSetCoeff0(Lp.lcm, n_Lcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing->cf));

  #if ADIDEBUG
  PrintS("\nLp.lcm (lc) = ");pWrite(Lp.lcm);
  #endif

  // Lp.lcm == 0
  if (nIsZero(pGetCoeff(Lp.lcm)))
  {
#ifdef KDEBUG
      if (TEST_OPT_DEBUG)
      {
        PrintS("--- Lp.lcm == 0\n");
        PrintS("p:");
        wrp(p);
        Print("  strat->S[%d]:", i);
        wrp(strat->S[i]);
        PrintLn();
      }
#endif
      strat->cp++;
      pLmDelete(Lp.lcm);
      return;
  }
  // basic product criterion
  pLcm(p,strat->S[i],Lp.lcm);
  pSetm(Lp.lcm);

  #if ADIDEBUG
  PrintS("\nLp.lcm (lcm) = ");pWrite(Lp.lcm);
  #endif

  assume(!strat->sugarCrit);
  if (pHasNotCF(p,strat->S[i]) && n_IsUnit(pGetCoeff(p),currRing->cf)
      && n_IsUnit(pGetCoeff(strat->S[i]),currRing->cf))
  {
#ifdef KDEBUG
      if (TEST_OPT_DEBUG)
      {
        PrintS("--- product criterion func enterOnePairRing type 1\n");
        PrintS("p:");
        wrp(p);
        Print("  strat->S[%d]:", i);
        wrp(strat->S[i]);
        PrintLn();
      }
#endif
      strat->cp++;
      pLmDelete(Lp.lcm);
      return;
  }
  assume(!strat->fromT);
  /*
  *the set B collects the pairs of type (S[j],p)
  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
  */
  for(j = strat->Bl;j>=0;j--)
  {
    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
    compareCoeff = n_DivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm), currRing->cf);
    if ((compareCoeff == pDivComp_EQUAL) || (compare == compareCoeff))
    {
      if (compare == 1)
      {
        strat->c3++;
#ifdef KDEBUG
        if (TEST_OPT_DEBUG)
        {
          PrintS("--- chain criterion type 1\n");
          PrintS("strat->B[j]:");
          wrp(strat->B[j].lcm);
          PrintS("  Lp.lcm:");
          wrp(Lp.lcm);
          PrintLn();
        }
#endif
        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
        {
          pLmDelete(Lp.lcm);
          return;
        }
        break;
      }
      else if (compare == -1)
      {
#ifdef KDEBUG
        if (TEST_OPT_DEBUG)
        {
          PrintS("--- chain criterion type 2\n");
          Print("strat->B[%d].lcm:",j);
          wrp(strat->B[j].lcm);
          PrintS("  Lp.lcm:");
          wrp(Lp.lcm);
          PrintLn();
        }
#endif
        deleteInL(strat->B,&strat->Bl,j,strat);
        strat->c3++;
      }
    }
    if ((compare == pDivComp_EQUAL) && (compareCoeff != 2))
    {
      if (compareCoeff == pDivComp_LESS)
      {
#ifdef KDEBUG
        if (TEST_OPT_DEBUG)
        {
          PrintS("--- chain criterion type 3\n");
          Print("strat->B[%d].lcm:", j);
          wrp(strat->B[j].lcm);
          PrintS("  Lp.lcm:");
          wrp(Lp.lcm);
          PrintLn();
        }
#endif
        strat->c3++;
        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
        {
          pLmDelete(Lp.lcm);
          return;
        }
        break;
      }
      else
      // Add hint for same LM and LC (later) (TODO Oliver)
      // if (compareCoeff == pDivComp_GREATER)
      {
#ifdef KDEBUG
        if (TEST_OPT_DEBUG)
        {
          PrintS("--- chain criterion type 4\n");
          Print("strat->B[%d].lcm:", j);
          wrp(strat->B[j].lcm);
          PrintS("  Lp.lcm:");
          wrp(Lp.lcm);
          PrintLn();
        }
#endif
        deleteInL(strat->B,&strat->Bl,j,strat);
        strat->c3++;
      }
    }
  }
  /*
  *the pair (S[i],p) enters B if the spoly != 0
  */
  /*-  compute the short s-polynomial -*/
  if ((strat->S[i]==NULL) || (p==NULL))
  {
#ifdef KDEBUG
    if (TEST_OPT_DEBUG)
    {
      PrintS("--- spoly = NULL\n");
    }
#endif
    pLmDelete(Lp.lcm);
    return;
  }
  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
  {
    // Is from a previous computed GB, therefore we know that spoly will
    // reduce to zero. Oliver.
    WarnS("Could we come here? 8738947389");
    Lp.p=NULL;
  }
  else
  {
    Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
  }
  if (Lp.p == NULL)
  {
#ifdef KDEBUG
    if (TEST_OPT_DEBUG)
    {
      PrintS("--- spoly = NULL\n");
    }
#endif
    /*- the case that the s-poly is 0 -*/
    if (strat->pairtest==NULL) initPairtest(strat);
    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
    strat->pairtest[strat->sl+1] = TRUE;
    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
    /*
    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
    *term of p devides the lcm(s,r)
    *(this canceling should be done here because
    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
    *the first case is handeled in chainCrit
    */
    pLmDelete(Lp.lcm);
  }
  else
  {
    /*- the pair (S[i],p) enters B -*/
    Lp.p1 = strat->S[i];
    Lp.p2 = p;

    pNext(Lp.p) = strat->tail;

    if (atR >= 0)
    {
      Lp.i_r2 = atR;
      Lp.i_r1 = strat->S_2_R[i];
    }
    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
  }
}


/*2
* put the  lcm(s[i],p)  into the set B
*/

BOOLEAN enterOneStrongPoly (int i,poly p,int /*ecart*/, int /*isFromQ*/,kStrategy strat, int atR = -1)
{
  number d, s, t;
  assume(i<=strat->sl);
  assume(atR >= 0);
  poly m1, m2, gcd;

  d = n_ExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t, currRing->cf);

  if (nIsZero(s) || nIsZero(t))  // evtl. durch divBy tests ersetzen
  {
    nDelete(&d);
    nDelete(&s);
    nDelete(&t);
    return FALSE;
  }

  k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
  //p_Test(m1,strat->tailRing);
  //p_Test(m2,strat->tailRing);
  while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
  {
    memset(&(strat->P), 0, sizeof(strat->P));
    kStratChangeTailRing(strat);
    strat->P = *(strat->R[atR]);
    p_LmFree(m1, strat->tailRing);
    p_LmFree(m2, strat->tailRing);
    p_LmFree(gcd, currRing);
    k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
  }
  pSetCoeff0(m1, s);
  pSetCoeff0(m2, t);
  pSetCoeff0(gcd, d);
  p_Test(m1,strat->tailRing);
  p_Test(m2,strat->tailRing);

#ifdef KDEBUG
  if (TEST_OPT_DEBUG)
  {
    // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
    PrintS("m1 = ");
    p_wrp(m1, strat->tailRing);
    PrintS(" ; m2 = ");
    p_wrp(m2, strat->tailRing);
    PrintS(" ; gcd = ");
    wrp(gcd);
    PrintS("\n--- create strong gcd poly: ");
    Print("\n p: %d", i);
    wrp(p);
    Print("\n strat->S[%d]: ", i);
    wrp(strat->S[i]);
    PrintS(" ---> ");
  }
#endif

  pNext(gcd) = p_Add_q(pp_Mult_mm(pNext(p), m1, strat->tailRing), pp_Mult_mm(pNext(strat->S[i]), m2, strat->tailRing), strat->tailRing);
  p_LmDelete(m1, strat->tailRing);
  p_LmDelete(m2, strat->tailRing);

#ifdef KDEBUG
  if (TEST_OPT_DEBUG)
  {
    wrp(gcd);
    PrintLn();
  }
#endif

  LObject h;
  h.p = gcd;
  h.tailRing = strat->tailRing;
  int posx;
  h.pCleardenom();
  strat->initEcart(&h);
  if (strat->Ll==-1)
    posx =0;
  else
    posx = strat->posInL(strat->L,strat->Ll,&h,strat);
  h.sev = pGetShortExpVector(h.p);
  if (currRing!=strat->tailRing)
    h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
  enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
  return TRUE;
}
#endif

/*2
* put the pair (s[i],p)  into the set B, ecart=ecart(p)
*/

void enterOnePairNormal (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
{
  assume(i<=strat->sl);
  if (strat->interred_flag) return;

  int      l,j,compare;
  LObject  Lp;
  Lp.i_r = -1;

#ifdef KDEBUG
  Lp.ecart=0; Lp.length=0;
#endif
  /*- computes the lcm(s[i],p) -*/
  Lp.lcm = pInit();

#ifndef HAVE_RATGRING
  pLcm(p,strat->S[i],Lp.lcm);
#elif defined(HAVE_RATGRING)
  //  if (rIsRatGRing(currRing))
  pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
#endif
  pSetm(Lp.lcm);


  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
  {
    if((!((strat->ecartS[i]>0)&&(ecart>0)))
    && pHasNotCF(p,strat->S[i]))
    {
    /*
    *the product criterion has applied for (s,p),
    *i.e. lcm(s,p)=product of the leading terms of s and p.
    *Suppose (s,r) is in L and the leading term
    *of p divides lcm(s,r)
    *(==> the leading term of p divides the leading term of r)
    *but the leading term of s does not divide the leading term of r
    *(notice that tis condition is automatically satisfied if r is still
    *in S), then (s,r) can be cancelled.
    *This should be done here because the
    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
    *
    *Moreover, skipping (s,r) holds also for the noncommutative case.
    */
      strat->cp++;
      pLmFree(Lp.lcm);
      Lp.lcm=NULL;
      return;
    }
    else
      Lp.ecart = si_max(ecart,strat->ecartS[i]);
    if (strat->fromT && (strat->ecartS[i]>ecart))
    {
      pLmFree(Lp.lcm);
      Lp.lcm=NULL;
      return;
      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
    }
    /*
    *the set B collects the pairs of type (S[j],p)
    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
    */
    {
      j = strat->Bl;
      loop
      {
        if (j < 0)  break;
        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
        if ((compare==1)
        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
        {
          strat->c3++;
          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
          {
            pLmFree(Lp.lcm);
            return;
          }
          break;
        }
        else
        if ((compare ==-1)
        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
        {
          deleteInL(strat->B,&strat->Bl,j,strat);
          strat->c3++;
        }
        j--;
      }
    }
  }
  else /*sugarcrit*/
  {
    if (ALLOW_PROD_CRIT(strat))
    {
      // if currRing->nc_type!=quasi (or skew)
      // TODO: enable productCrit for super commutative algebras...
      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
      pHasNotCF(p,strat->S[i]))
      {
      /*
      *the product criterion has applied for (s,p),
      *i.e. lcm(s,p)=product of the leading terms of s and p.
      *Suppose (s,r) is in L and the leading term
      *of p devides lcm(s,r)
      *(==> the leading term of p devides the leading term of r)
      *but the leading term of s does not devide the leading term of r
      *(notice that tis condition is automatically satisfied if r is still
      *in S), then (s,r) can be canceled.
      *This should be done here because the
      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
      */
          strat->cp++;
          pLmFree(Lp.lcm);
          Lp.lcm=NULL;
          return;
      }
      if (strat->fromT && (strat->ecartS[i]>ecart))
      {
        pLmFree(Lp.lcm);
        Lp.lcm=NULL;
        return;
        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
      }
      /*
      *the set B collects the pairs of type (S[j],p)
      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
      */
      for(j = strat->Bl;j>=0;j--)
      {
        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
        if (compare==1)
        {
          strat->c3++;
          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
          {
            pLmFree(Lp.lcm);
            return;
          }
          break;
        }
        else
        if (compare ==-1)
        {
          deleteInL(strat->B,&strat->Bl,j,strat);
          strat->c3++;
        }
      }
    }
  }
  /*
  *the pair (S[i],p) enters B if the spoly != 0
  */
  /*-  compute the short s-polynomial -*/
  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
    pNorm(p);

  if ((strat->S[i]==NULL) || (p==NULL))
    return;

  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
    Lp.p=NULL;
  else
  {
    #ifdef HAVE_PLURAL
    if ( rIsPluralRing(currRing) )
    {
      if(pHasNotCF(p, strat->S[i]))
      {
         if(ncRingType(currRing) == nc_lie)
         {
             // generalized prod-crit for lie-type
             strat->cp++;
             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
         }
         else
        if( ALLOW_PROD_CRIT(strat) )
        {
            // product criterion for homogeneous case in SCA
            strat->cp++;
            Lp.p = NULL;
        }
        else
        {
          Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
                nc_CreateShortSpoly(strat->S[i], p, currRing);

          assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
          pNext(Lp.p) = strat->tail; // !!!
        }
      }
      else
      {
        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
              nc_CreateShortSpoly(strat->S[i], p, currRing);

        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
        pNext(Lp.p) = strat->tail; // !!!

      }


#if MYTEST
      if (TEST_OPT_DEBUG)
      {
        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
        PrintS("p: "); pWrite(p);
        PrintS("SPoly: "); pWrite(Lp.p);
      }
#endif

    }
    else
    #endif
    {
      assume(!rIsPluralRing(currRing));
      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
#if MYTEST
      if (TEST_OPT_DEBUG)
      {
        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
        PrintS("p: "); pWrite(p);
        PrintS("commutative SPoly: "); pWrite(Lp.p);
      }
#endif

      }
  }
  if (Lp.p == NULL)
  {
    /*- the case that the s-poly is 0 -*/
    if (strat->pairtest==NULL) initPairtest(strat);
    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
    strat->pairtest[strat->sl+1] = TRUE;
    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
    /*
    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
    *term of p devides the lcm(s,r)
    *(this canceling should be done here because
    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
    *the first case is handeled in chainCrit
    */
    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
  }
  else
  {
    /*- the pair (S[i],p) enters B -*/
    Lp.p1 = strat->S[i];
    Lp.p2 = p;

    if (
        (!rIsPluralRing(currRing))
//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
       )
    {
      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
      pNext(Lp.p) = strat->tail; // !!!
    }

    if (atR >= 0)
    {
      Lp.i_r1 = strat->S_2_R[i];
      Lp.i_r2 = atR;
    }
    else
    {
      Lp.i_r1 = -1;
      Lp.i_r2 = -1;
    }
    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);

    if (TEST_OPT_INTSTRATEGY)
    {
      if (!rIsPluralRing(currRing))
        nDelete(&(Lp.p->coef));
    }

    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
  }
}

/*2
* put the pair (s[i],p)  into the set B, ecart=ecart(p)
* NOTE: here we need to add the signature-based criteria
*/

#ifdef DEBUGF5
void enterOnePairSig (int i, poly p, poly pSig, int from, int ecart, int isFromQ, kStrategy strat, int atR = -1)
#else
void enterOnePairSig (int i, poly p, poly pSig, int, int ecart, int isFromQ, kStrategy strat, int atR = -1)
#endif
{
  assume(i<=strat->sl);
  if (strat->interred_flag) return;

  int      l;
  poly m1 = NULL,m2 = NULL; // we need the multipliers for the s-polynomial to compute
              // the corresponding signatures for criteria checks
  LObject  Lp;
  poly pSigMult = p_Copy(pSig,currRing);
  poly sSigMult = p_Copy(strat->sig[i],currRing);
  unsigned long pSigMultNegSev,sSigMultNegSev;
  Lp.i_r = -1;

#ifdef KDEBUG
  Lp.ecart=0; Lp.length=0;
#endif
  /*- computes the lcm(s[i],p) -*/
  Lp.lcm = pInit();
  k_GetLeadTerms(p,strat->S[i],currRing,m1,m2,currRing);
#ifndef HAVE_RATGRING
  pLcm(p,strat->S[i],Lp.lcm);
#elif defined(HAVE_RATGRING)
  //  if (rIsRatGRing(currRing))
  pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
#endif
  pSetm(Lp.lcm);

  // set coeffs of multipliers m1 and m2
  pSetCoeff0(m1, nInit(1));
  pSetCoeff0(m2, nInit(1));
//#if 1
#ifdef DEBUGF5
  Print("P1  ");
  pWrite(pHead(p));
  Print("P2  ");
  pWrite(pHead(strat->S[i]));
  Print("M1  ");
  pWrite(m1);
  Print("M2  ");
  pWrite(m2);
#endif
  // get multiplied signatures for testing
  pSigMult = currRing->p_Procs->pp_Mult_mm(pSigMult,m1,currRing);
  pSigMultNegSev = ~p_GetShortExpVector(pSigMult,currRing);
  sSigMult = currRing->p_Procs->pp_Mult_mm(sSigMult,m2,currRing);
  sSigMultNegSev = ~p_GetShortExpVector(sSigMult,currRing);

//#if 1
#ifdef DEBUGF5
  Print("----------------\n");
  pWrite(pSigMult);
  pWrite(sSigMult);
  Print("----------------\n");
  Lp.checked  = 0;
#endif
  int sigCmp = p_LmCmp(pSigMult,sSigMult,currRing);
//#if 1
#if DEBUGF5
  Print("IN PAIR GENERATION - COMPARING SIGS: %d\n",sigCmp);
  pWrite(pSigMult);
  pWrite(sSigMult);
#endif
  if(sigCmp==0)
  {
    // printf("!!!!   EQUAL SIGS   !!!!\n");
    // pSig = sSig, delete element due to Rewritten Criterion
    pDelete(&pSigMult);
    pDelete(&sSigMult);
    pLmFree(Lp.lcm);
    Lp.lcm=NULL;
    pDelete (&m1);
    pDelete (&m2);
    return;
  }
  // testing by syzCrit = F5 Criterion
  // testing by rewCrit1 = Rewritten Criterion
  // NOTE: Arri's Rewritten Criterion is tested below, we need Lp.p for it!
  if  ( strat->syzCrit(pSigMult,pSigMultNegSev,strat) ||
        strat->syzCrit(sSigMult,sSigMultNegSev,strat)
        || strat->rewCrit1(sSigMult,sSigMultNegSev,Lp.lcm,strat,i+1)
      )
  {
    pDelete(&pSigMult);
    pDelete(&sSigMult);
    pLmFree(Lp.lcm);
    Lp.lcm=NULL;
    pDelete (&m1);
    pDelete (&m2);
    return;
  }
  /*
  *the pair (S[i],p) enters B if the spoly != 0
  */
  /*-  compute the short s-polynomial -*/
  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
    pNorm(p);

  if ((strat->S[i]==NULL) || (p==NULL))
    return;

  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
    Lp.p=NULL;
  else
  {
    #ifdef HAVE_PLURAL
    if ( rIsPluralRing(currRing) )
    {
      if(pHasNotCF(p, strat->S[i]))
      {
         if(ncRingType(currRing) == nc_lie)
         {
             // generalized prod-crit for lie-type
             strat->cp++;
             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
         }
         else
        if( ALLOW_PROD_CRIT(strat) )
        {
            // product criterion for homogeneous case in SCA
            strat->cp++;
            Lp.p = NULL;
        }
        else
        {
          Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
                nc_CreateShortSpoly(strat->S[i], p, currRing);

          assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
          pNext(Lp.p) = strat->tail; // !!!
        }
      }
      else
      {
        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
              nc_CreateShortSpoly(strat->S[i], p, currRing);

        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
        pNext(Lp.p) = strat->tail; // !!!

      }


#if MYTEST
      if (TEST_OPT_DEBUG)
      {
        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
        PrintS("p: "); pWrite(p);
        PrintS("SPoly: "); pWrite(Lp.p);
      }
#endif

    }
    else
    #endif
    {
      assume(!rIsPluralRing(currRing));
      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
#if MYTEST
      if (TEST_OPT_DEBUG)
      {
        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
        PrintS("p: "); pWrite(p);
        PrintS("commutative SPoly: "); pWrite(Lp.p);
      }
#endif

      }
  }
  // store from which element this pair comes from for further tests
  //Lp.from = strat->sl+1;
  if(sigCmp==currRing->OrdSgn)
  {
    // pSig > sSig
    pDelete (&sSigMult);
    Lp.sig    = pSigMult;
    Lp.sevSig = ~pSigMultNegSev;
  }
  else
  {
    // pSig < sSig
    pDelete (&pSigMult);
    Lp.sig    = sSigMult;
    Lp.sevSig = ~sSigMultNegSev;
  }
  if (Lp.p == NULL)
  {
    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
    int pos = posInSyz(strat, Lp.sig);
    enterSyz(Lp, strat, pos);
  }
  else
  {
    // testing by rewCrit3 = Arris Rewritten Criterion (for F5 nothing happens!)
    if (strat->rewCrit3(Lp.sig,~Lp.sevSig,Lp.p,strat,strat->sl+1)) {
      pLmFree(Lp.lcm);
      pDelete(&Lp.sig);
      Lp.lcm=NULL;
      pDelete (&m1);
      pDelete (&m2);
      return;
    }
    // in any case Lp is checked up to the next strat->P which is added
    // to S right after this critical pair creation.
    // NOTE: this even holds if the 2nd generator gives the bigger signature
    //       moreover, this improves rewCriterion,
    //       i.e. strat->checked > strat->from if and only if the 2nd generator
    //       gives the bigger signature.
    Lp.checked = strat->sl+1;
    // at this point it is clear that the pair will be added to L, since it has
    // passed all tests up to now

  // adds buchberger's first criterion
    if (pLmCmp(m2,pHead(p)) == 0) {
      Lp.prod_crit = TRUE; // Product Criterion
#if 0
      int pos = posInSyz(strat, Lp.sig);
      enterSyz(Lp, strat, pos);
      Lp.lcm=NULL;
      pDelete (&m1);
      pDelete (&m2);
      return;
#endif
    }
    pDelete (&m1);
    pDelete (&m2);
#if DEBUGF5
    PrintS("SIGNATURE OF PAIR:  ");
    pWrite(Lp.sig);
#endif
    /*- the pair (S[i],p) enters B -*/
    Lp.p1 = strat->S[i];
    Lp.p2 = p;

    if (
        (!rIsPluralRing(currRing))
//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
       )
    {
      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
      pNext(Lp.p) = strat->tail; // !!!
    }

    if (atR >= 0)
    {
      Lp.i_r1 = strat->S_2_R[i];
      Lp.i_r2 = atR;
    }
    else
    {
      Lp.i_r1 = -1;
      Lp.i_r2 = -1;
    }
    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);

    if (TEST_OPT_INTSTRATEGY)
    {
      if (!rIsPluralRing(currRing))
        nDelete(&(Lp.p->coef));
    }

    l = strat->posInLSba(strat->B,strat->Bl,&Lp,strat);
    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
  }
}

/*2
* put the pair (s[i],p) into the set L, ecart=ecart(p)
* in the case that s forms a SB of (s)
*/
void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
{
  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
  if(pHasNotCF(p,strat->S[i]))
  {
    //PrintS("prod-crit\n");
    if(ALLOW_PROD_CRIT(strat))
    {
      //PrintS("prod-crit\n");
      strat->cp++;
      return;
    }
  }

  int      l,j,compare;
  LObject  Lp;
  Lp.i_r = -1;

  Lp.lcm = pInit();
  pLcm(p,strat->S[i],Lp.lcm);
  pSetm(Lp.lcm);
  for(j = strat->Ll;j>=0;j--)
  {
    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
    {
      //PrintS("c3-crit\n");
      strat->c3++;
      pLmFree(Lp.lcm);
      return;
    }
    else if (compare ==-1)
    {
      //Print("c3-crit with L[%d]\n",j);
      deleteInL(strat->L,&strat->Ll,j,strat);
      strat->c3++;
    }
  }
  /*-  compute the short s-polynomial -*/

  #ifdef HAVE_PLURAL
  if (rIsPluralRing(currRing))
  {
    Lp.p = nc_CreateShortSpoly(strat->S[i],p, currRing); // ??? strat->tailRing?
  }
  else
  #endif
    Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);

  if (Lp.p == NULL)
  {
     //PrintS("short spoly==NULL\n");
     pLmFree(Lp.lcm);
  }
  else
  {
    /*- the pair (S[i],p) enters L -*/
    Lp.p1 = strat->S[i];
    Lp.p2 = p;
    if (atR >= 0)
    {
      Lp.i_r1 = strat->S_2_R[i];
      Lp.i_r2 = atR;
    }
    else
    {
      Lp.i_r1 = -1;
      Lp.i_r2 = -1;
    }
    assume(pNext(Lp.p) == NULL);
    pNext(Lp.p) = strat->tail;
    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
    if (TEST_OPT_INTSTRATEGY)
    {
      nDelete(&(Lp.p->coef));
    }
    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
    //Print("-> L[%d]\n",l);
    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
  }
}

/*2
* merge set B into L
*/
void kMergeBintoL(kStrategy strat)
{
  int j=strat->Ll+strat->Bl+1;
  if (j>strat->Lmax)
  {
    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
                                 j*sizeof(LObject));
    strat->Lmax=j;
  }
  j = strat->Ll;
  int i;
  for (i=strat->Bl; i>=0; i--)
  {
    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
  }
  strat->Bl = -1;
}

/*2
* merge set B into L
*/
void kMergeBintoLSba(kStrategy strat)
{
  int j=strat->Ll+strat->Bl+1;
  if (j>strat->Lmax)
  {
    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
                                 j*sizeof(LObject));
    strat->Lmax=j;
  }
  j = strat->Ll;
  int i;
  for (i=strat->Bl; i>=0; i--)
  {
    j = strat->posInLSba(strat->L,j,&(strat->B[i]),strat);
    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
  }
  strat->Bl = -1;
}
/*2
*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
*using the chain-criterion in B and L and enters B to L
*/
void chainCritNormal (poly p,int ecart,kStrategy strat)
{
  int i,j,l;

  /*
  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
  *In this case all elements in B such
  *that their lcm is divisible by the leading term of S[i] can be canceled
  */
  if (strat->pairtest!=NULL)
  {
    {
      /*- i.e. there is an i with pairtest[i]==TRUE -*/
      for (j=0; j<=strat->sl; j++)
      {
        if (strat->pairtest[j])
        {
          for (i=strat->Bl; i>=0; i--)
          {
            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
            {
              deleteInL(strat->B,&strat->Bl,i,strat);
              strat->c3++;
            }
          }
        }
      }
    }
    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
    strat->pairtest=NULL;
  }
  if (strat->Gebauer || strat->fromT)
  {
    if (strat->sugarCrit)
    {
    /*
    *suppose L[j] == (s,r) and p/lcm(s,r)
    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
    *and in case the sugar is o.k. then L[j] can be canceled
    */
      for (j=strat->Ll; j>=0; j--)
      {
        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
        && ((pNext(strat->L[j].p) == strat->tail) || (rHasGlobalOrdering(currRing)))
        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
        {
          if (strat->L[j].p == strat->tail)
          {
              deleteInL(strat->L,&strat->Ll,j,strat);
              strat->c3++;
          }
        }
      }
      /*
      *this is GEBAUER-MOELLER:
      *in B all elements with the same lcm except the "best"
      *(i.e. the last one in B with this property) will be canceled
      */
      j = strat->Bl;
      loop /*cannot be changed into a for !!! */
      {
        if (j <= 0) break;
        i = j-1;
        loop
        {
          if (i <  0) break;
          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
          {
            strat->c3++;
            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
            {
              deleteInL(strat->B,&strat->Bl,i,strat);
              j--;
            }
            else
            {
              deleteInL(strat->B,&strat->Bl,j,strat);
              break;
            }
          }
          i--;
        }
        j--;
      }
    }
    else /*sugarCrit*/
    {
      /*
      *suppose L[j] == (s,r) and p/lcm(s,r)
      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
      *and in case the sugar is o.k. then L[j] can be canceled
      */
      for (j=strat->Ll; j>=0; j--)
      {
        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
        {
          if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
          {
            deleteInL(strat->L,&strat->Ll,j,strat);
            strat->c3++;
          }
        }
      }
      /*
      *this is GEBAUER-MOELLER:
      *in B all elements with the same lcm except the "best"
      *(i.e. the last one in B with this property) will be canceled
      */
      j = strat->Bl;
      loop   /*cannot be changed into a for !!! */
      {
        if (j <= 0) break;
        for(i=j-1; i>=0; i--)
        {
          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
          {
            strat->c3++;
            deleteInL(strat->B,&strat->Bl,i,strat);
            j--;
          }
        }
        j--;
      }
    }
    /*
    *the elements of B enter L
    */
    kMergeBintoL(strat);
  }
  else
  {
    for (j=strat->Ll; j>=0; j--)
    {
      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
      {
        if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
        {
          deleteInL(strat->L,&strat->Ll,j,strat);
          strat->c3++;
        }
      }
    }
    /*
    *this is our MODIFICATION of GEBAUER-MOELLER:
    *First the elements of B enter L,
    *then we fix a lcm and the "best" element in L
    *(i.e the last in L with this lcm and of type (s,p))
    *and cancel all the other elements of type (r,p) with this lcm
    *except the case the element (s,r) has also the same lcm
    *and is on the worst position with respect to (s,p) and (r,p)
    */
    /*
    *B enters to L/their order with respect to B is permutated for elements
    *B[i].p with the same leading term
    */
    kMergeBintoL(strat);
    j = strat->Ll;
    loop  /*cannot be changed into a for !!! */
    {
      if (j <= 0)
      {
        /*now L[0] cannot be canceled any more and the tail can be removed*/
        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
        break;
      }
      if (strat->L[j].p2 == p)
      {
        i = j-1;
        loop
        {
          if (i < 0)  break;
          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
          {
            /*L[i] could be canceled but we search for a better one to cancel*/
            strat->c3++;
            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
            && (pNext(strat->L[l].p) == strat->tail)
            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
            && pDivisibleBy(p,strat->L[l].lcm))
            {
              /*
              *"NOT equal(...)" because in case of "equal" the element L[l]
              *is "older" and has to be from theoretical point of view behind
              *L[i], but we do not want to reorder L
              */
              strat->L[i].p2 = strat->tail;
              /*
              *L[l] will be canceled, we cannot cancel L[i] later on,
              *so we mark it with "tail"
              */
              deleteInL(strat->L,&strat->Ll,l,strat);
              i--;
            }
            else
            {
              deleteInL(strat->L,&strat->Ll,i,strat);
            }
            j--;
          }
          i--;
        }
      }
      else if (strat->L[j].p2 == strat->tail)
      {
        /*now L[j] cannot be canceled any more and the tail can be removed*/
        strat->L[j].p2 = p;
      }
      j--;
    }
  }
}
/*2
*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
*using the chain-criterion in B and L and enters B to L
*/
void chainCritSig (poly p,int /*ecart*/,kStrategy strat)
{
  int i,j,l;
  kMergeBintoLSba(strat);
  j = strat->Ll;
  loop  /*cannot be changed into a for !!! */
  {
    if (j <= 0)
    {
      /*now L[0] cannot be canceled any more and the tail can be removed*/
      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
      break;
    }
    if (strat->L[j].p2 == p)
    {
      i = j-1;
      loop
      {
        if (i < 0)  break;
        if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
        {
          /*L[i] could be canceled but we search for a better one to cancel*/
          strat->c3++;
          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
              && (pNext(strat->L[l].p) == strat->tail)
              && (!pLmEqual(strat->L[i].p,strat->L[l].p))
              && pDivisibleBy(p,strat->L[l].lcm))
          {
            /*
             *"NOT equal(...)" because in case of "equal" the element L[l]
             *is "older" and has to be from theoretical point of view behind
             *L[i], but we do not want to reorder L
             */
            strat->L[i].p2 = strat->tail;
            /*
             *L[l] will be canceled, we cannot cancel L[i] later on,
             *so we mark it with "tail"
             */
            deleteInL(strat->L,&strat->Ll,l,strat);
            i--;
          }
          else
          {
            deleteInL(strat->L,&strat->Ll,i,strat);
          }
          j--;
        }
        i--;
      }
    }
    else if (strat->L[j].p2 == strat->tail)
    {
      /*now L[j] cannot be canceled any more and the tail can be removed*/
      strat->L[j].p2 = p;
    }
    j--;
  }
}
#ifdef HAVE_RATGRING
void chainCritPart (poly p,int ecart,kStrategy strat)
{
  int i,j,l;

  /*
  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
  *In this case all elements in B such
  *that their lcm is divisible by the leading term of S[i] can be canceled
  */
  if (strat->pairtest!=NULL)
  {
    {
      /*- i.e. there is an i with pairtest[i]==TRUE -*/
      for (j=0; j<=strat->sl; j++)
      {
        if (strat->pairtest[j])
        {
          for (i=strat->Bl; i>=0; i--)
          {
            if (_p_LmDivisibleByPart(strat->S[j],currRing,
               strat->B[i].lcm,currRing,
               currRing->real_var_start,currRing->real_var_end))
            {
              if(TEST_OPT_DEBUG)
              {
                 Print("chain-crit-part: S[%d]=",j);
                 p_wrp(strat->S[j],currRing);
                 Print(" divide B[%d].lcm=",i);
                 p_wrp(strat->B[i].lcm,currRing);
                 PrintLn();
              }
              deleteInL(strat->B,&strat->Bl,i,strat);
              strat->c3++;
            }
          }
        }
      }
    }
    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
    strat->pairtest=NULL;
  }
  if (strat->Gebauer || strat->fromT)
  {
    if (strat->sugarCrit)
    {
    /*
    *suppose L[j] == (s,r) and p/lcm(s,r)
    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
    *and in case the sugar is o.k. then L[j] can be canceled
    */
      for (j=strat->Ll; j>=0; j--)
      {
        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
        && ((pNext(strat->L[j].p) == strat->tail) || (rHasGlobalOrdering(currRing)))
        && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
        {
          if (strat->L[j].p == strat->tail)
          {
              if(TEST_OPT_DEBUG)
              {
                 PrintS("chain-crit-part: pCompareChainPart p=");
                 p_wrp(p,currRing);
                 Print(" delete L[%d]",j);
                 p_wrp(strat->L[j].lcm,currRing);
                 PrintLn();
              }
              deleteInL(strat->L,&strat->Ll,j,strat);
              strat->c3++;
          }
        }
      }
      /*
      *this is GEBAUER-MOELLER:
      *in B all elements with the same lcm except the "best"
      *(i.e. the last one in B with this property) will be canceled
      */
      j = strat->Bl;
      loop /*cannot be changed into a for !!! */
      {
        if (j <= 0) break;
        i = j-1;
        loop
        {
          if (i <  0) break;
          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
          {
            strat->c3++;
            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
            {
              if(TEST_OPT_DEBUG)
              {
                 Print("chain-crit-part: sugar B[%d].lcm=",j);
                 p_wrp(strat->B[j].lcm,currRing);
                 Print(" delete B[%d]",i);
                 p_wrp(strat->B[i].lcm,currRing);
                 PrintLn();
              }
              deleteInL(strat->B,&strat->Bl,i,strat);
              j--;
            }
            else
            {
              if(TEST_OPT_DEBUG)
              {
                 Print("chain-crit-part: sugar B[%d].lcm=",i);
                 p_wrp(strat->B[i].lcm,currRing);
                 Print(" delete B[%d]",j);
                 p_wrp(strat->B[j].lcm,currRing);
                 PrintLn();
              }
              deleteInL(strat->B,&strat->Bl,j,strat);
              break;
            }
          }
          i--;
        }
        j--;
      }
    }
    else /*sugarCrit*/
    {
      /*
      *suppose L[j] == (s,r) and p/lcm(s,r)
      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
      *and in case the sugar is o.k. then L[j] can be canceled
      */
      for (j=strat->Ll; j>=0; j--)
      {
        if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
        {
          if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
          {
              if(TEST_OPT_DEBUG)
              {
                 PrintS("chain-crit-part: sugar:pCompareChainPart p=");
                 p_wrp(p,currRing);
                 Print(" delete L[%d]",j);
                 p_wrp(strat->L[j].lcm,currRing);
                 PrintLn();
              }
            deleteInL(strat->L,&strat->Ll,j,strat);
            strat->c3++;
          }
        }
      }
      /*
      *this is GEBAUER-MOELLER:
      *in B all elements with the same lcm except the "best"
      *(i.e. the last one in B with this property) will be canceled
      */
      j = strat->Bl;
      loop   /*cannot be changed into a for !!! */
      {
        if (j <= 0) break;
        for(i=j-1; i>=0; i--)
        {
          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
          {
              if(TEST_OPT_DEBUG)
              {
                 Print("chain-crit-part: equal lcm B[%d].lcm=",j);
                 p_wrp(strat->B[j].lcm,currRing);
                 Print(" delete B[%d]\n",i);
              }
            strat->c3++;
            deleteInL(strat->B,&strat->Bl,i,strat);
            j--;
          }
        }
        j--;
      }
    }
    /*
    *the elements of B enter L
    */
    kMergeBintoL(strat);
  }
  else
  {
    for (j=strat->Ll; j>=0; j--)
    {
      if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
      {
        if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
        {
              if(TEST_OPT_DEBUG)
              {
                 PrintS("chain-crit-part: pCompareChainPart p=");
                 p_wrp(p,currRing);
                 Print(" delete L[%d]",j);
                 p_wrp(strat->L[j].lcm,currRing);
                 PrintLn();
              }
          deleteInL(strat->L,&strat->Ll,j,strat);
          strat->c3++;
        }
      }
    }
    /*
    *this is our MODIFICATION of GEBAUER-MOELLER:
    *First the elements of B enter L,
    *then we fix a lcm and the "best" element in L
    *(i.e the last in L with this lcm and of type (s,p))
    *and cancel all the other elements of type (r,p) with this lcm
    *except the case the element (s,r) has also the same lcm
    *and is on the worst position with respect to (s,p) and (r,p)
    */
    /*
    *B enters to L/their order with respect to B is permutated for elements
    *B[i].p with the same leading term
    */
    kMergeBintoL(strat);
    j = strat->Ll;
    loop  /*cannot be changed into a for !!! */
    {
      if (j <= 0)
      {
        /*now L[0] cannot be canceled any more and the tail can be removed*/
        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
        break;
      }
      if (strat->L[j].p2 == p)
      {
        i = j-1;
        loop
        {
          if (i < 0)  break;
          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
          {
            /*L[i] could be canceled but we search for a better one to cancel*/
            strat->c3++;
            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
            && (pNext(strat->L[l].p) == strat->tail)
            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
            && _p_LmDivisibleByPart(p,currRing,
                           strat->L[l].lcm,currRing,
                           currRing->real_var_start, currRing->real_var_end))

            {
              /*
              *"NOT equal(...)" because in case of "equal" the element L[l]
              *is "older" and has to be from theoretical point of view behind
              *L[i], but we do not want to reorder L
              */
              strat->L[i].p2 = strat->tail;
              /*
              *L[l] will be canceled, we cannot cancel L[i] later on,
              *so we mark it with "tail"
              */
              if(TEST_OPT_DEBUG)
              {
                 PrintS("chain-crit-part: divisible_by p=");
                 p_wrp(p,currRing);
                 Print(" delete L[%d]",l);
                 p_wrp(strat->L[l].lcm,currRing);
                 PrintLn();
              }
              deleteInL(strat->L,&strat->Ll,l,strat);
              i--;
            }
            else
            {
              if(TEST_OPT_DEBUG)
              {
                 PrintS("chain-crit-part: divisible_by(2) p=");
                 p_wrp(p,currRing);
                 Print(" delete L[%d]",i);
                 p_wrp(strat->L[i].lcm,currRing);
                 PrintLn();
              }
              deleteInL(strat->L,&strat->Ll,i,strat);
            }
            j--;
          }
          i--;
        }
      }
      else if (strat->L[j].p2 == strat->tail)
      {
        /*now L[j] cannot be canceled any more and the tail can be removed*/
        strat->L[j].p2 = p;
      }
      j--;
    }
  }
}
#endif

/*2
*(s[0],h),...,(s[k],h) will be put to the pairset L
*/
void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
{

  if ((strat->syzComp==0)
  || (pGetComp(h)<=strat->syzComp))
  {
    int j;
    BOOLEAN new_pair=FALSE;

    if (pGetComp(h)==0)
    {
      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
      if ((isFromQ)&&(strat->fromQ!=NULL))
      {
        for (j=0; j<=k; j++)
        {
          if (!strat->fromQ[j])
          {
            new_pair=TRUE;
            strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
          //Print("j:%d, Ll:%d\n",j,strat->Ll);
          }
        }
      }
      else
      {
        new_pair=TRUE;
        for (j=0; j<=k; j++)
        {
          #if ADIDEBUG
          PrintS("\n initenterpairs: \n");
          PrintS("                ");p_Write(h, strat->tailRing);
          PrintS("                ");p_Write(strat->S[j],strat->tailRing);
          #endif
          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
          //Print("j:%d, Ll:%d\n",j,strat->Ll);
        }
      }
    }
    else
    {
      for (j=0; j<=k; j++)
      {
        if ((pGetComp(h)==pGetComp(strat->S[j]))
        || (pGetComp(strat->S[j])==0))
        {
          new_pair=TRUE;
          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
        //Print("j:%d, Ll:%d\n",j,strat->Ll);
        }
      }
    }

    if (new_pair)
    {
#ifdef HAVE_RATGRING
      if (currRing->real_var_start>0)
        chainCritPart(h,ecart,strat);
      else
#endif
      strat->chainCrit(h,ecart,strat);
    }
  }
}

/*2
*(s[0],h),...,(s[k],h) will be put to the pairset L
*using signatures <= only for signature-based standard basis algorithms
*/
void initenterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
{

  if ((strat->syzComp==0)
  || (pGetComp(h)<=strat->syzComp))
  {
    int j;
    BOOLEAN new_pair=FALSE;

    if (pGetComp(h)==0)
    {
      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
      if ((isFromQ)&&(strat->fromQ!=NULL))
      {
        for (j=0; j<=k; j++)
        {
          if (!strat->fromQ[j])
          {
            new_pair=TRUE;
            enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
          //Print("j:%d, Ll:%d\n",j,strat->Ll);
          }
        }
      }
      else
      {
        new_pair=TRUE;
        for (j=0; j<=k; j++)
        {
          enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
          //Print("j:%d, Ll:%d\n",j,strat->Ll);
        }
      }
    }
    else
    {
      for (j=0; j<=k; j++)
      {
        if ((pGetComp(h)==pGetComp(strat->S[j]))
        || (pGetComp(strat->S[j])==0))
        {
          new_pair=TRUE;
          enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
        //Print("j:%d, Ll:%d\n",j,strat->Ll);
        }
      }
    }

    if (new_pair)
    {
#ifdef HAVE_RATGRING
      if (currRing->real_var_start>0)
        chainCritPart(h,ecart,strat);
      else
#endif
      strat->chainCrit(h,ecart,strat);
    }
  }
}

#ifdef HAVE_RINGS
/*2
*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
*using the chain-criterion in B and L and enters B to L
*/
void chainCritRing (poly p,int, kStrategy strat)
{
  int i,j,l;
  /*
  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
  *In this case all elements in B such
  *that their lcm is divisible by the leading term of S[i] can be canceled
  */
  if (strat->pairtest!=NULL)
  {
    {
      /*- i.e. there is an i with pairtest[i]==TRUE -*/
      for (j=0; j<=strat->sl; j++)
      {
        if (strat->pairtest[j])
        {
          for (i=strat->Bl; i>=0; i--)
          {
            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
            {
#ifdef KDEBUG
              if (TEST_OPT_DEBUG)
              {
                PrintS("--- chain criterion func chainCritRing type 1\n");
                PrintS("strat->S[j]:");
                wrp(strat->S[j]);
                PrintS("  strat->B[i].lcm:");
                wrp(strat->B[i].lcm);
                PrintLn();
              }
#endif
              deleteInL(strat->B,&strat->Bl,i,strat);
              strat->c3++;
            }
          }
        }
      }
    }
    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
    strat->pairtest=NULL;
  }
  assume(!(strat->Gebauer || strat->fromT));
  for (j=strat->Ll; j>=0; j--)
  {
    if ((strat->L[j].lcm != NULL) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p), currRing->cf))
    {
      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
      {
        if ((pNext(strat->L[j].p) == strat->tail) || (rHasGlobalOrdering(currRing)))
        {
          deleteInL(strat->L,&strat->Ll,j,strat);
          strat->c3++;
#ifdef KDEBUG
              if (TEST_OPT_DEBUG)
              {
                PrintS("--- chain criterion func chainCritRing type 2\n");
                PrintS("strat->L[j].p:");
                wrp(strat->L[j].p);
                PrintS("  p:");
                wrp(p);
                PrintLn();
              }
#endif
        }
      }
    }
  }
  /*
  *this is our MODIFICATION of GEBAUER-MOELLER:
  *First the elements of B enter L,
  *then we fix a lcm and the "best" element in L
  *(i.e the last in L with this lcm and of type (s,p))
  *and cancel all the other elements of type (r,p) with this lcm
  *except the case the element (s,r) has also the same lcm
  *and is on the worst position with respect to (s,p) and (r,p)
  */
  /*
  *B enters to L/their order with respect to B is permutated for elements
  *B[i].p with the same leading term
  */
  kMergeBintoL(strat);
  j = strat->Ll;
  loop  /*cannot be changed into a for !!! */
  {
    if (j <= 0)
    {
      /*now L[0] cannot be canceled any more and the tail can be removed*/
      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
      break;
    }
    if (strat->L[j].p2 == p) // Was the element added from B?
    {
      i = j-1;
      loop
      {
        if (i < 0)  break;
        // Element is from B and has the same lcm as L[j]
        if ((strat->L[i].p2 == p) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm), currRing->cf)
             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
        {
          /*L[i] could be canceled but we search for a better one to cancel*/
          strat->c3++;
#ifdef KDEBUG
          if (TEST_OPT_DEBUG)
          {
            PrintS("--- chain criterion func chainCritRing type 3\n");
            PrintS("strat->L[j].lcm:");
            wrp(strat->L[j].lcm);
            PrintS("  strat->L[i].lcm:");
            wrp(strat->L[i].lcm);
            PrintLn();
          }
#endif
          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
          && (pNext(strat->L[l].p) == strat->tail)
          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
          && pDivisibleBy(p,strat->L[l].lcm))
          {
            /*
            *"NOT equal(...)" because in case of "equal" the element L[l]
            *is "older" and has to be from theoretical point of view behind
            *L[i], but we do not want to reorder L
            */
            strat->L[i].p2 = strat->tail;
            /*
            *L[l] will be canceled, we cannot cancel L[i] later on,
            *so we mark it with "tail"
            */
            deleteInL(strat->L,&strat->Ll,l,strat);
            i--;
          }
          else
          {
            deleteInL(strat->L,&strat->Ll,i,strat);
          }
          j--;
        }
        i--;
      }
    }
    else if (strat->L[j].p2 == strat->tail)
    {
      /*now L[j] cannot be canceled any more and the tail can be removed*/
      strat->L[j].p2 = p;
    }
    j--;
  }
}
#endif

#ifdef HAVE_RINGS
long ind2(long arg)
{
  long ind = 0;
  if (arg <= 0) return 0;
  while (arg%2 == 0)
  {
    arg = arg / 2;
    ind++;
  }
  return ind;
}

long ind_fact_2(long arg)
{
  long ind = 0;
  if (arg <= 0) return 0;
  if (arg%2 == 1) { arg--; }
  while (arg > 0)
  {
    ind += ind2(arg);
    arg = arg - 2;
  }
  return ind;
}
#endif

#ifdef HAVE_VANIDEAL
long twoPow(long arg)
{
  return 1L << arg;
}

/*2
* put the pair (p, f) in B and f in T
*/
void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
{
  int      l,j,compare,compareCoeff;
  LObject  Lp;

  if (strat->interred_flag) return;
#ifdef KDEBUG
  Lp.ecart=0; Lp.length=0;
#endif
  /*- computes the lcm(s[i],p) -*/
  Lp.lcm = pInit();

  pLcm(p,f,Lp.lcm);
  pSetm(Lp.lcm);
  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
  assume(!strat->sugarCrit);
  assume(!strat->fromT);
  /*
  *the set B collects the pairs of type (S[j],p)
  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
  */
  for(j = strat->Bl;j>=0;j--)
  {
    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
    if (compareCoeff == 0 || compare == compareCoeff)
    {
      if (compare == 1)
      {
        strat->c3++;
        pLmDelete(Lp.lcm);
        return;
      }
      else
      if (compare == -1)
      {
        deleteInL(strat->B,&strat->Bl,j,strat);
        strat->c3++;
      }
    }
    if (compare == pDivComp_EQUAL)
    {
      // Add hint for same LM and direction of LC (later) (TODO Oliver)
      if (compareCoeff == 1)
      {
        strat->c3++;
        pLmDelete(Lp.lcm);
        return;
      }
      else
      if (compareCoeff == -1)
      {
        deleteInL(strat->B,&strat->Bl,j,strat);
        strat->c3++;
      }
    }
  }
  /*
  *the pair (S[i],p) enters B if the spoly != 0
  */
  /*-  compute the short s-polynomial -*/
  if ((f==NULL) || (p==NULL)) return;
  pNorm(p);
  {
    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
  }
  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
  {
    /*- the case that the s-poly is 0 -*/
//    if (strat->pairtest==NULL) initPairtest(strat);
//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
//    strat->pairtest[strat->sl+1] = TRUE;
    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
    /*
    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
    *term of p devides the lcm(s,r)
    *(this canceling should be done here because
    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
    *the first case is handeled in chainCrit
    */
    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
  }
  else
  {
    /*- the pair (S[i],p) enters B -*/
    Lp.p1 = f;
    Lp.p2 = p;

    pNext(Lp.p) = strat->tail;

    LObject tmp_h(f, currRing, strat->tailRing);
    tmp_h.SetShortExpVector();
    strat->initEcart(&tmp_h);
    tmp_h.sev = pGetShortExpVector(tmp_h.p);
    tmp_h.t_p = t_p;

    enterT(tmp_h, strat, strat->tl + 1);

    if (atR >= 0)
    {
      Lp.i_r2 = atR;
      Lp.i_r1 = strat->tl;
    }

    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
  }
}

/* Helper for kCreateZeroPoly
 * enumerating the exponents
ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
 */

int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
/* gives the next exponent from the set H_1 */
{
  long add = ind2(cexp[1] + 2);
  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
  {
    cexp[1] += 2;
    cind[1] += add;
    *cabsind += add;
  }
  else
  {
    // cabsind >= habsind
    if (N == 1) return 0;
    int i = 1;
    while (exp[i] == cexp[i] && i <= N) i++;
    cexp[i] = exp[i];
    *cabsind -= cind[i];
    cind[i] = ind[i];
    step[i] = 500000;
    *cabsind += cind[i];
    // Print("in: %d\n", *cabsind);
    i += 1;
    if (i > N) return 0;
    do
    {
      step[1] = 500000;
      for (int j = i + 1; j <= N; j++)
      {
        if (step[1] > step[j]) step[1] = step[j];
      }
      add = ind2(cexp[i] + 2);
      if (*cabsind - step[1] + add >= bound)
      {
        cexp[i] = exp[i];
        *cabsind -= cind[i];
        cind[i] = ind[i];
        *cabsind += cind[i];
        step[i] = 500000;
        i += 1;
        if (i > N) return 0;
      }
      else step[1] = -1;
    } while (step[1] != -1);
    step[1] = 500000;
    cexp[i] += 2;
    cind[i] += add;
    *cabsind += add;
    if (add < step[i]) step[i] = add;
    for (i = 2; i <= N; i++)
    {
      if (step[1] > step[i]) step[1] = step[i];
    }
  }
  return 1;
}

/*
 * Creates the zero Polynomial on position exp
 * long exp[] : exponent of leading term
 * cabsind    : total 2-ind of exp (if -1 will be computed)
 * poly* t_p  : will hold the LT in tailRing
 * leadRing   : ring for the LT
 * tailRing   : ring for the tail
 */

poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
{

  poly zeroPoly = NULL;

  number tmp1;
  poly tmp2, tmp3;

  if (cabsind == -1)
  {
    cabsind = 0;
    for (int i = 1; i <= leadRing->N; i++)
    {
      cabsind += ind_fact_2(exp[i]);
    }
//    Print("cabsind: %d\n", cabsind);
  }
  if (cabsind < leadRing->ch)
  {
    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
  }
  else
  {
    zeroPoly = p_ISet(1, tailRing);
  }
  for (int i = 1; i <= leadRing->N; i++)
  {
    for (long j = 1; j <= exp[i]; j++)
    {
      tmp1 = nInit(j);
      tmp2 = p_ISet(1, tailRing);
      p_SetExp(tmp2, i, 1, tailRing);
      p_Setm(tmp2, tailRing);
      if (nIsZero(tmp1))
      { // should nowbe obsolet, test ! TODO OLIVER
        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
      }
      else
      {
        tmp3 = p_NSet(nCopy(tmp1), tailRing);
        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
      }
    }
  }
  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
  for (int i = 1; i <= leadRing->N; i++)
  {
    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
  }
  p_Setm(tmp2, leadRing);
  *t_p = zeroPoly;
  zeroPoly = pNext(zeroPoly);
  pNext(*t_p) = NULL;
  pNext(tmp2) = zeroPoly;
  return tmp2;
}

// #define OLI_DEBUG

/*
 * Generate the s-polynomial for the virtual set of zero-polynomials
 */

void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
{
  // Initialize
  long exp[50];            // The exponent of \hat{X} (basepoint)
  long cexp[50];           // The current exponent for iterating over all
  long ind[50];            // The power of 2 in the i-th component of exp
  long cind[50];           // analog for cexp
  long mult[50];           // How to multiply the elements of G
  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
  long habsind = 0;        // The abs. index of the coefficient of h
  long step[50];           // The last increases
  for (int i = 1; i <= currRing->N; i++)
  {
    exp[i] = p_GetExp(p, i, currRing);
    if (exp[i] & 1 != 0)
    {
      exp[i] = exp[i] - 1;
      mult[i] = 1;
    }
    cexp[i] = exp[i];
    ind[i] = ind_fact_2(exp[i]);
    cabsind += ind[i];
    cind[i] = ind[i];
    step[i] = 500000;
  }
  step[1] = 500000;
  habsind = ind2(n_Int(pGetCoeff(p), currRing->cf);
  long bound = currRing->ch - habsind;
#ifdef OLI_DEBUG
  PrintS("-------------\npoly  :");
  wrp(p);
  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
  Print("bound : %d\n", bound);
  Print("cind  : %d\n", cabsind);
#endif
  if (cabsind == 0)
  {
    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
    {
      return;
    }
  }
  // Now the whole simplex
  do
  {
    // Build s-polynomial
    // 2**ind-def * mult * g - exp-def * h
    poly t_p;
    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
#ifdef OLI_DEBUG
    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
    Print("zPoly : ");
    wrp(zeroPoly);
    Print("\n");
#endif
    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
  }
  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
}

/*
 * Create the Groebner basis of the vanishing polynomials.
 */

ideal createG0()
{
  // Initialize
  long exp[50];            // The exponent of \hat{X} (basepoint)
  long cexp[50];           // The current exponent for iterating over all
  long ind[50];            // The power of 2 in the i-th component of exp
  long cind[50];           // analog for cexp
  long mult[50];           // How to multiply the elements of G
  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
  long habsind = 0;        // The abs. index of the coefficient of h
  long step[50];           // The last increases
  for (int i = 1; i <= currRing->N; i++)
  {
    exp[i] = 0;
    cexp[i] = exp[i];
    ind[i] = 0;
    step[i] = 500000;
    cind[i] = ind[i];
  }
  long bound = currRing->ch;
  step[1] = 500000;
#ifdef OLI_DEBUG
  PrintS("-------------\npoly  :");
//  wrp(p);
  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
  Print("bound : %d\n", bound);
  Print("cind  : %d\n", cabsind);
#endif
  if (cabsind == 0)
  {
    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
    {
      return idInit(1, 1);
    }
  }
  ideal G0 = idInit(1, 1);
  // Now the whole simplex
  do
  {
    // Build s-polynomial
    // 2**ind-def * mult * g - exp-def * h
    poly t_p;
    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
#ifdef OLI_DEBUG
    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
    Print("zPoly : ");
    wrp(zeroPoly);
    Print("\n");
#endif
    // Add to ideal
    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
    IDELEMS(G0) += 1;
    G0->m[IDELEMS(G0) - 1] = zeroPoly;
  }
  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
  idSkipZeroes(G0);
  return G0;
}
#endif

#ifdef HAVE_RINGS
/*2
*(s[0],h),...,(s[k],h) will be put to the pairset L
*/
void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
{
  const unsigned long iCompH = pGetComp(h);
  if (!nIsOne(pGetCoeff(h)))
  {
    int j;

    for (j=0; j<=k; j++)
    {
      // Print("j:%d, Ll:%d\n",j,strat->Ll);
//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
      if (((iCompH == pGetComp(strat->S[j]))
      || (0 == pGetComp(strat->S[j])))
      && ((iCompH<=strat->syzComp)||(strat->syzComp==0)))
      {
        enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR);
      }
    }
  }
/*
ring r=256,(x,y,z),dp;
ideal I=12xz-133y, 2xy-z;
*/

}

/*2
* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
*/
void enterExtendedSpoly(poly h,kStrategy strat)
{
  if (nIsOne(pGetCoeff(h))) return;
  number gcd;
  bool go = false;
  if (n_DivBy((number) 0, pGetCoeff(h), currRing->cf))
  {
    gcd = n_Ann(pGetCoeff(h),currRing->cf);
    go = true;
  }
  else
    gcd = n_Gcd((number) 0, pGetCoeff(h), strat->tailRing->cf);
  if (go || !nIsOne(gcd))
  {
    poly p = h->next;
    if (!go)
    {
      number tmp = gcd;
      gcd = n_Ann(gcd,currRing->cf);
      nDelete(&tmp);
    }
    p_Test(p,strat->tailRing);
    p = pp_Mult_nn(p, gcd, strat->tailRing);
    nDelete(&gcd);

    if (p != NULL)
    {
      if (TEST_OPT_PROT)
      {
        PrintS("Z");
      }
#ifdef KDEBUG
      if (TEST_OPT_DEBUG)
      {
        PrintS("--- create zero spoly: ");
        p_wrp(h,currRing,strat->tailRing);
        PrintS(" ---> ");
      }
#endif
      poly tmp = pInit();
      pSetCoeff0(tmp, pGetCoeff(p));
      for (int i = 1; i <= rVar(currRing); i++)
      {
        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
      }
      if (rRing_has_Comp(currRing) && rRing_has_Comp(strat->tailRing))
      {
        p_SetComp(tmp, p_GetComp(p, strat->tailRing), currRing);
      }
      p_Setm(tmp, currRing);
      p = p_LmFreeAndNext(p, strat->tailRing);
      pNext(tmp) = p;
      LObject h;
      h.Init();
      h.p = tmp;
      h.tailRing = strat->tailRing;
      int posx;
      if (h.p!=NULL)
      {
        if (TEST_OPT_INTSTRATEGY)
        {
          //pContent(h.p);
          h.pCleardenom(); // also does a pContent
        }
        else
        {
          h.pNorm();
        }
        strat->initEcart(&h);
        if (strat->Ll==-1)
          posx =0;
        else
          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
        h.sev = pGetShortExpVector(h.p);
        if (strat->tailRing != currRing)
        {
          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
        }
#ifdef KDEBUG
        if (TEST_OPT_DEBUG)
        {
          p_wrp(tmp,currRing,strat->tailRing);
          PrintLn();
        }
#endif
        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
      }
    }
  }
  nDelete(&gcd);
}

void clearSbatch (poly h,int k,int pos,kStrategy strat)
{
  int j = pos;
  if ( (!strat->fromT)
  && ((strat->syzComp==0)
    ||(pGetComp(h)<=strat->syzComp)
  ))
  {
    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
    unsigned long h_sev = pGetShortExpVector(h);
    loop
    {
      if (j > k) break;
      clearS(h,h_sev, &j,&k,strat);
      j++;
    }
    // Print("end clearS sl=%d\n",strat->sl);
  }
}

/*2
* Generates a sufficient set of spolys (maybe just a finite generating
* set of the syzygys)
*/
void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
{
#if ADIDEBUG
  PrintS("\nEnter superenterpairs\n");
  int iii = strat->Ll;
#endif
  assume (rField_is_Ring(currRing));
  // enter also zero divisor * poly, if this is non zero and of smaller degree
  if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
#if ADIDEBUG
  if(iii==strat->Ll)
  {
    PrintS("\n                enterExtendedSpoly has not changed the list L.\n");
  }
  else
  {
    PrintLn();
    PrintS("\n                enterExtendedSpoly changed the list L:\n");
    for(iii=0;iii<=strat->Ll;iii++)
    {
      Print("\n                L[%d]:\n",iii);
      PrintS("                     ");p_Write(strat->L[iii].p1,strat->tailRing);
      PrintS("                     ");p_Write(strat->L[iii].p2,strat->tailRing);
      PrintS("                     ");p_Write(strat->L[iii].p,strat->tailRing);
    }
  }
  iii = strat->Ll;
#endif
  initenterpairs(h, k, ecart, 0, strat, atR);
#if ADIDEBUG
  if(iii==strat->Ll)
  {
    PrintS("\n                initenterpairs has not changed the list L.\n");
  }
  else
  {
    PrintS("\n                initenterpairs changed the list L:\n");
    for(iii=0;iii<=strat->Ll;iii++)
    {
      Print("\n                L[%d]:\n",iii);
      PrintS("                     ");p_Write(strat->L[iii].p1,strat->tailRing);
      PrintS("                     ");p_Write(strat->L[iii].p2,strat->tailRing);
      PrintS("                     ");p_Write(strat->L[iii].p,strat->tailRing);
    }
  }
  iii = strat->Ll;
#endif
  initenterstrongPairs(h, k, ecart, 0, strat, atR);
#if ADIDEBUG
  if(iii==strat->Ll)
  {
    PrintS("\n                initenterstrongPairs has not changed the list L.\n");
  }
  else
  {
    PrintS("\n                initenterstrongPairs changed the list L:\n");
    for(iii=0;iii<=strat->Ll;iii++)
    {
      Print("\n                L[%d]:\n",iii);
      PrintS("                     ");p_Write(strat->L[iii].p1,strat->tailRing);
      PrintS("                     ");p_Write(strat->L[iii].p2,strat->tailRing);
      PrintS("                     ");p_Write(strat->L[iii].p,strat->tailRing);
    }
  }
  PrintS("\nEnd of superenterpairs\n");
#endif
  clearSbatch(h, k, pos, strat);
}
#endif

/*2
*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
*superfluous elements in S will be deleted
*/
void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
{
  int j=pos;

#ifdef HAVE_RINGS
  assume (!rField_is_Ring(currRing));
#endif

  initenterpairs(h,k,ecart,0,strat, atR);
  if ( (!strat->fromT)
  && ((strat->syzComp==0)
    ||(pGetComp(h)<=strat->syzComp)))
  {
    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
    unsigned long h_sev = pGetShortExpVector(h);
    loop
    {
      if (j > k) break;
      clearS(h,h_sev, &j,&k,strat);
      j++;
    }
    //Print("end clearS sl=%d\n",strat->sl);
  }
 // PrintS("end enterpairs\n");
}

/*2
*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
*superfluous elements in S will be deleted
*this is a special variant of signature-based algorithms including the
*signatures for criteria checks
*/
void enterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat, int atR)
{
int j=pos;

#ifdef HAVE_RINGS
assume (!rField_is_Ring(currRing));
#endif

initenterpairsSig(h,hSig,hFrom,k,ecart,0,strat, atR);
if ( (!strat->fromT)
&& ((strat->syzComp==0)
  ||(pGetComp(h)<=strat->syzComp)))
{
  //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
  unsigned long h_sev = pGetShortExpVector(h);
  loop
  {
    if (j > k) break;
    clearS(h,h_sev, &j,&k,strat);
    j++;
  }
  //Print("end clearS sl=%d\n",strat->sl);
}
// PrintS("end enterpairs\n");
}

/*2
*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
*superfluous elements in S will be deleted
*/
void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
{
  int j;
  const int iCompH = pGetComp(h);

#ifdef HAVE_RINGS
  if (rField_is_Ring(currRing))
  {
    for (j=0; j<=k; j++)
    {
      const int iCompSj = pGetComp(strat->S[j]);
      if ((iCompH==iCompSj)
          //|| (0==iCompH) // can only happen,if iCompSj==0
          || (0==iCompSj))
      {
        enterOnePairRing(j,h,ecart,FALSE,strat, atR);
      }
    }
    kMergeBintoL(strat);
  }
  else
#endif
  for (j=0; j<=k; j++)
  {
    const int iCompSj = pGetComp(strat->S[j]);
    if ((iCompH==iCompSj)
        //|| (0==iCompH) // can only happen,if iCompSj==0
        || (0==iCompSj))
    {
      enterOnePairSpecial(j,h,ecart,strat, atR);
    }
  }

  if (strat->noClearS) return;

//   #ifdef HAVE_PLURAL
/*
  if (rIsPluralRing(currRing))
  {
    j=pos;
    loop
    {
      if (j > k) break;

      if (pLmDivisibleBy(h, strat->S[j]))
      {
        deleteInS(j, strat);
        j--;
        k--;
      }

      j++;
    }
  }
  else
*/
//   #endif // ??? Why was the following cancelation disabled for non-commutative rings?
  {
    j=pos;
    loop
    {
      unsigned long h_sev = pGetShortExpVector(h);
      if (j > k) break;
      clearS(h,h_sev,&j,&k,strat);
      j++;
    }
  }
}

/*2
*reorders  s with respect to posInS,
*suc is the first changed index or zero
*/

void reorderS (int* suc,kStrategy strat)
{
  int i,j,at,ecart, s2r;
  int fq=0;
  unsigned long sev;
  poly  p;
  int new_suc=strat->sl+1;
  i= *suc;
  if (i<0) i=0;

  for (; i<=strat->sl; i++)
  {
    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
    if (at != i)
    {
      if (new_suc > at) new_suc = at;
      p = strat->S[i];
      ecart = strat->ecartS[i];
      sev = strat->sevS[i];
      s2r = strat->S_2_R[i];
      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
      for (j=i; j>=at+1; j--)
      {
        strat->S[j] = strat->S[j-1];
        strat->ecartS[j] = strat->ecartS[j-1];
        strat->sevS[j] = strat->sevS[j-1];
        strat->S_2_R[j] = strat->S_2_R[j-1];
      }
      strat->S[at] = p;
      strat->ecartS[at] = ecart;
      strat->sevS[at] = sev;
      strat->S_2_R[at] = s2r;
      if (strat->fromQ!=NULL)
      {
        for (j=i; j>=at+1; j--)
        {
          strat->fromQ[j] = strat->fromQ[j-1];
        }
        strat->fromQ[at]=fq;
      }
    }
  }
  if (new_suc <= strat->sl) *suc=new_suc;
  else                      *suc=-1;
}


/*2
*looks up the position of p in set
*set[0] is the smallest with respect to the ordering-procedure deg/pComp
* Assumption: posInS only depends on the leading term
*             otherwise, bba has to be changed
*/
int posInS (const kStrategy strat, const int length,const poly p,
            const int ecart_p)
{
  if(length==-1) return 0;
  polyset set=strat->S;
  int i;
  int an = 0;
  int en = length;
  int cmp_int = currRing->OrdSgn;
  if ((currRing->MixedOrder)
#ifdef HAVE_PLURAL
  && (currRing->real_var_start==0)
#endif
#if 0
  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
#endif
  )
  {
    int o=p_Deg(p,currRing);
    int oo=p_Deg(set[length],currRing);

    if ((oo<o)
    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
      return length+1;

    loop
    {
      if (an >= en-1)
      {
        if ((p_Deg(set[an],currRing)>=o) && (pLmCmp(set[an],p) == cmp_int))
        {
          return an;
        }
        return en;
      }
      i=(an+en) / 2;
      if ((p_Deg(set[i],currRing)>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
      else                              an=i;
    }
  }
  else
  {
#ifdef HAVE_RINGS
    if (rField_is_Ring(currRing))
    {
      if (pLmCmp(set[length],p)== -cmp_int)
        return length+1;
      int cmp;
      loop
      {
        if (an >= en-1)
        {
          cmp = pLmCmp(set[an],p);
          if (cmp == cmp_int)  return an;
          if (cmp == -cmp_int) return en;
          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[an]), currRing->cf)) return en;
          return an;
        }
        i = (an+en) / 2;
        cmp = pLmCmp(set[i],p);
        if (cmp == cmp_int)         en = i;
        else if (cmp == -cmp_int)   an = i;
        else
        {
          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[i]), currRing->cf)) an = i;
          else en = i;
        }
      }
    }
    else
#endif
    if (pLmCmp(set[length],p)== -cmp_int)
      return length+1;

    loop
    {
      if (an >= en-1)
      {
        if (pLmCmp(set[an],p) == cmp_int) return an;
        if (pLmCmp(set[an],p) == -cmp_int) return en;
        if ((cmp_int!=1)
        && ((strat->ecartS[an])>ecart_p))
          return an;
        return en;
      }
      i=(an+en) / 2;
      if (pLmCmp(set[i],p) == cmp_int) en=i;
      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
      else
      {
        if ((cmp_int!=1)
        &&((strat->ecartS[i])<ecart_p))
          en=i;
        else
          an=i;
      }
    }
  }
}


/*2
* looks up the position of p in set
* the position is the last one
*/
int posInT0 (const TSet,const int length,LObject &)
{
  return (length+1);
}


/*2
* looks up the position of p in T
* set[0] is the smallest with respect to the ordering-procedure
* pComp
*/
int posInT1 (const TSet set,const int length,LObject &p)
{
  if (length==-1) return 0;

  if (pLmCmp(set[length].p,p.p)!= currRing->OrdSgn) return length+1;

  int i;
  int an = 0;
  int en= length;

  loop
  {
    if (an >= en-1)
    {
      if (pLmCmp(set[an].p,p.p) == currRing->OrdSgn) return an;
      return en;
    }
    i=(an+en) / 2;
    if (pLmCmp(set[i].p,p.p) == currRing->OrdSgn) en=i;
    else                                 an=i;
  }
}

/*2
* looks up the position of p in T
* set[0] is the smallest with respect to the ordering-procedure
* length
*/
int posInT2 (const TSet set,const int length,LObject &p)
{
  p.GetpLength();
  if (length==-1)
    return 0;
  if (set[length].length<p.length)
    return length+1;

  int i;
  int an = 0;
  int en= length;

  loop
  {
    if (an >= en-1)
    {
      if (set[an].length>p.length) return an;
      return en;
    }
    i=(an+en) / 2;
    if (set[i].length>p.length) en=i;
    else                        an=i;
  }
}

/*2
* looks up the position of p in T
* set[0] is the smallest with respect to the ordering-procedure
* totaldegree,pComp
*/
int posInT11 (const TSet set,const int length,LObject &p)
/*{
 * int j=0;
 * int o;
 *
 * o = p.GetpFDeg();
 * loop
 * {
 *   if ((pFDeg(set[j].p) > o)
 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
 *   {
 *     return j;
 *   }
 *   j++;
 *   if (j > length) return j;
 * }
 *}
 */
{
  if (length==-1) return 0;

  int o = p.GetpFDeg();
  int op = set[length].GetpFDeg();

  if ((op < o)
  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
    return length+1;

  int i;
  int an = 0;
  int en= length;

  loop
  {
    if (an >= en-1)
    {
      op= set[an].GetpFDeg();
      if ((op > o)
      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
        return an;
      return en;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg();
    if (( op > o)
    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
      en=i;
    else
      an=i;
  }
}

/*2 Pos for rings T: Here I am
* looks up the position of p in T
* set[0] is the smallest with respect to the ordering-procedure
* totaldegree,pComp
*/
int posInTrg0 (const TSet set,const int length,LObject &p)
{
  if (length==-1) return 0;
  int o = p.GetpFDeg();
  int op = set[length].GetpFDeg();
  int i;
  int an = 0;
  int en = length;
  int cmp_int = currRing->OrdSgn;
  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
    return length+1;
  int cmp;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg();
      if (op > o) return an;
      if (op < 0) return en;
      cmp = pLmCmp(set[an].p,p.p);
      if (cmp == cmp_int)  return an;
      if (cmp == -cmp_int) return en;
      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
      return an;
    }
    i = (an + en) / 2;
    op = set[i].GetpFDeg();
    if (op > o)       en = i;
    else if (op < o)  an = i;
    else
    {
      cmp = pLmCmp(set[i].p,p.p);
      if (cmp == cmp_int)                                     en = i;
      else if (cmp == -cmp_int)                               an = i;
      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
      else                                                    en = i;
    }
  }
}
/*
  int o = p.GetpFDeg();
  int op = set[length].GetpFDeg();

  if ((op < o)
  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
    return length+1;

  int i;
  int an = 0;
  int en= length;

  loop
  {
    if (an >= en-1)
    {
      op= set[an].GetpFDeg();
      if ((op > o)
      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
        return an;
      return en;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg();
    if (( op > o)
    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
      en=i;
    else
      an=i;
  }
}
  */
/*2
* looks up the position of p in T
* set[0] is the smallest with respect to the ordering-procedure
* totaldegree,pComp
*/
int posInT110 (const TSet set,const int length,LObject &p)
{
  p.GetpLength();
  if (length==-1) return 0;

  int o = p.GetpFDeg();
  int op = set[length].GetpFDeg();

  if (( op < o)
  || (( op == o) && (set[length].length<p.length))
  || (( op == o) && (set[length].length == p.length)
     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg();
      if (( op > o)
      || (( op == o) && (set[an].length > p.length))
      || (( op == o) && (set[an].length == p.length)
         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
        return an;
      return en;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg();
    if (( op > o)
    || (( op == o) && (set[i].length > p.length))
    || (( op == o) && (set[i].length == p.length)
       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
      en=i;
    else
      an=i;
  }
}

/*2
* looks up the position of p in set
* set[0] is the smallest with respect to the ordering-procedure
* pFDeg
*/
int posInT13 (const TSet set,const int length,LObject &p)
{
  if (length==-1) return 0;

  int o = p.GetpFDeg();

  if (set[length].GetpFDeg() <= o)
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if (set[an].GetpFDeg() > o)
        return an;
      return en;
    }
    i=(an+en) / 2;
    if (set[i].GetpFDeg() > o)
      en=i;
    else
      an=i;
  }
}

// determines the position based on: 1.) Ecart 2.) pLength
int posInT_EcartpLength(const TSet set,const int length,LObject &p)
{
  int ol = p.GetpLength();
  if (length==-1) return 0;

  int op=p.ecart;

  int oo=set[length].ecart;
  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
    {
      if (an >= en-1)
      {
        int oo=set[an].ecart;
        if((oo > op)
           || ((oo==op) && (set[an].pLength > ol)))
          return an;
        return en;
      }
      i=(an+en) / 2;
      int oo=set[i].ecart;
      if ((oo > op)
          || ((oo == op) && (set[i].pLength > ol)))
        en=i;
      else
        an=i;
    }
}

/*2
* looks up the position of p in set
* set[0] is the smallest with respect to the ordering-procedure
* maximaldegree, pComp
*/
int posInT15 (const TSet set,const int length,LObject &p)
/*{
 *int j=0;
 * int o;
 *
 * o = p.GetpFDeg()+p.ecart;
 * loop
 * {
 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
 *     && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
 *   {
 *     return j;
 *   }
 *   j++;
 *   if (j > length) return j;
 * }
 *}
 */
{
  if (length==-1) return 0;

  int o = p.GetpFDeg() + p.ecart;
  int op = set[length].GetpFDeg()+set[length].ecart;

  if ((op < o)
  || ((op == o)
     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg()+set[an].ecart;
      if (( op > o)
      || (( op  == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
        return an;
      return en;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg()+set[i].ecart;
    if (( op > o)
    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
      en=i;
    else
      an=i;
  }
}

/*2
* looks up the position of p in set
* set[0] is the smallest with respect to the ordering-procedure
* pFDeg+ecart, ecart, pComp
*/
int posInT17 (const TSet set,const int length,LObject &p)
/*
*{
* int j=0;
* int  o;
*
*  o = p.GetpFDeg()+p.ecart;
*  loop
*  {
*    if ((pFDeg(set[j].p)+set[j].ecart > o)
*    || (((pFDeg(set[j].p)+set[j].ecart == o)
*      && (set[j].ecart < p.ecart)))
*    || ((pFDeg(set[j].p)+set[j].ecart == o)
*      && (set[j].ecart==p.ecart)
*      && (pLmCmp(set[j].p,p.p)==currRing->OrdSgn)))
*      return j;
*    j++;
*    if (j > length) return j;
*  }
* }
*/
{
  if (length==-1) return 0;

  int o = p.GetpFDeg() + p.ecart;
  int op = set[length].GetpFDeg()+set[length].ecart;

  if ((op < o)
  || (( op == o) && (set[length].ecart > p.ecart))
  || (( op == o) && (set[length].ecart==p.ecart)
     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg()+set[an].ecart;
      if (( op > o)
      || (( op == o) && (set[an].ecart < p.ecart))
      || (( op  == o) && (set[an].ecart==p.ecart)
         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
        return an;
      return en;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg()+set[i].ecart;
    if ((op > o)
    || (( op == o) && (set[i].ecart < p.ecart))
    || (( op == o) && (set[i].ecart == p.ecart)
       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
      en=i;
    else
      an=i;
  }
}
/*2
* looks up the position of p in set
* set[0] is the smallest with respect to the ordering-procedure
* pGetComp, pFDeg+ecart, ecart, pComp
*/
int posInT17_c (const TSet set,const int length,LObject &p)
{
  if (length==-1) return 0;

  int cc = (-1+2*currRing->order[0]==ringorder_c);
  /* cc==1 for (c,..), cc==-1 for (C,..) */
  int o = p.GetpFDeg() + p.ecart;
  unsigned long c = pGetComp(p.p)*cc;

  if (pGetComp(set[length].p)*cc < c)
    return length+1;
  if (pGetComp(set[length].p)*cc == c)
  {
    int op = set[length].GetpFDeg()+set[length].ecart;
    if ((op < o)
    || ((op == o) && (set[length].ecart > p.ecart))
    || ((op == o) && (set[length].ecart==p.ecart)
       && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
      return length+1;
  }

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if (pGetComp(set[an].p)*cc < c)
        return en;
      if (pGetComp(set[an].p)*cc == c)
      {
        int op = set[an].GetpFDeg()+set[an].ecart;
        if ((op > o)
        || ((op == o) && (set[an].ecart < p.ecart))
        || ((op == o) && (set[an].ecart==p.ecart)
           && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
          return an;
      }
      return en;
    }
    i=(an+en) / 2;
    if (pGetComp(set[i].p)*cc > c)
      en=i;
    else if (pGetComp(set[i].p)*cc == c)
    {
      int op = set[i].GetpFDeg()+set[i].ecart;
      if ((op > o)
      || ((op == o) && (set[i].ecart < p.ecart))
      || ((op == o) && (set[i].ecart == p.ecart)
         && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
        en=i;
      else
        an=i;
    }
    else
      an=i;
  }
}

/*2
* looks up the position of p in set
* set[0] is the smallest with respect to
* ecart, pFDeg, length
*/
int posInT19 (const TSet set,const int length,LObject &p)
{
  p.GetpLength();
  if (length==-1) return 0;

  int o = p.ecart;
  int op=p.GetpFDeg();

  if (set[length].ecart < o)
    return length+1;
  if (set[length].ecart == o)
  {
     int oo=set[length].GetpFDeg();
     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
       return length+1;
  }

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if (set[an].ecart > o)
        return an;
      if (set[an].ecart == o)
      {
         int oo=set[an].GetpFDeg();
         if((oo > op)
         || ((oo==op) && (set[an].length > p.length)))
           return an;
      }
      return en;
    }
    i=(an+en) / 2;
    if (set[i].ecart > o)
      en=i;
    else if (set[i].ecart == o)
    {
       int oo=set[i].GetpFDeg();
       if ((oo > op)
       || ((oo == op) && (set[i].length > p.length)))
         en=i;
       else
        an=i;
    }
    else
      an=i;
  }
}

/*2
*looks up the position of polynomial p in set
*set[length] is the smallest element in set with respect
*to the ordering-procedure pComp
*/
int posInLSpecial (const LSet set, const int length,
                   LObject *p,const kStrategy)
{
  if (length<0) return 0;

  int d=p->GetpFDeg();
  int op=set[length].GetpFDeg();

  if ((op > d)
  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
  || (pLmCmp(set[length].p,p->p)== currRing->OrdSgn))
     return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op=set[an].GetpFDeg();
      if ((op > d)
      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
      || (pLmCmp(set[an].p,p->p)== currRing->OrdSgn))
         return en;
      return an;
    }
    i=(an+en) / 2;
    op=set[i].GetpFDeg();
    if ((op>d)
    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
    || (pLmCmp(set[i].p,p->p) == currRing->OrdSgn))
      an=i;
    else
      en=i;
  }
}

/*2
*looks up the position of polynomial p in set
*set[length] is the smallest element in set with respect
*to the ordering-procedure pComp
*/
int posInL0 (const LSet set, const int length,
             LObject* p,const kStrategy)
{
  if (length<0) return 0;

  if (pLmCmp(set[length].p,p->p)== currRing->OrdSgn)
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if (pLmCmp(set[an].p,p->p) == currRing->OrdSgn) return en;
      return an;
    }
    i=(an+en) / 2;
    if (pLmCmp(set[i].p,p->p) == currRing->OrdSgn) an=i;
    else                                 en=i;
    /*aend. fuer lazy == in !=- machen */
  }
}

/*2
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the signature order
*/
int posInLSig (const LSet set, const int length,
               LObject* p,const kStrategy /*strat*/)
{
if (length<0) return 0;
if (pLmCmp(set[length].sig,p->sig)== currRing->OrdSgn)
  return length+1;

int i;
int an = 0;
int en= length;
loop
{
  if (an >= en-1)
  {
    if (pLmCmp(set[an].sig,p->sig) == currRing->OrdSgn) return en;
    return an;
  }
  i=(an+en) / 2;
  if (pLmCmp(set[i].sig,p->sig) == currRing->OrdSgn) an=i;
  else                                      en=i;
  /*aend. fuer lazy == in !=- machen */
}
}

// for sba, sorting syzygies
int posInSyz (const kStrategy strat, poly sig)
{
if (strat->syzl==0) return 0;
if (pLmCmp(strat->syz[strat->syzl-1],sig) != currRing->OrdSgn)
  return strat->syzl;
int i;
int an = 0;
int en= strat->syzl-1;
loop
{
  if (an >= en-1)
  {
    if (pLmCmp(strat->syz[an],sig) != currRing->OrdSgn) return en;
    return an;
  }
  i=(an+en) / 2;
  if (pLmCmp(strat->syz[i],sig) != currRing->OrdSgn) an=i;
  else                                      en=i;
  /*aend. fuer lazy == in !=- machen */
}
}

/*2
*
* is only used in F5C, must ensure that the interreduction process does add new
* critical pairs to strat->L only behind all other critical pairs which are
* still in strat->L!
*/
int posInLF5C (const LSet /*set*/, const int /*length*/,
               LObject* /*p*/,const kStrategy strat)
{
  return strat->Ll+1;
}

/*2
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the ordering-procedure totaldegree,pComp
*/
int posInL11 (const LSet set, const int length,
              LObject* p,const kStrategy)
/*{
 * int j=0;
 * int o;
 *
 * o = p->GetpFDeg();
 * loop
 * {
 *   if (j > length)            return j;
 *   if ((set[j].GetpFDeg() < o)) return j;
 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
 *   {
 *     return j;
 *   }
 *   j++;
 * }
 *}
 */
{
  if (length<0) return 0;

  int o = p->GetpFDeg();
  int op = set[length].GetpFDeg();

  if ((op > o)
  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
    return length+1;
  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg();
      if ((op > o)
      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
        return en;
      return an;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg();
    if ((op > o)
    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
      an=i;
    else
      en=i;
  }
}

/*2 Position for rings L: Here I am
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the ordering-procedure totaldegree,pComp
*/
inline int getIndexRng(long coeff)
{
  if (coeff == 0) return -1;
  long tmp = coeff;
  int ind = 0;
  while (tmp % 2 == 0)
  {
    tmp = tmp / 2;
    ind++;
  }
  return ind;
}

int posInLrg0 (const LSet set, const int length,
              LObject* p,const kStrategy)
/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
        if (pLmCmp(set[i],p) == cmp_int)         en = i;
        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
        else
        {
          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
          else en = i;
        }*/
{
  if (length < 0) return 0;

  int o = p->GetpFDeg();
  int op = set[length].GetpFDeg();

  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
    return length + 1;
  int i;
  int an = 0;
  int en = length;
  loop
  {
    if (an >= en - 1)
    {
      op = set[an].GetpFDeg();
      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
        return en;
      return an;
    }
    i = (an+en) / 2;
    op = set[i].GetpFDeg();
    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
      an = i;
    else
      en = i;
  }
}

/*{
  if (length < 0) return 0;

  int o = p->GetpFDeg();
  int op = set[length].GetpFDeg();

  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
  int inda;
  int indi;

  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))))
    return length + 1;
  int i;
  int an = 0;
  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
  int en = length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg();
      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))))
        return en;
      return an;
    }
    i = (an + en) / 2;
    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
    op = set[i].GetpFDeg();
    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))))
    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
    {
      an = i;
      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
    }
    else
      en = i;
  }
} */

/*2
* looks up the position of polynomial p in set
* set[length] is the smallest element in set with respect
* to the ordering-procedure totaldegree,pLength0
*/
int posInL110 (const LSet set, const int length,
               LObject* p,const kStrategy)
{
  if (length<0) return 0;

  int o = p->GetpFDeg();
  int op = set[length].GetpFDeg();

  if ((op > o)
  || ((op == o) && (set[length].length >p->length))
  || ((op == o) && (set[length].length <= p->length)
     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
    return length+1;
  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg();
      if ((op > o)
      || ((op == o) && (set[an].length >p->length))
      || ((op == o) && (set[an].length <=p->length)
         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
        return en;
      return an;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg();
    if ((op > o)
    || ((op == o) && (set[i].length > p->length))
    || ((op == o) && (set[i].length <= p->length)
       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
      an=i;
    else
      en=i;
  }
}

/*2
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the ordering-procedure totaldegree
*/
int posInL13 (const LSet set, const int length,
              LObject* p,const kStrategy)
{
  if (length<0) return 0;

  int o = p->GetpFDeg();

  if (set[length].GetpFDeg() > o)
    return length+1;

  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if (set[an].GetpFDeg() >= o)
        return en;
      return an;
    }
    i=(an+en) / 2;
    if (set[i].GetpFDeg() >= o)
      an=i;
    else
      en=i;
  }
}

/*2
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the ordering-procedure maximaldegree,pComp
*/
int posInL15 (const LSet set, const int length,
              LObject* p,const kStrategy)
/*{
 * int j=0;
 * int o;
 *
 * o = p->ecart+p->GetpFDeg();
 * loop
 * {
 *   if (j > length)                       return j;
 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
 *   && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
 *   {
 *     return j;
 *   }
 *   j++;
 * }
 *}
 */
{
  if (length<0) return 0;

  int o = p->GetpFDeg() + p->ecart;
  int op = set[length].GetpFDeg() + set[length].ecart;

  if ((op > o)
  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
    return length+1;
  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      op = set[an].GetpFDeg() + set[an].ecart;
      if ((op > o)
      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
        return en;
      return an;
    }
    i=(an+en) / 2;
    op = set[i].GetpFDeg() + set[i].ecart;
    if ((op > o)
    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
      an=i;
    else
      en=i;
  }
}

/*2
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the ordering-procedure totaldegree
*/
int posInL17 (const LSet set, const int length,
              LObject* p,const kStrategy)
{
  if (length<0) return 0;

  int o = p->GetpFDeg() + p->ecart;

  if ((set[length].GetpFDeg() + set[length].ecart > o)
  || ((set[length].GetpFDeg() + set[length].ecart == o)
     && (set[length].ecart > p->ecart))
  || ((set[length].GetpFDeg() + set[length].ecart == o)
     && (set[length].ecart == p->ecart)
     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
    return length+1;
  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if ((set[an].GetpFDeg() + set[an].ecart > o)
      || ((set[an].GetpFDeg() + set[an].ecart == o)
         && (set[an].ecart > p->ecart))
      || ((set[an].GetpFDeg() + set[an].ecart == o)
         && (set[an].ecart == p->ecart)
         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
        return en;
      return an;
    }
    i=(an+en) / 2;
    if ((set[i].GetpFDeg() + set[i].ecart > o)
    || ((set[i].GetpFDeg() + set[i].ecart == o)
       && (set[i].ecart > p->ecart))
    || ((set[i].GetpFDeg() +set[i].ecart == o)
       && (set[i].ecart == p->ecart)
       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
      an=i;
    else
      en=i;
  }
}
/*2
* looks up the position of polynomial p in set
* e is the ecart of p
* set[length] is the smallest element in set with respect
* to the ordering-procedure pComp
*/
int posInL17_c (const LSet set, const int length,
                LObject* p,const kStrategy)
{
  if (length<0) return 0;

  int cc = (-1+2*currRing->order[0]==ringorder_c);
  /* cc==1 for (c,..), cc==-1 for (C,..) */
  unsigned long c = pGetComp(p->p)*cc;
  int o = p->GetpFDeg() + p->ecart;

  if (pGetComp(set[length].p)*cc > c)
    return length+1;
  if (pGetComp(set[length].p)*cc == c)
  {
    if ((set[length].GetpFDeg() + set[length].ecart > o)
    || ((set[length].GetpFDeg() + set[length].ecart == o)
       && (set[length].ecart > p->ecart))
    || ((set[length].GetpFDeg() + set[length].ecart == o)
       && (set[length].ecart == p->ecart)
       && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
      return length+1;
  }
  int i;
  int an = 0;
  int en= length;
  loop
  {
    if (an >= en-1)
    {
      if (pGetComp(set[an].p)*cc > c)
        return en;
      if (pGetComp(set[an].p)*cc == c)
      {
        if ((set[an].GetpFDeg() + set[an].ecart > o)
        || ((set[an].GetpFDeg() + set[an].ecart == o)
           && (set[an].ecart > p->ecart))
        || ((set[an].GetpFDeg() + set[an].ecart == o)
           && (set[an].ecart == p->ecart)
           && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
          return en;
      }
      return an;
    }
    i=(an+en) / 2;
    if (pGetComp(set[i].p)*cc > c)
      an=i;
    else if (pGetComp(set[i].p)*cc == c)
    {
      if ((set[i].GetpFDeg() + set[i].ecart > o)
      || ((set[i].GetpFDeg() + set[i].ecart == o)
         && (set[i].ecart > p->ecart))
      || ((set[i].GetpFDeg() +set[i].ecart == o)
         && (set[i].ecart == p->ecart)
         && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
        an=i;
      else
        en=i;
    }
    else
      en=i;
  }
}

/*
 * SYZYGY CRITERION for signature-based standard basis algorithms
 */
BOOLEAN syzCriterion(poly sig, unsigned long not_sevSig, kStrategy strat)
{
//#if 1
#ifdef DEBUGF5
  Print("syzygy criterion checks:  ");
  pWrite(sig);
#endif
  for (int k=0; k<strat->syzl; k++)
  {
    //printf("-%d",k);
//#if 1
#ifdef DEBUGF5
    Print("checking with: %d / %d --  \n",k,strat->syzl);
    pWrite(pHead(strat->syz[k]));
#endif
    if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
    {
//#if 1
#ifdef DEBUGF5
      PrintS("DELETE!\n");
#endif
      //printf("- T -\n\n");
      return TRUE;
    }
  }
  //printf("- F -\n\n");
  return FALSE;
}

/*
 * SYZYGY CRITERION for signature-based standard basis algorithms
 */
BOOLEAN syzCriterionInc(poly sig, unsigned long not_sevSig, kStrategy strat)
{
//#if 1
#ifdef DEBUGF5
  Print("--- syzygy criterion checks:  ");
  pWrite(sig);
#endif
  int comp = p_GetComp(sig, currRing);
  int min, max;
  if (comp<=1)
    return FALSE;
  else
  {
    min = strat->syzIdx[comp-2];
    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-2],comp-2);
    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-1],comp-1);
    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp],comp);
    if (comp == strat->currIdx)
    {
      max = strat->syzl;
    }
    else
    {
      max = strat->syzIdx[comp-1];
    }
    for (int k=min; k<max; k++)
    {
#ifdef F5DEBUG
      Print("COMP %d/%d - MIN %d - MAX %d - SYZL %ld\n",comp,strat->currIdx,min,max,strat->syzl);
      Print("checking with: %d --  ",k);
      pWrite(pHead(strat->syz[k]));
#endif
      if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
        return TRUE;
    }
    return FALSE;
  }
}

/*
 * REWRITTEN CRITERION for signature-based standard basis algorithms
 */
BOOLEAN faugereRewCriterion(poly sig, unsigned long not_sevSig, poly /*lm*/, kStrategy strat, int start=0)
{
  //printf("Faugere Rewritten Criterion\n");
//#if 1
#ifdef DEBUGF5
  PrintS("rewritten criterion checks:  ");
  pWrite(sig);
#endif
  for(int k = strat->sl; k>=start; k--)
  {
//#if 1
#ifdef DEBUGF5
    Print("checking with:  ");
    pWrite(strat->sig[k]);
    pWrite(pHead(strat->S[k]));
#endif
    if (p_LmShortDivisibleBy(strat->sig[k], strat->sevSig[k], sig, not_sevSig, currRing))
    {
//#if 1
#ifdef DEBUGF5
      PrintS("DELETE!\n");
#endif
      return TRUE;
    }
    //k--;
  }
#ifdef DEBUGF5
  Print("ALL ELEMENTS OF S\n----------------------------------------\n");
  for(int kk = 0; kk<strat->sl+1; kk++)
  {
    pWrite(pHead(strat->S[kk]));
  }
  Print("------------------------------\n");
#endif
  return FALSE;
}

/*
 * REWRITTEN CRITERION for signature-based standard basis algorithms
 ***************************************************************************
 * TODO:This should become the version of Arri/Perry resp. Bjarke/Stillman *
 ***************************************************************************
 */

// real implementation of arri's rewritten criterion, only called once in
// kstd2.cc, right before starting reduction
// IDEA:  Arri says that it is enough to consider 1 polynomial for each unique
//        signature appearing during the computations. Thus we first of all go
//        through strat->L and delete all other pairs of the same signature,
//        keeping only the one with least possible leading monomial. After this
//        we check if we really need to compute this critical pair at all: There
//        can be elements already in strat->S whose signatures divide the
//        signature of the critical pair in question and whose multiplied
//        leading monomials are smaller than the leading monomial of the
//        critical pair. In this situation we can discard the critical pair
//        completely.
BOOLEAN arriRewCriterion(poly /*sig*/, unsigned long /*not_sevSig*/, poly /*lm*/, kStrategy strat, int start=0)
{
  poly p1 = pOne();
  poly p2 = pOne();
  for (int ii=strat->sl; ii>start; ii--)
  {
    if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], strat->P.sig, ~strat->P.sevSig, currRing))
    {
      p_ExpVectorSum(p1,strat->P.sig,strat->S[ii],currRing);
      p_ExpVectorSum(p2,strat->sig[ii],strat->P.p,currRing);
      if (!(pLmCmp(p1,p2) == 1))
      {
        pDelete(&p1);
        pDelete(&p2);
        return TRUE;
      }
    }
  }
  pDelete(&p1);
  pDelete(&p2);
  return FALSE;
}

BOOLEAN arriRewCriterionPre(poly sig, unsigned long not_sevSig, poly lm, kStrategy strat, int /*start=0*/)
{
  int found = -1;
  for (int i=strat->Bl; i>-1; i--) {
    if (pLmEqual(strat->B[i].sig,sig)) {
      found = i;
      break;
    }
  }
  if (found != -1) {
    if (pLmCmp(lm,strat->B[found].GetLmCurrRing()) == -1) {
      deleteInL(strat->B,&strat->Bl,found,strat);
    } else {
      return TRUE;
    }
  }
  poly p1 = pOne();
  poly p2 = pOne();
  for (int ii=strat->sl; ii>-1; ii--)
  {
    if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], sig, not_sevSig, currRing))
    {
      p_ExpVectorSum(p1,sig,strat->S[ii],currRing);
      p_ExpVectorSum(p2,strat->sig[ii],lm,currRing);
      if (!(pLmCmp(p1,p2) == 1))
      {
        pDelete(&p1);
        pDelete(&p2);
        return TRUE;
      }
    }
  }
  pDelete(&p1);
  pDelete(&p2);
  return FALSE;
}

/***************************************************************
 *
 * Tail reductions
 *
 ***************************************************************/
TObject*
kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
                    long ecart)
{
  int j = 0;
  const unsigned long not_sev = ~L->sev;
  const unsigned long* sev = strat->sevS;
  poly p;
  ring r;
  L->GetLm(p, r);

  assume(~not_sev == p_GetShortExpVector(p, r));

  if (r == currRing)
  {
    loop
    {
      if (j > pos) return NULL;
#if defined(PDEBUG) || defined(PDIV_DEBUG)
      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
        break;
#else
      if (!(sev[j] & not_sev) &&
          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
          p_LmDivisibleBy(strat->S[j], p, r))
        break;

#endif
      j++;
    }
    // if called from NF, T objects do not exist:
    if (strat->tl < 0 || strat->S_2_R[j] == -1)
    {
      T->Set(strat->S[j], r, strat->tailRing);
      return T;
    }
    else
    {
/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
      return strat->S_2_T(j);
    }
  }
  else
  {
    TObject* t;
    loop
    {
      if (j > pos) return NULL;
      assume(strat->S_2_R[j] != -1);
#if defined(PDEBUG) || defined(PDIV_DEBUG)
      t = strat->S_2_T(j);
      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
        return t;
#else
      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
      {
        t = strat->S_2_T(j);
        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
      }
#endif
      j++;
    }
  }
}

poly redtail (LObject* L, int pos, kStrategy strat)
{
  poly h, hn;
  strat->redTailChange=FALSE;

  poly p = L->p;
  if (strat->noTailReduction || pNext(p) == NULL)
    return p;

  LObject Ln(strat->tailRing);
  TObject* With;
  // placeholder in case strat->tl < 0
  TObject  With_s(strat->tailRing);
  h = p;
  hn = pNext(h);
  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
  long e;
  int l;
  BOOLEAN save_HE=strat->kHEdgeFound;
  strat->kHEdgeFound |=
    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;

  while(hn != NULL)
  {
    op = strat->tailRing->pFDeg(hn, strat->tailRing);
    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
    loop
    {
      Ln.Set(hn, strat->tailRing);
      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
      if (strat->kHEdgeFound)
        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
      else
        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
      if (With == NULL) break;
      With->length=0;
      With->pLength=0;
      strat->redTailChange=TRUE;
      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
      {
        // reducing the tail would violate the exp bound
        if (kStratChangeTailRing(strat, L))
        {
          strat->kHEdgeFound = save_HE;
          return redtail(L, pos, strat);
        }
        else
          return NULL;
      }
      hn = pNext(h);
      if (hn == NULL) goto all_done;
      op = strat->tailRing->pFDeg(hn, strat->tailRing);
      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
    }
    h = hn;
    hn = pNext(h);
  }

  all_done:
  if (strat->redTailChange)
  {
    L->pLength = 0;
  }
  strat->kHEdgeFound = save_HE;
  return p;
}

poly redtail (poly p, int pos, kStrategy strat)
{
  LObject L(p, currRing);
  return redtail(&L, pos, strat);
}

poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
{
#define REDTAIL_CANONICALIZE 100
  strat->redTailChange=FALSE;
  if (strat->noTailReduction) return L->GetLmCurrRing();
  poly h, p;
  p = h = L->GetLmTailRing();
  if ((h==NULL) || (pNext(h)==NULL))
    return L->GetLmCurrRing();

  TObject* With;
  // placeholder in case strat->tl < 0
  TObject  With_s(strat->tailRing);

  LObject Ln(pNext(h), strat->tailRing);
  Ln.pLength = L->GetpLength() - 1;

  pNext(h) = NULL;
  if (L->p != NULL) pNext(L->p) = NULL;
  L->pLength = 1;

  Ln.PrepareRed(strat->use_buckets);

  int cnt=REDTAIL_CANONICALIZE;
  while(!Ln.IsNull())
  {
    loop
    {
      Ln.SetShortExpVector();
      if (withT)
      {
        int j;
        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
        if (j < 0) break;
        With = &(strat->T[j]);
      }
      else
      {
        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
        if (With == NULL) break;
      }
      cnt--;
      if (cnt==0)
      {
        cnt=REDTAIL_CANONICALIZE;
        /*poly tmp=*/Ln.CanonicalizeP();
        if (normalize)
        {
          Ln.Normalize();
          //pNormalize(tmp);
          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
        }
      }
      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
      {
        With->pNorm();
      }
      strat->redTailChange=TRUE;
      if (ksReducePolyTail(L, With, &Ln))
      {
        // reducing the tail would violate the exp bound
        //  set a flag and hope for a retry (in bba)
        strat->completeReduce_retry=TRUE;
        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
        do
        {
          pNext(h) = Ln.LmExtractAndIter();
          pIter(h);
          L->pLength++;
        } while (!Ln.IsNull());
        goto all_done;
      }
      if (Ln.IsNull()) goto all_done;
      if (! withT) With_s.Init(currRing);
    }
    pNext(h) = Ln.LmExtractAndIter();
    pIter(h);
    pNormalize(h);
    L->pLength++;
  }

  all_done:
  Ln.Delete();
  if (L->p != NULL) pNext(L->p) = pNext(p);

  if (strat->redTailChange)
  {
    L->length = 0;
    L->pLength = 0;
  }

  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
  //L->Normalize(); // HANNES: should have a test
  kTest_L(L);
  return L->GetLmCurrRing();
}

#ifdef HAVE_RINGS
poly redtailBba_Z (LObject* L, int pos, kStrategy strat )
// normalize=FALSE, withT=FALSE, coeff=Z
{
  strat->redTailChange=FALSE;
  if (strat->noTailReduction) return L->GetLmCurrRing();
  poly h, p;
  p = h = L->GetLmTailRing();
  if ((h==NULL) || (pNext(h)==NULL))
    return L->GetLmCurrRing();

  TObject* With;
  // placeholder in case strat->tl < 0
  TObject  With_s(strat->tailRing);

  LObject Ln(pNext(h), strat->tailRing);
  Ln.pLength = L->GetpLength() - 1;

  pNext(h) = NULL;
  if (L->p != NULL) pNext(L->p) = NULL;
  L->pLength = 1;

  Ln.PrepareRed(strat->use_buckets);

  int cnt=REDTAIL_CANONICALIZE;
  while(!Ln.IsNull())
  {
    loop
    {
      Ln.SetShortExpVector();
      With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
      if (With == NULL) break;
      cnt--;
      if (cnt==0)
      {
        cnt=REDTAIL_CANONICALIZE;
        /*poly tmp=*/Ln.CanonicalizeP();
      }
      // we are in Z, do not call pNorm
      strat->redTailChange=TRUE;
      // test divisibility of coefs:
      poly p_Ln=Ln.GetLmCurrRing();
      poly p_With=With->GetLmCurrRing();
      number z=n_IntMod(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf);
      if (!nIsZero(z))
      {
        // subtract z*Ln, add z.Ln to L
        poly m=pHead(p_Ln);
        pSetCoeff(m,z);
        poly mm=pHead(m);
        pNext(h) = m;
        pIter(h);
        L->pLength++;
        mm=pNeg(mm);
        if (Ln.bucket!=NULL)
        {
          int dummy=1;
          kBucket_Add_q(Ln.bucket,mm,&dummy);
        }
        else
        {
          if ((Ln.t_p!=NULL)&&(Ln.p==NULL))
            Ln.GetP();
          if (Ln.p!=NULL)
          {
            Ln.p=pAdd(Ln.p,mm);
            if (Ln.t_p!=NULL)
            {
              pNext(Ln.t_p)=NULL;
              p_LmDelete(Ln.t_p,strat->tailRing);
            }
          }
        }
      }
      else
        nDelete(&z);

      if (ksReducePolyTail(L, With, &Ln))
      {
        // reducing the tail would violate the exp bound
        //  set a flag and hope for a retry (in bba)
        strat->completeReduce_retry=TRUE;
        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
        do
        {
          pNext(h) = Ln.LmExtractAndIter();
          pIter(h);
          L->pLength++;
        } while (!Ln.IsNull());
        goto all_done;
      }
      if (Ln.IsNull()) goto all_done;
      With_s.Init(currRing);
    }
    pNext(h) = Ln.LmExtractAndIter();
    pIter(h);
    pNormalize(h);
    L->pLength++;
  }

  all_done:
  Ln.Delete();
  if (L->p != NULL) pNext(L->p) = pNext(p);

  if (strat->redTailChange)
  {
    L->length = 0;
  }

  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
  //L->Normalize(); // HANNES: should have a test
  kTest_L(L);
  return L->GetLmCurrRing();
}
#endif

/*2
*checks the change degree and write progress report
*/
void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
{
  if (i != *olddeg)
  {
    Print("%d",i);
    *olddeg = i;
  }
  if (TEST_OPT_OLDSTD)
  {
    if (strat->Ll != *reduc)
    {
      if (strat->Ll != *reduc-1)
        Print("(%d)",strat->Ll+1);
      else
        PrintS("-");
      *reduc = strat->Ll;
    }
    else
      PrintS(".");
    mflush();
  }
  else
  {
    if (red_result == 0)
      PrintS("-");
    else if (red_result < 0)
      PrintS(".");
    if ((red_result > 0) || ((strat->Ll % 100)==99))
    {
      if (strat->Ll != *reduc && strat->Ll > 0)
      {
        Print("(%d)",strat->Ll+1);
        *reduc = strat->Ll;
      }
    }
  }
}

/*2
*statistics
*/
void messageStat (int hilbcount,kStrategy strat)
{
  //PrintS("\nUsage/Allocation of temporary storage:\n");
  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
  /* in usual case strat->cv is 0, it gets changed only in shift routines */
  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
  /*mflush();*/
}

#ifdef KDEBUG
/*2
*debugging output: all internal sets, if changed
*for testing purpuse only/has to be changed for later use
*/
void messageSets (kStrategy strat)
{
  int i;
  if (strat->news)
  {
    PrintS("set S");
    for (i=0; i<=strat->sl; i++)
    {
      Print("\n  %d:",i);
      p_wrp(strat->S[i], currRing, strat->tailRing);
    }
    strat->news = FALSE;
  }
  if (strat->newt)
  {
    PrintS("\nset T");
    for (i=0; i<=strat->tl; i++)
    {
      Print("\n  %d:",i);
      strat->T[i].wrp();
      Print(" o:%ld e:%d l:%d",
        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
    }
    strat->newt = FALSE;
  }
  PrintS("\nset L");
  for (i=strat->Ll; i>=0; i--)
  {
    Print("\n%d:",i);
    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
    PrintS("  ");
    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
    PrintS("\n  p : ");
    strat->L[i].wrp();
    Print("  o:%ld e:%d l:%d",
          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
  }
  PrintLn();
}

#endif


/*2
*construct the set s from F
*/
void initS (ideal F, ideal Q, kStrategy strat)
{
  int   i,pos;

  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
  strat->ecartS=initec(i);
  strat->sevS=initsevS(i);
  strat->S_2_R=initS_2_R(i);
  strat->fromQ=NULL;
  strat->Shdl=idInit(i,F->rank);
  strat->S=strat->Shdl->m;
  /*- put polys into S -*/
  if (Q!=NULL)
  {
    strat->fromQ=initec(i);
    memset(strat->fromQ,0,i*sizeof(int));
    for (i=0; i<IDELEMS(Q); i++)
    {
      if (Q->m[i]!=NULL)
      {
        LObject h;
        h.p = pCopy(Q->m[i]);
        if (TEST_OPT_INTSTRATEGY)
        {
          //pContent(h.p);
          h.pCleardenom(); // also does a pContent
        }
        else
        {
          h.pNorm();
        }
        if (rHasLocalOrMixedOrdering(currRing))
        {
          deleteHC(&h, strat);
        }
        if (h.p!=NULL)
        {
          strat->initEcart(&h);
          if (strat->sl==-1)
            pos =0;
          else
          {
            pos = posInS(strat,strat->sl,h.p,h.ecart);
          }
          h.sev = pGetShortExpVector(h.p);
          strat->enterS(h,pos,strat,-1);
          strat->fromQ[pos]=1;
        }
      }
    }
  }
  for (i=0; i<IDELEMS(F); i++)
  {
    if (F->m[i]!=NULL)
    {
      LObject h;
      h.p = pCopy(F->m[i]);
      if (rHasLocalOrMixedOrdering(currRing))
      {
                    /*#ifdef HAVE_RINGS
                          if (rField_is_Ring(currRing))
                            {
                            h.pCleardenom();
                            }
                          else
                                #endif*/
        cancelunit(&h);  /*- tries to cancel a unit -*/
        deleteHC(&h, strat);
      }
      if (h.p!=NULL)
      // do not rely on the input being a SB!
      {
        if (TEST_OPT_INTSTRATEGY)
        {
          //pContent(h.p);
          h.pCleardenom(); // also does a pContent
        }
        else
        {
          h.pNorm();
        }
        strat->initEcart(&h);
        if (strat->sl==-1)
          pos =0;
        else
          pos = posInS(strat,strat->sl,h.p,h.ecart);
        h.sev = pGetShortExpVector(h.p);
        strat->enterS(h,pos,strat,-1);
      }
    }
  }
  /*- test, if a unit is in F -*/
  if ((strat->sl>=0)
#ifdef HAVE_RINGS
       && n_IsUnit(pGetCoeff(strat->S[0]),currRing->cf)
#endif
       && pIsConstant(strat->S[0]))
  {
    while (strat->sl>0) deleteInS(strat->sl,strat);
  }
}

void initSL (ideal F, ideal Q,kStrategy strat)
{
  int   i,pos;

  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
  else i=setmaxT;
  strat->ecartS=initec(i);
  strat->sevS=initsevS(i);
  strat->S_2_R=initS_2_R(i);
  strat->fromQ=NULL;
  strat->Shdl=idInit(i,F->rank);
  strat->S=strat->Shdl->m;
  /*- put polys into S -*/
  if (Q!=NULL)
  {
    strat->fromQ=initec(i);
    memset(strat->fromQ,0,i*sizeof(int));
    for (i=0; i<IDELEMS(Q); i++)
    {
      if (Q->m[i]!=NULL)
      {
        LObject h;
        h.p = pCopy(Q->m[i]);
        if (rHasLocalOrMixedOrdering(currRing))
        {
          deleteHC(&h,strat);
        }
        if (TEST_OPT_INTSTRATEGY)
        {
          //pContent(h.p);
          h.pCleardenom(); // also does a pContent
        }
        else
        {
          h.pNorm();
        }
        if (h.p!=NULL)
        {
          strat->initEcart(&h);
          if (strat->sl==-1)
            pos =0;
          else
          {
            pos = posInS(strat,strat->sl,h.p,h.ecart);
          }
          h.sev = pGetShortExpVector(h.p);
          strat->enterS(h,pos,strat,-1);
          strat->fromQ[pos]=1;
        }
      }
    }
  }
  for (i=0; i<IDELEMS(F); i++)
  {
    if (F->m[i]!=NULL)
    {
      LObject h;
      h.p = pCopy(F->m[i]);
      if (h.p!=NULL)
      {
        if (rHasLocalOrMixedOrdering(currRing))
        {
          cancelunit(&h);  /*- tries to cancel a unit -*/
          deleteHC(&h, strat);
        }
        if (h.p!=NULL)
        {
          if (TEST_OPT_INTSTRATEGY)
          {
            //pContent(h.p);
            h.pCleardenom(); // also does a pContent
          }
          else
          {
            h.pNorm();
          }
          strat->initEcart(&h);
          if (strat->Ll==-1)
            pos =0;
          else
            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
          h.sev = pGetShortExpVector(h.p);
          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
        }
      }
    }
  }
  /*- test, if a unit is in F -*/

  if ((strat->Ll>=0)
#ifdef HAVE_RINGS
       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
#endif
       && pIsConstant(strat->L[strat->Ll].p))
  {
    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
  }
}

void initSLSba (ideal F, ideal Q,kStrategy strat)
{
  int   i,pos;
  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
  else i=setmaxT;
  strat->ecartS =   initec(i);
  strat->sevS   =   initsevS(i);
  strat->sevSig =   initsevS(i);
  strat->S_2_R  =   initS_2_R(i);
  strat->fromQ  =   NULL;
  strat->Shdl   =   idInit(i,F->rank);
  strat->S      =   strat->Shdl->m;
  strat->sig    =   (poly *)omAlloc0(i*sizeof(poly));
  if (strat->sbaOrder != 1)
  {
    strat->syz    = (poly *)omAlloc0(i*sizeof(poly));
    strat->sevSyz = initsevS(i);
    strat->syzmax = i;
    strat->syzl   = 0;
  }
  /*- put polys into S -*/
  if (Q!=NULL)
  {
    strat->fromQ=initec(i);
    memset(strat->fromQ,0,i*sizeof(int));
    for (i=0; i<IDELEMS(Q); i++)
    {
      if (Q->m[i]!=NULL)
      {
        LObject h;
        h.p = pCopy(Q->m[i]);
        if (rHasLocalOrMixedOrdering(currRing))
        {
          deleteHC(&h,strat);
        }
        if (TEST_OPT_INTSTRATEGY)
        {
          //pContent(h.p);
          h.pCleardenom(); // also does a pContent
        }
        else
        {
          h.pNorm();
        }
        if (h.p!=NULL)
        {
          strat->initEcart(&h);
          if (strat->sl==-1)
            pos =0;
          else
          {
            pos = posInS(strat,strat->sl,h.p,h.ecart);
          }
          h.sev = pGetShortExpVector(h.p);
          strat->enterS(h,pos,strat,-1);
          strat->fromQ[pos]=1;
        }
      }
    }
  }
  for (i=0; i<IDELEMS(F); i++)
  {
    if (F->m[i]!=NULL)
    {
      LObject h;
      h.p = pCopy(F->m[i]);
      h.sig = pOne();
      //h.sig = pInit();
      //p_SetCoeff(h.sig,nInit(1),currRing);
      p_SetComp(h.sig,i+1,currRing);
      // if we are working with the Schreyer order we generate it
      // by multiplying the initial signatures with the leading monomial
      // of the corresponding initial polynomials generating the ideal
      // => we can keep the underlying monomial order and get a Schreyer
      //    order without any bigger overhead
      if (strat->sbaOrder == 0 || strat->sbaOrder == 3)
      {
        p_ExpVectorAdd (h.sig,F->m[i],currRing);
      }
      h.sevSig = pGetShortExpVector(h.sig);
#ifdef DEBUGF5
      pWrite(h.p);
      pWrite(h.sig);
#endif
      if (h.p!=NULL)
      {
        if (rHasLocalOrMixedOrdering(currRing))
        {
          cancelunit(&h);  /*- tries to cancel a unit -*/
          deleteHC(&h, strat);
        }
        if (h.p!=NULL)
        {
          if (TEST_OPT_INTSTRATEGY)
          {
            //pContent(h.p);
            h.pCleardenom(); // also does a pContent
          }
          else
          {
            h.pNorm();
          }
          strat->initEcart(&h);
          if (strat->Ll==-1)
            pos =0;
          else
            pos = strat->posInLSba(strat->L,strat->Ll,&h,strat);
          h.sev = pGetShortExpVector(h.p);
          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
        }
      }
      /*
      if (strat->sbaOrder != 1)
      {
        for(j=0;j<i;j++)
        {
          strat->syz[ctr] = pCopy(F->m[j]);
          p_SetCompP(strat->syz[ctr],i+1,currRing);
          // add LM(F->m[i]) to the signature to get a Schreyer order
          // without changing the underlying polynomial ring at all
          p_ExpVectorAdd (strat->syz[ctr],F->m[i],currRing);
          // since p_Add_q() destroys all input
          // data we need to recreate help
          // each time
          poly help = pCopy(F->m[i]);
          p_SetCompP(help,j+1,currRing);
          pWrite(strat->syz[ctr]);
          pWrite(help);
          printf("%d\n",pLmCmp(strat->syz[ctr],help));
          strat->syz[ctr] = p_Add_q(strat->syz[ctr],help,currRing);
          printf("%d. SYZ  ",ctr);
          pWrite(strat->syz[ctr]);
          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
          ctr++;
        }
        strat->syzl = ps;
      }
      */
    }
  }
  /*- test, if a unit is in F -*/

  if ((strat->Ll>=0)
#ifdef HAVE_RINGS
       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
#endif
       && pIsConstant(strat->L[strat->Ll].p))
  {
    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
  }
}

void initSyzRules (kStrategy strat)